First import from sources

1 files changed, 1561 insertions, 0 deletions

diff --git a/translate/ghdldrv/ghdlprint.adb b/translate/ghdldrv/ghdlprint.adb
new file mode 100644
index 0000000..d9de2df
--- /dev/null
+++ b/translate/ghdldrv/ghdlprint.adb
@@ -0,0 +1,1561 @@
+--  GHDL driver - print commands.
+--  Copyright (C) 2002, 2003, 2004, 2005 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.Characters.Latin_1;
+with Ada.Text_IO; use Ada.Text_IO;
+with GNAT.Directory_Operations;
+with GNAT.OS_Lib; use GNAT.OS_Lib;
+with Types; use Types;
+with Flags;
+with Name_Table; use Name_Table;
+with Files_Map;
+with Libraries;
+with Errorout; use Errorout;
+with Iirs; use Iirs;
+with Tokens;
+with Scan;
+with Version;
+with Xrefs;
+with Ghdlmain; use Ghdlmain;
+with Ghdllocal; use Ghdllocal;
+
+package body Ghdlprint is
+   type Html_Format_Type is (Html_2, Html_Css);
+   Html_Format : Html_Format_Type := Html_2;
+
+   procedure Put_Html (C : Character) is
+   begin
+      case C is
+         when '>' =>
+            Put (">");
+         when '<' =>
+            Put ("&lt;");
+         when '&' =>
+            Put ("&amp;");
+         when others =>
+            Put (C);
+      end case;
+   end Put_Html;
+
+   procedure Put_Html (S : String) is
+   begin
+      for I in S'Range loop
+         Put_Html (S (I));
+      end loop;
+   end Put_Html;
+
+   package Nat_IO is new Ada.Text_IO.Integer_IO (Num => Natural);
+   procedure Put_Nat (N : Natural) is
+   begin
+      Nat_IO.Put (N, Width => 0);
+   end Put_Nat;
+
+   type Filexref_Info_Type is record
+      Output : String_Acc;
+      Referenced : Boolean;
+   end record;
+   type Filexref_Info_Arr is array (Source_File_Entry range <>)
+     of Filexref_Info_Type;
+   type Filexref_Info_Arr_Acc is access Filexref_Info_Arr;
+   Filexref_Info : Filexref_Info_Arr_Acc := null;
+
+   procedure PP_Html_File (File : Source_File_Entry)
+   is
+      use Scan;
+      use Tokens;
+      use Files_Map;
+      use Ada.Characters.Latin_1;
+
+      Line : Natural;
+      Buf : File_Buffer_Acc;
+      Prev_Tok : Token_Type;
+
+      --  True if tokens are between 'end' and ';'
+      In_End : Boolean := False;
+
+      --  Current logical column number.  Used to expand TABs.
+      Col : Natural;
+
+      --  Position just after the last token.
+      Last_Tok : Source_Ptr;
+
+      --  Position just before the current token.
+      Bef_Tok : Source_Ptr;
+
+      --  Position just after the current token.
+      Aft_Tok : Source_Ptr;
+
+      procedure Disp_Ln
+      is
+         N : Natural;
+         Str : String (1 .. 5);
+      begin
+         case Html_Format is
+            when Html_2 =>
+               Put ("<font size=-1>");
+            when Html_Css =>
+               Put ("<i>");
+         end case;
+         N := Line;
+         for I in reverse Str'Range loop
+            if N = 0 then
+               Str (I) := ' ';
+            else
+               Str (I) := Character'Val (48 + N mod 10);
+               N := N / 10;
+            end if;
+         end loop;
+         Put (Str);
+         case Html_Format is
+            when Html_2 =>
+               Put ("</font>");
+            when Html_Css =>
+               Put ("</i>");
+         end case;
+         Put (" ");
+         Col := 0;
+      end Disp_Ln;
+
+      procedure Disp_Spaces
+      is
+         C : Character;
+         P : Source_Ptr;
+         N_Col : Natural;
+      begin
+         P := Last_Tok;
+         while P < Bef_Tok loop
+            C := Buf (P);
+            if C = HT then
+               --  Expand TABS.
+               N_Col := Col + 8;
+               N_Col := N_Col - N_Col mod 8;
+               while Col < N_Col loop
+                  Put (' ');
+                  Col := Col + 1;
+               end loop;
+            else
+               Put (' ');
+               Col := Col + 1;
+            end if;
+            P := P + 1;
+         end loop;
+      end Disp_Spaces;
+
+      procedure Disp_Text
+      is
+         P : Source_Ptr;
+      begin
+         P := Bef_Tok;
+         while P < Aft_Tok loop
+            Put_Html (Buf (P));
+            Col := Col + 1;
+            P := P + 1;
+         end loop;
+      end Disp_Text;
+
+      procedure Disp_Reserved is
+      begin
+         Disp_Spaces;
+         case Html_Format is
+            when Html_2 =>
+               Put ("<font color=red>");
+               Disp_Text;
+               Put ("</font>");
+            when Html_Css =>
+               Put ("<em>");
+               Disp_Text;
+               Put ("</em>");
+         end case;
+      end Disp_Reserved;
+
+      procedure Disp_Href (Loc : Location_Type)
+      is
+         L_File : Source_File_Entry;
+         L_Pos : Source_Ptr;
+      begin
+         Location_To_File_Pos (Loc, L_File, L_Pos);
+         Put (" href=""");
+         if L_File /= File then
+            --  External reference.
+            if Filexref_Info (L_File).Output /= null then
+               Put (Filexref_Info (L_File).Output.all);
+               Put ("#");
+               Put_Nat (Natural (L_Pos));
+            else
+               --  Reference to an unused file.
+               Put ("index.html#f");
+               Put_Nat (Natural (L_File));
+               Filexref_Info (L_File).Referenced := True;
+            end if;
+         else
+            --  Local reference.
+            Put ("#");
+            Put_Nat (Natural (L_Pos));
+         end if;
+         Put ("""");
+      end Disp_Href;
+
+      procedure Disp_Anchor (Loc : Location_Type)
+      is
+         L_File : Source_File_Entry;
+         L_Pos : Source_Ptr;
+      begin
+         Put (" name=""");
+         Location_To_File_Pos (Loc, L_File, L_Pos);
+         Put_Nat (Natural (L_Pos));
+         Put ("""");
+      end Disp_Anchor;
+
+      procedure Disp_Identifier
+      is
+         use Xrefs;
+         Ref : Xref;
+         Decl : Iir;
+         Bod : Iir;
+         Loc : Location_Type;
+      begin
+         Disp_Spaces;
+         if Flags.Flag_Xref then
+            Loc := File_Pos_To_Location (File, Bef_Tok);
+            Ref := Find (Loc);
+            if Ref = Bad_Xref then
+               Disp_Text;
+               Warning_Msg_Sem ("cannot find xref", Loc);
+               return;
+            end if;
+         else
+            Disp_Text;
+            return;
+         end if;
+         case Get_Xref_Kind (Ref) is
+            when Xref_Decl =>
+               Put ("<a");
+               Disp_Anchor (Loc);
+               Decl := Get_Xref_Node (Ref);
+               case Get_Kind (Decl) is
+                  when Iir_Kind_Function_Declaration
+                    | Iir_Kind_Procedure_Declaration =>
+                     Bod := Get_Subprogram_Body (Decl);
+                  when Iir_Kind_Package_Declaration =>
+                     Bod := Get_Package_Body (Decl);
+                  when Iir_Kind_Type_Declaration =>
+                     Decl := Get_Type (Decl);
+                     case Get_Kind (Decl) is
+                        when Iir_Kind_Protected_Type_Declaration =>
+                           Bod := Get_Protected_Type_Body (Decl);
+                        when Iir_Kind_Incomplete_Type_Definition =>
+                           Bod := Get_Type_Declarator (Decl);
+                        when others =>
+                           Bod := Null_Iir;
+                     end case;
+                  when others =>
+                     Bod := Null_Iir;
+               end case;
+               if Bod /= Null_Iir then
+                  Disp_Href (Get_Location (Bod));
+               end if;
+               Put (">");
+               Disp_Text;
+               Put ("</a>");
+            when Xref_Ref
+              | Xref_End =>
+               Decl := Get_Xref_Node (Ref);
+               Loc := Get_Location (Decl);
+               if Loc /= Location_Nil then
+                  Put ("<a");
+                  Disp_Href (Loc);
+                  Put (">");
+                  Disp_Text;
+                  Put ("</a>");
+               else
+                  --  This may happen for overload list, in use clauses.
+                  Disp_Text;
+               end if;
+            when Xref_Body =>
+               Put ("<a");
+               Disp_Anchor (Loc);
+               Disp_Href (Get_Location (Get_Xref_Node (Ref)));
+               Put (">");
+               Disp_Text;
+               Put ("</a>");
+         end case;
+      end Disp_Identifier;
+
+      procedure Disp_Attribute
+      is
+         use Xrefs;
+         Ref : Xref;
+         Decl : Iir;
+         Loc : Location_Type;
+      begin
+         Disp_Spaces;
+         if Flags.Flag_Xref then
+            Loc := File_Pos_To_Location (File, Bef_Tok);
+            Ref := Find (Loc);
+         else
+            Ref := Bad_Xref;
+         end if;
+         if Ref = Bad_Xref then
+            case Html_Format is
+               when Html_2 =>
+                  Put ("<font color=orange>");
+                  Disp_Text;
+                  Put ("</font>");
+               when Html_Css =>
+                  Put ("<var>");
+                  Disp_Text;
+                  Put ("</var>");
+            end case;
+         else
+            Decl := Get_Xref_Node (Ref);
+            Loc := Get_Location (Decl);
+            Put ("<a");
+            Disp_Href (Loc);
+            Put (">");
+            Disp_Text;
+            Put ("</a>");
+         end if;
+      end Disp_Attribute;
+   begin
+      Scan.Flag_Comment := True;
+      Scan.Flag_Newline := True;
+
+      Set_File (File);
+      Buf := Get_File_Source (File);
+
+      Put_Line ("<pre>");
+      Line := 1;
+      Disp_Ln;
+      Last_Tok := Source_Ptr_Org;
+      Prev_Tok := Tok_Invalid;
+      loop
+         Scan.Scan;
+         Bef_Tok := Get_Token_Position;
+         Aft_Tok := Get_Position;
+         case Current_Token is
+            when Tok_Eof =>
+               exit;
+            when Tok_Newline =>
+               New_Line;
+               Line := Line + 1;
+               Disp_Ln;
+            when Tok_Comment =>
+               Disp_Spaces;
+               case Html_Format is
+                  when Html_2 =>
+                     Put ("<font color=green>");
+                     Disp_Text;
+                     Put ("</font>");
+                  when Html_Css =>
+                     Put ("<tt>");
+                     Disp_Text;
+                     Put ("</tt>");
+               end case;
+            when Tok_Access .. Tok_Elsif
+              | Tok_Entity .. Tok_With
+              | Tok_Mod .. Tok_Rem
+              | Tok_And .. Tok_Not =>
+               Disp_Reserved;
+            when Tok_End =>
+               Disp_Reserved;
+               In_End := True;
+            when Tok_Semi_Colon =>
+               In_End := False;
+               Disp_Spaces;
+               Disp_Text;
+            when Tok_Xnor .. Tok_Ror =>
+               if Flags.Vhdl_Std > Vhdl_87 then
+                  Disp_Reserved;
+               else
+                  Disp_Identifier;
+               end if;
+            when Tok_Protected =>
+               if Flags.Vhdl_Std >= Vhdl_00 then
+                  Disp_Reserved;
+               else
+                  Disp_Identifier;
+               end if;
+            when Tok_String
+              | Tok_Bit_String
+              | Tok_Character =>
+               Disp_Spaces;
+               case Html_Format is
+                  when Html_2 =>
+                     Put ("<font color=blue>");
+                     Disp_Text;
+                     Put ("</font>");
+                  when Html_Css =>
+                     Put ("<kbd>");
+                     Disp_Text;
+                     Put ("</kbd>");
+               end case;
+            when Tok_Identifier =>
+               if Prev_Tok = Tok_Tick then
+                  Disp_Attribute;
+               else
+                  Disp_Identifier;
+               end if;
+            when Tok_Left_Paren .. Tok_Colon
+              | Tok_Comma .. Tok_Dot
+              | Tok_Integer
+              | Tok_Real
+              | Tok_Equal .. Tok_Slash
+              | Tok_Invalid =>
+               Disp_Spaces;
+               Disp_Text;
+         end case;
+         Last_Tok := Aft_Tok;
+         Prev_Tok := Current_Token;
+      end loop;
+      Close_File;
+      New_Line;
+      Put_Line ("</pre>");
+      Put_Line ("<hr/>");
+   end PP_Html_File;
+
+   procedure Put_Html_Header
+   is
+   begin
+      Put ("<html>");
+      Put_Line (" <head>");
+      case Html_Format is
+         when Html_2 =>
+            null;
+         when Html_Css =>
+            Put_Line (" <link rel=stylesheet type=""text/css""");
+            Put_Line ("  href=""ghdl.css"" title=""default""/>");
+      end case;
+      --Put_Line ("<?xml version=""1.0"" encoding=""utf-8"" ?>");
+      --Put_Line("<!DOCTYPE html PUBLIC ""-//W3C//DTD XHTML 1.0 Strict//EN""");
+      --Put_Line ("""http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd"">");
+      --Put_Line ("<html xmlns=""http://www.w3.org/1999/xhtml"""
+      --         & " xml:lang=""en"">");
+      --Put_Line ("<head>");
+   end Put_Html_Header;
+
+   procedure Put_Css is
+   begin
+      Put_Line ("/* EM is used for reserved words */");
+      Put_Line ("EM { color : red; font-style: normal }");
+      New_Line;
+      Put_Line ("/* TT is used for comments */");
+      Put_Line ("TT { color : green; font-style: normal }");
+      New_Line;
+      Put_Line ("/* KBD is used for literals and strings */");
+      Put_Line ("KBD { color : blue; font-style: normal }");
+      New_Line;
+      Put_Line ("/* I is used for line numbers */");
+      Put_Line ("I { color : gray; font-size: 50% }");
+      New_Line;
+      Put_Line ("/* VAR is used for attributes name */");
+      Put_Line ("VAR { color : orange; font-style: normal }");
+      New_Line;
+      Put_Line ("/* A is used for identifiers.  */");
+      Put_Line ("A { color: blue; font-style: normal;");
+      Put_Line ("    text-decoration: none }");
+   end Put_Css;
+
+   procedure Put_Html_Foot
+   is
+   begin
+      Put_Line ("<p>");
+      Put ("<small>This page was generated using ");
+      Put ("<a href=""http://ghdl.free.fr"">");
+      Put (Version.Ghdl_Version);
+      Put ("</a>, a program written by");
+      Put (" Tristan Gingold");
+      New_Line;
+      Put_Line ("</p>");
+      Put_Line ("</body>");
+      Put_Line ("</html>");
+   end Put_Html_Foot;
+
+   function Create_Output_Filename (Name : String; Num : Natural)
+                                   return String_Acc
+   is
+      --  Position of the extension.  0 if none.
+      Ext_Pos : Natural;
+
+      Num_Str : String := Natural'Image (Num);
+   begin
+      --  Search for the extension.
+      Ext_Pos := 0;
+      for I in reverse Name'Range loop
+         exit when Name (I) = Directory_Separator;
+         if Name (I) = '.' then
+            Ext_Pos := I - 1;
+            exit;
+         end if;
+      end loop;
+      if Ext_Pos = 0 then
+         Ext_Pos := Name'Last;
+      end if;
+      Num_Str (1) := '.';
+      return new String'(Name (Name'First .. Ext_Pos) & Num_Str & ".html");
+   end Create_Output_Filename;
+
+   --  Command --chop.
+   type Command_Chop is new Command_Lib with null record;
+   function Decode_Command (Cmd : Command_Chop; Name : String)
+                           return Boolean;
+   function Get_Short_Help (Cmd : Command_Chop) return String;
+   procedure Perform_Action (Cmd : in out Command_Chop;
+                             Args : Argument_List);
+
+   function Decode_Command (Cmd : Command_Chop; Name : String)
+                           return Boolean
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return Name = "--chop";
+   end Decode_Command;
+
+   function Get_Short_Help (Cmd : Command_Chop) return String
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return "--chop [OPTS] FILEs  Chop FILEs";
+   end Get_Short_Help;
+
+   procedure Perform_Action (Cmd : in out Command_Chop; Args : Argument_List)
+   is
+      pragma Unreferenced (Cmd);
+      use Ada.Characters.Latin_1;
+
+      function Build_File_Name_Length (Lib : Iir) return Natural
+      is
+         Len : Natural;
+         Id : Name_Id;
+         Id1 : Name_Id;
+      begin
+         Id := Get_Identifier (Lib);
+         Len := Get_Name_Length (Id);
+         case Get_Kind (Lib) is
+            when Iir_Kind_Configuration_Declaration
+              | Iir_Kind_Entity_Declaration
+              | Iir_Kind_Package_Declaration =>
+               null;
+            when Iir_Kind_Package_Body =>
+               Len := Len + 1 + 4; -- add -body
+            when Iir_Kind_Architecture_Declaration =>
+               Id1 := Get_Identifier (Get_Entity (Lib));
+               Len := Len + 1 + Get_Name_Length (Id1);
+            when others =>
+               Error_Kind ("build_file_name", Lib);
+         end case;
+         Len := Len + 1 + 4; --  add .vhdl
+         return Len;
+      end Build_File_Name_Length;
+
+      procedure Build_File_Name (Lib : Iir; Res : out String)
+      is
+         Id : Name_Id;
+         P : Natural;
+
+         procedure Append (Str : String) is
+         begin
+            Res (P + 1 .. P + Str'Length) := Str;
+            P := P + Str'Length;
+         end Append;
+      begin
+         Id := Get_Identifier (Lib);
+         P := Res'First - 1;
+         case Get_Kind (Lib) is
+            when Iir_Kind_Configuration_Declaration
+              | Iir_Kind_Entity_Declaration
+              | Iir_Kind_Package_Declaration =>
+               Image (Id);
+               Append (Name_Buffer (1 .. Name_Length));
+            when Iir_Kind_Package_Body =>
+               Image (Id);
+               Append (Name_Buffer (1 .. Name_Length));
+               Append ("-body");
+            when Iir_Kind_Architecture_Declaration =>
+               Image (Get_Identifier (Get_Entity (Lib)));
+               Append (Name_Buffer (1 .. Name_Length));
+               Append ("-");
+               Image (Id);
+               Append (Name_Buffer (1 .. Name_Length));
+            when others =>
+               null;
+         end case;
+         Append (".vhdl");
+      end Build_File_Name;
+
+      --  Scan source file BUF+START until end of line.
+      --  Return line kind to KIND and position of next line to NEXT.
+      type Line_Type is (Line_Blank, Line_Comment, Line_Text);
+      procedure Find_Eol (Buf : File_Buffer_Acc;
+                          Start : Source_Ptr;
+                          Next : out Source_Ptr;
+                          Kind : out Line_Type)
+      is
+         P : Source_Ptr;
+      begin
+         P := Start;
+
+         Kind := Line_Blank;
+
+         --  Skip blanks.
+         while Buf (P) = ' ' or Buf (P) = HT loop
+            P := P + 1;
+         end loop;
+
+         --  Skip comment if any.
+         if Buf (P) = '-' and Buf (P + 1) = '-' then
+            Kind := Line_Comment;
+            P := P + 2;
+         elsif Buf (P) /= CR and Buf (P) /= LF and Buf (P) /= EOT then
+            Kind := Line_Text;
+         end if;
+
+         --  Skip until end of line.
+         while Buf (P) /= CR and Buf (P) /= LF and Buf (P) /= EOT loop
+            P := P + 1;
+         end loop;
+
+         if Buf (P) = CR then
+            P := P + 1;
+            if Buf (P) = LF then
+               P := P + 1;
+            end if;
+         elsif Buf (P) = LF then
+            P := P + 1;
+            if Buf (P) = CR then
+               P := P + 1;
+            end if;
+         end if;
+
+         Next := P;
+      end Find_Eol;
+
+      Id : Name_Id;
+      Design_File : Iir_Design_File;
+      Unit : Iir;
+      Lib : Iir;
+      Len : Natural;
+   begin
+      Flags.Bootstrap := True;
+      --  Load word library.
+      Libraries.Load_Std_Library;
+      Libraries.Load_Work_Library;
+
+      --  First loop: parse source file, check destination file does not
+      --  exist.
+      for I in Args'Range loop
+         Id := Get_Identifier (Args (I).all);
+         Design_File := Libraries.Load_File (Id);
+         if Design_File = Null_Iir then
+            raise Compile_Error;
+         end if;
+         Unit := Get_First_Design_Unit (Design_File);
+         while Unit /= Null_Iir loop
+            Lib := Get_Library_Unit (Unit);
+            Len := Build_File_Name_Length (Lib);
+            declare
+               Filename : String (1 .. Len + 1);
+            begin
+               Build_File_Name (Lib, Filename);
+               Filename (Len + 1) := Ghdllocal.Nul;
+               if Is_Regular_File (Filename) then
+                  Error ("file '" & Filename (1 .. Len) & "' already exists");
+                  raise Compile_Error;
+               end if;
+               Put (Filename (1 .. Len));
+               Put ("  (for ");
+               Disp_Library_Unit (Lib);
+               Put (")");
+               New_Line;
+            end;
+            Unit := Get_Chain (Unit);
+         end loop;
+      end loop;
+
+      --  Second loop: do the real work.
+      for I in Args'Range loop
+         Id := Get_Identifier (Args (I).all);
+         Design_File := Libraries.Load_File (Id);
+         Unit := Get_First_Design_Unit (Design_File);
+         declare
+            use Files_Map;
+
+            File_Entry : Source_File_Entry;
+            Buffer : File_Buffer_Acc;
+
+            Start : Source_Ptr;
+            Lend : Source_Ptr;
+            First : Source_Ptr;
+            Next : Source_Ptr;
+            Kind : Line_Type;
+         begin
+            --  A design_file must have at least one design unit.
+            if Unit = Null_Iir then
+               raise Compile_Error;
+            end if;
+
+            Location_To_File_Pos
+              (Get_Location (Unit), File_Entry, Start);
+            Buffer := Get_File_Source (File_Entry);
+
+            First := Source_Ptr_Org;
+            if Get_Chain (Unit) /= Null_Iir then
+               --  If there is only one unit, then the whole file is written.
+               --  First last blank line.
+               Next := Source_Ptr_Org;
+               loop
+                  Start := Next;
+                  Find_Eol (Buffer, Start, Next, Kind);
+                  exit when Kind = Line_Text;
+                  if Kind = Line_Blank then
+                     First := Next;
+                  end if;
+               end loop;
+
+               --  FIXME: write header.
+            end if;
+
+            while Unit /= Null_Iir loop
+               Lib := Get_Library_Unit (Unit);
+
+               Location_To_File_Pos
+                 (Get_End_Location (Unit), File_Entry, Lend);
+               if Lend < First then
+                  raise Internal_Error;
+               end if;
+
+               Location_To_File_Pos
+                 (Get_End_Location (Unit), File_Entry, Lend);
+               --  Find the ';'.
+               while Buffer (Lend) /= ';' loop
+                  Lend := Lend + 1;
+               end loop;
+               Lend := Lend + 1;
+               --  Find end of line.
+               Find_Eol (Buffer, Lend, Next, Kind);
+               if Kind = Line_Text then
+                  --  There is another unit on the same line.
+                  Next := Lend;
+                  --  Skip blanks.
+                  while Buffer (Next) = ' ' or Buffer (Next) = HT loop
+                     Next := Next + 1;
+                  end loop;
+               else
+                  --  Find first blank line.
+                  loop
+                     Start := Next;
+                     Find_Eol (Buffer, Start, Next, Kind);
+                     exit when Kind /= Line_Comment;
+                  end loop;
+                  if Kind = Line_Text then
+                     --  There is not blank lines.
+                     --  All the comments are supposed to belong to the next
+                     --  unit.
+                     Find_Eol (Buffer, Lend, Next, Kind);
+                     Lend := Next;
+                  else
+                     Lend := Start;
+                  end if;
+               end if;
+
+               if Get_Chain (Unit) = Null_Iir then
+                  --  Last unit.
+                  --  Put the end of the file in it.
+                  Lend := Get_File_Length (File_Entry);
+               end if;
+
+               --  FIXME: file with only one unit.
+               --  FIXME: set extension.
+               Len := Build_File_Name_Length (Lib);
+               declare
+                  Filename : String (1 .. Len + 1);
+                  Fd : File_Descriptor;
+
+                  Wlen : Integer;
+               begin
+                  Build_File_Name (Lib, Filename);
+                  Filename (Len + 1) := Character'Val (0);
+                  Fd := Create_File (Filename, Binary);
+                  if Fd = Invalid_FD then
+                     Error
+                       ("cannot create file '" & Filename (1 .. Len) & "'");
+                     raise Compile_Error;
+                  end if;
+                  Wlen := Integer (Lend - First);
+                  if Write (Fd, Buffer (First)'Address, Wlen) /= Wlen then
+                     Error ("cannot write to '" & Filename (1 .. Len) & "'");
+                     raise Compile_Error;
+                  end if;
+                  Close (Fd);
+               end;
+               First := Next;
+
+               Unit := Get_Chain (Unit);
+            end loop;
+         end;
+      end loop;
+   end Perform_Action;
+
+   --  Command --lines.
+   type Command_Lines is new Command_Lib with null record;
+   function Decode_Command (Cmd : Command_Lines; Name : String)
+                           return Boolean;
+   function Get_Short_Help (Cmd : Command_Lines) return String;
+   procedure Perform_Action (Cmd : in out Command_Lines;
+                             Args : Argument_List);
+
+   function Decode_Command (Cmd : Command_Lines; Name : String)
+                           return Boolean
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return Name = "--lines";
+   end Decode_Command;
+
+   function Get_Short_Help (Cmd : Command_Lines) return String
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return "--lines FILEs      Precede line with its number";
+   end Get_Short_Help;
+
+   procedure Perform_Action (Cmd : in out Command_Lines; Args : Argument_List)
+   is
+      pragma Unreferenced (Cmd);
+      use Scan;
+      use Tokens;
+      use Files_Map;
+      use Ada.Characters.Latin_1;
+
+      Id : Name_Id;
+      Fe : Source_File_Entry;
+      Local_Id : Name_Id;
+      Line : Natural;
+      File : Source_File_Entry;
+      Buf : File_Buffer_Acc;
+      Ptr : Source_Ptr;
+      Eptr : Source_Ptr;
+      C : Character;
+      N : Natural;
+      Log : Natural;
+      Str : String (1 .. 10);
+   begin
+      Local_Id := Get_Identifier ("");
+      for I in Args'Range loop
+         Id := Get_Identifier (Args (I).all);
+         Fe := Files_Map.Load_Source_File (Local_Id, Id);
+         if Fe = No_Source_File_Entry then
+            Error ("cannot open file " & Args (I).all);
+            raise Compile_Error;
+         end if;
+         Set_File (Fe);
+         loop
+            Scan.Scan;
+            exit when Current_Token = Tok_Eof;
+         end loop;
+         File := Get_Current_Source_File;
+         Line := Get_Current_Line;
+         Close_File;
+
+         --  Compute log10 of line.
+         N := Line;
+         Log := 0;
+         loop
+            N := N / 10;
+            Log := Log + 1;
+            exit when N = 0;
+         end loop;
+
+         --  Disp file name.
+         Put (Args (I).all);
+         Put (':');
+         New_Line;
+
+         Buf := Get_File_Source (File);
+         for J in 1 .. Line loop
+            Ptr := Line_To_Position (File, J);
+            exit when Ptr = Source_Ptr_Bad;
+            exit when Buf (Ptr) = Files_Map.EOT;
+
+            --  Disp line number.
+            N := J;
+            for K in reverse 1 .. Log loop
+               if N = 0 then
+                  Str (K) := ' ';
+               else
+                  Str (K) := Character'Val (48 + N mod 10);
+                  N := N / 10;
+               end if;
+            end loop;
+            Put (Str (1 .. Log));
+            Put (": ");
+
+            --  Search for end of line (or end of file).
+            Eptr := Ptr;
+            loop
+               C := Buf (Eptr);
+               exit when C = Files_Map.EOT or C = LF or C = CR;
+               Eptr := Eptr + 1;
+            end loop;
+
+            --  Disp line.
+            Put (String (Buf (Ptr .. Eptr - 1)));
+            New_Line;
+         end loop;
+      end loop;
+   end Perform_Action;
+
+   type Command_Html is abstract new Command_Lib with null record;
+
+   procedure Decode_Option (Cmd : in out Command_Html;
+                            Option : String;
+                            Arg : String;
+                            Res : out Option_Res);
+
+   procedure Disp_Long_Help (Cmd : Command_Html);
+
+   procedure Decode_Option (Cmd : in out Command_Html;
+                            Option : String;
+                            Arg : String;
+                            Res : out Option_Res)
+   is
+   begin
+      if Option = "--format=css" then
+         Html_Format := Html_Css;
+         Res := Option_Ok;
+      elsif Option = "--format=html2" then
+         Html_Format := Html_2;
+         Res := Option_Ok;
+      else
+         Decode_Option (Command_Lib (Cmd), Option, Arg, Res);
+      end if;
+   end Decode_Option;
+
+   procedure Disp_Long_Help (Cmd : Command_Html)
+   is
+      use Ada.Text_IO;
+   begin
+      Disp_Long_Help (Command_Lib (Cmd));
+      Put_Line ("--format=html2  Use FONT attributes");
+      Put_Line ("--format=css    Use ghdl.css file");
+   end Disp_Long_Help;
+
+   --  Command --pp_html.
+   type Command_PP_Html is new Command_Html with null record;
+   function Decode_Command (Cmd : Command_PP_Html; Name : String)
+                           return Boolean;
+   function Get_Short_Help (Cmd : Command_PP_Html) return String;
+   procedure Perform_Action (Cmd : in out Command_PP_Html;
+                             Files : Argument_List);
+
+   function Decode_Command (Cmd : Command_PP_Html; Name : String)
+                           return Boolean
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return Name = "--pp-html";
+   end Decode_Command;
+
+   function Get_Short_Help (Cmd : Command_PP_Html) return String
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return "--pp-html FILEs    Pretty-print FILEs in HTML";
+   end Get_Short_Help;
+
+   procedure Perform_Action (Cmd : in out Command_PP_Html;
+                             Files : Argument_List)
+   is
+      pragma Unreferenced (Cmd);
+      use Scan;
+      use Tokens;
+      use Files_Map;
+      use Ada.Characters.Latin_1;
+
+      Id : Name_Id;
+      Fe : Source_File_Entry;
+      Local_Id : Name_Id;
+   begin
+      Local_Id := Get_Identifier ("");
+      Put_Html_Header;
+      Put_Line ("  <title>");
+      for I in Files'Range loop
+         Put ("    ");
+         Put_Line (Files (I).all);
+      end loop;
+      Put_Line ("  </title>");
+      Put_Line ("</head>");
+      New_Line;
+      Put_Line ("<body>");
+
+      for I in Files'Range loop
+         Id := Get_Identifier (Files (I).all);
+         Fe := Files_Map.Load_Source_File (Local_Id, Id);
+         if Fe = No_Source_File_Entry then
+            Error ("cannot open file " & Files (I).all);
+            raise Compile_Error;
+         end if;
+         Put ("  <h1>");
+         Put (Files (I).all);
+         Put ("</h1>");
+         New_Line;
+
+         PP_Html_File (Fe);
+      end loop;
+      Put_Html_Foot;
+   end Perform_Action;
+
+   --  Command --xref-html.
+   type Command_Xref_Html is new Command_Html with record
+      Output_Dir : String_Access := null;
+   end record;
+
+   function Decode_Command (Cmd : Command_Xref_Html; Name : String)
+                           return Boolean;
+   function Get_Short_Help (Cmd : Command_Xref_Html) return String;
+   procedure Decode_Option (Cmd : in out Command_Xref_Html;
+                            Option : String;
+                            Arg : String;
+                            Res : out Option_Res);
+   procedure Disp_Long_Help (Cmd : Command_Xref_Html);
+
+   procedure Perform_Action (Cmd : in out Command_Xref_Html;
+                             Files_Name : Argument_List);
+
+   function Decode_Command (Cmd : Command_Xref_Html; Name : String)
+                           return Boolean
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return Name = "--xref-html";
+   end Decode_Command;
+
+   function Get_Short_Help (Cmd : Command_Xref_Html) return String
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return "--xref-html FILEs  Display FILEs in HTML with xrefs";
+   end Get_Short_Help;
+
+   procedure Decode_Option (Cmd : in out Command_Xref_Html;
+                            Option : String;
+                            Arg : String;
+                            Res : out Option_Res)
+   is
+   begin
+      if Option = "-o" then
+         if Arg = "" then
+            Res := Option_Arg_Req;
+         else
+            Cmd.Output_Dir := new String'(Arg);
+            Res := Option_Arg;
+         end if;
+      else
+         Decode_Option (Command_Html (Cmd), Option, Arg, Res);
+      end if;
+   end Decode_Option;
+
+   procedure Disp_Long_Help (Cmd : Command_Xref_Html)
+   is
+      use Ada.Text_IO;
+   begin
+      Disp_Long_Help (Command_Html (Cmd));
+      Put_Line ("-o DIR          Put generated files into DIR (def: html/)");
+      New_Line;
+      Put_Line ("When format is css, the CSS file 'ghdl.css' "
+                & "is never overwritten.");
+   end Disp_Long_Help;
+
+   procedure Analyze_Design_File_Units (File : Iir_Design_File)
+   is
+      Unit : Iir_Design_Unit;
+   begin
+      Unit := Get_First_Design_Unit (File);
+      while Unit /= Null_Iir loop
+         case Get_Date_State (Unit) is
+            when Date_Extern
+              | Date_Disk =>
+               raise Internal_Error;
+            when Date_Parse =>
+               Libraries.Load_Design_Unit (Unit, Null_Iir);
+            when Date_Analyze =>
+               null;
+         end case;
+         Unit := Get_Chain (Unit);
+      end loop;
+   end Analyze_Design_File_Units;
+
+   procedure Perform_Action
+     (Cmd : in out Command_Xref_Html; Files_Name : Argument_List)
+   is
+      use GNAT.Directory_Operations;
+
+      Id : Name_Id;
+      File : Source_File_Entry;
+
+      type File_Data is record
+         Fe : Source_File_Entry;
+         Design_File : Iir;
+         Output : String_Acc;
+      end record;
+      type File_Data_Array is array (Files_Name'Range) of File_Data;
+
+      Files : File_Data_Array;
+      Output : File_Type;
+      Prev_Output : File_Access;
+   begin
+      Xrefs.Init;
+      Flags.Flag_Xref := True;
+
+      --  Load work library.
+      Setup_Libraries (True);
+
+      if Cmd.Output_Dir = null then
+         Cmd.Output_Dir := new String'("html");
+      elsif Cmd.Output_Dir.all = "-" then
+         Cmd.Output_Dir := null;
+      end if;
+
+      --  Try to create the directory.
+      if Cmd.Output_Dir /= null
+        and then not Is_Directory (Cmd.Output_Dir.all)
+      then
+         declare
+         begin
+            Make_Dir (Cmd.Output_Dir.all);
+         exception
+            when Directory_Error =>
+               Error ("cannot create directory " & Cmd.Output_Dir.all);
+               return;
+         end;
+      end if;
+
+      --  Parse all files.
+      for I in Files'Range loop
+         Id := Get_Identifier (Files_Name (I).all);
+         File := Files_Map.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;
+         Files (I).Output := Create_Output_Filename
+           (Base_Name (Files_Name (I).all), I);
+         if Is_Regular_File (Files (I).Output.all) then
+            --  Prevent overwrite.
+            null;
+         end if;
+         --  Put units in library.
+         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;
+
+      Xrefs.Sort_By_Location;
+
+      if False then
+         for I in 1 .. Xrefs.Get_Last_Xref loop
+            declare
+               use Xrefs;
+
+               procedure Put_Loc (L : Location_Type)
+               is
+                  use Files_Map;
+
+                  L_File : Source_File_Entry;
+                  L_Pos : Source_Ptr;
+               begin
+                  Files_Map.Location_To_File_Pos (L, L_File, L_Pos);
+                  Put_Nat (Natural (L_File));
+                  --Image (Get_File_Name (L_File));
+                  --Put (Name_Buffer (1 .. Name_Length));
+                  Put (":");
+                  Put_Nat (Natural (L_Pos));
+               end Put_Loc;
+            begin
+               Put_Loc (Get_Xref_Location (I));
+               case Get_Xref_Kind (I) is
+                  when Xref_Decl =>
+                     Put (" decl ");
+                     Put (Image (Get_Identifier (Get_Xref_Node (I))));
+                  when Xref_Ref =>
+                     Put (" use ");
+                     Put_Loc (Get_Location (Get_Xref_Node (I)));
+                  when Xref_End =>
+                     Put (" end ");
+                  when Xref_Body =>
+                     Put (" body ");
+               end case;
+               New_Line;
+            end;
+         end loop;
+      end if;
+
+      --  Create filexref_info.
+      Filexref_Info := new Filexref_Info_Arr
+        (No_Source_File_Entry .. Files_Map.Get_Last_Source_File_Entry);
+      Filexref_Info.all := (others => (Output => null,
+                                       Referenced => False));
+      for I in Files'Range loop
+         Filexref_Info (Files (I).Fe).Output := Files (I).Output;
+      end loop;
+
+      Prev_Output := Current_Input;
+
+      for I in Files'Range loop
+         if Cmd.Output_Dir /= null then
+            Create (Output, Out_File,
+                    Cmd.Output_Dir.all & Directory_Separator
+                    & Files (I).Output.all);
+
+            Set_Output (Output);
+         end if;
+
+         Put_Html_Header;
+         Put_Line ("  <title>");
+         Put_Html (Files_Name (I).all);
+         Put ("</title>");
+         Put_Line ("</head>");
+         New_Line;
+         Put_Line ("<body>");
+
+         Put ("<h1>");
+         Put_Html (Files_Name (I).all);
+         Put ("</h1>");
+         New_Line;
+
+         PP_Html_File (Files (I).Fe);
+         Put_Html_Foot;
+
+         if Cmd.Output_Dir /= null then
+            Close (Output);
+         end if;
+      end loop;
+
+      --  Create indexes.
+      if Cmd.Output_Dir /= null then
+         Create (Output, Out_File,
+                 Cmd.Output_Dir.all & Directory_Separator & "index.html");
+         Set_Output (Output);
+
+         Put_Html_Header;
+         Put_Line ("  <title>Xrefs indexes</title>");
+         Put_Line ("</head>");
+         New_Line;
+         Put_Line ("<body>");
+         Put_Line ("<p>list of files:");
+         Put_Line ("<ul>");
+         for I in Files'Range loop
+            Put ("<li>");
+            Put ("<a href=""");
+            Put (Files (I).Output.all);
+            Put (""">");
+            Put_Html (Files_Name (I).all);
+            Put ("</a>");
+            Put ("</li>");
+            New_Line;
+         end loop;
+         Put_Line ("</ul></p>");
+         Put_Line ("<hr>");
+
+         --  TODO: list of design units.
+
+         Put_Line ("<p>list of files referenced but not available:");
+         Put_Line ("<ul>");
+         for I in No_Source_File_Entry + 1 .. Filexref_Info'Last loop
+            if Filexref_Info (I).Output = null
+              and then Filexref_Info (I).Referenced
+            then
+               Put ("<li><a name=""f");
+               Put_Nat (Natural (I));
+               Put (""">");
+               Put_Html (Image (Files_Map.Get_File_Name (I)));
+               Put ("</a></li>");
+               New_Line;
+            end if;
+         end loop;
+         Put_Line ("</ul></p><hr>");
+         Put_Html_Foot;
+
+         Close (Output);
+      end if;
+
+      if Html_Format = Html_Css
+        and then Cmd.Output_Dir /= null
+      then
+         declare
+            Css_Filename : String :=
+              Cmd.Output_Dir.all & Directory_Separator & "ghdl.css";
+         begin
+            if not Is_Regular_File (Css_Filename & Nul) then
+               Create (Output, Out_File, Css_Filename);
+               Set_Output (Output);
+               Put_Css;
+               Close (Output);
+            end if;
+         end;
+      end if;
+   exception
+      when Compilation_Error =>
+         Error ("xrefs has failed due to compilation error");
+   end Perform_Action;
+
+
+   --  Command --xref
+   type Command_Xref is new Command_Lib with null record;
+
+   function Decode_Command (Cmd : Command_Xref; Name : String)
+                           return Boolean;
+   function Get_Short_Help (Cmd : Command_Xref) return String;
+
+   procedure Perform_Action (Cmd : in out Command_Xref;
+                             Files_Name : Argument_List);
+
+   function Decode_Command (Cmd : Command_Xref; Name : String)
+                           return Boolean
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return Name = "--xref";
+   end Decode_Command;
+
+   function Get_Short_Help (Cmd : Command_Xref) return String
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return "--xref FILEs  Generate xrefs";
+   end Get_Short_Help;
+
+   procedure Perform_Action
+     (Cmd : in out Command_Xref; 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);
+
+      Xrefs.Init;
+      Flags.Flag_Xref := 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;
+
+      Xrefs.Fix_End_Xrefs;
+      Xrefs.Sort_By_Node_Location;
+
+      for F in Files'Range loop
+
+         Put ("GHDL-XREF V0");
+
+         declare
+            use Xrefs;
+
+            Cur_Decl : Iir;
+            Cur_File : Source_File_Entry;
+
+            procedure Emit_Loc (Loc : Location_Type; C : Character)
+            is
+               L_File : Source_File_Entry;
+               L_Pos : Source_Ptr;
+               L_Line : Natural;
+               L_Off : Natural;
+            begin
+               Location_To_Coord (Loc, L_File, L_Pos, L_Line, L_Off);
+               --Put_Nat (Natural (L_File));
+               --Put (':');
+               Put_Nat (L_Line);
+               Put (C);
+               Put_Nat (L_Off);
+            end Emit_Loc;
+
+            procedure Emit_Decl (N : Iir)
+            is
+               Loc : Location_Type;
+               Loc_File : Source_File_Entry;
+               Loc_Pos : Source_Ptr;
+               C : Character;
+            begin
+               New_Line;
+               Cur_Decl := N;
+               Loc := Get_Location (N);
+               Location_To_File_Pos (Loc, Loc_File, Loc_Pos);
+               if Loc_File /= Cur_File then
+                  Cur_File := Loc_File;
+                  Put ("XFILE: ");
+                  Image (Get_Source_File_Directory (Cur_File));
+                  Put (Name_Buffer (1 .. Name_Length));
+                  Image (Get_File_Name (Cur_File));
+                  Put (Name_Buffer (1 .. Name_Length));
+                  New_Line;
+               end if;
+
+               --  Letters:
+               --   b d fgh jk  no qr  uvwxyz
+               --     D   H JK MNO QR  U WXYZ
+               case Get_Kind (N) is
+                  when Iir_Kind_Type_Declaration =>
+                     C := 'T';
+                  when Iir_Kind_Subtype_Declaration =>
+                     C := 't';
+                  when Iir_Kind_Entity_Declaration =>
+                     C := 'E';
+                  when Iir_Kind_Architecture_Declaration =>
+                     C := 'A';
+                  when Iir_Kind_Library_Declaration =>
+                     C := 'L';
+                  when Iir_Kind_Package_Declaration =>
+                     C := 'P';
+                  when Iir_Kind_Package_Body =>
+                     C := 'B';
+                  when Iir_Kind_Function_Declaration =>
+                     C := 'F';
+                  when Iir_Kind_Procedure_Declaration =>
+                     C := 'p';
+                  when Iir_Kind_Signal_Interface_Declaration =>
+                     C := 's';
+                  when Iir_Kind_Signal_Declaration =>
+                     C := 'S';
+                  when Iir_Kind_Constant_Interface_Declaration =>
+                     C := 'c';
+                  when Iir_Kind_Constant_Declaration =>
+                     C := 'C';
+                  when Iir_Kind_Variable_Declaration =>
+                     C := 'V';
+                  when Iir_Kind_Element_Declaration =>
+                     C := 'e';
+                  when Iir_Kind_Iterator_Declaration =>
+                     C := 'i';
+                  when Iir_Kind_Attribute_Declaration =>
+                     C := 'a';
+                  when Iir_Kind_Enumeration_Literal =>
+                     C := 'l';
+                  when Iir_Kind_Component_Declaration =>
+                     C := 'm';
+                  when Iir_Kind_Component_Instantiation_Statement =>
+                     C := 'I';
+                  when Iir_Kind_Generate_Statement =>
+                     C := 'G';
+                  when others =>
+                     C := '?';
+               end case;
+               Emit_Loc (Loc, C);
+               --Disp_Tree.Disp_Iir_Address (N);
+               Put (' ');
+               case Get_Kind (N) is
+                  when Iir_Kind_Function_Body
+                    | Iir_Kind_Procedure_Body =>
+                     null;
+                  when others =>
+                     Image (Get_Identifier (N));
+                     Put (Name_Buffer (1 .. Name_Length));
+               end case;
+            end Emit_Decl;
+
+            procedure Emit_Ref (R : Xref; T : Character)
+            is
+               N : Iir;
+            begin
+               N := Get_Xref_Node (R);
+               if N /= Cur_Decl then
+                  Emit_Decl (N);
+               end if;
+               Put (' ');
+               Emit_Loc (Get_Xref_Location (R), T);
+            end Emit_Ref;
+
+            Loc : Location_Type;
+            Loc_File : Source_File_Entry;
+            Loc_Pos : Source_Ptr;
+         begin
+            Cur_Decl := Null_Iir;
+            Cur_File := No_Source_File_Entry;
+
+            for I in First_Xref .. Get_Last_Xref loop
+               Loc := Get_Xref_Location (I);
+               Location_To_File_Pos (Loc, Loc_File, Loc_Pos);
+               if Loc_File = Files (F).Fe then
+                  --  This is a local location.
+                  case Get_Xref_Kind (I) is
+                     when Xref_Decl =>
+                        Emit_Decl (Get_Xref_Node (I));
+                     when Xref_End =>
+                        Emit_Ref (I, 'e');
+                     when Xref_Ref =>
+                        Emit_Ref (I, 'r');
+                     when Xref_Body =>
+                        Emit_Ref (I, 'b');
+                     when others =>
+                        null;
+                  end case;
+               end if;
+            end loop;
+            New_Line;
+         end;
+      end loop;
+   exception
+      when Compilation_Error =>
+         Error ("xrefs has failed due to compilation error");
+   end Perform_Action;
+
+   procedure Register_Commands is
+   begin
+      Register_Command (new Command_Chop);
+      Register_Command (new Command_Lines);
+      Register_Command (new Command_PP_Html);
+      Register_Command (new Command_Xref_Html);
+      Register_Command (new Command_Xref);
+   end Register_Commands;
+end Ghdlprint;