From b869a4acb52358fe8ca5decaac826af056bfdfca Mon Sep 17 00:00:00 2001 From: Jonas Baggett Date: Tue, 1 Nov 2016 19:23:38 +0100 Subject: There is a new --write-opt-file option that will create a wave option file with all the signals of the design. (#179) The --wave-opt-file option is renamed to --read-opt-file for consistency Some code cleanup and bug fixes --- doc/Simulation_and_runtime.rst | 19 +- src/grt/grt-fst.adb | 46 ++- src/grt/grt-options.adb | 14 +- src/grt/grt-types.ads | 1 + src/grt/grt-vcd.adb | 59 ++-- src/grt/grt-wave_opt-design.adb | 149 ++++++++++ src/grt/grt-wave_opt-design.ads | 60 ++++ src/grt/grt-wave_opt-file-debug.adb | 65 +++++ src/grt/grt-wave_opt-file-debug.ads | 35 +++ src/grt/grt-wave_opt-file.adb | 438 +++++++++++++++++++++++++++++ src/grt/grt-wave_opt-file.ads | 77 +++++ src/grt/grt-wave_opt.adb | 75 +++++ src/grt/grt-wave_opt.ads | 90 ++++++ src/grt/grt-wave_opt_file-parse-debug.adb | 67 ----- src/grt/grt-wave_opt_file-parse-debug.ads | 35 --- src/grt/grt-wave_opt_file-parse.adb | 346 ----------------------- src/grt/grt-wave_opt_file-parse.ads | 54 ---- src/grt/grt-wave_opt_file-tree_reading.adb | 135 --------- src/grt/grt-wave_opt_file-tree_reading.ads | 53 ---- src/grt/grt-wave_opt_file.adb | 75 ----- src/grt/grt-wave_opt_file.ads | 80 ------ src/grt/grt-waves.adb | 51 ++-- 22 files changed, 1096 insertions(+), 928 deletions(-) create mode 100644 src/grt/grt-wave_opt-design.adb create mode 100644 src/grt/grt-wave_opt-design.ads create mode 100644 src/grt/grt-wave_opt-file-debug.adb create mode 100644 src/grt/grt-wave_opt-file-debug.ads create mode 100644 src/grt/grt-wave_opt-file.adb create mode 100644 src/grt/grt-wave_opt-file.ads create mode 100644 src/grt/grt-wave_opt.adb create mode 100644 src/grt/grt-wave_opt.ads delete mode 100644 src/grt/grt-wave_opt_file-parse-debug.adb delete mode 100644 src/grt/grt-wave_opt_file-parse-debug.ads delete mode 100644 src/grt/grt-wave_opt_file-parse.adb delete mode 100644 src/grt/grt-wave_opt_file-parse.ads delete mode 100644 src/grt/grt-wave_opt_file-tree_reading.adb delete mode 100644 src/grt/grt-wave_opt_file-tree_reading.ads delete mode 100644 src/grt/grt-wave_opt_file.adb delete mode 100644 src/grt/grt-wave_opt_file.ads diff --git a/doc/Simulation_and_runtime.rst b/doc/Simulation_and_runtime.rst index 979a9892a..518c8a290 100644 --- a/doc/Simulation_and_runtime.rst +++ b/doc/Simulation_and_runtime.rst @@ -118,11 +118,28 @@ all options available, including the debugging one. Disable buffering on stdout, stderr and files opened in write or append mode (TEXTIO). -.. option:: --wave-opt-file= +.. option:: --read-opt-file= Filter signals to be dumped to the wave file according to the wave option file provided. + Here is a description of the wave option file format : + + $ version = 1.0 # Optional + + # Signals in packages : + my_pkg.global_signal_a + + # Signals in entities : + /top/sub/clk + + +.. option:: --write-opt-file= + + If the wave option file doesn't exist, creates it with all the signals of + the design. Otherwise throws an error, because it won't erase an existing + file. + .. option:: --vcd= diff --git a/src/grt/grt-fst.adb b/src/grt/grt-fst.adb index 29bc5acad..20455b3aa 100644 --- a/src/grt/grt-fst.adb +++ b/src/grt/grt-fst.adb @@ -52,8 +52,8 @@ with Grt.Hooks; use Grt.Hooks; with Grt.Rtis; use Grt.Rtis; with Grt.Rtis_Types; use Grt.Rtis_Types; with Grt.Vstrings; -with Grt.Wave_Opt_File; use Grt.Wave_Opt_File; -with Grt.Wave_Opt_File.Tree_Reading; use Grt.Wave_Opt_File.Tree_Reading; +with Grt.Wave_Opt; use Grt.Wave_Opt; +with Grt.Wave_Opt.Design; use Grt.Wave_Opt.Design; with Ada.Unchecked_Deallocation; pragma Elaborate_All (Grt.Table); @@ -413,11 +413,10 @@ package body Grt.Fst is end Fst_Add_Signal; procedure Fst_Put_Hierarchy - (Inst : VhpiHandleT; Wave_Elem : Wave_Opt_File.Elem_Acc); + (Inst : VhpiHandleT; Wave_Elem : Wave_Opt.Elem_Acc); - procedure Fst_Put_Scope (Scope : fstScopeType; - Decl : VhpiHandleT; - Wave_Elem : Wave_Opt_File.Elem_Acc) + procedure Fst_Put_Scope + (Scope : fstScopeType; Decl : VhpiHandleT; Wave_Elem : Wave_Opt.Elem_Acc) is Name : String (1 .. 128); Name_Len : Integer; @@ -473,12 +472,12 @@ package body Grt.Fst is end Fst_Put_Scope; procedure Fst_Put_Hierarchy - (Inst : VhpiHandleT; Wave_Elem : Wave_Opt_File.Elem_Acc) + (Inst : VhpiHandleT; Wave_Elem : Wave_Opt.Elem_Acc) is Decl_It : VhpiHandleT; Decl : VhpiHandleT; Error : AvhpiErrorT; - Wave_Elem_Child : Wave_Opt_File.Elem_Acc; + Wave_Elem_Child : Wave_Opt.Elem_Acc; begin Vhpi_Iterator (VhpiDecls, Inst, Decl_It, Error); if Error /= AvhpiErrorOk then @@ -495,18 +494,17 @@ package body Grt.Fst is return; end if; - - 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 Vhpi_Get_Kind (Decl) is + when VhpiPortDeclK + | VhpiSigDeclK => + Wave_Elem_Child := Get_Cursor + (Wave_Elem, Avhpi_Get_Base_Name (Decl), Is_Signal => True); + if Is_Displayed (Wave_Elem_Child) then Fst_Add_Signal (Decl); - when others => - null; - end case; - end if; + end if; + when others => + null; + end case; end loop; -- Extract sub-scopes. @@ -529,7 +527,7 @@ package body Grt.Fst is return; end if; - Wave_Elem_Child := Get_Cursor (Avhpi_Get_Base_Name (Decl), Wave_Elem); + Wave_Elem_Child := Get_Cursor (Wave_Elem, Avhpi_Get_Base_Name (Decl)); if Is_Displayed (Wave_Elem_Child) then case Vhpi_Get_Kind (Decl) is when VhpiIfGenerateK => @@ -626,7 +624,7 @@ package body Grt.Fst is Pack : VhpiHandleT; Error : AvhpiErrorT; Root : VhpiHandleT; - Wave_Elem : Wave_Opt_File.Elem_Acc; + Wave_Elem : Wave_Opt.Elem_Acc; begin -- Do nothing if there is no VCD file to generate. if Context = Null_fstContext then @@ -652,7 +650,7 @@ package body Grt.Fst is Avhpi_Error (Error); return; end if; - Wave_Elem := Get_Top_Cursor (Avhpi_Get_Base_Name (Pack), Pkg); + Wave_Elem := Get_Top_Cursor (Pkg, Avhpi_Get_Base_Name (Pack)); if Is_Displayed (Wave_Elem) then Fst_Put_Hierarchy (Pack, Wave_Elem); end if; @@ -660,11 +658,11 @@ package body Grt.Fst is -- Then top entity. Get_Root_Inst (Root); - Wave_Elem := Get_Top_Cursor (Avhpi_Get_Base_Name (Root), Entity); + Wave_Elem := Get_Top_Cursor (Entity, Avhpi_Get_Base_Name (Root)); if Is_Displayed (Wave_Elem) then Fst_Put_Hierarchy (Root, Wave_Elem); end if; - Wave_Opt_File.Tree_Reading.Check_If_All_Found; + Wave_Opt.Design.Last_Checks; if Flag_Aliases then Free_Hash_Tab; diff --git a/src/grt/grt-options.adb b/src/grt/grt-options.adb index 6c3f333d3..8c045bd7d 100644 --- a/src/grt/grt-options.adb +++ b/src/grt/grt-options.adb @@ -28,7 +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; +with Grt.Wave_Opt.File; package body Grt.Options is @@ -165,7 +165,8 @@ package body Grt.Options is P (" --no-run do not simulate, only elaborate"); P (" --unbuffered disable buffering on stdout, stderr and"); P (" files opened in write or append mode (TEXTIO)."); - P (" --wave-opt-file=FILENAME read a wave option file"); + P (" --read-wave-opt=FILENAME read a wave option file."); + P (" --write-wave-opt=FILENAME write a wave option file."); -- P (" --threads=N use N threads for simulation"); P ("Additional features:"); P (" --has-feature=X test presence of feature X"); @@ -486,9 +487,14 @@ package body Grt.Options is Unbuffered_Writes := True; setbuf (stdout, NULL_voids); setbuf (stderr, NULL_voids); - elsif Option'Length >= 16 and then Option (1 .. 16) = "--wave-opt-file=" + elsif Len >= 16 and then Option (1 .. 16) = "--read-wave-opt=" then - Wave_Opt_File.Parse.Start (Option (17 .. Option'Last)); + Wave_Opt.File.Start + (Option (17 .. Option'Last), To_Be_Created => False); + elsif Len >= 17 and then Option (1 .. 17) = "--write-wave-opt=" + then + Wave_Opt.File.Start + (Option (18 .. Option'Last), To_Be_Created => True); elsif not Grt.Hooks.Call_Option_Hooks (Option) then Error_C ("unknown option '"); Error_C (Option); diff --git a/src/grt/grt-types.ads b/src/grt/grt-types.ads index 4824762b7..5fb60f2d5 100644 --- a/src/grt/grt-types.ads +++ b/src/grt/grt-types.ads @@ -49,6 +49,7 @@ package Grt.Types is -- Access to an unconstrained string. type String_Access is access String; + type String_Cst is access constant String; procedure Unchecked_Deallocation is new Ada.Unchecked_Deallocation (Name => String_Access, Object => String); diff --git a/src/grt/grt-vcd.adb b/src/grt/grt-vcd.adb index 95a724c76..b44090ed5 100644 --- a/src/grt/grt-vcd.adb +++ b/src/grt/grt-vcd.adb @@ -49,8 +49,8 @@ with Grt.Rtis; use Grt.Rtis; with Grt.Rtis_Addr; use Grt.Rtis_Addr; with Grt.Rtis_Types; use Grt.Rtis_Types; with Grt.Vstrings; -with Grt.Wave_Opt_File; use Grt.Wave_Opt_File; -with Grt.Wave_Opt_File.Tree_Reading; use Grt.Wave_Opt_File.Tree_Reading; +with Grt.Wave_Opt; use Grt.Wave_Opt; +with Grt.Wave_Opt.Design; use Grt.Wave_Opt.Design; pragma Elaborate_All (Grt.Table); package body Grt.Vcd is @@ -532,12 +532,12 @@ package body Grt.Vcd is end Add_Signal; procedure Vcd_Put_Hierarchy - (Inst : VhpiHandleT; Wave_Elem : Wave_Opt_File.Elem_Acc) + (Inst : VhpiHandleT; Wave_Elem : Wave_Opt.Elem_Acc) is Decl_It : VhpiHandleT; Decl : VhpiHandleT; Error : AvhpiErrorT; - Wave_Elem_Child : Wave_Opt_File.Elem_Acc; + Wave_Elem_Child : Wave_Opt.Elem_Acc; begin Vhpi_Iterator (VhpiDecls, Inst, Decl_It, Error); if Error /= AvhpiErrorOk then @@ -554,17 +554,17 @@ package body Grt.Vcd is return; end if; - 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 Vhpi_Get_Kind (Decl) is + when VhpiPortDeclK + | VhpiSigDeclK => + Wave_Elem_Child := Get_Cursor + (Wave_Elem, Avhpi_Get_Base_Name (Decl), Is_Signal => True); + if Is_Displayed (Wave_Elem_Child) then Add_Signal (Decl); - when others => - null; - end case; - end if; + end if; + when others => + null; + end case; end loop; -- Extract sub-scopes. @@ -585,13 +585,14 @@ package body Grt.Vcd is Avhpi_Error (Error); return; end if; - 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 => + case Vhpi_Get_Kind (Decl) is + when VhpiIfGenerateK + | VhpiForGenerateK + | VhpiBlockStmtK + | VhpiCompInstStmtK => + Wave_Elem_Child := Get_Cursor + (Wave_Elem, Avhpi_Get_Base_Name (Decl)); + if Is_Displayed (Wave_Elem_Child) then Vcd_Put ("$scope module "); Vcd_Put_Name (Decl); Vcd_Putc (' '); @@ -599,10 +600,10 @@ package body Grt.Vcd is Vcd_Put_Hierarchy (Decl, Wave_Elem_Child); Vcd_Put ("$upscope "); Vcd_Put_End; - when others => - null; - end case; - end if; + end if; + when others => + null; + end case; end loop; end Vcd_Put_Hierarchy; @@ -872,7 +873,7 @@ package body Grt.Vcd is Pack : VhpiHandleT; Error : AvhpiErrorT; Root : VhpiHandleT; - Wave_Elem : Wave_Opt_File.Elem_Acc; + Wave_Elem : Wave_Opt.Elem_Acc; begin -- Do nothing if there is no VCD file to generate. if Vcd_Close = null then @@ -893,7 +894,7 @@ package body Grt.Vcd is Avhpi_Error (Error); return; end if; - Wave_Elem := Get_Top_Cursor (Avhpi_Get_Base_Name (Pack), Pkg); + Wave_Elem := Get_Top_Cursor (Pkg, Avhpi_Get_Base_Name (Pack)); if Is_Displayed (Wave_Elem) then Vcd_Put_Hierarchy (Pack, Wave_Elem); end if; @@ -901,11 +902,11 @@ package body Grt.Vcd is -- Then top entity. Get_Root_Inst (Root); - Wave_Elem := Get_Top_Cursor (Avhpi_Get_Base_Name (Root), Entity); + Wave_Elem := Get_Top_Cursor (Entity, Avhpi_Get_Base_Name (Root)); if Is_Displayed (Wave_Elem) then Vcd_Put_Hierarchy (Root, Wave_Elem); end if; - Wave_Opt_File.Tree_Reading.Check_If_All_Found; + Wave_Opt.Design.Last_Checks; -- End of header. Vcd_Put ("$enddefinitions "); diff --git a/src/grt/grt-wave_opt-design.adb b/src/grt/grt-wave_opt-design.adb new file mode 100644 index 000000000..2002cca0d --- /dev/null +++ b/src/grt/grt-wave_opt-design.adb @@ -0,0 +1,149 @@ +-- 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.Errors; use Grt.Errors; +with Grt.Wave_Opt.File; use Grt.Wave_Opt.File; + +package body Grt.Wave_Opt.Design is + + -- Find the element that matches the name given. Starts with the element + -- given, then go thru all its siblings + function Find_Cursor (Name : String; + First_Sibling : Elem_Acc; + Is_Signal : Boolean := False) + return Elem_Acc; + + function Get_Top_Cursor (Tree_Index : Tree_Index_Type; Name : Ghdl_C_String) + return Elem_Acc + is + Root : Elem_Acc; + begin + Root := Trees (Tree_Index); + if State = Write_File and then Root.Next_Child = null then + Write_Tree_Comment (Tree_Index); + end if; + return Get_Cursor (Root, Name); + end Get_Top_Cursor; + + function Get_Cursor (Parent : Elem_Acc; + Name : Ghdl_C_String; + Is_Signal : Boolean := False) return Elem_Acc + is + Cursor : Elem_Acc; + Dummy_Bool : Boolean; + Str_Name : constant String := Name (1 .. strlen (Name)); + begin + case State is + when Write_File => + Cursor := Parent; + Update_Tree (Cursor => Cursor, + Updated => Dummy_Bool, + Elem_Name => Str_Name, + Level => Parent.Level + 1); + if Is_Signal then + Write_Signal_Path (Cursor); + end if; + return Cursor; + when Display_Tree => + return Find_Cursor (Str_Name, Parent.Next_Child, Is_Signal); + when Display_All => + return null; + end case; + end Get_Cursor; + + function Find_Cursor (Name : String; + First_Sibling : Elem_Acc; + Is_Signal : Boolean := False) + return Elem_Acc + is + Cursor : Elem_Acc; + begin + Cursor := First_Sibling; + loop + if Cursor = null then + return null; + elsif Cursor.Name.all = Name 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; + + function Is_Displayed (Cursor : Elem_Acc) return Boolean is + begin + if State /= Display_Tree 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 Last_Checks + procedure Check_Sub_Tree_If_All_Found (Previous_Cursor : Elem_Acc); + + procedure Last_Checks is + begin + if Wave_Opt.State = Display_Tree then + for Index in Tree_Index_Type'Range loop + Check_Sub_Tree_If_All_Found (Trees (Index).Next_Child); + end loop; + end if; + -- TODO : The tree of the wave option file should be deallocated here, + -- but the memory gain shouldn't be significative + end Last_Checks; + + procedure Check_Sub_Tree_If_All_Found (Previous_Cursor : Elem_Acc) + is + Cursor : Elem_Acc; + begin + Cursor := Previous_Cursor; + while Cursor /= null loop + if Cursor.Kind = Not_Found then + Print_Context (Cursor, Warning); + Report_C (Cursor.Name.all); + Report_C (" : first element of the path not found in design."); + Report_E (" more references may follow"); + elsif Cursor.Level = Cursor.Path_Context.Max_Level + and then Cursor.Kind = Pkg_Entity + then + Print_Context (Cursor, Warning); + Report_C (Cursor.Name.all); + Report_E (" is not a signal"); + else + Check_Sub_Tree_If_All_Found (Cursor.Next_Child); + end if; + Cursor := Cursor.Next_Sibling; + end loop; + + end Check_Sub_Tree_If_All_Found; + +end Grt.Wave_Opt.Design; diff --git a/src/grt/grt-wave_opt-design.ads b/src/grt/grt-wave_opt-design.ads new file mode 100644 index 000000000..54a96acfa --- /dev/null +++ b/src/grt/grt-wave_opt-design.ads @@ -0,0 +1,60 @@ +-- 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 doing the link between the +-- design and the other wave option packages. +-- Provides functions to find in the tree which signals are to be +-- displayed or not. +-- When State = Display_Tree, it reads the tree created after +-- parsing the wave option file and filters signals accordingly. +-- When State = Write_File, it calls File.Update_Tree to create +-- the tree from the design tree and write the signal paths of all +-- the design to a new wave option file. + +with Grt.Types; use Grt.Types; + +package Grt.Wave_Opt.Design 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 (Tree_Index : Tree_Index_Type; Name : Ghdl_C_String) + return Elem_Acc; + + -- If there is an element in the parent element given that matches the name + -- given, returns it, otherwise returns null + function Get_Cursor + (Parent : Elem_Acc; Name : Ghdl_C_String; 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; + + -- If relevent, read the whole tree and check if every element was found in + -- design + procedure Last_Checks; + +end Grt.Wave_Opt.Design; diff --git a/src/grt/grt-wave_opt-file-debug.adb b/src/grt/grt-wave_opt-file-debug.adb new file mode 100644 index 000000000..44878077a --- /dev/null +++ b/src/grt/grt-wave_opt-file-debug.adb @@ -0,0 +1,65 @@ +-- 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.Debug is + + -- Dump recursively an element of the tree. + procedure Dump_Sub_Tree (Cursor : Elem_Acc); + + 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).Next_Child); + end loop; + Put_Line ("----------- END -----------------"); + New_Line; + end Dump_Tree; + + procedure Dump_Sub_Tree (Cursor : Elem_Acc) + is + Sibling_Cursor : Elem_Acc; + begin + Sibling_Cursor := Cursor; + while Sibling_Cursor /= null loop + Put ((3 .. 2 * Sibling_Cursor.Level => ' ')); + Put ('/'); + Put_Line (Sibling_Cursor.Name.all); + Dump_Sub_Tree (Sibling_Cursor.Next_Child); + Sibling_Cursor := Sibling_Cursor.Next_Sibling; + end loop; + end Dump_Sub_Tree; + +end Grt.Wave_Opt.File.Debug; diff --git a/src/grt/grt-wave_opt-file-debug.ads b/src/grt/grt-wave_opt-file-debug.ads new file mode 100644 index 000000000..a8542b43f --- /dev/null +++ b/src/grt/grt-wave_opt-file-debug.ads @@ -0,0 +1,35 @@ +-- 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.Debug is + pragma Preelaborate; + + -- Dump all the tree + procedure Dump_Tree; + +end Grt.Wave_Opt.File.Debug; diff --git a/src/grt/grt-wave_opt-file.adb b/src/grt/grt-wave_opt-file.adb new file mode 100644 index 000000000..bad572f15 --- /dev/null +++ b/src/grt/grt-wave_opt-file.adb @@ -0,0 +1,438 @@ +-- 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.Types; use Grt.Types; +with Grt.Strings; use Grt.Strings; +with Grt.Astdio; use Grt.Astdio; +with Grt.Errors; use Grt.Errors; +--~ with Grt.Wave_Opt.File.Debug; + +package body Grt.Wave_Opt.File is + + -- Open the wave option file + function Open (Option_File : String; To_Be_Created : Boolean) return FILEs; + + -- Initialize the root of the tree + procedure Initialize_Tree; + + -- Tell if the tree is empty (beside the root) + function Tree_Is_Empty return Boolean; + + -- Parse the wave option file + procedure Parse_File (Stream : FILEs); + + -- Parse the line where the version is set + procedure Parse_Version (Line : String; Lineno : Positive); + + -- 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 : in out String; Lineno : Positive); + + procedure Start (Option_File : String; To_Be_Created : Boolean) is + Stream : FILEs; + begin + File_Path := new String'(Option_File); + Stream := Open (Option_File, To_Be_Created); + + if State = Display_Tree then + Parse_File (Stream); + -- Otherwise, State = Write_File + else + Write_Stream := Stream; + end if; + end Start; + + procedure Parse_File (Stream : FILEs) + is + First, Last : Integer; + Line : String (1 .. Buf_Size); + Lineno : Natural; + begin + 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)); + + if Line (First) = '$' then + Parse_Version (Line (First .. Last), Lineno); + else + Parse_Path (Line (First .. Last), Lineno); + end if; + + <> 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 Tree_Is_Empty then + Report_E ("No signal path was found in the wave option file," & + " then every signals will be displayed."); + end if; + + fclose (Stream); + --~ Debug.Dump_Tree; + + end Parse_File; + + procedure Parse_Version (Line : String; Lineno : Positive) + 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", Lineno, Line'First); + end if; + + if not Tree_Is_Empty then + Error_Context + ("version cannot be set after signal paths", Lineno, Line'First); + 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, Lineno, Line'First); + end if; + + -- Catch "version\n", "version1.0" + First := First + 7; + if not Is_Whitespace (Line (First)) then + Error_Context (Msg_Invalid_Format, Lineno, Line'First); + 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, Lineno, Line'First); + 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, Lineno, Line'First); + end if; + + -- Catch version a.2 + Num := Value (Line (First .. Dot_Index - 1)); + if Num = -1 then + Error_Context (Msg_Invalid_Format, Lineno, Line'First); + 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, Lineno, Line'First); + end if; + Version.Minor := Num; + + if Version.Major /= Current_Version.Major + or else Version.Minor > Current_Version.Minor + then + Print_Context (Line'First, Lineno, 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 + begin + Report_C (Version.Major); + Report_C ("."); + Report_C (Version.Minor); + end Print_Version; + + procedure Initialize_Tree is + begin + for I in Tree_Index_Type'Range loop + Trees (I) := new Elem_Type; + Trees (I).Name := new String'(1 => Seps (I)); + Trees (I).Level := 0; + end loop; + end Initialize_Tree; + + function Tree_Is_Empty return Boolean is + begin + return Trees (Pkg).Next_Child = null + and Trees (Entity).Next_Child = null; + end Tree_Is_Empty; + + procedure Parse_Path (Line : in out String; Lineno : Positive) + is + -- Can equal to 0 in case of error (like '.' as a full path) + First, Last : Natural; + Path_Context : Path_Context_Acc; + Tree_Index : Tree_Index_Type; + Tree_Cursor : Elem_Acc; + Tree_Updated : Boolean; + begin + Path_Context := new Path_Context_Type'(Lineno => Lineno, + Max_Level => 0); + To_Lower (Line); + 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", Path_Context.Lineno, Line'First); + 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, '/') > 0 then + Error_Context + ("invalid signal path", Path_Context.Lineno, Line'First); + end if; + Tree_Index := Pkg; + end if; + Tree_Cursor := Trees (Tree_Index); + + 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; + + Path_Context.Max_Level := Path_Context.Max_Level + 1; + Update_Tree (Cursor => Tree_Cursor, + Updated => Tree_Updated, + Elem_Name => Line (First .. Last), + Level => Path_Context.Max_Level, + Path_Context => Path_Context); + + if Last = Line'Last then + if not Tree_Updated then + Error_Context ("ignored already known signal path", + Path_Context.Lineno, + Line'First, + 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", Path_Context.Lineno, Line'First); + end if; + + end loop; + + end Parse_Path; + + procedure Update_Tree (Cursor : in out Elem_Acc; + Updated : out Boolean; + Elem_Name : String; + Level : Natural; + Path_Context : Path_Context_Acc := null) + is + Sibling_Cursor, Previous_Sibling_Cursor : Elem_Acc; + Created_Elem : Elem_Acc; + begin + Previous_Sibling_Cursor := null; + Sibling_Cursor := Cursor.Next_Child; + 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 + Created_Elem := new Elem_Type; + Created_Elem.Name := new String'(Elem_Name); + Created_Elem.Path_Context := Path_Context; + Created_Elem.Column := Elem_Name'First; + Created_Elem.Level := Level; + Created_Elem.Parent := Cursor; + -- First element of level ? + if Previous_Sibling_Cursor = null then + Cursor.Next_Child := Created_Elem; + else + Previous_Sibling_Cursor.Next_Sibling := Created_Elem; + end if; + Cursor := Created_Elem; + Updated := True; + return; + -- Identifier was found in the tree ? Then move to its first child + elsif Elem_Name = Sibling_Cursor.Name.all then + Cursor := Sibling_Cursor; + Updated := False; + return; + end if; + Previous_Sibling_Cursor := Sibling_Cursor; + Sibling_Cursor := Sibling_Cursor.Next_Sibling; + end loop; + end Update_Tree; + + procedure Write_Version (Stream : FILEs) is + begin + Put (Stream, "$ version "); + Put_I32 (Stream, Ghdl_I32 (Current_Version.Major)); + Put (Stream, '.'); + Put_I32 (Stream, Ghdl_I32 (Current_Version.Minor)); + New_Line (Stream); + end Write_Version; + + function Open (Option_File : String; To_Be_Created : Boolean) return FILEs + is + Read_Mode : constant String := "rt" & ASCII.Nul; + Write_Mode : constant String := "wt" & ASCII.Nul; + Stream : FILEs; + Option_File_C : String (1 .. Option_File'Length + 1); + begin + Option_File_C (1 .. Option_File'Length) := Option_File; + Option_File_C (Option_File_C'Last) := ASCII.Nul; + State := Display_Tree; + Stream := fopen (Option_File_C'Address, Read_Mode'Address); + + if To_Be_Created then + if Stream /= NULL_Stream then + fclose (Stream); + Error_C ("'"); + Error_C (Option_File); + Error_E ("' already exists and it won't be erased."); + end if; + State := Write_File; + Stream := fopen (Option_File_C'Address, Write_Mode'Address); + if Stream = NULL_Stream then + Error_C ("cannot create '"); + Error_C (Option_File); + Error_E ("'."); + end if; + Write_Version (Stream); + elsif Stream = NULL_Stream then + Error_C ("cannot read '"); + Error_C (Option_File); + Error_E ("'."); + end if; + + Initialize_Tree; + + return Stream; + end Open; + + procedure Write_Tree_Comment (Tree_Index : Tree_Index_Type) is + begin + New_Line (Write_Stream); + if Tree_Index = Pkg then + Put_Line (Write_Stream, "# Signals in packages :"); + else + Put_Line (Write_Stream, "# Signals in entities :"); + end if; + end Write_Tree_Comment; + + procedure Write_Signal_Path (Signal : Elem_Acc) is + type Elem_Array is array (Positive range <>) of Elem_Acc; + Signal_Path : Elem_Array (1 .. Signal.Level - 1); + Cursor : Elem_Acc; + Sep : Character; + begin + Cursor := Signal.Parent; + for I in reverse Signal_Path'Range loop + Signal_Path (I) := Cursor; + Cursor := Cursor.Parent; + end loop; + if Signal_Path (1).Parent.Name.all = "/" then + Sep := '/'; + Put (Write_Stream, Sep); + else + Sep := '.'; + end if; + for I in Signal_Path'Range loop + Put (Write_Stream, Signal_Path (I).Name.all); + Put (Write_Stream, Sep); + end loop; + Put_Line (Write_Stream, Signal.Name.all); + end Write_Signal_Path; + + procedure Finalize is + begin + if State = Write_File then + fclose (Write_Stream); + State := Display_All; + end if; + end Finalize; + +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..fafc8eb0e --- /dev/null +++ b/src/grt/grt-wave_opt-file.ads @@ -0,0 +1,77 @@ +-- 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 file manipulation and +-- tree creation. +-- When State = Display_Tree, it parse the wave option file +-- provided in the command line and create a tree with the path of +-- the signals to be displayed on the waveform. + +with Grt.Stdio; use Grt.Stdio; + +package Grt.Wave_Opt.File is + pragma Preelaborate; + + -- Open the wave option file given as parameter and parses it if it exists, + -- otherwise creates it and it will be written when reading the design + -- hierarchy + procedure Start (Option_File : String; To_Be_Created : Boolean); + + -- Write the path of a signal to the option file + procedure Write_Signal_Path (Signal : Elem_Acc); + + -- Write a starting comment before the first signal path of the packages + -- tree or of the entities tree is ever written + procedure Write_Tree_Comment (Tree_Index : Tree_Index_Type); + + -- Update_Tree : Update the tree with the current VHDL element read from + -- the current path. + -- Called when the option file is read or when the option file is created + -- while reading the design hierarchy. + procedure Update_Tree (Cursor : in out Elem_Acc; + Updated : out Boolean; + Elem_Name : String; + Level : Natural; + Path_Context : Path_Context_Acc := null); + + -- Destructor + procedure Finalize; + +private + + Write_Stream : FILEs; + + Buf_Size : constant := 1024; + + 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; diff --git a/src/grt/grt-wave_opt.adb b/src/grt/grt-wave_opt.adb new file mode 100644 index 000000000..0a6059adc --- /dev/null +++ b/src/grt/grt-wave_opt.adb @@ -0,0 +1,75 @@ +-- 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.Errors; use Grt.Errors; + +package body Grt.Wave_Opt is + + procedure Print_Context + (Lineno, Column : Positive; Severity : Severity_Type) is + begin + case Severity is + when Error => + Error_C (""); + when Warning => + Report_C ("warning: "); + end case; + Report_C (File_Path.all); + Report_C (":"); + Report_C (Lineno); + Report_C (":"); + Report_C (Column); + Report_C (": "); + end Print_Context; + + procedure Print_Context (Element : Elem_Acc; Severity : Severity_Type) is + begin + Print_Context + (Element.Path_Context.Lineno, Element.Column, Severity); + end Print_Context; + + procedure Error_Context (Msg : String; + Lineno, Column : Positive; + Severity : Severity_Type := Error) is + begin + Print_Context (Lineno, Column, Severity); + case Severity is + when Error => + Error_E (Msg); + when Warning => + Report_E (Msg); + end case; + end Error_Context; + + procedure Error_Context + (Msg : String; Element : Elem_Acc; Severity : Severity_Type := Error) is + begin + Error_Context + (Msg, Element.Path_Context.Lineno, Element.Column, Severity); + end Error_Context; + +end Grt.Wave_Opt; diff --git a/src/grt/grt-wave_opt.ads b/src/grt/grt-wave_opt.ads new file mode 100644 index 000000000..f14ed7ac5 --- /dev/null +++ b/src/grt/grt-wave_opt.ads @@ -0,0 +1,90 @@ +-- 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 + +package Grt.Wave_Opt is + pragma Preelaborate; + + -- State : + -- Display_All : No signal filtering, display all + -- Write_File : Write in a new wave option file the signals found in the + -- design. No signal filtering too. + -- Display_Tree : Parse the given option file and create the tree. Display + -- only the signals that are in the tree + type State_Type is (Display_All, Write_File, Display_Tree); + State : State_Type := Display_All; + + type String_Cst is access constant String; + Value_String_Size : constant := 10; + + File_Path : String_Cst; + + type Path_Context_Type is record + Lineno : Natural; + Max_Level : Natural; + end record; + type Path_Context_Acc is access Path_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; + Path_Context : Path_Context_Acc := null; + Column : Natural := 0; + Level : Natural; + Kind : Elem_Kind_Type := Not_Found; + Parent : Elem_Acc := null; + Next_Sibling, Next_Child : Elem_Acc := null; + 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 + (Lineno, Column : Positive; Severity : Severity_Type); + procedure Print_Context (Element : Elem_Acc; Severity : Severity_Type); + + -- Print an error/warning with it's context + procedure Error_Context (Msg : String; + Lineno, Column : Positive; + Severity : Severity_Type := Error); + procedure Error_Context + (Msg : String; Element : Elem_Acc; Severity : Severity_Type := Error); + +end Grt.Wave_Opt; diff --git a/src/grt/grt-wave_opt_file-parse-debug.adb b/src/grt/grt-wave_opt_file-parse-debug.adb deleted file mode 100644 index 3461c9f3c..000000000 --- a/src/grt/grt-wave_opt_file-parse-debug.adb +++ /dev/null @@ -1,67 +0,0 @@ --- 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 - - -- Dump recursively an element of the tree. - procedure Dump_Sub_Tree (Cursor : Elem_Acc); - - 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)); - end loop; - Put_Line ("----------- END -----------------"); - New_Line; - end Dump_Tree; - -------------------------------------------------------------------------------- - - procedure Dump_Sub_Tree (Cursor : Elem_Acc) - is - Sibling_Cursor : Elem_Acc; - begin - Sibling_Cursor := Cursor; - while Sibling_Cursor /= null loop - Put ((3 .. 2 * Sibling_Cursor.Level => ' ')); - Put ('/'); - Put_Line (Sibling_Cursor.Name.all); - Dump_Sub_Tree (Sibling_Cursor.Next_Child); - 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 deleted file mode 100644 index dcf2e51e9..000000000 --- a/src/grt/grt-wave_opt_file-parse-debug.ads +++ /dev/null @@ -1,35 +0,0 @@ --- 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; - -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 deleted file mode 100644 index 7c6537b4f..000000000 --- a/src/grt/grt-wave_opt_file-parse.adb +++ /dev/null @@ -1,346 +0,0 @@ --- 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.Types; use Grt.Types; -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; Line_Pos : Positive); - - -- 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 : in out String); - - procedure Start (Option_File : String) - is - Stream : constant FILEs := File_Open (Option_File); - First, Last : Integer; - Line : String (1 .. Buf_Size); - Line_Pos : Natural; - begin - File_Path := new String'(Option_File); - Line_Pos := 0; - - -- Processes line after line. - loop - exit when fgets (Line'Address, Line'Length, Stream) = Null_Address; - Line_Pos := Line_Pos + 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)); - - - if Line (First) = '$' then - Parse_Version (Line (First .. Last), Line_Pos); - else - Path_Context := new Path_Context_Type'(Line_Pos => Line_Pos, - Max_Level => 0); - Parse_Path (Line (First .. Last)); - end if; - - <> 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; - -------------------------------------------------------------------------------- - - procedure Parse_Version (Line : String; Line_Pos : Positive) - 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", Line_Pos, Line'First); - end if; - - if Trees /= Tree_Array'(others => null) then - Error_Context - ("version cannot be set after signal paths", Line_Pos, Line'First); - 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, Line_Pos, Line'First); - end if; - - -- Catch "version\n", "version1.0" - First := First + 7; - if not Is_Whitespace (Line (First)) then - Error_Context (Msg_Invalid_Format, Line_Pos, Line'First); - 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, Line_Pos, Line'First); - 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, Line_Pos, Line'First); - end if; - - -- Catch version a.2 - Num := Value (Line (First .. Dot_Index - 1)); - if Num = -1 then - Error_Context (Msg_Invalid_Format, Line_Pos, Line'First); - 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, Line_Pos, Line'First); - end if; - Version.Minor := Num; - - if Version.Major /= Current_Version.Major - or else Version.Minor > Current_Version.Minor - then - Print_Context (Line'First, Line_Pos, 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 : in out String) - 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); - 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", Path_Context.Line_Pos, Line'First); - 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, '/') > 0 then - Error_Context - ("invalid signal path", Path_Context.Line_Pos, Line'First); - 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; - - Path_Context.Max_Level := Path_Context.Max_Level + 1; - Tree_Updated := Update_Tree (Line (First .. Last), Tree_Index); - - if Last = Line'Last then - if not Tree_Updated then - Error_Context ("ignored already known signal path", - Path_Context.Line_Pos, - Line'First, - 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", Path_Context.Line_Pos, Line'First); - 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), - Path_Context => Path_Context, - Column_Pos => Elem_Name'First, - Level => Path_Context.Max_Level, - 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; - - -------------------------------------------------------------------------- - - function File_Open (Option_File : String) return FILEs - is - Mode : constant String := "rt" & ASCII.Nul; - Stream : FILEs; - Option_File_C : String (1 .. Option_File'Length + 1); - begin - Option_File_C (1 .. Option_File'Length) := Option_File; - Option_File_C (Option_File_C'Last) := ASCII.Nul; - Stream := fopen (Option_File_C'Address, Mode'Address); - if Stream = NULL_Stream then - Error_C ("cannot open '"); - Error_C (Option_File); - 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 deleted file mode 100644 index a0e4ac74b..000000000 --- a/src/grt/grt-wave_opt_file-parse.ads +++ /dev/null @@ -1,54 +0,0 @@ --- 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; - - Path_Context : Path_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 deleted file mode 100644 index ba3834e50..000000000 --- a/src/grt/grt-wave_opt_file-tree_reading.adb +++ /dev/null @@ -1,135 +0,0 @@ --- 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.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); - - 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)); - 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) - is - Cursor : Elem_Acc; - begin - Cursor := Previous_Cursor; - while Cursor /= null loop - if Cursor.Kind = Not_Found then - Print_Context (Cursor, Warning); - Report_C ("no VHDL object in design matches "); - Report_E (Cursor.Name.all); - elsif Cursor.Level = Cursor.Path_Context.Max_Level - and then Cursor.Kind = Pkg_Entity - then - Print_Context (Cursor, Warning); - Report_C (Cursor.Name.all); - Report_E (" is not a signal"); - else - Check_Sub_Tree_If_All_Found (Cursor.Next_Child, Sep); - 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 deleted file mode 100644 index adeaaeb12..000000000 --- a/src/grt/grt-wave_opt_file-tree_reading.ads +++ /dev/null @@ -1,53 +0,0 @@ --- 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 - -with Grt.Types; use Grt.Types; - -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 deleted file mode 100644 index 8147e1bb7..000000000 --- a/src/grt/grt-wave_opt_file.adb +++ /dev/null @@ -1,75 +0,0 @@ --- 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.Errors; use Grt.Errors; - -package body Grt.Wave_Opt_File is - - procedure Print_Context - (Line_Pos, Column_Pos : Positive; Severity : Severity_Type) is - begin - case Severity is - when Error => - Error_C (""); - when Warning => - Report_C ("warning: "); - end case; - Report_C (File_Path.all); - Report_C (":"); - Report_C (Line_Pos); - Report_C (":"); - Report_C (Column_Pos); - Report_C (": "); - end Print_Context; - - procedure Print_Context (Element : Elem_Acc; Severity : Severity_Type) is - begin - Print_Context - (Element.Path_Context.Line_Pos, Element.Column_Pos, Severity); - end Print_Context; - - procedure Error_Context (Msg : String; - Line_Pos, Column_Pos : Positive; - Severity : Severity_Type := Error) is - begin - Print_Context (Line_Pos, Column_Pos, Severity); - case Severity is - when Error => - Error_E (Msg); - when Warning => - Report_E (Msg); - end case; - end Error_Context; - - procedure Error_Context - (Msg : String; Element : Elem_Acc; Severity : Severity_Type := Error) is - begin - Error_Context - (Msg, Element.Path_Context.Line_Pos, Element.Column_Pos, Severity); - 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 deleted file mode 100644 index 3999f317c..000000000 --- a/src/grt/grt-wave_opt_file.ads +++ /dev/null @@ -1,80 +0,0 @@ --- 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 - -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 Path_Context_Type is record - Line_Pos : Natural; - Max_Level : Natural; - end record; - type Path_Context_Acc is access Path_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; - Path_Context : Path_Context_Acc; - Column_Pos : Positive; - Level : Positive; - 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_Pos, Column_Pos : Positive; Severity : Severity_Type); - procedure Print_Context (Element : Elem_Acc; Severity : Severity_Type); - - -- Print an error/warning with it's context - procedure Error_Context (Msg : String; - Line_Pos, Column_Pos : Positive; - Severity : Severity_Type := Error); - procedure Error_Context - (Msg : String; Element : Elem_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 db8cf9174..a94eae23f 100644 --- a/src/grt/grt-waves.adb +++ b/src/grt/grt-waves.adb @@ -44,8 +44,9 @@ 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; +with Grt.Wave_Opt; use Grt.Wave_Opt; +with Grt.Wave_Opt.File; use Grt.Wave_Opt.File; +with Grt.Wave_Opt.Design; use Grt.Wave_Opt.Design; pragma Elaborate_All (Grt.Rtis_Utils); pragma Elaborate_All (Grt.Table); @@ -915,15 +916,15 @@ package body Grt.Waves is -- Create a hierarchy block. procedure Wave_Put_Hierarchy_Block (Inst : VhpiHandleT; Step : Step_Type; - Wave_Elem : Wave_Opt_File.Elem_Acc); + Wave_Elem : Wave_Opt.Elem_Acc); procedure Wave_Put_Hierarchy_1 - (Inst : VhpiHandleT; Step : Step_Type; Wave_Elem : Wave_Opt_File.Elem_Acc) + (Inst : VhpiHandleT; Step : Step_Type; Wave_Elem : Wave_Opt.Elem_Acc) is Decl_It : VhpiHandleT; Decl : VhpiHandleT; Error : AvhpiErrorT; - Wave_Elem_Child : Wave_Opt_File.Elem_Acc; + Wave_Elem_Child : Wave_Opt.Elem_Acc; begin Vhpi_Iterator (VhpiDecls, Inst, Decl_It, Error); if Error /= AvhpiErrorOk then @@ -940,12 +941,12 @@ package body Grt.Waves is return; end if; - 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 Vhpi_Get_Kind (Decl) is + when VhpiPortDeclK + | VhpiSigDeclK => + Wave_Elem_Child := Get_Cursor + (Wave_Elem, Avhpi_Get_Base_Name (Decl), Is_Signal => True); + if Is_Displayed (Wave_Elem_Child) then case Step is when Step_Name => Create_String_Id (Avhpi_Get_Base_Name (Decl)); @@ -954,12 +955,12 @@ package body Grt.Waves is when Step_Hierarchy => Write_Hierarchy_El (Decl); end case; - --Wave_Put_Name (Decl); - --Wave_Newline; - when others => - null; - end case; - end if; + end if; + --Wave_Put_Name (Decl); + --Wave_Newline; + when others => + null; + end case; end loop; -- No sub-scopes for packages. @@ -984,7 +985,7 @@ package body Grt.Waves is Nbr_Scopes := Nbr_Scopes + 1; - Wave_Elem_Child := Get_Cursor (Avhpi_Get_Base_Name (Decl), Wave_Elem); + Wave_Elem_Child := Get_Cursor (Wave_Elem, Avhpi_Get_Base_Name (Decl)); if Is_Displayed (Wave_Elem_Child) then case Vhpi_Get_Kind (Decl) is when VhpiIfGenerateK @@ -1011,7 +1012,7 @@ package body Grt.Waves is procedure Wave_Put_Hierarchy_Block (Inst : VhpiHandleT; Step : Step_Type; - Wave_Elem : Wave_Opt_File.Elem_Acc) is + Wave_Elem : Wave_Opt.Elem_Acc) is begin case Step is when Step_Name => @@ -1035,7 +1036,7 @@ package body Grt.Waves is Pack_It : VhpiHandleT; Pack : VhpiHandleT; Error : AvhpiErrorT; - Wave_Elem : Wave_Opt_File.Elem_Acc; + Wave_Elem : Wave_Opt.Elem_Acc; begin -- First packages. Get_Package_Inst (Pack_It); @@ -1046,14 +1047,14 @@ package body Grt.Waves is Avhpi_Error (Error); return; end if; - Wave_Elem := Get_Top_Cursor (Avhpi_Get_Base_Name (Pack), Pkg); + Wave_Elem := Get_Top_Cursor (Pkg, Avhpi_Get_Base_Name (Pack)); if Is_Displayed (Wave_Elem) then Wave_Put_Hierarchy_Block (Pack, Step, Wave_Elem); end if; end loop; -- Then top entity. - Wave_Elem := Get_Top_Cursor (Avhpi_Get_Base_Name (Root), Entity); + Wave_Elem := Get_Top_Cursor (Entity, Avhpi_Get_Base_Name (Root)); if Is_Displayed (Wave_Elem) then Wave_Put_Hierarchy_Block (Root, Step, Wave_Elem); end if; @@ -1577,9 +1578,7 @@ package body Grt.Waves is -- Vcd_Search_Packages; Wave_Put_Hierarchy (Root, Step_Name); - 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 + Wave_Opt.File.Finalize; if Str_Table.Last > 0 then Freeze_Strings; @@ -1591,6 +1590,8 @@ package body Grt.Waves is Write_Known_Types; Write_Hierarchy (Root); + Wave_Opt.Design.Last_Checks; + -- End of header mark. Wave_Section ("EOH" & NUL); -- cgit v1.2.3