diff options
author | Tristan Gingold <tgingold@free.fr> | 2018-08-08 07:23:51 +0200 |
---|---|---|
committer | Tristan Gingold <tgingold@free.fr> | 2018-08-10 09:47:28 +0200 |
commit | cc783ab03cf4b2f52fe68c29053dd4dfee9c5e5f (patch) | |
tree | 6fced3e0d1338c78413db14acefa99ba17c0b2c7 | |
parent | 258bbf955b78fd9838c23b1d3e36c8ce6f90f6cc (diff) | |
download | ghdl-cc783ab03cf4b2f52fe68c29053dd4dfee9c5e5f.tar.gz ghdl-cc783ab03cf4b2f52fe68c29053dd4dfee9c5e5f.tar.bz2 ghdl-cc783ab03cf4b2f52fe68c29053dd4dfee9c5e5f.zip |
Add support for --time-resolution (jit only). Fix #613
-rw-r--r-- | src/flags.adb | 13 | ||||
-rw-r--r-- | src/flags.ads | 12 | ||||
-rw-r--r-- | src/ghdldrv/ghdlcomp.adb | 30 | ||||
-rw-r--r-- | src/ghdldrv/ghdlcomp.ads | 12 | ||||
-rw-r--r-- | src/ghdldrv/ghdldrv.adb | 5 | ||||
-rw-r--r-- | src/ghdldrv/ghdlrun.adb | 68 | ||||
-rw-r--r-- | src/grt/grt-main.adb | 6 | ||||
-rw-r--r-- | src/grt/grt-options.adb | 157 | ||||
-rw-r--r-- | src/grt/grt-options.ads | 4 | ||||
-rw-r--r-- | src/options.adb | 25 | ||||
-rw-r--r-- | src/vhdl/iirs.ads | 7 | ||||
-rw-r--r-- | src/vhdl/nodes_meta.adb | 368 | ||||
-rw-r--r-- | src/vhdl/sem_expr.adb | 45 | ||||
-rw-r--r-- | src/vhdl/simulate/simul-execution.adb | 4 | ||||
-rw-r--r-- | src/vhdl/std_package.adb | 130 | ||||
-rw-r--r-- | src/vhdl/std_package.ads | 8 | ||||
-rw-r--r-- | src/vhdl/translate/ortho_front.adb | 16 | ||||
-rw-r--r-- | src/vhdl/translate/trans-chap12.adb | 8 | ||||
-rw-r--r-- | src/vhdl/translate/trans-chap12.ads | 6 | ||||
-rw-r--r-- | src/vhdl/translate/translation.adb | 3 | ||||
-rw-r--r-- | src/vhdl/translate/translation.ads | 7 |
21 files changed, 456 insertions, 478 deletions
diff --git a/src/flags.adb b/src/flags.adb index 4bd150124..de536815b 100644 --- a/src/flags.adb +++ b/src/flags.adb @@ -41,16 +41,7 @@ package body Flags is Flag_String (4) := 't'; end if; - if Flag_Time_64 then - -- Time_Resolution is always fs. - Flag_String (5) := '-'; - elsif Vhdl_Std = Vhdl_87 then - -- Time_Resolution is fixed in vhdl87, as time expressions are - -- locally static. - Flag_String (5) := Time_Resolution; - else - -- Time_Resolution can be changed at simulation time. - Flag_String (5) := '?'; - end if; + -- Time_Resolution is always fs. + Flag_String (5) := '-'; end Create_Flag_String; end Flags; diff --git a/src/flags.ads b/src/flags.ads index f9c0be2a1..3134c14de 100644 --- a/src/flags.ads +++ b/src/flags.ads @@ -122,18 +122,6 @@ package Flags is -- If set, performs VITAL checks. Flag_Vital_Checks : Boolean := True; - -- --time-resolution=X - -- Where X corresponds to: - -- fs => 'f' - -- ps => 'p' - -- ns => 'n' - -- us => 'u' - -- ms => 'm' - -- sec => 's' - -- min => 'M' - -- hr => 'h' - Time_Resolution: Character := 'f'; - -- Integer and time types can be either 32 bits or 64 bits values. -- The default is 32 bits for Integer and 64 bits for Time. -- Be very careful: if you don't use the default sizes, you may have to diff --git a/src/ghdldrv/ghdlcomp.adb b/src/ghdldrv/ghdlcomp.adb index e9a0338a9..df7f02cb1 100644 --- a/src/ghdldrv/ghdlcomp.adb +++ b/src/ghdldrv/ghdlcomp.adb @@ -49,6 +49,7 @@ package body Ghdlcomp is Arg : String; Res : out Option_Res) is + pragma Assert (Option'First = 1); begin if Option = "--expect-failure" then Flag_Expect_Failure := True; @@ -58,6 +59,31 @@ package body Ghdlcomp is Res := Option_Ok; elsif Hooks.Decode_Option.all (Option) then Res := Option_Ok; + elsif Option'Length > 18 + and then Option (1 .. 18) = "--time-resolution=" + then + Res := Option_Ok; + if Option (19 .. Option'Last) = "fs" then + Time_Resolution := 'f'; + elsif Option (19 .. Option'Last) = "ps" then + Time_Resolution := 'p'; + elsif Option (19 .. Option'Last) = "ns" then + Time_Resolution := 'n'; + elsif Option (19 .. Option'Last) = "us" then + Time_Resolution := 'u'; + elsif Option (19 .. Option'Last) = "ms" then + Time_Resolution := 'm'; + elsif Option (19 .. Option'Last) = "sec" then + Time_Resolution := 's'; + elsif Option (19 .. Option'Last) = "min" then + Time_Resolution := 'M'; + elsif Option (19 .. Option'Last) = "hr" then + Time_Resolution := 'h'; + elsif Option (19 .. Option'Last) = "auto" then + Time_Resolution := 'a'; + else + Res := Option_Bad; + end if; else Decode_Option (Command_Lib (Cmd), Option, Arg, Res); end if; @@ -71,6 +97,8 @@ package body Ghdlcomp is Disp_Long_Help (Command_Lib (Cmd)); Hooks.Disp_Long_Help.all; Put_Line (" --expect-failure Expect analysis/elaboration failure"); + Put_Line (" --time-resolution=UNIT Set the resolution of type time"); + Put_Line (" UNIT can be fs, ps, ns, us, ms, sec, min or hr"); end Disp_Long_Help; -- Command -r @@ -366,8 +394,6 @@ package body Ghdlcomp is raise Compilation_Error; end if; - Setup_Libraries (True); - Hooks.Compile_Init.all (True); -- Parse all files. diff --git a/src/ghdldrv/ghdlcomp.ads b/src/ghdldrv/ghdlcomp.ads index 487f70fc1..0e265a7c2 100644 --- a/src/ghdldrv/ghdlcomp.ads +++ b/src/ghdldrv/ghdlcomp.ads @@ -69,6 +69,18 @@ package Ghdlcomp is -- Output of --disp-config. procedure Disp_Config; + -- --time-resolution=X + -- Where X corresponds to: + -- fs => 'f' + -- ps => 'p' + -- ns => 'n' + -- us => 'u' + -- ms => 'm' + -- sec => 's' + -- min => 'M' + -- hr => 'h' + Time_Resolution: Character := 'f'; + -- Functionnal interface. -- Must be first initialized by Compile_Init procedure Compile_Analyze_Init (Load_Work : Boolean := True); diff --git a/src/ghdldrv/ghdldrv.adb b/src/ghdldrv/ghdldrv.adb index b68c46850..31d4a530b 100644 --- a/src/ghdldrv/ghdldrv.adb +++ b/src/ghdldrv/ghdldrv.adb @@ -677,6 +677,11 @@ package body Ghdldrv is Add_Argument (Compiler_Args, new String'(Opt)); end if; Res := Option_Ok; + elsif Opt'Length > 18 + and then Opt (1 .. 18) = "--time-resolution=" + then + Error ("option --time-resolution not supported by back-end"); + raise Option_Error; elsif Opt'Length >= 2 and then (Opt (2) = 'O' or Opt (2) = 'f') then diff --git a/src/ghdldrv/ghdlrun.adb b/src/ghdldrv/ghdlrun.adb index 76c683ab2..b2cff0411 100644 --- a/src/ghdldrv/ghdlrun.adb +++ b/src/ghdldrv/ghdlrun.adb @@ -15,26 +15,29 @@ -- along with GCC; see the file COPYING. If not, write to the Free -- Software Foundation, 59 Temple Place - Suite 330, Boston, MA -- 02111-1307, USA. +with System; use System; + +with Ada.Unchecked_Conversion; +with Ada.Command_Line; +with Ada.Text_IO; + +with Interfaces; with Interfaces.C; with Ghdlmain; use Ghdlmain; with Ghdllocal; use Ghdllocal; with GNAT.OS_Lib; use GNAT.OS_Lib; -with Ada.Unchecked_Conversion; -with Ada.Command_Line; -with Ada.Text_IO; - with Ortho_Jit; with Ortho_Nodes; use Ortho_Nodes; -with Interfaces; -with System; use System; with Trans_Decls; with Iirs; use Iirs; +with Std_Package; with Flags; with Errorout; use Errorout; with Libraries; with Canon; +with Configuration; with Trans_Be; with Translation; with Ieee.Std_Logic_1164; @@ -61,7 +64,7 @@ with Grt.Std_Logic_1164; with Grt.Errors; with Grt.Backtraces.Jit; -with Ghdlcomp; +with Ghdlcomp; use Ghdlcomp; with Foreigns; with Grtlink; @@ -84,6 +87,18 @@ package body Ghdlrun is procedure Compile_Init (Analyze_Only : Boolean) is begin if Analyze_Only then + Setup_Libraries (True); + else + Setup_Libraries (False); + Libraries.Load_Std_Library; + -- WORK library is not loaded. FIXME: why ? + end if; + + if Time_Resolution /= 'a' then + Std_Package.Set_Time_Resolution (Time_Resolution); + end if; + + if Analyze_Only then return; end if; @@ -95,9 +110,6 @@ package body Ghdlrun is -- The design is always analyzed in whole. Flags.Flag_Whole_Analyze := True; - Setup_Libraries (False); - Libraries.Load_Std_Library; - Ortho_Jit.Init; Translation.Initialize; @@ -116,6 +128,7 @@ package body Ghdlrun is procedure Compile_Elab (Cmd_Name : String; Args : Argument_List; Opt_Arg : out Natural) is + Config : Iir; begin Extract_Elab_Unit (Cmd_Name, Args, Opt_Arg); if Sec_Name = null then @@ -123,11 +136,44 @@ package body Ghdlrun is end if; Flags.Flag_Elaborate := True; + + Config := Configuration.Configure (Prim_Name.all, Sec_Name.all); + if Config = Null_Iir then + raise Compilation_Error; + end if; + + if Time_Resolution = 'a' then + Time_Resolution := Std_Package.Get_Minimal_Time_Resolution; + if Time_Resolution = '?' then + Time_Resolution := 'f'; + end if; + if Flag_Verbose then + declare + use Ada.Text_IO; + begin + Put ("Time resolution is 1 "); + case Time_Resolution is + when 'f' => Put ("fs"); + when 'p' => Put ("ps"); + when 'n' => Put ("ns"); + when 'u' => Put ("us"); + when 'm' => Put ("ms"); + when 's' => Put ("sec"); + when 'M' => Put ("min"); + when 'h' => Put ("hr"); + when others => Put ("??"); + end case; + New_Line; + end; + end if; + end if; + Std_Package.Set_Time_Resolution (Time_Resolution); + case Elab_Mode is when Elab_Static => raise Program_Error; when Elab_Dynamic => - Translation.Elaborate (Prim_Name.all, Sec_Name.all, "", True); + Translation.Elaborate (Config, "", True); end case; if Errorout.Nbr_Errors > 0 then diff --git a/src/grt/grt-main.adb b/src/grt/grt-main.adb index d50f8d7db..8a0f307b9 100644 --- a/src/grt/grt-main.adb +++ b/src/grt/grt-main.adb @@ -112,12 +112,6 @@ package body Grt.Main is -- They may insert hooks. Grt.Modules.Register_Modules; - -- If the time resolution is to be set by the user, select a default - -- resolution. Options may override it. - if Flag_String (5) = '?' then - Set_Time_Resolution ('n'); - end if; - -- Decode options. Grt.Options.Decode (Stop); diff --git a/src/grt/grt-options.adb b/src/grt/grt-options.adb index 535c0b8a8..3362e5ac1 100644 --- a/src/grt/grt-options.adb +++ b/src/grt/grt-options.adb @@ -32,112 +32,6 @@ with Grt.Wave_Opt.File; package body Grt.Options is - Std_Standard_Time_Fs : Std_Time; - Std_Standard_Time_Ps : Std_Time; - Std_Standard_Time_Ns : Std_Time; - Std_Standard_Time_Us : Std_Time; - Std_Standard_Time_Ms : Std_Time; - Std_Standard_Time_Sec : Std_Time; - Std_Standard_Time_Min : Std_Time; - Std_Standard_Time_Hr : Std_Time; - pragma Export (C, Std_Standard_Time_Fs, "std__standard__time__BT__fs"); - pragma Weak_External (Std_Standard_Time_Fs); - pragma Export (C, Std_Standard_Time_Ps, "std__standard__time__BT__ps"); - pragma Weak_External (Std_Standard_Time_Ps); - pragma Export (C, Std_Standard_Time_Ns, "std__standard__time__BT__ns"); - pragma Weak_External (Std_Standard_Time_Ns); - pragma Export (C, Std_Standard_Time_Us, "std__standard__time__BT__us"); - pragma Weak_External (Std_Standard_Time_Us); - pragma Export (C, Std_Standard_Time_Ms, "std__standard__time__BT__ms"); - pragma Weak_External (Std_Standard_Time_Ms); - pragma Export (C, Std_Standard_Time_Sec, "std__standard__time__BT__sec"); - pragma Weak_External (Std_Standard_Time_Sec); - pragma Export (C, Std_Standard_Time_Min, "std__standard__time__BT__min"); - pragma Weak_External (Std_Standard_Time_Min); - pragma Export (C, Std_Standard_Time_Hr, "std__standard__time__BT__hr"); - pragma Weak_External (Std_Standard_Time_Hr); - - procedure Set_Time_Resolution (Res : Character) is - begin - Std_Standard_Time_Hr := 0; - case Res is - when 'f' => - Std_Standard_Time_Fs := 1; - Std_Standard_Time_Ps := 1000; - Std_Standard_Time_Ns := 1000_000; - Std_Standard_Time_Us := 1000_000_000; - Std_Standard_Time_Ms := Std_Time'Last; - Std_Standard_Time_Sec := Std_Time'Last; - Std_Standard_Time_Min := Std_Time'Last; - Std_Standard_Time_Hr := Std_Time'Last; - when 'p' => - Std_Standard_Time_Fs := 0; - Std_Standard_Time_Ps := 1; - Std_Standard_Time_Ns := 1000; - Std_Standard_Time_Us := 1000_000; - Std_Standard_Time_Ms := 1000_000_000; - Std_Standard_Time_Sec := Std_Time'Last; - Std_Standard_Time_Min := Std_Time'Last; - Std_Standard_Time_Hr := Std_Time'Last; - when 'n' => - Std_Standard_Time_Fs := 0; - Std_Standard_Time_Ps := 0; - Std_Standard_Time_Ns := 1; - Std_Standard_Time_Us := 1000; - Std_Standard_Time_Ms := 1000_000; - Std_Standard_Time_Sec := 1000_000_000; - Std_Standard_Time_Min := Std_Time'Last; - Std_Standard_Time_Hr := Std_Time'Last; - when 'u' => - Std_Standard_Time_Fs := 0; - Std_Standard_Time_Ps := 0; - Std_Standard_Time_Ns := 0; - Std_Standard_Time_Us := 1; - Std_Standard_Time_Ms := 1000; - Std_Standard_Time_Sec := 1000_000; - Std_Standard_Time_Min := 60_000_000; - Std_Standard_Time_Hr := Std_Time'Last; - when 'm' => - Std_Standard_Time_Fs := 0; - Std_Standard_Time_Ps := 0; - Std_Standard_Time_Ns := 0; - Std_Standard_Time_Us := 0; - Std_Standard_Time_Ms := 1; - Std_Standard_Time_Sec := 1000; - Std_Standard_Time_Min := 60_000; - Std_Standard_Time_Hr := 3600_000; - when 's' => - Std_Standard_Time_Fs := 0; - Std_Standard_Time_Ps := 0; - Std_Standard_Time_Ns := 0; - Std_Standard_Time_Us := 0; - Std_Standard_Time_Ms := 0; - Std_Standard_Time_Sec := 1; - Std_Standard_Time_Min := 60; - Std_Standard_Time_Hr := 3600; - when 'M' => - Std_Standard_Time_Fs := 0; - Std_Standard_Time_Ps := 0; - Std_Standard_Time_Ns := 0; - Std_Standard_Time_Us := 0; - Std_Standard_Time_Ms := 0; - Std_Standard_Time_Sec := 0; - Std_Standard_Time_Min := 1; - Std_Standard_Time_Hr := 60; - when 'h' => - Std_Standard_Time_Fs := 0; - Std_Standard_Time_Ps := 0; - Std_Standard_Time_Ns := 0; - Std_Standard_Time_Us := 0; - Std_Standard_Time_Ms := 0; - Std_Standard_Time_Sec := 0; - Std_Standard_Time_Min := 0; - Std_Standard_Time_Hr := 1; - when others => - Error ("bad time resolution"); - end case; - end Set_Time_Resolution; - procedure Help is use Grt.Astdio; @@ -316,57 +210,6 @@ package body Grt.Options is Flag_Stats := True; elsif Option = "--no-run" then Flag_No_Run := True; - elsif Len > 18 and then Option (1 .. 18) = "--time-resolution=" then - declare - Res : Character; - Unit : String (1 .. 3); - begin - Res := '?'; - if Len >= 20 then - Unit (1) := To_Lower (Option (19)); - Unit (2) := To_Lower (Option (20)); - if Len = 20 then - if Unit (1 .. 2) = "fs" then - Res := 'f'; - elsif Unit (1 .. 2) = "ps" then - Res := 'p'; - elsif Unit (1 .. 2) = "ns" then - Res := 'n'; - elsif Unit (1 .. 2) = "us" then - Res := 'u'; - elsif Unit (1 .. 2) = "ms" then - Res := 'm'; - elsif Unit (1 .. 2) = "hr" then - Res := 'h'; - end if; - elsif Len = 21 then - Unit (3) := To_Lower (Option (21)); - if Unit = "min" then - Res := 'M'; - elsif Unit = "sec" then - Res := 's'; - end if; - end if; - end if; - if Res = '?' then - Error_C ("bad unit for '"); - Error_C (Option); - Error_E ("'"); - else - if Flag_String (5) = '-' then - Error ("time resolution is ignored"); - elsif Flag_String (5) = '?' then - if Stop_Time /= Std_Time'First then - Error ("time resolution must be set " - & "before --stop-time"); - else - Set_Time_Resolution (Res); - end if; - elsif Flag_String (5) /= Res then - Error ("time resolution is fixed during analysis"); - end if; - end if; - end; elsif Len > 12 and then Option (1 .. 12) = "--stop-time=" then Stop_Time := Parse_Time (Option (13 .. Len)); if Stop_Time = -1 then diff --git a/src/grt/grt-options.ads b/src/grt/grt-options.ads index 78fe9d8d7..4f24793f0 100644 --- a/src/grt/grt-options.ads +++ b/src/grt/grt-options.ads @@ -149,10 +149,6 @@ package Grt.Options is -- message and returns -1. function Parse_Time (Str : String) return Std_Time; - -- Set the time resolution. - -- Only call this subprogram if you are allowed to set the time resolution. - procedure Set_Time_Resolution (Res : Character); - -- Simply linked list of generic override (option -gIDENT=VALUE). type Generic_Override_Type; type Generic_Override_Acc is access Generic_Override_Type; diff --git a/src/options.adb b/src/options.adb index 9c752da87..43f68bbb5 100644 --- a/src/options.adb +++ b/src/options.adb @@ -200,29 +200,6 @@ package body Options is Flag_Integer_64 := True; elsif Opt = "--ftime32" then Flag_Time_64 := False; --- elsif Opt'Length > 17 --- and then Opt (Beg .. Beg + 17) = "--time-resolution=" --- then --- Beg := Beg + 18; --- if Opt (Beg .. Beg + 1) = "fs" then --- Time_Resolution := 'f'; --- elsif Opt (Beg .. Beg + 1) = "ps" then --- Time_Resolution := 'p'; --- elsif Opt (Beg .. Beg + 1) = "ns" then --- Time_Resolution := 'n'; --- elsif Opt (Beg .. Beg + 1) = "us" then --- Time_Resolution := 'u'; --- elsif Opt (Beg .. Beg + 1) = "ms" then --- Time_Resolution := 'm'; --- elsif Opt (Beg .. Beg + 2) = "sec" then --- Time_Resolution := 's'; --- elsif Opt (Beg .. Beg + 2) = "min" then --- Time_Resolution := 'M'; --- elsif Opt (Beg .. Beg + 1) = "hr" then --- Time_Resolution := 'h'; --- else --- return False; --- end if; elsif Back_End.Parse_Option /= null and then Back_End.Parse_Option.all (Opt) then @@ -257,8 +234,6 @@ package body Options is P (" -Wunused warns if a subprogram is never used"); P (" -Werror turns warnings into errors"); -- P ("Simulation option:"); --- P (" --time-resolution=UNIT set the resolution of type time"); --- P (" UNIT can be fs, ps, ns, us, ms, sec, min or hr"); -- P (" --assert-level=LEVEL set the level which stop the"); -- P (" simulation. LEVEL is note, warning, error,"); -- P (" failure or none"); diff --git a/src/vhdl/iirs.ads b/src/vhdl/iirs.ads index f7985f6d4..33ac760f0 100644 --- a/src/vhdl/iirs.ads +++ b/src/vhdl/iirs.ads @@ -2162,6 +2162,9 @@ package Iirs is -- Get/Set_Name_Staticness (State2) -- -- Get/Set_Visible_Flag (Flag4) + -- + -- Used for time literals, to compute minimal resolution. + -- Get/Set_Use_Flag (Flag6) -- LRM08 5.2 Scalar types -- @@ -4966,6 +4969,10 @@ package Iirs is --Iir_Kind_Physical_Int_Literal Iir_Kind_Physical_Fp_Literal; + subtype Iir_Kinds_Physical_Literal is Iir_Kind range + Iir_Kind_Physical_Int_Literal .. + Iir_Kind_Physical_Fp_Literal; + subtype Iir_Kinds_Array_Type_Definition is Iir_Kind range Iir_Kind_Array_Type_Definition .. Iir_Kind_Array_Subtype_Definition; diff --git a/src/vhdl/nodes_meta.adb b/src/vhdl/nodes_meta.adb index fe1b2353b..b14c47b93 100644 --- a/src/vhdl/nodes_meta.adb +++ b/src/vhdl/nodes_meta.adb @@ -2864,6 +2864,7 @@ package body Nodes_Meta is -- Iir_Kind_Unit_Declaration Field_Identifier, Field_Visible_Flag, + Field_Use_Flag, Field_Expr_Staticness, Field_Name_Staticness, Field_Parent, @@ -4482,189 +4483,189 @@ package body Nodes_Meta is Iir_Kind_Package_Body => 551, Iir_Kind_Architecture_Body => 563, Iir_Kind_Package_Header => 565, - Iir_Kind_Unit_Declaration => 573, - Iir_Kind_Library_Declaration => 580, - Iir_Kind_Component_Declaration => 590, - Iir_Kind_Attribute_Declaration => 597, - Iir_Kind_Group_Template_Declaration => 603, - Iir_Kind_Group_Declaration => 610, - Iir_Kind_Element_Declaration => 618, - Iir_Kind_Non_Object_Alias_Declaration => 626, - Iir_Kind_Psl_Declaration => 634, - Iir_Kind_Psl_Endpoint_Declaration => 648, - Iir_Kind_Terminal_Declaration => 654, - Iir_Kind_Free_Quantity_Declaration => 663, - Iir_Kind_Across_Quantity_Declaration => 675, - Iir_Kind_Through_Quantity_Declaration => 687, - Iir_Kind_Enumeration_Literal => 698, - Iir_Kind_Function_Declaration => 723, - Iir_Kind_Procedure_Declaration => 747, - Iir_Kind_Function_Body => 757, - Iir_Kind_Procedure_Body => 768, - Iir_Kind_Object_Alias_Declaration => 779, - Iir_Kind_File_Declaration => 793, - Iir_Kind_Guard_Signal_Declaration => 806, - Iir_Kind_Signal_Declaration => 823, - Iir_Kind_Variable_Declaration => 836, - Iir_Kind_Constant_Declaration => 850, - Iir_Kind_Iterator_Declaration => 861, - Iir_Kind_Interface_Constant_Declaration => 877, - Iir_Kind_Interface_Variable_Declaration => 893, - Iir_Kind_Interface_Signal_Declaration => 914, - Iir_Kind_Interface_File_Declaration => 930, - Iir_Kind_Interface_Type_Declaration => 940, - Iir_Kind_Interface_Package_Declaration => 952, - Iir_Kind_Interface_Function_Declaration => 969, - Iir_Kind_Interface_Procedure_Declaration => 982, - Iir_Kind_Signal_Attribute_Declaration => 985, - Iir_Kind_Identity_Operator => 989, - Iir_Kind_Negation_Operator => 993, - Iir_Kind_Absolute_Operator => 997, - Iir_Kind_Not_Operator => 1001, - Iir_Kind_Implicit_Condition_Operator => 1005, - Iir_Kind_Condition_Operator => 1009, - Iir_Kind_Reduction_And_Operator => 1013, - Iir_Kind_Reduction_Or_Operator => 1017, - Iir_Kind_Reduction_Nand_Operator => 1021, - Iir_Kind_Reduction_Nor_Operator => 1025, - Iir_Kind_Reduction_Xor_Operator => 1029, - Iir_Kind_Reduction_Xnor_Operator => 1033, - Iir_Kind_And_Operator => 1038, - Iir_Kind_Or_Operator => 1043, - Iir_Kind_Nand_Operator => 1048, - Iir_Kind_Nor_Operator => 1053, - Iir_Kind_Xor_Operator => 1058, - Iir_Kind_Xnor_Operator => 1063, - Iir_Kind_Equality_Operator => 1068, - Iir_Kind_Inequality_Operator => 1073, - Iir_Kind_Less_Than_Operator => 1078, - Iir_Kind_Less_Than_Or_Equal_Operator => 1083, - Iir_Kind_Greater_Than_Operator => 1088, - Iir_Kind_Greater_Than_Or_Equal_Operator => 1093, - Iir_Kind_Match_Equality_Operator => 1098, - Iir_Kind_Match_Inequality_Operator => 1103, - Iir_Kind_Match_Less_Than_Operator => 1108, - Iir_Kind_Match_Less_Than_Or_Equal_Operator => 1113, - Iir_Kind_Match_Greater_Than_Operator => 1118, - Iir_Kind_Match_Greater_Than_Or_Equal_Operator => 1123, - Iir_Kind_Sll_Operator => 1128, - Iir_Kind_Sla_Operator => 1133, - Iir_Kind_Srl_Operator => 1138, - Iir_Kind_Sra_Operator => 1143, - Iir_Kind_Rol_Operator => 1148, - Iir_Kind_Ror_Operator => 1153, - Iir_Kind_Addition_Operator => 1158, - Iir_Kind_Substraction_Operator => 1163, - Iir_Kind_Concatenation_Operator => 1168, - Iir_Kind_Multiplication_Operator => 1173, - Iir_Kind_Division_Operator => 1178, - Iir_Kind_Modulus_Operator => 1183, - Iir_Kind_Remainder_Operator => 1188, - Iir_Kind_Exponentiation_Operator => 1193, - Iir_Kind_Function_Call => 1201, - Iir_Kind_Aggregate => 1208, - Iir_Kind_Parenthesis_Expression => 1211, - Iir_Kind_Qualified_Expression => 1215, - Iir_Kind_Type_Conversion => 1220, - Iir_Kind_Allocator_By_Expression => 1224, - Iir_Kind_Allocator_By_Subtype => 1229, - Iir_Kind_Selected_Element => 1236, - Iir_Kind_Dereference => 1241, - Iir_Kind_Implicit_Dereference => 1246, - Iir_Kind_Slice_Name => 1253, - Iir_Kind_Indexed_Name => 1259, - Iir_Kind_Psl_Expression => 1261, - Iir_Kind_Sensitized_Process_Statement => 1282, - Iir_Kind_Process_Statement => 1302, - Iir_Kind_Concurrent_Simple_Signal_Assignment => 1314, - Iir_Kind_Concurrent_Conditional_Signal_Assignment => 1326, - Iir_Kind_Concurrent_Selected_Signal_Assignment => 1339, - Iir_Kind_Concurrent_Assertion_Statement => 1347, - Iir_Kind_Concurrent_Procedure_Call_Statement => 1354, - Iir_Kind_Psl_Assert_Statement => 1367, - Iir_Kind_Psl_Cover_Statement => 1380, - Iir_Kind_Block_Statement => 1393, - Iir_Kind_If_Generate_Statement => 1404, - Iir_Kind_Case_Generate_Statement => 1413, - Iir_Kind_For_Generate_Statement => 1422, - Iir_Kind_Component_Instantiation_Statement => 1433, - Iir_Kind_Psl_Default_Clock => 1437, - Iir_Kind_Simple_Simultaneous_Statement => 1444, - Iir_Kind_Generate_Statement_Body => 1455, - Iir_Kind_If_Generate_Else_Clause => 1461, - Iir_Kind_Simple_Signal_Assignment_Statement => 1471, - Iir_Kind_Conditional_Signal_Assignment_Statement => 1481, - Iir_Kind_Selected_Waveform_Assignment_Statement => 1492, - Iir_Kind_Null_Statement => 1496, - Iir_Kind_Assertion_Statement => 1503, - Iir_Kind_Report_Statement => 1509, - Iir_Kind_Wait_Statement => 1517, - Iir_Kind_Variable_Assignment_Statement => 1524, - Iir_Kind_Conditional_Variable_Assignment_Statement => 1531, - Iir_Kind_Return_Statement => 1537, - Iir_Kind_For_Loop_Statement => 1546, - Iir_Kind_While_Loop_Statement => 1555, - Iir_Kind_Next_Statement => 1562, - Iir_Kind_Exit_Statement => 1569, - Iir_Kind_Case_Statement => 1577, - Iir_Kind_Procedure_Call_Statement => 1583, - Iir_Kind_If_Statement => 1593, - Iir_Kind_Elsif => 1599, - Iir_Kind_Character_Literal => 1607, - Iir_Kind_Simple_Name => 1615, - Iir_Kind_Selected_Name => 1624, - Iir_Kind_Operator_Symbol => 1630, - Iir_Kind_Reference_Name => 1633, - Iir_Kind_External_Constant_Name => 1642, - Iir_Kind_External_Signal_Name => 1651, - Iir_Kind_External_Variable_Name => 1660, - Iir_Kind_Selected_By_All_Name => 1666, - Iir_Kind_Parenthesis_Name => 1671, - Iir_Kind_Package_Pathname => 1675, - Iir_Kind_Absolute_Pathname => 1676, - Iir_Kind_Relative_Pathname => 1677, - Iir_Kind_Pathname_Element => 1682, - Iir_Kind_Base_Attribute => 1684, - Iir_Kind_Subtype_Attribute => 1689, - Iir_Kind_Element_Attribute => 1694, - Iir_Kind_Left_Type_Attribute => 1699, - Iir_Kind_Right_Type_Attribute => 1704, - Iir_Kind_High_Type_Attribute => 1709, - Iir_Kind_Low_Type_Attribute => 1714, - Iir_Kind_Ascending_Type_Attribute => 1719, - Iir_Kind_Image_Attribute => 1725, - Iir_Kind_Value_Attribute => 1731, - Iir_Kind_Pos_Attribute => 1737, - Iir_Kind_Val_Attribute => 1743, - Iir_Kind_Succ_Attribute => 1749, - Iir_Kind_Pred_Attribute => 1755, - Iir_Kind_Leftof_Attribute => 1761, - Iir_Kind_Rightof_Attribute => 1767, - Iir_Kind_Delayed_Attribute => 1776, - Iir_Kind_Stable_Attribute => 1785, - Iir_Kind_Quiet_Attribute => 1794, - Iir_Kind_Transaction_Attribute => 1803, - Iir_Kind_Event_Attribute => 1807, - Iir_Kind_Active_Attribute => 1811, - Iir_Kind_Last_Event_Attribute => 1815, - Iir_Kind_Last_Active_Attribute => 1819, - Iir_Kind_Last_Value_Attribute => 1823, - Iir_Kind_Driving_Attribute => 1827, - Iir_Kind_Driving_Value_Attribute => 1831, - Iir_Kind_Behavior_Attribute => 1831, - Iir_Kind_Structure_Attribute => 1831, - Iir_Kind_Simple_Name_Attribute => 1838, - Iir_Kind_Instance_Name_Attribute => 1843, - Iir_Kind_Path_Name_Attribute => 1848, - Iir_Kind_Left_Array_Attribute => 1855, - Iir_Kind_Right_Array_Attribute => 1862, - Iir_Kind_High_Array_Attribute => 1869, - Iir_Kind_Low_Array_Attribute => 1876, - Iir_Kind_Length_Array_Attribute => 1883, - Iir_Kind_Ascending_Array_Attribute => 1890, - Iir_Kind_Range_Array_Attribute => 1897, - Iir_Kind_Reverse_Range_Array_Attribute => 1904, - Iir_Kind_Attribute_Name => 1913 + Iir_Kind_Unit_Declaration => 574, + Iir_Kind_Library_Declaration => 581, + Iir_Kind_Component_Declaration => 591, + Iir_Kind_Attribute_Declaration => 598, + Iir_Kind_Group_Template_Declaration => 604, + Iir_Kind_Group_Declaration => 611, + Iir_Kind_Element_Declaration => 619, + Iir_Kind_Non_Object_Alias_Declaration => 627, + Iir_Kind_Psl_Declaration => 635, + Iir_Kind_Psl_Endpoint_Declaration => 649, + Iir_Kind_Terminal_Declaration => 655, + Iir_Kind_Free_Quantity_Declaration => 664, + Iir_Kind_Across_Quantity_Declaration => 676, + Iir_Kind_Through_Quantity_Declaration => 688, + Iir_Kind_Enumeration_Literal => 699, + Iir_Kind_Function_Declaration => 724, + Iir_Kind_Procedure_Declaration => 748, + Iir_Kind_Function_Body => 758, + Iir_Kind_Procedure_Body => 769, + Iir_Kind_Object_Alias_Declaration => 780, + Iir_Kind_File_Declaration => 794, + Iir_Kind_Guard_Signal_Declaration => 807, + Iir_Kind_Signal_Declaration => 824, + Iir_Kind_Variable_Declaration => 837, + Iir_Kind_Constant_Declaration => 851, + Iir_Kind_Iterator_Declaration => 862, + Iir_Kind_Interface_Constant_Declaration => 878, + Iir_Kind_Interface_Variable_Declaration => 894, + Iir_Kind_Interface_Signal_Declaration => 915, + Iir_Kind_Interface_File_Declaration => 931, + Iir_Kind_Interface_Type_Declaration => 941, + Iir_Kind_Interface_Package_Declaration => 953, + Iir_Kind_Interface_Function_Declaration => 970, + Iir_Kind_Interface_Procedure_Declaration => 983, + Iir_Kind_Signal_Attribute_Declaration => 986, + Iir_Kind_Identity_Operator => 990, + Iir_Kind_Negation_Operator => 994, + Iir_Kind_Absolute_Operator => 998, + Iir_Kind_Not_Operator => 1002, + Iir_Kind_Implicit_Condition_Operator => 1006, + Iir_Kind_Condition_Operator => 1010, + Iir_Kind_Reduction_And_Operator => 1014, + Iir_Kind_Reduction_Or_Operator => 1018, + Iir_Kind_Reduction_Nand_Operator => 1022, + Iir_Kind_Reduction_Nor_Operator => 1026, + Iir_Kind_Reduction_Xor_Operator => 1030, + Iir_Kind_Reduction_Xnor_Operator => 1034, + Iir_Kind_And_Operator => 1039, + Iir_Kind_Or_Operator => 1044, + Iir_Kind_Nand_Operator => 1049, + Iir_Kind_Nor_Operator => 1054, + Iir_Kind_Xor_Operator => 1059, + Iir_Kind_Xnor_Operator => 1064, + Iir_Kind_Equality_Operator => 1069, + Iir_Kind_Inequality_Operator => 1074, + Iir_Kind_Less_Than_Operator => 1079, + Iir_Kind_Less_Than_Or_Equal_Operator => 1084, + Iir_Kind_Greater_Than_Operator => 1089, + Iir_Kind_Greater_Than_Or_Equal_Operator => 1094, + Iir_Kind_Match_Equality_Operator => 1099, + Iir_Kind_Match_Inequality_Operator => 1104, + Iir_Kind_Match_Less_Than_Operator => 1109, + Iir_Kind_Match_Less_Than_Or_Equal_Operator => 1114, + Iir_Kind_Match_Greater_Than_Operator => 1119, + Iir_Kind_Match_Greater_Than_Or_Equal_Operator => 1124, + Iir_Kind_Sll_Operator => 1129, + Iir_Kind_Sla_Operator => 1134, + Iir_Kind_Srl_Operator => 1139, + Iir_Kind_Sra_Operator => 1144, + Iir_Kind_Rol_Operator => 1149, + Iir_Kind_Ror_Operator => 1154, + Iir_Kind_Addition_Operator => 1159, + Iir_Kind_Substraction_Operator => 1164, + Iir_Kind_Concatenation_Operator => 1169, + Iir_Kind_Multiplication_Operator => 1174, + Iir_Kind_Division_Operator => 1179, + Iir_Kind_Modulus_Operator => 1184, + Iir_Kind_Remainder_Operator => 1189, + Iir_Kind_Exponentiation_Operator => 1194, + Iir_Kind_Function_Call => 1202, + Iir_Kind_Aggregate => 1209, + Iir_Kind_Parenthesis_Expression => 1212, + Iir_Kind_Qualified_Expression => 1216, + Iir_Kind_Type_Conversion => 1221, + Iir_Kind_Allocator_By_Expression => 1225, + Iir_Kind_Allocator_By_Subtype => 1230, + Iir_Kind_Selected_Element => 1237, + Iir_Kind_Dereference => 1242, + Iir_Kind_Implicit_Dereference => 1247, + Iir_Kind_Slice_Name => 1254, + Iir_Kind_Indexed_Name => 1260, + Iir_Kind_Psl_Expression => 1262, + Iir_Kind_Sensitized_Process_Statement => 1283, + Iir_Kind_Process_Statement => 1303, + Iir_Kind_Concurrent_Simple_Signal_Assignment => 1315, + Iir_Kind_Concurrent_Conditional_Signal_Assignment => 1327, + Iir_Kind_Concurrent_Selected_Signal_Assignment => 1340, + Iir_Kind_Concurrent_Assertion_Statement => 1348, + Iir_Kind_Concurrent_Procedure_Call_Statement => 1355, + Iir_Kind_Psl_Assert_Statement => 1368, + Iir_Kind_Psl_Cover_Statement => 1381, + Iir_Kind_Block_Statement => 1394, + Iir_Kind_If_Generate_Statement => 1405, + Iir_Kind_Case_Generate_Statement => 1414, + Iir_Kind_For_Generate_Statement => 1423, + Iir_Kind_Component_Instantiation_Statement => 1434, + Iir_Kind_Psl_Default_Clock => 1438, + Iir_Kind_Simple_Simultaneous_Statement => 1445, + Iir_Kind_Generate_Statement_Body => 1456, + Iir_Kind_If_Generate_Else_Clause => 1462, + Iir_Kind_Simple_Signal_Assignment_Statement => 1472, + Iir_Kind_Conditional_Signal_Assignment_Statement => 1482, + Iir_Kind_Selected_Waveform_Assignment_Statement => 1493, + Iir_Kind_Null_Statement => 1497, + Iir_Kind_Assertion_Statement => 1504, + Iir_Kind_Report_Statement => 1510, + Iir_Kind_Wait_Statement => 1518, + Iir_Kind_Variable_Assignment_Statement => 1525, + Iir_Kind_Conditional_Variable_Assignment_Statement => 1532, + Iir_Kind_Return_Statement => 1538, + Iir_Kind_For_Loop_Statement => 1547, + Iir_Kind_While_Loop_Statement => 1556, + Iir_Kind_Next_Statement => 1563, + Iir_Kind_Exit_Statement => 1570, + Iir_Kind_Case_Statement => 1578, + Iir_Kind_Procedure_Call_Statement => 1584, + Iir_Kind_If_Statement => 1594, + Iir_Kind_Elsif => 1600, + Iir_Kind_Character_Literal => 1608, + Iir_Kind_Simple_Name => 1616, + Iir_Kind_Selected_Name => 1625, + Iir_Kind_Operator_Symbol => 1631, + Iir_Kind_Reference_Name => 1634, + Iir_Kind_External_Constant_Name => 1643, + Iir_Kind_External_Signal_Name => 1652, + Iir_Kind_External_Variable_Name => 1661, + Iir_Kind_Selected_By_All_Name => 1667, + Iir_Kind_Parenthesis_Name => 1672, + Iir_Kind_Package_Pathname => 1676, + Iir_Kind_Absolute_Pathname => 1677, + Iir_Kind_Relative_Pathname => 1678, + Iir_Kind_Pathname_Element => 1683, + Iir_Kind_Base_Attribute => 1685, + Iir_Kind_Subtype_Attribute => 1690, + Iir_Kind_Element_Attribute => 1695, + Iir_Kind_Left_Type_Attribute => 1700, + Iir_Kind_Right_Type_Attribute => 1705, + Iir_Kind_High_Type_Attribute => 1710, + Iir_Kind_Low_Type_Attribute => 1715, + Iir_Kind_Ascending_Type_Attribute => 1720, + Iir_Kind_Image_Attribute => 1726, + Iir_Kind_Value_Attribute => 1732, + Iir_Kind_Pos_Attribute => 1738, + Iir_Kind_Val_Attribute => 1744, + Iir_Kind_Succ_Attribute => 1750, + Iir_Kind_Pred_Attribute => 1756, + Iir_Kind_Leftof_Attribute => 1762, + Iir_Kind_Rightof_Attribute => 1768, + Iir_Kind_Delayed_Attribute => 1777, + Iir_Kind_Stable_Attribute => 1786, + Iir_Kind_Quiet_Attribute => 1795, + Iir_Kind_Transaction_Attribute => 1804, + Iir_Kind_Event_Attribute => 1808, + Iir_Kind_Active_Attribute => 1812, + Iir_Kind_Last_Event_Attribute => 1816, + Iir_Kind_Last_Active_Attribute => 1820, + Iir_Kind_Last_Value_Attribute => 1824, + Iir_Kind_Driving_Attribute => 1828, + Iir_Kind_Driving_Value_Attribute => 1832, + Iir_Kind_Behavior_Attribute => 1832, + Iir_Kind_Structure_Attribute => 1832, + Iir_Kind_Simple_Name_Attribute => 1839, + Iir_Kind_Instance_Name_Attribute => 1844, + Iir_Kind_Path_Name_Attribute => 1849, + Iir_Kind_Left_Array_Attribute => 1856, + Iir_Kind_Right_Array_Attribute => 1863, + Iir_Kind_High_Array_Attribute => 1870, + Iir_Kind_Low_Array_Attribute => 1877, + Iir_Kind_Length_Array_Attribute => 1884, + Iir_Kind_Ascending_Array_Attribute => 1891, + Iir_Kind_Range_Array_Attribute => 1898, + Iir_Kind_Reverse_Range_Array_Attribute => 1905, + Iir_Kind_Attribute_Name => 1914 ); function Get_Fields_First (K : Iir_Kind) return Fields_Index is @@ -10311,6 +10312,7 @@ package body Nodes_Meta is | Iir_Kind_Subtype_Declaration | Iir_Kind_Nature_Declaration | Iir_Kind_Subnature_Declaration + | Iir_Kind_Unit_Declaration | Iir_Kind_Component_Declaration | Iir_Kind_Attribute_Declaration | Iir_Kind_Group_Template_Declaration diff --git a/src/vhdl/sem_expr.adb b/src/vhdl/sem_expr.adb index 92dcc408a..5fa1e91c3 100644 --- a/src/vhdl/sem_expr.adb +++ b/src/vhdl/sem_expr.adb @@ -3593,10 +3593,20 @@ package body Sem_Expr is end case; end Sem_Aggregate; - -- Transform LIT into a physical_literal. - -- LIT can be either a not analyzed physical literal or - -- a simple name that is a physical unit. In the later case, a physical - -- literal is created. + function Is_Physical_Literal_Zero (Lit : Iir) return Boolean is + begin + case Iir_Kinds_Physical_Literal (Get_Kind (Lit)) is + when Iir_Kind_Physical_Int_Literal => + return Get_Value (Lit) = 0; + when Iir_Kind_Physical_Fp_Literal => + return Get_Fp_Value (Lit) = 0.0; + end case; + end Is_Physical_Literal_Zero; + + -- Transform LIT into a physical_literal. + -- LIT can be either a not analyzed physical literal or + -- a simple name that is a physical unit. In the later case, a physical + -- literal is created. function Sem_Physical_Literal (Lit: Iir) return Iir is Unit_Name : Iir; @@ -3625,17 +3635,36 @@ package body Sem_Expr is Error_Class_Match (Unit_Name, "unit"); end if; Set_Named_Entity (Unit_Name, Create_Error_Name (Unit_Name)); + else + -- Physical unit is used. + Set_Use_Flag (Unit, True); + + if Get_Type (Unit) = Time_Type_Definition + and then Get_Value (Get_Physical_Literal (Unit)) = 0 + and then not Is_Physical_Literal_Zero (Res) + then + -- LRM08 5.2.4.2 Predefined physical types + -- It is an error if a given unit of type TIME appears anywhere + -- within the design hierarchy defining a model to be elaborated, + -- and if the position number of that unit is less than that of + -- the secondary unit selected as the resolution limit for type + -- TIME during the elaboration of the model, unless that unit is + -- part of a physical literal whose abstract literal is either + -- the integer value zero or the floating-point value zero. + Error_Msg_Sem + (+Res, "physical unit %i is below the time resolution", +Unit); + end if; end if; Set_Unit_Name (Res, Unit_Name); Set_Physical_Unit (Res, Get_Named_Entity (Unit_Name)); Unit_Type := Get_Type (Unit_Name); Set_Type (Res, Unit_Type); - -- LRM93 7.4.2 - -- 1. a literal of type TIME. + -- LRM93 7.4.2 + -- 1. a literal of type TIME. -- - -- LRM93 7.4.1 - -- 1. a literal of any type other than type TIME; + -- LRM93 7.4.1 + -- 1. a literal of any type other than type TIME; Set_Expr_Staticness (Res, Get_Expr_Staticness (Unit_Name)); --Eval_Check_Constraints (Res); return Res; diff --git a/src/vhdl/simulate/simul-execution.adb b/src/vhdl/simulate/simul-execution.adb index 0958462a5..451889bc9 100644 --- a/src/vhdl/simulate/simul-execution.adb +++ b/src/vhdl/simulate/simul-execution.adb @@ -3831,9 +3831,7 @@ package body Simul.Execution is begin case Get_Identifier (Imp) is when Std_Names.Name_Get_Resolution_Limit => - Res := Create_I64_Value - (Ghdl_I64 - (Evaluation.Get_Physical_Value (Std_Package.Time_Base))); + Res := Create_I64_Value (1); when Std_Names.Name_Textio_Read_Real => Res := Create_F64_Value (File_Operation.Textio_Read_Real (Block.Objects (1))); diff --git a/src/vhdl/std_package.adb b/src/vhdl/std_package.adb index 6d1456b7d..04c17ce22 100644 --- a/src/vhdl/std_package.adb +++ b/src/vhdl/std_package.adb @@ -36,6 +36,16 @@ package body Std_Package is Std_Location: Location_Type := Location_Nil; Std_Filename : Name_Id := Null_Identifier; + -- Could be public. + Time_Fs_Unit: Iir_Unit_Declaration; + Time_Ps_Unit: Iir_Unit_Declaration; + Time_Ns_Unit: Iir_Unit_Declaration; + Time_Us_Unit: Iir_Unit_Declaration; + Time_Ms_Unit: Iir_Unit_Declaration; + Time_Sec_Unit: Iir_Unit_Declaration; + Time_Min_Unit: Iir_Unit_Declaration; + Time_Hr_Unit: Iir_Unit_Declaration; + function Create_Std_Iir (Kind : Iir_Kind) return Iir is Res : Iir; @@ -824,14 +834,6 @@ package body Std_Package is Append (Last_Unit, Time_Type_Definition, Unit); end Create_Unit; - Time_Fs_Unit: Iir_Unit_Declaration; - Time_Ps_Unit: Iir_Unit_Declaration; - Time_Ns_Unit: Iir_Unit_Declaration; - Time_Us_Unit: Iir_Unit_Declaration; - Time_Ms_Unit: Iir_Unit_Declaration; - Time_Sec_Unit: Iir_Unit_Declaration; - Time_Min_Unit: Iir_Unit_Declaration; - Time_Hr_Unit: Iir_Unit_Declaration; Constraint : Iir_Range_Expression; begin if Vhdl_Std >= Vhdl_93c then @@ -908,28 +910,6 @@ package body Std_Package is Set_Subtype_Definition (Time_Type_Declaration, Time_Subtype_Definition); - -- The default time base. - case Flags.Time_Resolution is - when 'f' => - Time_Base := Time_Fs_Unit; - when 'p' => - Time_Base := Time_Ps_Unit; - when 'n' => - Time_Base := Time_Ns_Unit; - when 'u' => - Time_Base := Time_Us_Unit; - when 'm' => - Time_Base := Time_Ms_Unit; - when 's' => - Time_Base := Time_Sec_Unit; - when 'M' => - Time_Base := Time_Min_Unit; - when 'h' => - Time_Base := Time_Hr_Unit; - when others => - raise Internal_Error; - end case; - -- VHDL93 -- subtype DELAY_LENGTH is TIME range 0 to TIME'HIGH if Vhdl_Std >= Vhdl_93c then @@ -1280,4 +1260,94 @@ package body Std_Package is Set_Error_Origin (Error_Type, Null_Iir); Create_Wildcard_Type (Error_Type, "unknown type"); end Create_Std_Standard_Package; + + procedure Set_Time_Resolution (Resolution : Character) + is + Unit : Iir; + Prim : Iir; + Rng : Iir; + begin + case Resolution is + when 'f' => + Prim := Time_Fs_Unit; + when 'p' => + Prim := Time_Ps_Unit; + when 'n' => + Prim := Time_Ns_Unit; + when 'u' => + Prim := Time_Us_Unit; + when 'm' => + Prim := Time_Ms_Unit; + when 's' => + Prim := Time_Sec_Unit; + when 'M' => + Prim := Time_Min_Unit; + when 'h' => + Prim := Time_Hr_Unit; + when others => + raise Internal_Error; + end case; + + -- Adjust range of TIME subtype. + Rng := Get_Range_Constraint (Time_Subtype_Definition); + Set_Physical_Unit (Get_Left_Limit (Rng), Prim); + Set_Physical_Unit (Get_Right_Limit (Rng), Prim); + + -- Adjust range of DELAY_LENGTH. + if Vhdl_Std >= Vhdl_93c then + Rng := Get_Range_Constraint (Delay_Length_Subtype_Definition); + Set_Physical_Unit (Get_Left_Limit (Rng), Prim); + Set_Physical_Unit (Get_Right_Limit (Rng), Prim); + end if; + + Unit := Get_Unit_Chain (Time_Type_Definition); + while Unit /= Null_Iir loop + declare + Lit : constant Iir := Get_Physical_Literal (Unit); + Orig : constant Iir := Get_Literal_Origin (Lit); + Lit_Unit : Iir; + begin + if Prim = Null_Iir then + -- Primary already set, just recompute values. + Lit_Unit := Get_Physical_Literal (Get_Physical_Unit (Orig)); + Set_Value (Lit, Get_Value (Orig) * Get_Value (Lit_Unit)); + elsif Unit = Prim then + Set_Value (Lit, 1); + Prim := Null_Iir; + else + Set_Value (Lit, 0); + end if; + end; + Unit := Get_Chain (Unit); + end loop; + end Set_Time_Resolution; + + function Get_Minimal_Time_Resolution return Character is + begin + if Get_Use_Flag (Time_Fs_Unit) then + return 'f'; + end if; + if Get_Use_Flag (Time_Ps_Unit) then + return 'p'; + end if; + if Get_Use_Flag (Time_Ns_Unit) then + return 'n'; + end if; + if Get_Use_Flag (Time_Us_Unit) then + return 'u'; + end if; + if Get_Use_Flag (Time_Ms_Unit) then + return 'm'; + end if; + if Get_Use_Flag (Time_Sec_Unit) then + return 's'; + end if; + if Get_Use_Flag (Time_Min_Unit) then + return 'M'; + end if; + if Get_Use_Flag (Time_Hr_Unit) then + return 'h'; + end if; + return '?'; + end Get_Minimal_Time_Resolution; end Std_Package; diff --git a/src/vhdl/std_package.ads b/src/vhdl/std_package.ads index e655cb181..1c714b95c 100644 --- a/src/vhdl/std_package.ads +++ b/src/vhdl/std_package.ads @@ -27,10 +27,6 @@ package Std_Package is -- Some well know values declared in the STANDARD package. -- These values (except time_base) *must* not be modified, and are set by -- create_std_standard_package. - -- Time_base is the base unit of time. It is set during the creation of - -- all these nodes, and can be modified only *immediatly* after. - - Time_Base: Iir_Unit_Declaration := Null_Iir; Std_Standard_File: Iir_Design_File := Null_Iir; Std_Standard_Unit : Iir_Design_Unit := Null_Iir; @@ -181,6 +177,10 @@ package Std_Package is -- Create the node for the standard package. procedure Create_Std_Standard_Package (Parent : Iir_Library_Declaration); + procedure Set_Time_Resolution (Resolution : Character); + + -- Return the minimal time resolution according to use of time units. + function Get_Minimal_Time_Resolution return Character; private -- For speed reasons, some often used nodes are hard-coded. Error_Mark : constant Iir := 2; diff --git a/src/vhdl/translate/ortho_front.adb b/src/vhdl/translate/ortho_front.adb index 236c94906..143a6f6f1 100644 --- a/src/vhdl/translate/ortho_front.adb +++ b/src/vhdl/translate/ortho_front.adb @@ -393,6 +393,7 @@ package body Ortho_Front is Res : Iir_Design_File; Design : Iir_Design_Unit; Next_Design : Iir_Design_Unit; + Config : Iir; begin if Nbr_Parse = 0 then -- Initialize only once... @@ -417,9 +418,13 @@ package body Ortho_Front is Error_Msg_Option ("missing -l for --elab"); raise Option_Error; end if; - Translation.Elaborate - (Elab_Entity.all, Elab_Architecture.all, - Elab_Filelist.all, False); + Config := Configuration.Configure + (Elab_Entity.all, Elab_Architecture.all); + if Errorout.Nbr_Errors > 0 then + -- This may happen (bad entity for example). + raise Compilation_Error; + end if; + Translation.Elaborate (Config, Elab_Filelist.all, False); if Errorout.Nbr_Errors > 0 then -- This may happen (bad entity for example). @@ -464,8 +469,9 @@ package body Ortho_Front is Flags.Flag_Elaborate := True; Flags.Flag_Only_Elab_Warnings := False; - Translation.Elaborate - (Elab_Entity.all, Elab_Architecture.all, "", True); + Config := Configuration.Configure + (Elab_Entity.all, Elab_Architecture.all); + Translation.Elaborate (Config, "", True); if Errorout.Nbr_Errors > 0 then -- This may happen (bad entity for example). diff --git a/src/vhdl/translate/trans-chap12.adb b/src/vhdl/translate/trans-chap12.adb index b0e096565..9a2d7022e 100644 --- a/src/vhdl/translate/trans-chap12.adb +++ b/src/vhdl/translate/trans-chap12.adb @@ -587,8 +587,7 @@ package body Trans.Chap12 is R := fclose (F); end Write_File_List; - procedure Elaborate (Primary : String; - Secondary : String; + procedure Elaborate (Config : Iir_Design_Unit; Filelist : String; Whole : Boolean) is @@ -596,17 +595,12 @@ package body Trans.Chap12 is Unit : Iir_Design_Unit; Lib_Unit : Iir; - Config : Iir_Design_Unit; Config_Lib : Iir_Configuration_Declaration; Entity : Iir_Entity_Declaration; Arch : Iir_Architecture_Body; Conf_Info : Config_Info_Acc; Last_Design_Unit : Natural; begin - Config := Configure (Primary, Secondary); - if Config = Null_Iir then - return; - end if; Config_Lib := Get_Library_Unit (Config); Entity := Get_Entity (Config_Lib); Arch := Strip_Denoting_Name diff --git a/src/vhdl/translate/trans-chap12.ads b/src/vhdl/translate/trans-chap12.ads index 23abea998..a0db62399 100644 --- a/src/vhdl/translate/trans-chap12.ads +++ b/src/vhdl/translate/trans-chap12.ads @@ -26,10 +26,8 @@ package Trans.Chap12 is -- Write to file FILELIST all the files that are needed to link the design. procedure Write_File_List (Filelist : String); - -- Primary unit + secondary unit (architecture name which may be null) - -- to elaborate. - procedure Elaborate (Primary : String; - Secondary : String; + -- Generate elaboration code for CONFIG. + procedure Elaborate (Config : Iir_Design_Unit; Filelist : String; Whole : Boolean); end Trans.Chap12; diff --git a/src/vhdl/translate/translation.adb b/src/vhdl/translate/translation.adb index 5c39283e3..a7ec6e7da 100644 --- a/src/vhdl/translate/translation.adb +++ b/src/vhdl/translate/translation.adb @@ -2085,8 +2085,7 @@ package body Translation is Free_Old_Temp; end Finalize; - procedure Elaborate (Primary : String; - Secondary : String; + procedure Elaborate (Config : Iir; Filelist : String; Whole : Boolean) renames Trans.Chap12.Elaborate; diff --git a/src/vhdl/translate/translation.ads b/src/vhdl/translate/translation.ads index 2228f8973..4c9b2ff27 100644 --- a/src/vhdl/translate/translation.ads +++ b/src/vhdl/translate/translation.ads @@ -40,10 +40,9 @@ package Translation is procedure Gen_Filename (Design_File : Iir); - -- Primary unit + secondary unit (architecture name which may be null) - -- to elaborate. - procedure Elaborate (Primary : String; - Secondary : String; + -- Generate elaboration code for CONFIG. Also use units from Configure + -- package. + procedure Elaborate (Config : Iir; Filelist : String; Whole : Boolean); |