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.

1 files changed, 354 insertions, 0 deletions

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;