Add support for --time-resolution (jit only). Fix #613

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