summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/files_map.adb27
-rw-r--r--src/files_map.ads7
-rw-r--r--src/flags.adb15
-rw-r--r--src/types.ads3
-rw-r--r--src/vhdl/disp_tree.adb3
-rw-r--r--src/vhdl/errorout.adb34
-rw-r--r--src/vhdl/errorout.ads4
-rw-r--r--src/vhdl/parse.adb3
-rw-r--r--src/vhdl/parse_psl.adb2
-rw-r--r--src/vhdl/psl-errors.ads15
-rw-r--r--src/vhdl/sem_scopes.adb5
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;
generated by cgit (git 2.34.1) at 2024-12-20 19:27:59 +0000