aboutsummaryrefslogtreecommitdiffstats
path: root/translate/ghdldrv/ghdlprint.adb
diff options
context:
space:
mode:
Diffstat (limited to 'translate/ghdldrv/ghdlprint.adb')
-rw-r--r--translate/ghdldrv/ghdlprint.adb1561
1 files changed, 1561 insertions, 0 deletions
diff --git a/translate/ghdldrv/ghdlprint.adb b/translate/ghdldrv/ghdlprint.adb
new file mode 100644
index 000000000..d9de2df86
--- /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;
generated by cgit v1.2.3 (git 2.25.1) at 2024-08-02 20:59:58 +0000