Rename Get_Location_Str to Image.

11 files changed, 66 insertions, 52 deletions

diff --git a/src/files_map.adb b/src/files_map.adb
index 641ed73..94ce9cb 100644
--- a/src/files_map.adb
+++ b/src/files_map.adb
@@ -807,6 +807,33 @@ package body Files_Map is
       end if;
    end Get_Time_Stamp_String;
 
+   function Image (Loc : Location_Type; Filename : Boolean := True)
+                  return string
+   is
+      Line, Col : Natural;
+      Name : Name_Id;
+   begin
+      if Loc = Location_Nil then
+         --  Avoid a crash.
+         return "??:??:??";
+      else
+         Location_To_Position (Loc, Name, Line, Col);
+         declare
+            Line_Str : constant String := Natural'Image (Line);
+            Col_Str : constant String := Natural'Image (Col);
+         begin
+            if Filename then
+               return Name_Table.Image (Name)
+                 & ':' & Line_Str (Line_Str'First + 1 .. Line_Str'Last)
+                 & ':' & Col_Str (Col_Str'First + 1 .. Col_Str'Last);
+            else
+               return Line_Str (Line_Str'First + 1 .. Line_Str'Last)
+                 & ':' & Col_Str (Col_Str'First + 1 .. Col_Str'Last);
+            end if;
+         end;
+      end if;
+   end Image;
+
    -- Debug procedures.
    procedure Debug_Source_Lines (File: Source_File_Entry);
    pragma Unreferenced (Debug_Source_Lines);
diff --git a/src/files_map.ads b/src/files_map.ads
index cc317fd..8ad5a04 100644
--- a/src/files_map.ads
+++ b/src/files_map.ads
@@ -137,9 +137,10 @@ package Files_Map is
                                    Line : out Natural;
                                    Col : out Natural);
 
-   --  Get LINE and COL from LOCATION.
-   --procedure Get_Source_File_Line_And_Column
-   --  (Location: Location_Type; Line, Col: out Natural; Name : out Name_Id);
+   --  Return the image of LOC using the "FILENAME:LINE:COL" format or
+   --  "LINE:COL" format if FILENAME is false;
+   function Image (Loc : Location_Type; Filename : Boolean := True)
+                  return String;
 
    --  Free all memory and reinitialize.
    procedure Initialize;
diff --git a/src/flags.adb b/src/flags.adb
index fc00368..4bd1501 100644
--- a/src/flags.adb
+++ b/src/flags.adb
@@ -40,14 +40,17 @@ package body Flags is
       else
          Flag_String (4) := 't';
       end if;
-      if not Flag_Time_64 and Vhdl_Std = Vhdl_87 then
+
+      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
-         if Flag_Time_64 then
-            Flag_String (5) := '-';
-         else
-            Flag_String (5) := '?';
-         end if;
+         --  Time_Resolution can be changed at simulation time.
+         Flag_String (5) := '?';
       end if;
    end Create_Flag_String;
 end Flags;
diff --git a/src/types.ads b/src/types.ads
index 2fa4b3a..e15d00e 100644
--- a/src/types.ads
+++ b/src/types.ads
@@ -119,4 +119,7 @@ package Types is
    --  (e.g eval_pos).  In this case it is easier to raise an exception and
    --  let upper level subprograms handle the case.
    Node_Error : exception;
+
+   --  Result of a comparaison of two numeric values.
+   type Order_Type is (Less, Equal, Greater);
 end Types;
diff --git a/src/vhdl/disp_tree.adb b/src/vhdl/disp_tree.adb
index 21c9d34..62fc3c4 100644
--- a/src/vhdl/disp_tree.adb
+++ b/src/vhdl/disp_tree.adb
@@ -21,7 +21,6 @@
 with Ada.Text_IO; use Ada.Text_IO;
 with Name_Table;
 with Tokens;
-with Errorout;
 with Files_Map;
 with PSL.Dump_Tree;
 with Nodes_Meta;
@@ -309,7 +308,7 @@ package body Disp_Tree is
 
    function Image_Location_Type (Loc : Location_Type) return String is
    begin
-      return Errorout.Get_Location_Str (Loc);
+      return Files_Map.Image (Loc);
    end Image_Location_Type;
 
    function Image_Iir_Direction (Dir : Iir_Direction) return String is
diff --git a/src/vhdl/errorout.adb b/src/vhdl/errorout.adb
index 877fea2..a364120 100644
--- a/src/vhdl/errorout.adb
+++ b/src/vhdl/errorout.adb
@@ -832,41 +832,9 @@ package body Errorout is
    -- Disp a node location.
    -- Used for output of message.
 
-   function Get_Location_Str
-     (Name : Name_Id; Line, Col : Natural; Filename : Boolean)
-     return String
-   is
-      Line_Str : constant String := Natural'Image (Line);
-      Col_Str : constant String := Natural'Image (Col);
-   begin
-      if Filename then
-         return Name_Table.Image (Name)
-           & ':' & Line_Str (Line_Str'First + 1 .. Line_Str'Last)
-           & ':' & Col_Str (Col_Str'First + 1 .. Col_Str'Last);
-      else
-         return Line_Str (Line_Str'First + 1 .. Line_Str'Last)
-           & ':' & Col_Str (Col_Str'First + 1 .. Col_Str'Last);
-      end if;
-   end Get_Location_Str;
-
-   function Get_Location_Str (Loc : Location_Type; Filename : Boolean := True)
-     return string
-   is
-      Line, Col : Natural;
-      Name : Name_Id;
-   begin
-      if Loc = Location_Nil then
-         --  Avoid a crash.
-         return "??:??:??";
-      else
-         Location_To_Position (Loc, Name, Line, Col);
-         return Get_Location_Str (Name, Line, Col, Filename);
-      end if;
-   end Get_Location_Str;
-
    function Disp_Location (Node: Iir) return String is
    begin
-      return Get_Location_Str (Get_Location (Node));
+      return Image (Get_Location (Node));
    end Disp_Location;
 
    function Disp_Name (Kind : Iir_Kind) return String is
diff --git a/src/vhdl/errorout.ads b/src/vhdl/errorout.ads
index ce694fe..e062599 100644
--- a/src/vhdl/errorout.ads
+++ b/src/vhdl/errorout.ads
@@ -92,10 +92,8 @@ package Errorout is
    -- Disp a node location.
    -- Used for output of message.
    function Disp_Location (Node: Iir) return String;
-   function Get_Location_Str (Loc : Location_Type; Filename : Boolean := True)
-     return String;
 
-   -- Disp non-terminal name from KIND.
+   --  Disp non-terminal name from KIND.
    function Disp_Name (Kind : Iir_Kind) return String;
 
    --  SUBPRG must be a subprogram declaration or an enumeration literal
diff --git a/src/vhdl/parse.adb b/src/vhdl/parse.adb
index 3ad8c11..d94f4bb 100644
--- a/src/vhdl/parse.adb
+++ b/src/vhdl/parse.adb
@@ -27,6 +27,7 @@ with Flags; use Flags;
 with Parse_Psl;
 with Name_Table;
 with Str_Table;
+with Files_Map; use Files_Map;
 with Xrefs;
 
 --  Recursive descendant parser.
@@ -3874,7 +3875,7 @@ package body Parse is
                --  FIXME: in case of multiple missing parenthesises, several
                --    messages will be displayed
                Error_Msg_Parse ("missing ')' for opening parenthesis at "
-                                & Get_Location_Str (Loc, Filename => False));
+                                & Image (Loc, Filename => False));
                return Expr;
             when others =>
                --  Surely a parse error...
diff --git a/src/vhdl/parse_psl.adb b/src/vhdl/parse_psl.adb
index b71dc74..506218a 100644
--- a/src/vhdl/parse_psl.adb
+++ b/src/vhdl/parse_psl.adb
@@ -348,7 +348,7 @@ package body Parse_Psl is
          Res := Parse_FL_Property (Prio_Lowest);
          if Current_Token /= Tok_Right_Paren then
             Error_Msg_Parse ("missing matching ')' for '(' at line "
-                               & Get_Location_Str (Loc, False));
+                               & Image (Loc, False));
          else
             Scan;
          end if;
diff --git a/src/vhdl/psl-errors.ads b/src/vhdl/psl-errors.ads
index e99bb7d..7742dcf 100644
--- a/src/vhdl/psl-errors.ads
+++ b/src/vhdl/psl-errors.ads
@@ -1,3 +1,16 @@
+with Types; use Types;
 with Errorout;
+with Files_Map;
 
-package PSL.Errors renames Errorout;
+package PSL.Errors is
+   function Image (Loc : Location_Type; Filename : Boolean := True)
+                  return String renames Files_Map.Image;
+
+   procedure Error_Kind (Msg : String; N : PSL_Node) renames
+     Errorout.Error_Kind;
+
+   procedure Error_Msg_Parse (Msg: String)
+     renames Errorout.Error_Msg_Parse;
+   procedure Error_Msg_Sem (Msg: String; Loc: PSL_Node)
+     renames Errorout.Error_Msg_Sem;
+end PSL.Errors;
diff --git a/src/vhdl/sem_scopes.adb b/src/vhdl/sem_scopes.adb
index f77e6e8..cdc35af 100644
--- a/src/vhdl/sem_scopes.adb
+++ b/src/vhdl/sem_scopes.adb
@@ -19,6 +19,7 @@ with Ada.Text_IO;
 with GNAT.Table;
 with Flags; use Flags;
 with Name_Table; -- use Name_Table;
+with Files_Map; use Files_Map;
 with Errorout; use Errorout;
 with Iirs_Utils; use Iirs_Utils;
 
@@ -1277,7 +1278,7 @@ package body Sem_Scopes is
          Put (": ");
          Decl := Get_Declaration (Inter);
          Put (Iir_Kind'Image (Get_Kind (Decl)));
-         Put_Line (", loc: " & Get_Location_Str (Get_Location (Decl)));
+         Put_Line (", loc: " & Image (Get_Location (Decl)));
          if Get_Kind (Decl) in Iir_Kinds_Subprogram_Declaration then
             Put_Line ("   " & Disp_Subprg (Decl));
          end if;
@@ -1335,7 +1336,7 @@ package body Sem_Scopes is
       Put (": ");
       Decl := Get_Declaration (Inter);
       Put (Iir_Kind'Image (Get_Kind (Decl)));
-      Put_Line (", loc: " & Get_Location_Str (Get_Location (Decl)));
+      Put_Line (", loc: " & Image (Get_Location (Decl)));
       if Get_Kind (Decl) in Iir_Kinds_Subprogram_Declaration then
          Put_Line ("   " & Disp_Subprg (Decl));
       end if;