diff options
| -rw-r--r-- | src/grt/grt-options.adb | 4 | ||||
| -rw-r--r-- | src/grt/grt-strings.adb | 77 | ||||
| -rw-r--r-- | src/grt/grt-strings.ads | 25 | ||||
| -rw-r--r-- | src/grt/grt-vstrings.ads | 1 | ||||
| -rw-r--r-- | src/grt/grt-wave_opt_file-parse-debug.adb | 62 | ||||
| -rw-r--r-- | src/grt/grt-wave_opt_file-parse-debug.ads | 38 | ||||
| -rw-r--r-- | src/grt/grt-wave_opt_file-parse.adb | 354 | ||||
| -rw-r--r-- | src/grt/grt-wave_opt_file-parse.ads | 54 | ||||
| -rw-r--r-- | src/grt/grt-wave_opt_file-tree_reading.adb | 146 | ||||
| -rw-r--r-- | src/grt/grt-wave_opt_file-tree_reading.ads | 51 | ||||
| -rw-r--r-- | src/grt/grt-wave_opt_file.adb | 68 | ||||
| -rw-r--r-- | src/grt/grt-wave_opt_file.ads | 78 | ||||
| -rw-r--r-- | src/grt/grt-waves.adb | 114 |
13 files changed, 1027 insertions, 45 deletions
diff --git a/src/grt/grt-options.adb b/src/grt/grt-options.adb index 78c25c17a..1b582e5bb 100644 --- a/src/grt/grt-options.adb +++ b/src/grt/grt-options.adb @@ -28,6 +28,7 @@ with Grt.Errors; use Grt.Errors; with Grt.Stdio; use Grt.Stdio; with Grt.Astdio; with Grt.Hooks; +with Grt.Wave_Opt_File.Parse; package body Grt.Options is @@ -480,6 +481,9 @@ package body Grt.Options is end if; Last_Generic_Override := Over; end; + elsif Option'Length >= 18 and then + Option (1 .. 19) = "--wave-option-file=" then + Wave_Opt_File.Parse.Start (Option (20 .. Option'Last)); elsif Option = "--unbuffered" then Unbuffered_Writes := True; setbuf (stdout, NULL_voids); diff --git a/src/grt/grt-strings.adb b/src/grt/grt-strings.adb index 38e2c6b4e..82fd331e5 100644 --- a/src/grt/grt-strings.adb +++ b/src/grt/grt-strings.adb @@ -30,6 +30,46 @@ package body Grt.Strings is return C = ' ' or C = NBSP or C = HT; end Is_Whitespace; + function First_Non_Whitespace_Pos (Str : String) return Integer is + begin + for I in Str'Range loop + if not Is_Whitespace (Str (I)) then + return I; + end if; + end loop; + return -1; + end First_Non_Whitespace_Pos; + + function Last_Non_Whitespace_Pos (Str : String) return Integer is + begin + for Index in reverse Str'Range loop + if not Is_Whitespace (Str (Index)) then + return Index; + end if; + end loop; + return -1; + end Last_Non_Whitespace_Pos; + + function New_Line_Pos (Line : String) return Integer is + begin + return Find (Line, ASCII.LF); + end New_Line_Pos; + + function Find (Str : String; Char : Character) return Integer is + begin + for Index in Str'Range loop + if Str (Index) = Char then + return Index; + end if; + end loop; + return -1; + end Find; + function Find (Str : String; Char : Character; Start : Positive) + return Integer is + begin + return Find (Str (Start .. Str'Last), Char); + end Find; + function To_Lower (C : Character) return Character is begin if C in 'A' .. 'Z' then @@ -38,4 +78,41 @@ package body Grt.Strings is return C; end if; end To_Lower; + + procedure To_Lower (S : in out String) is + begin + for I in S'Range loop + S (I) := To_Lower (S (I)); + end loop; + end To_Lower; + + function Value (Str : String) return Integer + is + Decimal : Positive; + Value_Tmp : Natural; + Digit : Integer; + begin + Decimal := 1; + Value_Tmp := 0; + + for Index in reverse Str'Range loop + Digit := Value (Str (Index)); + if Digit = -1 then + return -1; + end if; + Value_Tmp := Value_Tmp + Digit * Decimal; + Decimal := Decimal * 10; + end loop; + return Value_Tmp; + end Value; + + function Value (Char : Character) return Integer is + begin + case Char is + when '0' .. '9' => + return Character'Pos (Char) - Character'Pos ('0'); + when others => + return -1; + end case; + end Value; end Grt.Strings; diff --git a/src/grt/grt-strings.ads b/src/grt/grt-strings.ads index d11c799f0..46d89008b 100644 --- a/src/grt/grt-strings.ads +++ b/src/grt/grt-strings.ads @@ -31,6 +31,29 @@ package Grt.Strings is -- Return True IFF C is a whitespace character (as defined in LRM93 14.3) function Is_Whitespace (C : in Character) return Boolean; - -- Convert C to lowercase. + -- The following functions return -1 in case there is no match in string --- + + -- Return the index of the first non whitespace character in string + function First_Non_Whitespace_Pos (Str : String) return Integer; + + -- Return the index of the last non whitespace character in string + function Last_Non_Whitespace_Pos (Str : String) return Integer; + + -- Return the index of the new line character (ASCII.LF) in string + function New_Line_Pos (Line : String) return Integer; + + -- Return the index of the first character that matches Char in string + function Find (Str : String; Char : Character) return Integer; + function Find (Str : String; Char : Character; Start : Positive) + return Integer; + + ---------------------------------------------------------------------------- + + -- Convert C/S to lowercase. function To_Lower (C : Character) return Character; + procedure To_Lower (S : in out String); + + -- Str/Char : image of a natural number/digit + function Value (Str : String) return Integer; + function Value (Char : Character) return Integer; end Grt.Strings; diff --git a/src/grt/grt-vstrings.ads b/src/grt/grt-vstrings.ads index 067b54c6b..80563e5a3 100644 --- a/src/grt/grt-vstrings.ads +++ b/src/grt/grt-vstrings.ads @@ -27,6 +27,7 @@ with Grt.Types; use Grt.Types; with System; use System; package Grt.Vstrings is + pragma Preelaborate; -- A Vstring (Variable string) is an object which contains an unbounded -- string. type Vstring is limited private; diff --git a/src/grt/grt-wave_opt_file-parse-debug.adb b/src/grt/grt-wave_opt_file-parse-debug.adb new file mode 100644 index 000000000..2f8c66ec6 --- /dev/null +++ b/src/grt/grt-wave_opt_file-parse-debug.adb @@ -0,0 +1,62 @@ +-- GHDL Run Time (GRT) - Wave option file package for debugging. +-- Copyright (C) 2016 Jonas Baggett +-- +-- GHDL is free software; you can redistribute it and/or modify it under +-- the terms of the GNU General Public License as published by the Free +-- Software Foundation; either version 2, or (at your option) any later +-- version. +-- +-- GHDL is distributed in the hope that it will be useful, but WITHOUT ANY +-- WARRANTY; without even the implied warranty of MERCHANTABILITY or +-- FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +-- for more details. +-- +-- You should have received a copy of the GNU General Public License +-- 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. +-- +-- As a special exception, if other files instantiate generics from this +-- unit, or you link this unit with other files to produce an executable, +-- this unit does not by itself cause the resulting executable to be +-- covered by the GNU General Public License. This exception does not +-- however invalidate any other reasons why the executable file might be +-- covered by the GNU Public License. + +-- Description: See package specifications + +with Grt.Astdio; use Grt.Astdio; + +package body Grt.Wave_Opt_File.Parse.Debug is + + procedure Dump_Tree is + begin + New_Line; + for Index in Tree_Index_Type'Range loop + Put_Line ("----------------------------"); + if Index = Pkg then + Put_Line ("Packages : "); + else + Put_Line ("Instances : "); + end if; + Dump_Sub_Tree (Trees (Index), 1); + end loop; + Put_Line ("----------- END -----------------"); + New_Line; + end Dump_Tree; + + procedure Dump_Sub_Tree (Cursor : Elem_Acc; Level : Positive) + is + Sibling_Cursor : Elem_Acc; + begin + Sibling_Cursor := Cursor; + while Sibling_Cursor /= null loop + Put ((3 .. 2 * Level => ' ')); + Put ('/'); + Put_Line (Sibling_Cursor.Name.all); + Dump_Sub_Tree (Sibling_Cursor.Next_Child, Level + 1); + Sibling_Cursor := Sibling_Cursor.Next_Sibling; + end loop; + end Dump_Sub_Tree; + +end Grt.Wave_Opt_File.Parse.Debug; diff --git a/src/grt/grt-wave_opt_file-parse-debug.ads b/src/grt/grt-wave_opt_file-parse-debug.ads new file mode 100644 index 000000000..210076141 --- /dev/null +++ b/src/grt/grt-wave_opt_file-parse-debug.ads @@ -0,0 +1,38 @@ +-- GHDL Run Time (GRT) - Wave option file package for debugging. +-- Copyright (C) 2016 Jonas Baggett +-- +-- GHDL is free software; you can redistribute it and/or modify it under +-- the terms of the GNU General Public License as published by the Free +-- Software Foundation; either version 2, or (at your option) any later +-- version. +-- +-- GHDL is distributed in the hope that it will be useful, but WITHOUT ANY +-- WARRANTY; without even the implied warranty of MERCHANTABILITY or +-- FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +-- for more details. +-- +-- You should have received a copy of the GNU General Public License +-- 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. +-- +-- As a special exception, if other files instantiate generics from this +-- unit, or you link this unit with other files to produce an executable, +-- this unit does not by itself cause the resulting executable to be +-- covered by the GNU General Public License. This exception does not +-- however invalidate any other reasons why the executable file might be +-- covered by the GNU Public License. + +-- Description: Wave option file child package for debugging purpose. +-- Prints the tree created after parsing. + +private package Grt.Wave_Opt_File.Parse.Debug is + pragma Preelaborate; + + -- Dump all the tree + procedure Dump_Tree; + + -- Dump recursively an element of the tree. Called by Dump_Tree + procedure Dump_Sub_Tree (Cursor : Elem_Acc; Level : Positive); + +end Grt.Wave_Opt_File.Parse.Debug; diff --git a/src/grt/grt-wave_opt_file-parse.adb b/src/grt/grt-wave_opt_file-parse.adb new file mode 100644 index 000000000..fe598a9b9 --- /dev/null +++ b/src/grt/grt-wave_opt_file-parse.adb @@ -0,0 +1,354 @@ +-- GHDL Run Time (GRT) - Wave option file package for parsing. +-- Copyright (C) 2016 Jonas Baggett +-- +-- GHDL is free software; you can redistribute it and/or modify it under +-- the terms of the GNU General Public License as published by the Free +-- Software Foundation; either version 2, or (at your option) any later +-- version. +-- +-- GHDL is distributed in the hope that it will be useful, but WITHOUT ANY +-- WARRANTY; without even the implied warranty of MERCHANTABILITY or +-- FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +-- for more details. +-- +-- You should have received a copy of the GNU General Public License +-- 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. +-- +-- As a special exception, if other files instantiate generics from this +-- unit, or you link this unit with other files to produce an executable, +-- this unit does not by itself cause the resulting executable to be +-- covered by the GNU General Public License. This exception does not +-- however invalidate any other reasons why the executable file might be +-- covered by the GNU Public License. + +-- Description: See package specifications + +------------------------------------------------------------------------------- + +-- TODO: +-- * Currently the elements of the paths parsed are converted to lowercase. +-- This is fine now, but maybe on day Verilog and/or System-C will be +-- supported by GHDL and they are case-sensitive languages. In this case, we +-- will need to find a different approach. Here are 2 possibilities : +-- 1) Create 2 trees when parsing : one case sensitive and one case +-- insensitive, then latter when we have more informations, prune VHDL +-- paths from the case sensitive tree and prune verilog / system-C paths +-- from the case insensitive tree (maybe it's not really needed). Then use +-- the right tree while looking for signals to be displayed in the design. +-- 2) Create only 1 case sensitive tree then latter when we have more +-- informations, look for VHDL paths in the tree and merge elements who +-- have the same name after lowering their characters. + +with System; use System; +with Grt.Stdio; use Grt.Stdio; +with Grt.Strings; use Grt.Strings; +with Grt.Vstrings; use Grt.Vstrings; +with Grt.Errors; use Grt.Errors; + +--~ with Grt.Wave_Opt_File.Parse.Debug; + +package body Grt.Wave_Opt_File.Parse is + -- Open the wave option file + function File_Open (Option_File : String) return FILEs; + + -- Update the tree with the current VHDL element parsed from the current + -- path. Returns True if the tree was actually updated. + function Update_Tree (Elem_Name : String; Tree_Index : Tree_Index_Type) + return Boolean; + + -- Parse the line where the version is set + procedure Parse_Version (Line : String_Access); + + -- Print the version variable given as parameter + procedure Print_Version (Version : Version_Type); + + -- Parse a line where a signal path is set + procedure Parse_Path (Line : String_Access); + + procedure Start (Option_File : String) + is + Stream : constant FILEs := File_Open (Option_File); + First, Last : Integer; + Line : String (1 .. Buf_Size); + Lineno : Natural; + begin + File_Path := new String'(Option_File); + Lineno := 0; + + -- Processes line after line. + loop + exit when fgets (Line'Address, Line'Length, Stream) = Null_Address; + Lineno := Lineno + 1; + + -- Determine end of line. + Last := New_Line_Pos (Line) - 1; + if Last < 0 then + Last := Line'Last; + end if; + + -- Skips empty lines and comments. + First := First_Non_Whitespace_Pos (Line (Line'First .. Last)); + if First = -1 or else Line (First) = '#' then + goto Continue; + end if; + + -- Create a line string without beginning and ending whitespaces + Last := Last_Non_Whitespace_Pos (Line (First .. Last)); + Line_Context := new Line_Context_Type'( + Str => new String'(Line (First .. Last)), + Num => Lineno, + Max_Level => 0); + + + if Line (First) = '$' then + Parse_Version (Line_Context.Str); + -- TODO : Line_Context should be deallocated here but the memory + -- gain shouldn't be significative + else + Parse_Path (Line_Context.Str); + end if; + + <<Continue>> null; + end loop; + + if Version.Major = -1 then + Report_C ("warning: version wasn't set at the beginning of the" & + " file; currently supported version is "); + Print_Version (Current_Version); + Report_E (""); + end if; + + if Trees = Tree_Array'(others => null) then + Report_E ("No signal path was found in the wave option file," & + " then every signals will be displayed."); + end if; + + --~ Debug.Dump_Tree; + + end Start; + +------------------------------------------------------------------------------- + + -- An error/warning message start with the context or the error/warning. + -- This procedure print this context + procedure Print_Context (Severity : Severity_Type); + + -- Print an error/warning with it's context + procedure Error_Context (Msg : String; Severity : Severity_Type := Error); + + procedure Parse_Version (Line : String_Access) + is + Msg_Invalid_Format : constant String := "invalid version format"; + First, Dot_Index, Num : Integer; + begin + + if Version /= (others => -1) then + Error_Context ("version is set more than once"); + end if; + + if Trees /= Tree_Array'(others => null) then + Error_Context ("version cannot be set after signal paths"); + end if; + + First := First_Non_Whitespace_Pos (Line (Line'First + 1 .. Line'Last)); + if Line (First .. First + 6) /= "version" then + Error_Context (Msg_Invalid_Format); + end if; + + -- Catch "version\n", "version1.0" + First := First + 7; + if not Is_Whitespace (Line (First)) then + Error_Context (Msg_Invalid_Format); + end if; + + -- Catch "version \n", "version \n", etc + First := First_Non_Whitespace_Pos (Line (First + 1 .. Line'Last)); + if First = -1 then + Error_Context (Msg_Invalid_Format); + end if; + + -- Catch the absence of "." or "version ." + Dot_Index := Find (Line (First + 1 .. Line'Last), '.'); + if Dot_Index = -1 then + Error_Context (Msg_Invalid_Format); + end if; + + -- Catch version a.2 + Num := Value (Line (First .. Dot_Index - 1)); + if Num = -1 then + Error_Context (Msg_Invalid_Format); + end if; + Version.Major := Num; + + -- Catch version 1.a + Num := Value (Line (Dot_Index + 1 .. Line'Last)); + if Num = -1 then + Error_Context (Msg_Invalid_Format); + end if; + Version.Minor := Num; + + if Version.Major /= Current_Version.Major + or else Version.Minor > Current_Version.Minor + then + Print_Context (Error); + Error_C ("unsupported format version; it must be "); + if Current_Version.Minor /= 0 then + Error_C ("between "); + Print_Version (Version_Type'(Current_Version.Major, 0)); + Error_C (" and "); + end if; + Print_Version (Current_Version); + Error_E; + end if; + + end Parse_Version; + + procedure Print_Version (Version : Version_Type) + is + Num_Str : String (1 .. Value_String_Size); + First : Positive; + begin + To_String (Num_Str, First, Ghdl_I32 (Version.Major)); + Report_C (Num_Str (First .. Num_Str'Last)); + Report_C ("."); + To_String (Num_Str, First, Ghdl_I32 (Version.Minor)); + Report_C (Num_Str (First .. Num_Str'Last)); + end Print_Version; + + -------------------------------------------------------------------------- + + procedure Parse_Path (Line : String_Access) + is + -- Can equal to 0 in case of error (like '.' as a full path) + First, Last : Natural; + Tree_Updated : Boolean; + Tree_Index : Tree_Index_Type; + begin + To_Lower (Line_Context.Str.all); + Last := Line'First; + if Line (Line'First) = '/' then + Tree_Index := Entity; + Last := Last + 1; + -- Catch '/' as a full path + if Last > Line'Length then + Error_Context ("invalid signal path"); + end if; + else + -- '/' not allowed for package signal paths in a. Catch also the + -- absence a first slash in entity signal paths, which misleads the + -- code to believe it's inside a package + if Find (Line.all, '/') > 0 then + Error_Context ("invalid signal path"); + end if; + Tree_Index := Pkg; + end if; + Tree_Cursor := Trees (Tree_Index); + Previous_Tree_Cursor := null; + + loop + First := Last; + + -- Find next identifier + loop + if Line (Last) = Seps (Tree_Index) then + Last := Last - 1; + exit; + elsif Last = Line'Last then + exit; + end if; + Last := Last + 1; + end loop; + + Tree_Updated := Update_Tree (Line (First .. Last), Tree_Index); + Line_Context.Max_Level := Line_Context.Max_Level + 1; + + if Last = Line'Last then + if not Tree_Updated then + Error_Context ("ignored already known signal path", Warning); + end if; + return; + end if; + + -- Skip the separator + Last := Last + 2; + -- Catch signal paths ending with / or . + if Last > Line'Last then + Error_Context ("invalid signal path"); + end if; + + end loop; + + end Parse_Path; + + function Update_Tree (Elem_Name : String; Tree_Index : Tree_Index_Type) + return Boolean + is + Sibling_Cursor, Previous_Sibling_Cursor : Elem_Acc; + Elem : Elem_Acc; + begin + Sibling_Cursor := Tree_Cursor; + Previous_Sibling_Cursor := null; + + loop + -- Already reached the last sibling and current identifier corresponds + -- to no existing element ? Then we will create an element + if Sibling_Cursor = null then + Elem := new Elem_Type'(Name => new String'(Elem_Name), + Line_Context => Line_Context, + Kind => Not_Found, + Next_Sibling | Next_Child => null); + -- First element of level ? + if Previous_Sibling_Cursor = null then + -- Is a top level ? + if Previous_Tree_Cursor = null then + Trees (Tree_Index) := Elem; + else + Previous_Tree_Cursor.Next_Child := Elem; + end if; + else + Previous_Sibling_Cursor.Next_Sibling := Elem; + end if; + Previous_Tree_Cursor := Elem; + -- Point to Elem.Next_Child which is null + Tree_Cursor := null; + return True; + -- Identifier was found in the tree ? Then move to its first child + elsif Elem_Name = Sibling_Cursor.Name.all then + Previous_Tree_Cursor := Sibling_Cursor; + Tree_Cursor := Sibling_Cursor.Next_Child; + return False; + end if; + Previous_Sibling_Cursor := Sibling_Cursor; + Sibling_Cursor := Sibling_Cursor.Next_Sibling; + end loop; + end Update_Tree; + + -------------------------------------------------------------------------- + + procedure Print_Context (Severity : Severity_Type) is + begin + Print_Context (Line_Context, Severity); + end Print_Context; + + procedure Error_Context (Msg : String; Severity : Severity_Type := Error) is + begin + Error_Context (Msg, Line_Context, Severity); + end Error_Context; + + function File_Open (Option_File : String) return FILEs + is + Mode : constant String := "rt" & ASCII.Nul; + Stream : FILEs; + begin + Stream := fopen (Option_File'Address, Mode'Address); + if Stream = NULL_Stream then + Error_C ("cannot open '"); + Error_C (Option_File (Option_File'First .. Option_File'Last - 1)); + Error_E ("'"); + end if; + return Stream; + end File_Open; + +end Grt.Wave_Opt_File.Parse; diff --git a/src/grt/grt-wave_opt_file-parse.ads b/src/grt/grt-wave_opt_file-parse.ads new file mode 100644 index 000000000..9278c37e2 --- /dev/null +++ b/src/grt/grt-wave_opt_file-parse.ads @@ -0,0 +1,54 @@ +-- GHDL Run Time (GRT) - Wave option file package for parsing. +-- Copyright (C) 2016 Jonas Baggett +-- +-- GHDL is free software; you can redistribute it and/or modify it under +-- the terms of the GNU General Public License as published by the Free +-- Software Foundation; either version 2, or (at your option) any later +-- version. +-- +-- GHDL is distributed in the hope that it will be useful, but WITHOUT ANY +-- WARRANTY; without even the implied warranty of MERCHANTABILITY or +-- FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +-- for more details. +-- +-- You should have received a copy of the GNU General Public License +-- 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. +-- +-- As a special exception, if other files instantiate generics from this +-- unit, or you link this unit with other files to produce an executable, +-- this unit does not by itself cause the resulting executable to be +-- covered by the GNU General Public License. This exception does not +-- however invalidate any other reasons why the executable file might be +-- covered by the GNU Public License. + +-- Description: Wave option file child package for parsing. +-- Parse a wave option file provided in the command line and +-- create a tree with the path of the signals to be displayed on +-- the waveform + +package Grt.Wave_Opt_File.Parse is + pragma Preelaborate; + + -- Parse the wave option file given as parameter + procedure Start (Option_File : String); + +private + + Buf_Size : constant := 1024; + + Line_Context : Line_Context_Acc; + + Tree_Cursor, Previous_Tree_Cursor : Elem_Acc; + + type Version_Type is record + Major : Integer; + Minor : Integer; + end record; + Version : Version_Type := (others => -1); + Current_Version : constant Version_Type := (Major => 1, Minor => 0); + + type Sep_Array is array (Tree_Index_Type) of Character; + +end Grt.Wave_Opt_File.Parse; diff --git a/src/grt/grt-wave_opt_file-tree_reading.adb b/src/grt/grt-wave_opt_file-tree_reading.adb new file mode 100644 index 000000000..f2343be7a --- /dev/null +++ b/src/grt/grt-wave_opt_file-tree_reading.adb @@ -0,0 +1,146 @@ +-- GHDL Run Time (GRT) - Wave option file package for reading the tree. +-- Copyright (C) 2016 Jonas Baggett +-- +-- GHDL is free software; you can redistribute it and/or modify it under +-- the terms of the GNU General Public License as published by the Free +-- Software Foundation; either version 2, or (at your option) any later +-- version. +-- +-- GHDL is distributed in the hope that it will be useful, but WITHOUT ANY +-- WARRANTY; without even the implied warranty of MERCHANTABILITY or +-- FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +-- for more details. +-- +-- You should have received a copy of the GNU General Public License +-- 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. +-- +-- As a special exception, if other files instantiate generics from this +-- unit, or you link this unit with other files to produce an executable, +-- this unit does not by itself cause the resulting executable to be +-- covered by the GNU General Public License. This exception does not +-- however invalidate any other reasons why the executable file might be +-- covered by the GNU Public License. + +-- Description: See package specifications + +with Grt.Strings; use Grt.Strings; +with Grt.Errors; use Grt.Errors; + +package body Grt.Wave_Opt_File.Tree_Reading is + -- Returns true is all signals are displayed. This is the case when no + -- wave option file was provided or the one provided contains no paths + function All_Signals_Displayed return Boolean; + + -- Find the element that matches the name given. Starts with the element + -- given, then go thru all its siblings + function Find_Cursor (Name : Ghdl_C_String; + First_Sibling : Elem_Acc; + Is_Signal : Boolean := False) + return Elem_Acc; + + function Get_Top_Cursor (Name : Ghdl_C_String; Index : Tree_Index_Type) + return Elem_Acc is + begin + return Find_Cursor (Name, Trees (Index)); + end Get_Top_Cursor; + + function Get_Cursor + (Name : Ghdl_C_String; Parent : Elem_Acc; Is_Signal : Boolean := False) + return Elem_Acc is + begin + if All_Signals_Displayed then + return null; + end if; + return Find_Cursor (Name, Parent.Next_Child, Is_Signal); + end Get_Cursor; + + function Is_Displayed (Cursor : Elem_Acc) return Boolean is + begin + if All_Signals_Displayed or else Cursor /= null then + return True; + end if; + return False; + end Is_Displayed; + + -- Read the whole sub tree given and check if every element was found in + -- design. Called by Check_If_All_Found + procedure Check_Sub_Tree_If_All_Found + (Previous_Cursor : Elem_Acc; Sep : Character; Level : Positive); + + procedure Check_If_All_Found is + begin + for Index in Tree_Index_Type'Range loop + Check_Sub_Tree_If_All_Found (Trees (Index), Seps (Index), 1); + end loop; + end Check_If_All_Found; + +------------------------------------------------------------------------------- + + function Find_Cursor (Name : Ghdl_C_String; + First_Sibling : Elem_Acc; + Is_Signal : Boolean := False) + return Elem_Acc + is + Len : constant Natural := strlen (Name); + Cursor : Elem_Acc; + begin + Cursor := First_Sibling; + loop + if Cursor = null then + return null; + elsif Cursor.Name.all = Name (1 .. Len) then + if Is_Signal then + Cursor.Kind := Signal; + else + Cursor.Kind := Pkg_Entity; + end if; + return Cursor; + end if; + Cursor := Cursor.Next_Sibling; + end loop; + end Find_Cursor; + + procedure Check_Sub_Tree_If_All_Found + (Previous_Cursor : Elem_Acc; Sep : Character; Level : Positive) + is + Cursor : Elem_Acc; + Index : Positive; + begin + Cursor := Previous_Cursor; + while Cursor /= null loop + if Cursor.Kind = Not_Found then + Print_Context (Cursor.Line_Context, Warning); + Report_C ("no VHDL object in design matches "); + -- Display the path of the first unfound vhdl object in signal path + if Level > 1 then + Index := Cursor.Line_Context.Str'First; + for I in 2 .. Level loop + Index := Find (Cursor.Line_Context.Str.all, Sep, Index + 1); + end loop; + Report_C (Cursor.Line_Context.Str (Cursor.Line_Context.Str'First + .. Index)); + elsif Sep = '/' then + Report_C ("/"); + end if; + Report_E (Cursor.Name.all); + elsif Level = Cursor.Line_Context.Max_Level + and then Cursor.Kind = Pkg_Entity + then + Error_Context ("not a signal", Cursor.Line_Context, Warning); + else + Check_Sub_Tree_If_All_Found (Cursor.Next_Child, Sep, Level + 1); + end if; + Cursor := Cursor.Next_Sibling; + end loop; + + end Check_Sub_Tree_If_All_Found; + + function All_Signals_Displayed return Boolean is + begin + return Trees = Tree_Array'(others => null); + end All_Signals_Displayed; + + +end Grt.Wave_Opt_File.Tree_Reading; diff --git a/src/grt/grt-wave_opt_file-tree_reading.ads b/src/grt/grt-wave_opt_file-tree_reading.ads new file mode 100644 index 000000000..1358ac2ca --- /dev/null +++ b/src/grt/grt-wave_opt_file-tree_reading.ads @@ -0,0 +1,51 @@ +-- GHDL Run Time (GRT) - Wave option file package for reading the tree. +-- Copyright (C) 2016 Jonas Baggett +-- +-- GHDL is free software; you can redistribute it and/or modify it under +-- the terms of the GNU General Public License as published by the Free +-- Software Foundation; either version 2, or (at your option) any later +-- version. +-- +-- GHDL is distributed in the hope that it will be useful, but WITHOUT ANY +-- WARRANTY; without even the implied warranty of MERCHANTABILITY or +-- FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +-- for more details. +-- +-- You should have received a copy of the GNU General Public License +-- 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. +-- +-- As a special exception, if other files instantiate generics from this +-- unit, or you link this unit with other files to produce an executable, +-- this unit does not by itself cause the resulting executable to be +-- covered by the GNU General Public License. This exception does not +-- however invalidate any other reasons why the executable file might be +-- covered by the GNU Public License. + +-- Description: Wave option file child package for reading the tree created +-- after parsing the wave option file. It provides functions to +-- find in the tree which signals are to be displayed or not + +package Grt.Wave_Opt_File.Tree_Reading is + pragma Preelaborate; + + -- Returns the top element of the tree corresponding to the index given, but + -- only if the name given matches with it. Otherwise returns null + function Get_Top_Cursor (Name : Ghdl_C_String; Index : Tree_Index_Type) + return Elem_Acc; + + -- If there is an element in the parent element given that match the name + -- given, returns it, otherwise returns null + function Get_Cursor + (Name : Ghdl_C_String; Parent : Elem_Acc; Is_Signal : Boolean := False) + return Elem_Acc; + + -- Returns true if the element given is not null, which means it exists in + -- the tree of the VHDL elements to be displayed + function Is_Displayed (Cursor : Elem_Acc) return Boolean; + + -- Read the whole tree and check if every element was found in design + procedure Check_If_All_Found; + +end Grt.Wave_Opt_File.Tree_Reading; diff --git a/src/grt/grt-wave_opt_file.adb b/src/grt/grt-wave_opt_file.adb new file mode 100644 index 000000000..c93c2e885 --- /dev/null +++ b/src/grt/grt-wave_opt_file.adb @@ -0,0 +1,68 @@ +-- GHDL Run Time (GRT) - Wave option file top package. +-- Copyright (C) 2016 Jonas Baggett +-- +-- GHDL is free software; you can redistribute it and/or modify it under +-- the terms of the GNU General Public License as published by the Free +-- Software Foundation; either version 2, or (at your option) any later +-- version. +-- +-- GHDL is distributed in the hope that it will be useful, but WITHOUT ANY +-- WARRANTY; without even the implied warranty of MERCHANTABILITY or +-- FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +-- for more details. +-- +-- You should have received a copy of the GNU General Public License +-- 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. +-- +-- As a special exception, if other files instantiate generics from this +-- unit, or you link this unit with other files to produce an executable, +-- this unit does not by itself cause the resulting executable to be +-- covered by the GNU General Public License. This exception does not +-- however invalidate any other reasons why the executable file might be +-- covered by the GNU Public License. + +-- Description: See package specifications + +with Grt.Vstrings; use Grt.Vstrings; +with Grt.Errors; use Grt.Errors; + +package body Grt.Wave_Opt_File is + + procedure Print_Context + (Line_Context : Line_Context_Acc; Severity : Severity_Type) + is + Lineno_Str : String (1 .. Value_String_Size); + First : Natural; + begin + case Severity is + when Error => + Error_C (""); + when Warning => + Report_C ("warning: "); + end case; + Report_C ("in file '"); + Report_C (File_Path.all); + Report_C ("' at line "); + To_String (Lineno_Str, First, Ghdl_I32 (Line_Context.Num)); + Report_C (Lineno_Str (First .. Lineno_Str'Last)); + Report_C (" - "); + Report_C (Line_Context.Str.all); + Report_C (" : "); + end Print_Context; + + procedure Error_Context (Msg : String; + Line_Context : Line_Context_Acc; + Severity : Severity_Type := Error) is + begin + Print_Context (Line_Context, Severity); + case Severity is + when Error => + Error_E (Msg); + when Warning => + Report_E (Msg); + end case; + end Error_Context; + +end Grt.Wave_Opt_File; diff --git a/src/grt/grt-wave_opt_file.ads b/src/grt/grt-wave_opt_file.ads new file mode 100644 index 000000000..426a73b1d --- /dev/null +++ b/src/grt/grt-wave_opt_file.ads @@ -0,0 +1,78 @@ +-- GHDL Run Time (GRT) - Wave option file top package. +-- Copyright (C) 2016 Jonas Baggett +-- +-- GHDL is free software; you can redistribute it and/or modify it under +-- the terms of the GNU General Public License as published by the Free +-- Software Foundation; either version 2, or (at your option) any later +-- version. +-- +-- GHDL is distributed in the hope that it will be useful, but WITHOUT ANY +-- WARRANTY; without even the implied warranty of MERCHANTABILITY or +-- FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +-- for more details. +-- +-- You should have received a copy of the GNU General Public License +-- 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. +-- +-- As a special exception, if other files instantiate generics from this +-- unit, or you link this unit with other files to produce an executable, +-- this unit does not by itself cause the resulting executable to be +-- covered by the GNU General Public License. This exception does not +-- however invalidate any other reasons why the executable file might be +-- covered by the GNU Public License. + +-- Description: Wave option file top package. +-- Allows to select signals to be displayed on the waveform (with +-- the help of it's child units) +-- Contains common stuff for it's child units + +with Grt.Types; use Grt.Types; + +package Grt.Wave_Opt_File is + pragma Preelaborate; + + type String_Cst is access constant String; + Value_String_Size : constant := 10; + + File_Path : String_Cst; + + type Line_Context_Type is record + Str : String_Access; + Num : Natural; + Max_Level : Natural; + end record; + type Line_Context_Acc is access Line_Context_Type; + + type Elem_Kind_Type is (Not_Found, Pkg_Entity, Signal); + type Elem_Type; + type Elem_Acc is access Elem_Type; + type Elem_Type is record + Name : String_Cst; + Line_Context : Line_Context_Acc; + Kind : Elem_Kind_Type; + Next_Sibling : Elem_Acc; + Next_Child : Elem_Acc; + end record; + + type Tree_Index_Type is (Pkg, Entity); + type Tree_Array is array (Tree_Index_Type) of Elem_Acc; + Trees : Tree_Array := (others => null); + type Sep_Array is array (Tree_Index_Type) of Character; + Seps : constant Sep_Array := (Pkg => '.', Entity => '/'); + + type Severity_Type is (Error, Warning); + +private + -- An error/warning message start with the context or the error/warning. + -- This procedure print this context + procedure Print_Context + (Line_Context : Line_Context_Acc; Severity : Severity_Type); + + -- Print an error/warning with it's context + procedure Error_Context (Msg : String; + Line_Context : Line_Context_Acc; + Severity : Severity_Type := Error); + +end Grt.Wave_Opt_File; diff --git a/src/grt/grt-waves.adb b/src/grt/grt-waves.adb index d14d2b0c4..11caef838 100644 --- a/src/grt/grt-waves.adb +++ b/src/grt/grt-waves.adb @@ -44,6 +44,8 @@ with Grt.Signals; use Grt.Signals; with System; use System; with Grt.Vstrings; use Grt.Vstrings; with Grt.Ghw; use Grt.Ghw; +with Grt.Wave_Opt_File; use Grt.Wave_Opt_File; +with Grt.Wave_Opt_File.Tree_Reading; use Grt.Wave_Opt_File.Tree_Reading; pragma Elaborate_All (Grt.Rtis_Utils); pragma Elaborate_All (Grt.Table); @@ -911,13 +913,17 @@ package body Grt.Waves is end Write_Hierarchy_El; -- Create a hierarchy block. - procedure Wave_Put_Hierarchy_Block (Inst : VhpiHandleT; Step : Step_Type); + procedure Wave_Put_Hierarchy_Block (Inst : VhpiHandleT; + Step : Step_Type; + Wave_Elem : Wave_Opt_File.Elem_Acc); - procedure Wave_Put_Hierarchy_1 (Inst : VhpiHandleT; Step : Step_Type) + procedure Wave_Put_Hierarchy_1 + (Inst : VhpiHandleT; Step : Step_Type; Wave_Elem : Wave_Opt_File.Elem_Acc) is Decl_It : VhpiHandleT; Decl : VhpiHandleT; Error : AvhpiErrorT; + Wave_Elem_Child : Wave_Opt_File.Elem_Acc; begin Vhpi_Iterator (VhpiDecls, Inst, Decl_It, Error); if Error /= AvhpiErrorOk then @@ -934,22 +940,26 @@ package body Grt.Waves is return; end if; - case Vhpi_Get_Kind (Decl) is - when VhpiPortDeclK - | VhpiSigDeclK => - case Step is - when Step_Name => - Create_String_Id (Avhpi_Get_Base_Name (Decl)); - Nbr_Scope_Signals := Nbr_Scope_Signals + 1; - Create_Object_Type (Decl); - when Step_Hierarchy => - Write_Hierarchy_El (Decl); - end case; - --Wave_Put_Name (Decl); - --Wave_Newline; - when others => - null; - end case; + Wave_Elem_Child := Get_Cursor (Avhpi_Get_Base_Name (Decl), Wave_Elem, + Is_Signal => True); + if Is_Displayed (Wave_Elem_Child) then + case Vhpi_Get_Kind (Decl) is + when VhpiPortDeclK + | VhpiSigDeclK => + case Step is + when Step_Name => + Create_String_Id (Avhpi_Get_Base_Name (Decl)); + Nbr_Scope_Signals := Nbr_Scope_Signals + 1; + Create_Object_Type (Decl); + when Step_Hierarchy => + Write_Hierarchy_El (Decl); + end case; + --Wave_Put_Name (Decl); + --Wave_Newline; + when others => + null; + end case; + end if; end loop; -- No sub-scopes for packages. @@ -974,30 +984,34 @@ package body Grt.Waves is Nbr_Scopes := Nbr_Scopes + 1; - case Vhpi_Get_Kind (Decl) is - when VhpiIfGenerateK - | VhpiForGenerateK - | VhpiBlockStmtK - | VhpiCompInstStmtK => - Wave_Put_Hierarchy_Block (Decl, Step); - when VhpiProcessStmtK => - case Step is - when Step_Name => - Create_String_Id (Avhpi_Get_Base_Name (Decl)); - when Step_Hierarchy => - Write_Hierarchy_El (Decl); - end case; - when others => - Internal_Error ("wave_put_hierarchy_1"); --- Wave_Put ("unknown "); --- Wave_Put (VhpiClassKindT'Image (Vhpi_Get_Kind (Decl))); --- Wave_Newline; - end case; + Wave_Elem_Child := Get_Cursor (Avhpi_Get_Base_Name (Decl), Wave_Elem); + if Is_Displayed (Wave_Elem_Child) then + case Vhpi_Get_Kind (Decl) is + when VhpiIfGenerateK + | VhpiForGenerateK + | VhpiBlockStmtK + | VhpiCompInstStmtK => + Wave_Put_Hierarchy_Block (Decl, Step, Wave_Elem_Child); + when VhpiProcessStmtK => + case Step is + when Step_Name => + Create_String_Id (Avhpi_Get_Base_Name (Decl)); + when Step_Hierarchy => + Write_Hierarchy_El (Decl); + end case; + when others => + Internal_Error ("wave_put_hierarchy_1"); + -- Wave_Put ("unknown "); + -- Wave_Put (VhpiClassKindT'Image (Vhpi_Get_Kind (Decl))); + -- Wave_Newline; + end case; + end if; end loop; end Wave_Put_Hierarchy_1; - procedure Wave_Put_Hierarchy_Block (Inst : VhpiHandleT; Step : Step_Type) - is + procedure Wave_Put_Hierarchy_Block (Inst : VhpiHandleT; + Step : Step_Type; + Wave_Elem : Wave_Opt_File.Elem_Acc) is begin case Step is when Step_Name => @@ -1009,7 +1023,7 @@ package body Grt.Waves is Write_Hierarchy_El (Inst); end case; - Wave_Put_Hierarchy_1 (Inst, Step); + Wave_Put_Hierarchy_1 (Inst, Step, Wave_Elem); if Step = Step_Hierarchy then Wave_Put_Byte (Ghw_Hie_Eos); @@ -1021,6 +1035,7 @@ package body Grt.Waves is Pack_It : VhpiHandleT; Pack : VhpiHandleT; Error : AvhpiErrorT; + Wave_Elem : Wave_Opt_File.Elem_Acc; begin -- First packages. Get_Package_Inst (Pack_It); @@ -1031,12 +1046,17 @@ package body Grt.Waves is Avhpi_Error (Error); return; end if; - - Wave_Put_Hierarchy_Block (Pack, Step); + Wave_Elem := Get_Top_Cursor (Avhpi_Get_Base_Name (Pack), Pkg); + if Is_Displayed (Wave_Elem) then + Wave_Put_Hierarchy_Block (Pack, Step, Wave_Elem); + end if; end loop; -- Then top entity. - Wave_Put_Hierarchy_Block (Root, Step); + Wave_Elem := Get_Top_Cursor (Avhpi_Get_Base_Name (Root), Entity); + if Is_Displayed (Wave_Elem) then + Wave_Put_Hierarchy_Block (Root, Step, Wave_Elem); + end if; end Wave_Put_Hierarchy; procedure Disp_Str_AVL (Str : AVL_Nid; Indent : Natural) @@ -1557,7 +1577,13 @@ package body Grt.Waves is -- Vcd_Search_Packages; Wave_Put_Hierarchy (Root, Step_Name); - Freeze_Strings; + Wave_Opt_File.Tree_Reading.Check_If_All_Found; + -- TODO : The tree of the wave option file should be deallocated here, + -- but the memory gain shouldn't be significative + + if Str_Table.Last > 0 then + Freeze_Strings; + end if; -- Register_Cycle_Hook (Vcd_Cycle'Access); Write_Strings_Compress; |