diff options
| -rw-r--r-- | src/flags.adb | 2 | ||||
| -rw-r--r-- | src/flags.ads | 2 | ||||
| -rw-r--r-- | src/ghdldrv/ghdlcomp.adb | 9 | ||||
| -rw-r--r-- | src/ghdldrv/ghdlmain.adb | 2 | ||||
| -rw-r--r-- | src/ghdldrv/ghdlmain.ads | 5 | ||||
| -rw-r--r-- | src/ghdldrv/ghdlrun.adb | 13 | ||||
| -rw-r--r-- | src/grt/grt-astdio.adb | 44 | ||||
| -rw-r--r-- | src/grt/grt-disp.adb | 15 | ||||
| -rw-r--r-- | src/grt/grt-options.adb | 44 | ||||
| -rw-r--r-- | src/grt/grt-options.ads | 10 | ||||
| -rw-r--r-- | src/grt/grt-vcd.adb | 16 | ||||
| -rw-r--r-- | src/grt/grt-vpi.adb | 6 | ||||
| -rw-r--r-- | src/grt/grt-waves.adb | 5 | ||||
| -rw-r--r-- | testsuite/gna/issue613/ent.vhdl | 2 | ||||
| -rwxr-xr-x | testsuite/gna/issue613/testsuite.sh | 8 |
15 files changed, 121 insertions, 62 deletions
diff --git a/src/flags.adb b/src/flags.adb index de536815b..cc0e0815a 100644 --- a/src/flags.adb +++ b/src/flags.adb @@ -41,7 +41,7 @@ package body Flags is Flag_String (4) := 't'; end if; - -- Time_Resolution is always fs. + -- Time_Resolution is always fs, maybe overwritten later. Flag_String (5) := '-'; end Create_Flag_String; end Flags; diff --git a/src/flags.ads b/src/flags.ads index 3134c14de..cae0fa82a 100644 --- a/src/flags.ads +++ b/src/flags.ads @@ -37,6 +37,8 @@ package Flags is -- Some flags (such as vhdl version) must be the same for every design -- units of a hierarchy. -- The Flag_String is a signature of all these flags. + -- Note: Flag_String (5) (time resolution) is directly overwritten in + -- ghdlrun. Flag_String : String (1 .. 5); procedure Create_Flag_String; diff --git a/src/ghdldrv/ghdlcomp.adb b/src/ghdldrv/ghdlcomp.adb index df7f02cb1..eb1ef80e3 100644 --- a/src/ghdldrv/ghdlcomp.adb +++ b/src/ghdldrv/ghdlcomp.adb @@ -75,14 +75,11 @@ package body Ghdlcomp is 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; + Error ("unknown unit name for --time-resolution"); + Res := Option_Err; end if; else Decode_Option (Command_Lib (Cmd), Option, Arg, Res); @@ -98,7 +95,7 @@ package body Ghdlcomp is 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"); + Put_Line (" UNIT can be fs, ps, ns, us, ms, sec or auto"); end Disp_Long_Help; -- Command -r diff --git a/src/ghdldrv/ghdlmain.adb b/src/ghdldrv/ghdlmain.adb index 81337af50..da23ea47f 100644 --- a/src/ghdldrv/ghdlmain.adb +++ b/src/ghdldrv/ghdlmain.adb @@ -354,6 +354,8 @@ package body Ghdlmain is Error ("unknown option '" & Arg.all & "' for command '" & Cmd_Name.all & "'"); raise Option_Error; + when Option_Err => + raise Option_Error; when Option_Ok => Arg_Index := Arg_Index + 1; when Option_Arg_Req => diff --git a/src/ghdldrv/ghdlmain.ads b/src/ghdldrv/ghdlmain.ads index c79530934..0625dfde9 100644 --- a/src/ghdldrv/ghdlmain.ads +++ b/src/ghdldrv/ghdlmain.ads @@ -36,11 +36,14 @@ package Ghdlmain is -- Option_OK: OPTION is handled. -- Option_Bad: OPTION is unknown. + -- Option_Err: OPTION has an error (message was displayed). -- Option_Arg_Req: OPTION requires an argument. Must be set only when -- ARG = "", the manager will recall Decode_Option. -- Option_Arg: OPTION used the argument. type Option_Res is - (Option_Bad, Option_Ok, Option_Arg, Option_Arg_Req, Option_End); + (Option_Bad, Option_Err, + Option_Ok, Option_Arg, Option_Arg_Req, + Option_End); procedure Decode_Option (Cmd : in out Command_Type; Option : String; Arg : String; diff --git a/src/ghdldrv/ghdlrun.adb b/src/ghdldrv/ghdlrun.adb index b2cff0411..d612095f7 100644 --- a/src/ghdldrv/ghdlrun.adb +++ b/src/ghdldrv/ghdlrun.adb @@ -110,10 +110,6 @@ package body Ghdlrun is -- The design is always analyzed in whole. Flags.Flag_Whole_Analyze := True; - Ortho_Jit.Init; - - Translation.Initialize; - case Elab_Mode is when Elab_Static => Canon.Canon_Flag_Add_Labels := True; @@ -159,8 +155,6 @@ package body Ghdlrun is 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; @@ -169,6 +163,13 @@ package body Ghdlrun is end if; Std_Package.Set_Time_Resolution (Time_Resolution); + -- Overwrite time resolution in flag string. + Flags.Flag_String (5) := Time_Resolution; + + Ortho_Jit.Init; + + Translation.Initialize; + case Elab_Mode is when Elab_Static => raise Program_Error; diff --git a/src/grt/grt-astdio.adb b/src/grt/grt-astdio.adb index a572dd3cc..5fdcd1a64 100644 --- a/src/grt/grt-astdio.adb +++ b/src/grt/grt-astdio.adb @@ -23,6 +23,7 @@ -- however invalidate any other reasons why the executable file might be -- covered by the GNU Public License. with Grt.C; use Grt.C; +with Grt.Options; package body Grt.Astdio is procedure Put (Stream : FILEs; Str : String) @@ -209,28 +210,37 @@ package body Grt.Astdio is end case; end Put_Dir; - procedure Put_Time (Stream : FILEs; Time : Std_Time) is + procedure Put_Time (Stream : FILEs; Time : Std_Time) + is + use Grt.Options; + Unit : Natural_Time_Scale; + T : Std_Time; begin if Time = Std_Time'First then Put (Stream, "-Inf"); else -- Do not bother with sec, min, and hr. - if (Time mod 1_000_000_000_000) = 0 then - Put_I64 (Stream, Ghdl_I64 (Time / 1_000_000_000_000)); - Put (Stream, "ms"); - elsif (Time mod 1_000_000_000) = 0 then - Put_I64 (Stream, Ghdl_I64 (Time / 1_000_000_000)); - Put (Stream, "us"); - elsif (Time mod 1_000_000) = 0 then - Put_I64 (Stream, Ghdl_I64 (Time / 1_000_000)); - Put (Stream, "ns"); - elsif (Time mod 1_000) = 0 then - Put_I64 (Stream, Ghdl_I64 (Time / 1_000)); - Put (Stream, "ps"); - else - Put_I64 (Stream, Ghdl_I64 (Time)); - Put (Stream, "fs"); - end if; + Unit := Time_Resolution_Scale; + T := Time; + while Unit > 1 and then (T mod 1_000) = 0 loop + T := T / 1000; + Unit := Unit - 1; + end loop; + Put_I64 (Stream, Ghdl_I64 (T)); + case Unit is + when 0 => + Put (Stream, "sec"); + when 1 => + Put (Stream, "ms"); + when 2 => + Put (Stream, "us"); + when 3 => + Put (Stream, "ns"); + when 4 => + Put (Stream, "ps"); + when 5 => + Put (Stream, "fs"); + end case; end if; end Put_Time; diff --git a/src/grt/grt-disp.adb b/src/grt/grt-disp.adb index e68b1168b..36644bf1a 100644 --- a/src/grt/grt-disp.adb +++ b/src/grt/grt-disp.adb @@ -54,14 +54,12 @@ package body Grt.Disp is -- Put_Str_Len (Stream, Type_Desc.E32.Values (Natural (E32))); --end Put_E32; - procedure Put_Sig_Index (Sig : Sig_Table_Index) - is + procedure Put_Sig_Index (Sig : Sig_Table_Index) is begin Put_I32 (stdout, Ghdl_I32 (Sig)); end Put_Sig_Index; - procedure Put_Sig_Range (Sig : Sig_Table_Range) - is + procedure Put_Sig_Range (Sig : Sig_Table_Range) is begin Put_Sig_Index (Sig.First); if Sig.Last /= Sig.First then @@ -70,8 +68,7 @@ package body Grt.Disp is end if; end Put_Sig_Range; - procedure Disp_Now - is + procedure Disp_Now is begin Put ("Now is "); Put_Time (stdout, Current_Time); @@ -80,8 +77,7 @@ package body Grt.Disp is New_Line; end Disp_Now; - procedure Disp_Propagation_Kind (Kind : Propagation_Kind_Type) - is + procedure Disp_Propagation_Kind (Kind : Propagation_Kind_Type) is begin case Kind is when Drv_One_Driver => @@ -184,8 +180,7 @@ package body Grt.Disp is end loop; end Disp_Signals_Order; - procedure Disp_Mode (Mode : Mode_Type) - is + procedure Disp_Mode (Mode : Mode_Type) is begin case Mode is when Mode_B1 => diff --git a/src/grt/grt-options.adb b/src/grt/grt-options.adb index cdf6c2886..5b154e4a5 100644 --- a/src/grt/grt-options.adb +++ b/src/grt/grt-options.adb @@ -117,6 +117,7 @@ package body Grt.Options is Pos : Natural; Time : Integer_64; Unit : String (1 .. 3); + Scale : Natural_Time_Scale; begin Extract_Integer (Str, Ok, Time, Pos); if not Ok then @@ -138,27 +139,33 @@ package body Grt.Options is Unit (2) := To_Lower (Str (Pos + 1)); if Unit = "fs " then - null; + Scale := 5; elsif Unit = "ps " then - Time := Time * (10 ** 3); + Scale := 4; elsif Unit = "ns " then - Time := Time * (10 ** 6); + Scale := 3; elsif Unit = "us " then - Time := Time * (10 ** 9); + Scale := 2; elsif Unit = "ms " then - Time := Time * (10 ** 12); + Scale := 1; elsif Unit = "sec" then - Time := Time * (10 ** 15); - elsif Unit = "min" then - Time := Time * (10 ** 15) * 60; - elsif Unit = "hr " then - Time := Time * (10 ** 15) * 3600; + Scale := 0; else Error_S ("bad unit name for '"); Diag_C (Str); Error_E ("'"); return -1; end if; + if Scale > Time_Resolution_Scale then + Error_S ("unit for '"); + Diag_C (Str); + Error_E ("' is less than time resolution"); + return -1; + end if; + while Scale < Time_Resolution_Scale loop + Time := Time * 1000; + Scale := Scale + 1; + end loop; return Std_Time (Time); end Parse_Time; @@ -361,6 +368,23 @@ package body Grt.Options is Len : Natural; Status : Decode_Option_Status; begin + case Flag_String (5) is + when 'f' | '-' => + Time_Resolution_Scale := 5; + when 'p' => + Time_Resolution_Scale := 4; + when 'n' => + Time_Resolution_Scale := 3; + when 'u' => + Time_Resolution_Scale := 2; + when 'm' => + Time_Resolution_Scale := 1; + when 's' => + Time_Resolution_Scale := 0; + when others => + Error ("unhandled time resolution"); + end case; + Stop := False; Last_Opt := Argc - 1; for I in 1 .. Argc - 1 loop diff --git a/src/grt/grt-options.ads b/src/grt/grt-options.ads index 4f24793f0..fa7e1f660 100644 --- a/src/grt/grt-options.ads +++ b/src/grt/grt-options.ads @@ -55,6 +55,16 @@ package Grt.Options is Flag_String : constant String (1 .. 5); pragma Import (C, Flag_String, "__ghdl_flag_string"); + -- Time resolution extracted from Flag_String, in multiple of -3: + -- 0: sec + -- 1: ms + -- 2: us + -- 3: ns + -- 4: ps + -- 5: fs + subtype Natural_Time_Scale is Natural range 0 .. 5; + Time_Resolution_Scale : Natural_Time_Scale; + -- Display options help. -- Should not be called directly. procedure Help; diff --git a/src/grt/grt-vcd.adb b/src/grt/grt-vcd.adb index 9050a26a4..b058dcdaf 100644 --- a/src/grt/grt-vcd.adb +++ b/src/grt/grt-vcd.adb @@ -53,6 +53,7 @@ with Grt.Vstrings; with Grt.Wave_Opt; use Grt.Wave_Opt; with Grt.Wave_Opt.Design; use Grt.Wave_Opt.Design; with Grt.Fcvt; +with Grt.Options; pragma Elaborate_All (Grt.Table); package body Grt.Vcd is @@ -241,7 +242,20 @@ package body Grt.Vcd is Vcd_Putline (" GHDL v0"); Vcd_Put_End; Vcd_Putline ("$timescale"); - Vcd_Putline (" 1 fs"); + case Options.Time_Resolution_Scale is + when 5 => + Vcd_Putline (" 1 fs"); + when 4 => + Vcd_Putline (" 1 ps"); + when 3 => + Vcd_Putline (" 1 ns"); + when 2 => + Vcd_Putline (" 1 us"); + when 1 => + Vcd_Putline (" 1 ms"); + when 0 => + Vcd_Putline (" 1 sec"); + end case; Vcd_Put_End; end Vcd_Init; diff --git a/src/grt/grt-vpi.adb b/src/grt/grt-vpi.adb index 4efa39584..ee6a9fdf5 100644 --- a/src/grt/grt-vpi.adb +++ b/src/grt/grt-vpi.adb @@ -325,7 +325,7 @@ package body Grt.Vpi is raise Program_Error; end if; Res := Std_Time (Unsigned_64 (V.mHigh) * 2 ** 32 + Unsigned_64 (V.mLow)); - return Res * 1000; + return Res; end Vpi_Time_To_Time; ------------------------------------------------------------------------------- @@ -479,7 +479,7 @@ package body Grt.Vpi is when vpiType => Res := Ref.mType; when vpiTimePrecision => - Res := -12; -- In ps. + Res := -3 * Options.Time_Resolution_Scale; when vpiSize => Res := Vpi_Get_Size (Ref); when vpiVector => @@ -1148,7 +1148,7 @@ package body Grt.Vpi is Res := Current_Time; - V := To_Unsigned_64 (Res) / 1000; + V := To_Unsigned_64 (Res); Time.mHigh := Unsigned_32 (V / 2 ** 32); Time.mLow := Unsigned_32 (V mod 2 ** 32); Time.mReal := 0.0; diff --git a/src/grt/grt-waves.adb b/src/grt/grt-waves.adb index e1931bfa2..c0d12993f 100644 --- a/src/grt/grt-waves.adb +++ b/src/grt/grt-waves.adb @@ -318,8 +318,7 @@ package body Grt.Waves is end if; end Wave_Init; - procedure Write_File_Header - is + procedure Write_File_Header is begin -- Magic, 9 bytes. Wave_Put ("GHDLwave" & Nl); @@ -331,6 +330,8 @@ package body Grt.Waves is Wave_Put_Byte (1); Wave_Write_Size_Order; + + -- TODO: add time resolution. end Write_File_Header; procedure Avhpi_Error (Err : AvhpiErrorT) diff --git a/testsuite/gna/issue613/ent.vhdl b/testsuite/gna/issue613/ent.vhdl index 202a2b9d0..c912189eb 100644 --- a/testsuite/gna/issue613/ent.vhdl +++ b/testsuite/gna/issue613/ent.vhdl @@ -2,7 +2,7 @@ entity ent is end entity; architecture a of ent is - constant SimulationTime_c : time := 10000 sec; + constant SimulationTime_c : time := 10000 ms; begin process begin report "Hello world" severity note; diff --git a/testsuite/gna/issue613/testsuite.sh b/testsuite/gna/issue613/testsuite.sh index ad890e137..029a98433 100755 --- a/testsuite/gna/issue613/testsuite.sh +++ b/testsuite/gna/issue613/testsuite.sh @@ -6,14 +6,14 @@ if ! $GHDL --help -a | grep -q time-resolution; then echo "option --time-resolution not available" else # Below the resolution - analyze_failure --time-resolution=min ent.vhdl + analyze_failure --time-resolution=sec ent.vhdl # Zero physical literals are always allowed. - analyze --time-resolution=sec t1.vhdl - analyze --time-resolution=sec t2.vhdl + analyze --time-resolution=ms t1.vhdl + analyze --time-resolution=ms t2.vhdl analyze ent.vhdl - elab_simulate --time-resolution=ms ent + elab_simulate --time-resolution=us ent elab_simulate --time-resolution=auto ent clean |