-- GHDL Run Time (GRT) - Wave option file package for reading the tree.
-- Copyright (C) 2016 Jonas Baggett
--
-- This program 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 of the License, or
-- (at your option) any later version.
--
-- This program 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 this program. If not, see <gnu.org/licenses>.
--
-- 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;
Parent : Match_List;
Is_Signal : Boolean := False)
return Match_List;
-- If the name of the current design object matches with the child tree
-- element given in parameter (Elem_Acc), this procedure is called to add
-- the latter to the list of all the child tree elements that match a design
-- object.
-- A list needs to be done, because if /top/sub/a, /top/sub/b and /top/sub/c
-- exist in the design and if we have /top/sub/a, /top/*/b and /top/**/c in
-- the tree, then a list of the child tree elements of /top will be done
-- with sub, * and ** so that /top/sub/a, /top/sub/b and /top/sub/c can be
-- matched with respectively /top/sub/a, /top/*/b and /top/**/c
procedure Match_List_Append
(List : in out Match_List; Tree_Elem : Elem_Acc);
-- TODO : Deallocate the list somewhere, but the memory gain shouldn't be
-- significative
function Get_Top_Cursor (Tree_Index : Tree_Index_Type; Name : Ghdl_C_String)
return Match_List
is
Root : Match_List;
begin
if State = Write_File and then Trees (Tree_Index).Next_Child = null then
Write_Tree_Comment (Tree_Index);
end if;
Root := new Match_Elem_Type'(Trees (Tree_Index), null);
return Get_Cursor (Root, Name);
end Get_Top_Cursor;
function Get_Cursor (Parent : Match_List;
Name : Ghdl_C_String;
Is_Signal : Boolean := False) return Match_List
is
Tree_Elem_Cursor : Elem_Acc;
Last_Updated : Boolean;
Str_Name : constant String := Name (1 .. strlen (Name));
begin
case State is
when Write_File =>
Tree_Elem_Cursor := Parent.Tree_Elem;
Last_Updated := True;
Update_Tree (Cursor => Tree_Elem_Cursor,
Last_Updated => Last_Updated,
Elem_Expr => Str_Name,
Level => Tree_Elem_Cursor.Level + 1);
if Is_Signal then
Write_Signal_Path (Tree_Elem_Cursor);
end if;
return new Match_Elem_Type'(Tree_Elem_Cursor, null);
when Display_Tree =>
return Find_Cursor (Str_Name, Parent, Is_Signal);
when Display_All =>
return null;
end case;
end Get_Cursor;
function Find_Cursor (Name : String;
Parent : Match_List;
Is_Signal : Boolean := False)
return Match_List
is
Tree_Elem_Cursor : Elem_Acc;
Parent_Cursor, List : Match_List;
--
function Match_Expr return Boolean is
begin
if Tree_Elem_Cursor.Expr.all = Name then
return True;
elsif Tree_Elem_Cursor.Expr.all = "*" then
-- Returns true in the following cases :
-- Design object : /top/a | Tree element : /top/*
-- Design object : /top/sub/... | Tree element : /top/*/...
if Is_Signal xor Tree_Elem_Cursor.Next_Child /= null then
return True;
end if;
elsif Tree_Elem_Cursor.Expr.all = "**" then
-- Returns true in the following cases :
-- Design object : /top/sub/... | Tree element : /top/**
-- Design object : /top/a | Tree element : /top/**
-- But will return false in the following case :
-- Design object : /top/a | Tree element : /top/**/x
if not Is_Signal or else Tree_Elem_Cursor.Next_Child = null then
return True;
end if;
end if;
return False;
end Match_Expr;
function Get_Cursor_Kind return Elem_Kind_Type is
begin
if Tree_Elem_Cursor.Expr.all = "**" then
return Recursion;
elsif Is_Signal then
return Signal;
else
return Pkg_Entity;
end if;
end Get_Cursor_Kind;
begin
Parent_Cursor := Parent;
loop
exit when Parent_Cursor = null;
Tree_Elem_Cursor := Parent_Cursor.Tree_Elem.Next_Child;
if Parent_Cursor.Tree_Elem.Expr.all = "**" then
-- Add the current tree element to the list in the following cases:
-- Design object : /top/y/x | Tree element : /top/**/x
-- Design object : /top/y/x/... | Tree element : /top/**/x/...
-- where x matchs the Name parameter, ** is the parent expression
if Tree_Elem_Cursor /= null
and then Tree_Elem_Cursor.Expr.all = Name
then
Match_List_Append (List, Tree_Elem_Cursor);
-- Add the parent tree element (**) to the list in the following
-- cases:
-- Design object : /top/y/x/... | Tree element : /top/**
-- Design object : /top/y/x | Tree element : /top/**
-- But it won't do it in the following case:
-- Design object : /top/y/x | Tree element : /top/**/z
-- as x != z
elsif not Is_Signal or else Tree_Elem_Cursor = null then
Match_List_Append (List, Parent_Cursor.Tree_Elem);
end if;
end if;
loop
exit when Tree_Elem_Cursor = null;
if Match_Expr then
Tree_Elem_Cursor.Kind := Get_Cursor_Kind;
Match_List_Append (List, Tree_Elem_Cursor);
end if;
Tree_Elem_Cursor := Tree_Elem_Cursor.Next_Sibling;
end loop;
Parent_Cursor := Parent_Cursor.Next;
end loop;
return List;
end Find_Cursor;
procedure Match_List_Append (List : in out Match_List; Tree_Elem : Elem_Acc)
is
begin
List := new Match_Elem_Type'(Tree_Elem => Tree_Elem, Next => List);
end Match_List_Append;
function Is_Displayed (Cursor : Match_List) 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
Warning_S;
Diag_C_Context (Cursor);
Diag_C (Cursor.Expr.all);
Diag_C (" : first element of the path not found in design.");
Diag_C (" More references may follow");
Warning_E;
elsif Cursor.Next_Child = null and then Cursor.Kind = Pkg_Entity then
Warning_S;
Diag_C_Context (Cursor);
Diag_C (Cursor.Expr.all);
Diag_C (" is not a signal");
Warning_E;
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;