diff options
Diffstat (limited to 'src/ghdldrv')
-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 |
4 files changed, 102 insertions, 13 deletions
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 |