aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--src/ghdldrv/ghdl_gcc.adb6
-rw-r--r--src/ghdldrv/ghdl_jit.adb6
-rw-r--r--src/ghdldrv/ghdl_llvm.adb6
-rw-r--r--src/ghdldrv/ghdlprint.adb1
-rw-r--r--src/ghdldrv/ghdlprint.ads5
-rw-r--r--src/ghdldrv/ghdlxml.adb526
-rw-r--r--src/ghdldrv/ghdlxml.ads21
-rw-r--r--src/vhdl/disp_tree.adb1
-rw-r--r--src/vhdl/disp_tree.ads23
9 files changed, 587 insertions, 8 deletions
diff --git a/src/ghdldrv/ghdl_gcc.adb b/src/ghdldrv/ghdl_gcc.adb
index f08c4cef0..c384222be 100644
--- a/src/ghdldrv/ghdl_gcc.adb
+++ b/src/ghdldrv/ghdl_gcc.adb
@@ -1,5 +1,5 @@
-- GHDL driver for gcc.
--- Copyright (C) 2002, 2003, 2004, 2005 Tristan Gingold
+-- Copyright (C) 2002-2016 Tristan Gingold
--
-- 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
@@ -20,6 +20,7 @@ with Ghdllocal;
with Ghdldrv;
with Ghdlprint;
with Ghdlvpi;
+with Ghdlxml;
procedure Ghdl_Gcc is
begin
@@ -28,9 +29,10 @@ begin
Ghdlmain.Version_String := new String'("GCC back-end code generator");
Ghdldrv.Backend := Ghdldrv.Backend_Gcc;
Ghdldrv.Register_Commands;
- Ghdlvpi.Register_Commands;
Ghdllocal.Register_Commands;
Ghdlprint.Register_Commands;
+ Ghdlvpi.Register_Commands;
+ Ghdlxml.Register_Commands;
Ghdlmain.Register_Commands;
Ghdlmain.Main;
end Ghdl_Gcc;
diff --git a/src/ghdldrv/ghdl_jit.adb b/src/ghdldrv/ghdl_jit.adb
index d80b7a4f8..d17e7fad4 100644
--- a/src/ghdldrv/ghdl_jit.adb
+++ b/src/ghdldrv/ghdl_jit.adb
@@ -1,5 +1,5 @@
-- GHDL driver for jit.
--- Copyright (C) 2002-2014 Tristan Gingold
+-- Copyright (C) 2002-2016 Tristan Gingold
--
-- 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
@@ -20,6 +20,7 @@ with Ghdllocal;
with Ghdlprint;
with Ghdlrun;
with Ghdlvpi;
+with Ghdlxml;
with Ortho_Jit;
procedure Ghdl_Jit is
@@ -29,9 +30,10 @@ begin
Ghdlmain.Version_String :=
new String'(Ortho_Jit.Get_Jit_Name & " code generator");
Ghdlrun.Register_Commands;
- Ghdlvpi.Register_Commands;
Ghdllocal.Register_Commands;
Ghdlprint.Register_Commands;
+ Ghdlvpi.Register_Commands;
+ Ghdlxml.Register_Commands;
Ghdlmain.Register_Commands;
Ghdlmain.Main;
end Ghdl_Jit;
diff --git a/src/ghdldrv/ghdl_llvm.adb b/src/ghdldrv/ghdl_llvm.adb
index 4c4c948d3..c170c4b56 100644
--- a/src/ghdldrv/ghdl_llvm.adb
+++ b/src/ghdldrv/ghdl_llvm.adb
@@ -1,5 +1,5 @@
-- GHDL driver for mcode/jit.
--- Copyright (C) 2002, 2003, 2004, 2005 Tristan Gingold
+-- Copyright (C) 2002-2016 Tristan Gingold
--
-- 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
@@ -20,6 +20,7 @@ with Ghdllocal;
with Ghdlprint;
with Ghdldrv;
with Ghdlvpi;
+with Ghdlxml;
procedure Ghdl_Llvm is
begin
@@ -28,9 +29,10 @@ begin
Ghdlmain.Version_String := new String'("llvm code generator");
Ghdldrv.Backend := Ghdldrv.Backend_Llvm;
Ghdldrv.Register_Commands;
- Ghdlvpi.Register_Commands;
Ghdllocal.Register_Commands;
Ghdlprint.Register_Commands;
+ Ghdlvpi.Register_Commands;
+ Ghdlxml.Register_Commands;
Ghdlmain.Register_Commands;
Ghdlmain.Main;
end Ghdl_Llvm;
diff --git a/src/ghdldrv/ghdlprint.adb b/src/ghdldrv/ghdlprint.adb
index 00fc9c25a..d9c6165a8 100644
--- a/src/ghdldrv/ghdlprint.adb
+++ b/src/ghdldrv/ghdlprint.adb
@@ -26,7 +26,6 @@ with Name_Table; use Name_Table;
with Files_Map;
with Libraries;
with Errorout; use Errorout;
-with Iirs; use Iirs;
with Iirs_Utils; use Iirs_Utils;
with Tokens;
with Scanner;
diff --git a/src/ghdldrv/ghdlprint.ads b/src/ghdldrv/ghdlprint.ads
index 82c3e6072..18cf6d081 100644
--- a/src/ghdldrv/ghdlprint.ads
+++ b/src/ghdldrv/ghdlprint.ads
@@ -15,6 +15,11 @@
-- 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.
+
+with Iirs; use Iirs;
+
package Ghdlprint is
+ procedure Analyze_Design_File_Units (File : Iir_Design_File);
+
procedure Register_Commands;
end Ghdlprint;
diff --git a/src/ghdldrv/ghdlxml.adb b/src/ghdldrv/ghdlxml.adb
new file mode 100644
index 000000000..329af4658
--- /dev/null
+++ b/src/ghdldrv/ghdlxml.adb
@@ -0,0 +1,526 @@
+-- GHDL driver - xml commands
+-- Copyright (C) 2016 Tristan Gingold
+--
+-- 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.
+with Ada.Text_IO; use Ada.Text_IO;
+with GNAT.OS_Lib; use GNAT.OS_Lib;
+with Types; use Types;
+with Name_Table; use Name_Table;
+with Nodes_Meta; use Nodes_Meta;
+with Str_Table;
+with Files_Map;
+with Disp_Tree; use Disp_Tree;
+with Ghdlprint; use Ghdlprint;
+with Libraries;
+with Errorout; use Errorout;
+with Iirs; use Iirs;
+with Ghdlmain; use Ghdlmain;
+with Ghdllocal; use Ghdllocal;
+
+package body Ghdlxml is
+
+ procedure Disp_Iir (Id : String; N : Iir);
+
+ -- Try to keep line length below that number.
+ Max_Line_Len : constant Natural := 80;
+
+ -- Number of space by indentation level.
+ Indent_Size : constant Natural := 2;
+
+ -- Current indentation level.
+ Indent : Natural;
+
+ -- Current column.
+ Col : Natural;
+
+ -- Low-level display routines. Consider line length, and handle
+ -- indentation. Only use these routines to display content.
+
+ -- Display indentation.
+ procedure Put_Indent is
+ Blanks : constant String (1 .. Indent_Size * Indent) := (others => ' ');
+ begin
+ pragma Assert (Col = 0);
+ Put (Blanks);
+ Col := Indent_Size * Indent;
+ end Put_Indent;
+
+ procedure Put_Stag (Name : String) is
+ begin
+ Put_Indent;
+ Put ('<');
+ Put (Name);
+ Col := Col + 1 + Name'Length;
+ end Put_Stag;
+
+ procedure Put_Stag_End is
+ begin
+ Put ('>');
+ New_Line;
+ Col := 0;
+ Indent := Indent + 1;
+ end Put_Stag_End;
+
+ procedure Put_Empty_Stag_End is
+ begin
+ Put ("/>");
+ New_Line;
+ Col := 0;
+ end Put_Empty_Stag_End;
+
+ procedure Put_Etag (Name : String) is
+ begin
+ Indent := Indent - 1;
+ Put_Indent;
+ Put ("</");
+ Put (Name);
+ Put (">");
+ New_Line;
+ Col := 0;
+ end Put_Etag;
+
+ procedure Put_Attribute (Attr : String; Value : String)
+ is
+ -- Number of characters to be displayed.
+ Len : constant Natural := 4 + Attr'Length + Value'Length;
+ begin
+ if Col + Len >= Max_Line_Len
+ and then Indent * Indent_Size + Len < Max_Line_Len
+ then
+ New_Line;
+ Col := 0;
+ Put_Indent;
+ end if;
+ Put (' ');
+ Put (Attr);
+ Put ("=""");
+ Put (Value);
+ Put ('"');
+ Col := Col + Len;
+ end Put_Attribute;
+
+ -- Espace special characters for XML.
+ --
+ -- According to: http://www.w3.org/TR/REC-xml/#NT-AttValue
+ --
+ -- [10] AttValue ::= '"' ([^<&"] | Reference)* '"'
+ -- | "'" ([^<&'] | Reference)* "'"
+ -- [67] Reference ::= EntityRef | CharRef
+ -- [66] CharRef ::= '&#' [0-9]+ ';'
+ -- | '&#x' [0-9a-fA-F]+ ';'
+ function To_XML (Str : String) return String
+ is
+ To_Hex : constant array (0 .. 15) of Character := "0123456789abcdef";
+ -- The escape sequence uses 6 characters.
+ Res : String (1 .. 6 * Str'Length);
+ Idx : Positive;
+ C : Character;
+ C_Pos : Natural;
+ begin
+ Idx := Res'First;
+ for I in Str'Range loop
+ C := Str (I);
+ case C is
+ when '<' | '&' | '"'
+ | Character'Val (128) .. Character'Val (255) =>
+ Res (Idx + 0) := '&';
+ Res (Idx + 1) := '#';
+ Res (Idx + 2) := 'x';
+ C_Pos := Character'Pos (C);
+ Res (Idx + 3) := To_Hex (C_Pos / 16);
+ Res (Idx + 4) := To_Hex (C_Pos mod 16);
+ Res (Idx + 5) := ';';
+ Idx := Idx + 6;
+ when others =>
+ Res (Idx) := C;
+ Idx := Idx + 1;
+ end case;
+ end loop;
+ return Res (1 .. Idx - 1);
+ end To_XML;
+
+ function XML_Image (Id : Name_Id) return String is
+ begin
+ return To_XML (Image (Id));
+ end XML_Image;
+
+ -- Strip leading blank if any.
+ function Strip (S : String) return String
+ is
+ F : constant Natural := S'First;
+ begin
+ if F > S'Last then
+ return "";
+ elsif S (F) = ' ' then
+ return S (F + 1 .. S'Last);
+ else
+ return S;
+ end if;
+ end Strip;
+
+ procedure Put_Field (F : Fields_Enum; Value : String) is
+ begin
+ Put_Attribute (Get_Field_Image (F), Value);
+ end Put_Field;
+
+ procedure Disp_Iir_Ref (Id : String; N : Iir) is
+ begin
+ if N = Null_Iir then
+ return;
+ end if;
+
+ Put_Stag (Id);
+ Put_Attribute ("ref", Strip (Iir'Image (N)));
+ Put_Empty_Stag_End;
+ end Disp_Iir_Ref;
+
+ procedure Disp_Iir_List_Ref (Id : String; L : Iir_List) is
+ begin
+ if L = Null_Iir_List then
+ return;
+ end if;
+
+ Put_Stag (Id);
+ Put_Attribute ("list-ref", Strip (Iir_List'Image (L)));
+ Put_Empty_Stag_End;
+ end Disp_Iir_List_Ref;
+
+ procedure Disp_Iir_Chain (Id : String; N : Iir)
+ is
+ El : Iir;
+ begin
+ if N = Null_Iir then
+ return;
+ end if;
+
+ Put_Stag (Id);
+ Put_Stag_End;
+
+ El := N;
+ while Is_Valid (El) loop
+ Disp_Iir ("el", El);
+ El := Get_Chain (El);
+ end loop;
+
+ Put_Etag (Id);
+ end Disp_Iir_Chain;
+
+ procedure Disp_Iir_List (Id : String; L : Iir_List; Ref : Boolean)
+ is
+ El : Iir;
+ begin
+ if L = Null_Iir_List then
+ return;
+ end if;
+
+ Put_Stag (Id);
+ case L is
+ when Iir_List_All =>
+ Put_Attribute ("list-id", "all");
+ Put_Empty_Stag_End;
+ return;
+ when Iir_List_Others =>
+ Put_Attribute ("list-id", "others");
+ Put_Empty_Stag_End;
+ return;
+ when others =>
+ Put_Attribute ("list-id", Strip (Iir_List'Image (L)));
+ Put_Stag_End;
+ end case;
+
+ for I in Natural loop
+ El := Get_Nth_Element (L, I);
+ exit when El = Null_Iir;
+ if Ref then
+ Disp_Iir_Ref ("el", El);
+ else
+ Disp_Iir ("el", El);
+ end if;
+ end loop;
+
+ Put_Etag (Id);
+ end Disp_Iir_List;
+
+ procedure Disp_Iir (Id : String; N : Iir) is
+ begin
+ if N = Null_Iir then
+ return;
+ end if;
+
+ Put_Stag (Id);
+
+ Put_Attribute ("id", Strip (Iir'Image (N)));
+ Put_Attribute ("kind", Get_Iir_Image (Get_Kind (N)));
+
+ declare
+ Loc : constant Location_Type := Get_Location (N);
+ File : Name_Id;
+ Line : Natural;
+ Col : Natural;
+ begin
+ if Loc /= No_Location then
+ Files_Map.Location_To_Position (Loc, File, Line, Col);
+ Put_Attribute ("file", Image (File));
+ Put_Attribute ("line", Strip (Natural'Image (Line)));
+ Put_Attribute ("col", Strip (Natural'Image (Col)));
+ end if;
+ end;
+
+ declare
+ Fields : constant Fields_Array := Get_Fields (Get_Kind (N));
+ F : Fields_Enum;
+ begin
+ -- First attributes
+ for I in Fields'Range loop
+ F := Fields (I);
+ case Get_Field_Type (F) is
+ when Type_Iir =>
+ null;
+ when Type_Iir_List =>
+ null;
+ when Type_String8_Id =>
+ null;
+ when Type_PSL_NFA =>
+ Put_Field (F, "PSL-NFA");
+ -- Disp_PSL_NFA (Get_PSL_NFA (N, F), Sub_Indent);
+ when Type_PSL_Node =>
+ Put_Field (F, "PSL-NODE");
+ when Type_Source_Ptr =>
+ null;
+ when Type_Date_Type =>
+ Put_Field
+ (F, Strip (Date_Type'Image (Get_Date_Type (N, F))));
+ when Type_Number_Base_Type =>
+ Put_Field
+ (F, Number_Base_Type'Image (Get_Number_Base_Type (N, F)));
+ when Type_Iir_Constraint =>
+ Put_Field
+ (F, Image_Iir_Constraint (Get_Iir_Constraint (N, F)));
+ when Type_Iir_Mode =>
+ Put_Field (F, Image_Iir_Mode (Get_Iir_Mode (N, F)));
+ when Type_Iir_Index32 =>
+ Put_Field (F, Iir_Index32'Image (Get_Iir_Index32 (N, F)));
+ when Type_Iir_Int64 =>
+ Put_Field (F, Iir_Int64'Image (Get_Iir_Int64 (N, F)));
+ when Type_Boolean =>
+ Put_Field (F, Image_Boolean (Get_Boolean (N, F)));
+ when Type_Iir_Staticness =>
+ Put_Field (F, Image_Iir_Staticness
+ (Get_Iir_Staticness (N, F)));
+ when Type_Date_State_Type =>
+ Put_Field (F, Image_Date_State_Type
+ (Get_Date_State_Type (N, F)));
+ when Type_Iir_All_Sensitized =>
+ Put_Field (F, Image_Iir_All_Sensitized
+ (Get_Iir_All_Sensitized (N, F)));
+ when Type_Iir_Signal_Kind =>
+ Put_Field (F, Image_Iir_Signal_Kind
+ (Get_Iir_Signal_Kind (N, F)));
+ when Type_Tri_State_Type =>
+ Put_Field (F, Image_Tri_State_Type
+ (Get_Tri_State_Type (N, F)));
+ when Type_Iir_Pure_State =>
+ Put_Field (F, Image_Iir_Pure_State
+ (Get_Iir_Pure_State (N, F)));
+ when Type_Iir_Delay_Mechanism =>
+ Put_Field (F, Image_Iir_Delay_Mechanism
+ (Get_Iir_Delay_Mechanism (N, F)));
+ when Type_Iir_Predefined_Functions =>
+ Put_Field (F, Image_Iir_Predefined_Functions
+ (Get_Iir_Predefined_Functions (N, F)));
+ when Type_Iir_Direction =>
+ Put_Field (F, Image_Iir_Direction
+ (Get_Iir_Direction (N, F)));
+ when Type_Location_Type =>
+ declare
+ Loc : constant Location_Type := Get_Location_Type (N, F);
+ begin
+ if Loc /= No_Location then
+ Put_Field (F, Image_Location_Type (Loc));
+ end if;
+ end;
+ when Type_Iir_Int32 =>
+ Put_Field
+ (F, Strip (Iir_Int32'Image (Get_Iir_Int32 (N, F))));
+ when Type_Int32 =>
+ Put_Field (F, Strip (Int32'Image (Get_Int32 (N, F))));
+ when Type_Iir_Fp64 =>
+ Put_Field (F, Iir_Fp64'Image (Get_Iir_Fp64 (N, F)));
+ when Type_Time_Stamp_Id =>
+ Put_Field (F, Image_Time_Stamp_Id
+ (Get_Time_Stamp_Id (N, F)));
+ when Type_File_Checksum_Id =>
+ Put_Field (F, Image_File_Checksum_Id
+ (Get_File_Checksum_Id (N, F)));
+ when Type_Token_Type =>
+ Put_Field (F, Image_Token_Type (Get_Token_Type (N, F)));
+ when Type_Name_Id =>
+ Put_Field (F, XML_Image (Get_Name_Id (N, F)));
+ end case;
+ end loop;
+
+ Put_Stag_End;
+
+ for I in Fields'Range loop
+ F := Fields (I);
+ case Get_Field_Type (F) is
+ when Type_Iir =>
+ declare
+ V : constant Iir := Get_Iir (N, F);
+ Img : constant String := Get_Field_Image (F);
+ begin
+ case Get_Field_Attribute (F) is
+ when Attr_None =>
+ Disp_Iir (Img, V);
+ when Attr_Ref
+ | Attr_Forward_Ref
+ | Attr_Maybe_Forward_Ref =>
+ Disp_Iir_Ref (Img, V);
+ when Attr_Maybe_Ref =>
+ if Get_Is_Ref (N) then
+ Disp_Iir_Ref (Img, V);
+ else
+ Disp_Iir (Img, V);
+ end if;
+ when Attr_Chain =>
+ Disp_Iir_Chain (Img, V);
+ when Attr_Chain_Next =>
+ null;
+ when Attr_Of_Ref =>
+ raise Internal_Error;
+ end case;
+ end;
+ when Type_Iir_List =>
+ declare
+ L : constant Iir_List := Get_Iir_List (N, F);
+ Img : constant String := Get_Field_Image (F);
+ begin
+ case Get_Field_Attribute (F) is
+ when Attr_None =>
+ Disp_Iir_List (Img, L, False);
+ when Attr_Of_Ref =>
+ Disp_Iir_List (Img, L, True);
+ when Attr_Ref =>
+ Disp_Iir_List_Ref (Img, L);
+ when others =>
+ raise Internal_Error;
+ end case;
+ end;
+ when Type_String8_Id =>
+ -- Special handling for strings
+ declare
+ Len : constant Int32 := Get_String_Length (N);
+ begin
+ Put_Stag (Get_Field_Image (F));
+ Put_Attribute ("length", Strip (Int32'Image (Len)));
+ Put_Attribute ("content",
+ To_XML (Str_Table.String_String8
+ (Get_String8_Id (N), Len)));
+ Put_Empty_Stag_End;
+ end;
+ when others =>
+ null;
+ end case;
+ end loop;
+ end;
+
+ Put_Etag (Id);
+ end Disp_Iir;
+
+ -- Command --file-to-xml
+ type Command_File_To_Xml is new Command_Lib with null record;
+
+ function Decode_Command (Cmd : Command_File_To_Xml; Name : String)
+ return Boolean;
+ function Get_Short_Help (Cmd : Command_File_To_Xml) return String;
+
+ procedure Perform_Action (Cmd : in out Command_File_To_Xml;
+ Files_Name : Argument_List);
+
+ function Decode_Command (Cmd : Command_File_To_Xml; Name : String)
+ return Boolean
+ is
+ pragma Unreferenced (Cmd);
+ begin
+ return Name = "--file-to-xml";
+ end Decode_Command;
+
+ function Get_Short_Help (Cmd : Command_File_To_Xml) return String
+ is
+ pragma Unreferenced (Cmd);
+ begin
+ return "--file-to-xml FILEs Dump AST in XML";
+ end Get_Short_Help;
+
+ procedure Perform_Action
+ (Cmd : in out Command_File_To_Xml; Files_Name : Argument_List)
+ is
+ pragma Unreferenced (Cmd);
+
+ use Files_Map;
+
+ Id : Name_Id;
+ File : Source_File_Entry;
+
+ type File_Data is record
+ Fe : Source_File_Entry;
+ Design_File : Iir;
+ end record;
+ type File_Data_Array is array (Files_Name'Range) of File_Data;
+
+ Files : File_Data_Array;
+ begin
+ -- Load work library.
+ Setup_Libraries (True);
+
+ -- Parse all files.
+ for I in Files'Range loop
+ Id := Get_Identifier (Files_Name (I).all);
+ File := Load_Source_File (Libraries.Local_Directory, Id);
+ if File = No_Source_File_Entry then
+ Error ("cannot open " & Image (Id));
+ return;
+ end if;
+ Files (I).Fe := File;
+ Files (I).Design_File := Libraries.Load_File (File);
+ if Files (I).Design_File = Null_Iir then
+ return;
+ end if;
+ -- Put units in library.
+ -- Note: design_units stay while design_file get empty.
+ Libraries.Add_Design_File_Into_Library (Files (I).Design_File);
+ end loop;
+
+ -- Analyze all files.
+ for I in Files'Range loop
+ Analyze_Design_File_Units (Files (I).Design_File);
+ end loop;
+
+ Indent := 0;
+ Col := 0;
+ Put_Line
+ ("<?xml version=""1.0"" encoding=""UTF-8"" standalone=""yes""?>");
+ Disp_Iir_Chain ("root", Libraries.Get_Libraries_Chain);
+ exception
+ when Compilation_Error =>
+ Error ("xml dump failed due to compilation error");
+ end Perform_Action;
+
+ procedure Register_Commands is
+ begin
+ Register_Command (new Command_File_To_Xml);
+ end Register_Commands;
+end Ghdlxml;
diff --git a/src/ghdldrv/ghdlxml.ads b/src/ghdldrv/ghdlxml.ads
new file mode 100644
index 000000000..0094e248f
--- /dev/null
+++ b/src/ghdldrv/ghdlxml.ads
@@ -0,0 +1,21 @@
+-- GHDL driver - xml commands
+-- Copyright (C) 2016 Tristan Gingold
+--
+-- 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.
+
+package Ghdlxml is
+ procedure Register_Commands;
+end Ghdlxml;
diff --git a/src/vhdl/disp_tree.adb b/src/vhdl/disp_tree.adb
index 78a8096a8..e254bb883 100644
--- a/src/vhdl/disp_tree.adb
+++ b/src/vhdl/disp_tree.adb
@@ -20,7 +20,6 @@
with Ada.Text_IO; use Ada.Text_IO;
with Name_Table;
-with Tokens;
with Files_Map;
with PSL.Dump_Tree;
with Nodes_Meta;
diff --git a/src/vhdl/disp_tree.ads b/src/vhdl/disp_tree.ads
index f30c6278f..0ea056a6a 100644
--- a/src/vhdl/disp_tree.ads
+++ b/src/vhdl/disp_tree.ads
@@ -17,6 +17,7 @@
-- 02111-1307, USA.
with Types; use Types;
with Iirs; use Iirs;
+with Tokens; use Tokens;
package Disp_Tree is
-- Disp TREE recursively.
@@ -24,4 +25,26 @@ package Disp_Tree is
procedure Disp_Tree_For_Psl
(N : Int32; Indent : Natural; Depth : Natural);
+
+ -- Image for various field types.
+ function Image_Name_Id (Ident: Name_Id) return String;
+ function Image_Iir_Staticness (Static: Iir_Staticness) return String;
+ function Image_Boolean (Bool : Boolean) return String;
+ function Image_Iir_Delay_Mechanism (Mech : Iir_Delay_Mechanism)
+ return String;
+ function Image_Iir_Mode (Mode : Iir_Mode) return String;
+ function Image_Iir_Signal_Kind (Kind : Iir_Signal_Kind) return String;
+ function Image_Iir_Pure_State (State : Iir_Pure_State) return String;
+ function Image_Iir_All_Sensitized (Sig : Iir_All_Sensitized)
+ return String;
+ function Image_Iir_Constraint (Const : Iir_Constraint) return String;
+ function Image_Date_State_Type (State : Date_State_Type) return String;
+ function Image_Tri_State_Type (State : Tri_State_Type) return String;
+ function Image_Time_Stamp_Id (Id : Time_Stamp_Id) return String;
+ function Image_File_Checksum_Id (Id : File_Checksum_Id) return String;
+ function Image_Iir_Predefined_Functions (F : Iir_Predefined_Functions)
+ return String;
+ function Image_Location_Type (Loc : Location_Type) return String;
+ function Image_Iir_Direction (Dir : Iir_Direction) return String;
+ function Image_Token_Type (Tok : Tokens.Token_Type) return String;
end Disp_Tree;