From cc783ab03cf4b2f52fe68c29053dd4dfee9c5e5f Mon Sep 17 00:00:00 2001
From: Tristan Gingold <tgingold@free.fr>
Date: Wed, 8 Aug 2018 07:23:51 +0200
Subject: Add support for --time-resolution (jit only). Fix #613
---
src/flags.adb | 13 +-
src/flags.ads | 12 --
src/ghdldrv/ghdlcomp.adb | 30 ++-
src/ghdldrv/ghdlcomp.ads | 12 ++
src/ghdldrv/ghdldrv.adb | 5 +
src/ghdldrv/ghdlrun.adb | 68 ++++++-
src/grt/grt-main.adb | 6 -
src/grt/grt-options.adb | 157 ---------------
src/grt/grt-options.ads | 4 -
src/options.adb | 25 ---
src/vhdl/iirs.ads | 7 +
src/vhdl/nodes_meta.adb | 368 +++++++++++++++++-----------------
src/vhdl/sem_expr.adb | 45 ++++-
src/vhdl/simulate/simul-execution.adb | 4 +-
src/vhdl/std_package.adb | 130 +++++++++---
src/vhdl/std_package.ads | 8 +-
src/vhdl/translate/ortho_front.adb | 16 +-
src/vhdl/translate/trans-chap12.adb | 8 +-
src/vhdl/translate/trans-chap12.ads | 6 +-
src/vhdl/translate/translation.adb | 3 +-
src/vhdl/translate/translation.ads | 7 +-
21 files changed, 456 insertions(+), 478 deletions(-)
(limited to 'src')
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;
@@ -83,6 +86,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);
--
cgit v1.2.3