diff options
author | Jonsba <jonasb@tranquille.ch> | 2016-07-26 18:59:08 +0200 |
---|---|---|
committer | tgingold <tgingold@users.noreply.github.com> | 2016-07-26 18:59:08 +0200 |
commit | cc352d278fcce918d374406ff64c27cde0a59402 (patch) | |
tree | 74372f5905b98a854324431761aa9b002915894b /src/grt | |
parent | 7776856c175ed776c7606ad48f8170dcb79243a9 (diff) | |
download | ghdl-cc352d278fcce918d374406ff64c27cde0a59402.tar.gz ghdl-cc352d278fcce918d374406ff64c27cde0a59402.tar.bz2 ghdl-cc352d278fcce918d374406ff64c27cde0a59402.zip |
Adding support for a wave option file that selects signals to be displayed (#121)
Adding support for a wave option file that selects signals to be displayed on the waveform (currently only works with the ghw wave format). Only full signal paths are supported now (no wildcards). Wave option file version set to 1.0.
Diffstat (limited to 'src/grt')
-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; |