From f771391fd9c0a99e1652209a74c1687c77a7ab35 Mon Sep 17 00:00:00 2001 From: Tristan Gingold Date: Thu, 30 May 2019 10:07:25 +0200 Subject: vhdl: renames disp_vhdl to prints --- src/files_map.adb | 7 +- src/files_map.ads | 7 +- src/ghdldrv/ghdllocal.adb | 4 +- src/ghdldrv/ghdlprint.adb | 12 +- src/psl/psl-nodes_priv.ads | 1 + src/psl/psl-types.ads | 1 + src/vhdl/translate/trans_analyzes.adb | 4 +- src/vhdl/vhdl-canon.adb | 4 +- src/vhdl/vhdl-disp_vhdl.adb | 4155 --------------------------------- src/vhdl/vhdl-disp_vhdl.ads | 57 - src/vhdl/vhdl-flists.ads | 2 +- src/vhdl/vhdl-lists.ads | 2 +- src/vhdl/vhdl-nodes.ads | 4 +- src/vhdl/vhdl-parse_psl.adb | 2 +- src/vhdl/vhdl-prints.adb | 4155 +++++++++++++++++++++++++++++++++ src/vhdl/vhdl-prints.ads | 57 + src/vhdl/vhdl-sem_lib.adb | 6 +- src/vhdl/vhdl-sem_psl.adb | 136 +- src/vhdl/vhdl-types.ads | 3 +- 19 files changed, 4317 insertions(+), 4302 deletions(-) delete mode 100644 src/vhdl/vhdl-disp_vhdl.adb delete mode 100644 src/vhdl/vhdl-disp_vhdl.ads create mode 100644 src/vhdl/vhdl-prints.adb create mode 100644 src/vhdl/vhdl-prints.ads diff --git a/src/files_map.adb b/src/files_map.adb index e93934ce2..d6ee415b1 100644 --- a/src/files_map.adb +++ b/src/files_map.adb @@ -626,9 +626,10 @@ package body Files_Map is return Create_Source_File_From_String (Name, ""); end Create_Virtual_Source_File; - function Create_Instance_Source_File - (Ref : Source_File_Entry; Loc : Location_Type; Inst : Vhdl.Types.Node) - return Source_File_Entry + function Create_Instance_Source_File (Ref : Source_File_Entry; + Loc : Location_Type; + Inst : Vhdl.Types.Vhdl_Node) + return Source_File_Entry is pragma Unreferenced (Inst); Base : Source_File_Entry; diff --git a/src/files_map.ads b/src/files_map.ads index a5a05e30e..2e0dd0ae2 100644 --- a/src/files_map.ads +++ b/src/files_map.ads @@ -70,9 +70,10 @@ package Files_Map is -- location LOC). The content of this file is the same as REF, but with -- new locations so that it is possible to retrieve the instance from -- the new locations. - function Create_Instance_Source_File - (Ref : Source_File_Entry; Loc : Location_Type; Inst : Vhdl.Types.Node) - return Source_File_Entry; + function Create_Instance_Source_File (Ref : Source_File_Entry; + Loc : Location_Type; + Inst : Vhdl.Types.Vhdl_Node) + return Source_File_Entry; -- Unload last source file. Works only with the last one. Must be -- carefully used as the corresponding locations will be reused. diff --git a/src/ghdldrv/ghdllocal.adb b/src/ghdldrv/ghdllocal.adb index 3aee26250..3b4884acb 100644 --- a/src/ghdldrv/ghdllocal.adb +++ b/src/ghdldrv/ghdllocal.adb @@ -27,7 +27,7 @@ with Vhdl.Std_Package; with Flags; with Name_Table; with Std_Names; -with Vhdl.Disp_Vhdl; +with Vhdl.Prints; with Default_Paths; with Vhdl.Scanner; with Errorout; @@ -1118,7 +1118,7 @@ package body Ghdllocal is end if; Flags.Bootstrap := True; Libraries.Load_Std_Library; - Vhdl.Disp_Vhdl.Disp_Vhdl (Vhdl.Std_Package.Std_Standard_Unit); + Vhdl.Prints.Disp_Vhdl (Vhdl.Std_Package.Std_Standard_Unit); end Perform_Action; -- Command --find-top. diff --git a/src/ghdldrv/ghdlprint.adb b/src/ghdldrv/ghdlprint.adb index 91168c023..7d232c697 100644 --- a/src/ghdldrv/ghdlprint.adb +++ b/src/ghdldrv/ghdlprint.adb @@ -37,7 +37,7 @@ with Vhdl.Xrefs; with Vhdl.Sem_Lib; use Vhdl.Sem_Lib; with Ghdlmain; use Ghdlmain; with Ghdllocal; use Ghdllocal; -with Vhdl.Disp_Vhdl; +with Vhdl.Prints; with Vhdl.Elocations; package body Ghdlprint is @@ -1024,17 +1024,23 @@ package body Ghdlprint is end if; Unit := Get_First_Design_Unit (Design_File); + if Cmd.Flag_Sem then + Design_File := Null_Iir; + end if; while Unit /= Null_Iir loop if Cmd.Flag_Sem then -- Analyze the design unit. Vhdl.Sem_Lib.Finish_Compilation (Unit, True); + if Cmd.Flag_Sem and then Design_File = Null_Iir then + Design_File := Get_Design_File (Unit); + end if; end if; Next_Unit := Get_Chain (Unit); if Errorout.Nbr_Errors = 0 then - Vhdl.Disp_Vhdl.Disp_Vhdl (Unit); - Set_Chain (Unit, Null_Iir); + Vhdl.Prints.Disp_Vhdl (Unit); if Cmd.Flag_Sem then + Set_Chain (Unit, Null_Iir); Libraries.Add_Design_Unit_Into_Library (Unit); end if; end if; diff --git a/src/psl/psl-nodes_priv.ads b/src/psl/psl-nodes_priv.ads index 5c0bf51d0..9927b8bde 100644 --- a/src/psl/psl-nodes_priv.ads +++ b/src/psl/psl-nodes_priv.ads @@ -20,6 +20,7 @@ with Types; use Types; package PSL.Nodes_Priv is -- PSL Node. type PSL_Node is new Int32; + Null_PSL_Node : constant PSL_Node := 0; -- PSL NFA type PSL_NFA is new Int32; diff --git a/src/psl/psl-types.ads b/src/psl/psl-types.ads index e6e3c700a..24a9f9a80 100644 --- a/src/psl/psl-types.ads +++ b/src/psl/psl-types.ads @@ -22,6 +22,7 @@ package PSL.Types is subtype PSL_Node is PSL.Nodes_Priv.PSL_Node; function "=" (L, R : PSL_Node) return Boolean renames PSL.Nodes_Priv."="; + Null_PSL_Node : constant PSL_Node := PSL.Nodes_Priv.Null_PSL_Node; -- PSL NFA subtype PSL_NFA is PSL.Nodes_Priv.PSL_NFA; diff --git a/src/vhdl/translate/trans_analyzes.adb b/src/vhdl/translate/trans_analyzes.adb index 2311b12eb..420d04c37 100644 --- a/src/vhdl/translate/trans_analyzes.adb +++ b/src/vhdl/translate/trans_analyzes.adb @@ -20,7 +20,7 @@ with Errorout; with Simple_IO; with Vhdl.Utils; use Vhdl.Utils; with Vhdl.Nodes_Walk; use Vhdl.Nodes_Walk; -with Vhdl.Disp_Vhdl; +with Vhdl.Prints; with Vhdl.Errors; use Vhdl.Errors; package body Trans_Analyzes is @@ -247,7 +247,7 @@ package body Trans_Analyzes is else Put (" "); end if; - Vhdl.Disp_Vhdl.Disp_Vhdl (El); + Vhdl.Prints.Disp_Vhdl (El); New_Line; Next (It); end loop; diff --git a/src/vhdl/vhdl-canon.adb b/src/vhdl/vhdl-canon.adb index f0037d298..604272813 100644 --- a/src/vhdl/vhdl-canon.adb +++ b/src/vhdl/vhdl-canon.adb @@ -2155,7 +2155,7 @@ package body Vhdl.Canon is Prop := Get_Property (Decl); Prop := PSL.Rewrites.Rewrite_Property (Prop); Set_Property (Decl, Prop); - if Get_Parameter_List (Decl) = Null_Node then + if Get_Parameter_List (Decl) = Null_PSL_Node then -- Generate the NFA. Fa := PSL.Build.Build_FA (Prop); Set_PSL_NFA (El, Fa); @@ -2176,7 +2176,7 @@ package body Vhdl.Canon is Seq : PSL_Node; Fa : PSL_NFA; begin - pragma Assert (Get_Parameter_List (Decl) = Null_Node); + pragma Assert (Get_Parameter_List (Decl) = Null_PSL_Node); Seq := Get_Sequence (Decl); Seq := PSL.Rewrites.Rewrite_SERE (Seq); Set_Sequence (Decl, Seq); diff --git a/src/vhdl/vhdl-disp_vhdl.adb b/src/vhdl/vhdl-disp_vhdl.adb deleted file mode 100644 index 107b3f8a8..000000000 --- a/src/vhdl/vhdl-disp_vhdl.adb +++ /dev/null @@ -1,4155 +0,0 @@ --- VHDL regeneration from internal nodes. --- 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 GHDL; see the file COPYING. If not, write to the Free --- Software Foundation, 59 Temple Place - Suite 330, Boston, MA --- 02111-1307, USA. - --- Re-print a tree as VHDL sources. Except for comments and parenthesis, the --- sequence of tokens displayed is the same as the sequence of tokens in the --- input file. If parenthesis are kept by the parser, the only differences --- are comments and layout. -with Types; use Types; -with Simple_IO; -with Flags; use Flags; -with Name_Table; -with Str_Table; -with Std_Names; use Std_Names; -with Files_Map; -with Vhdl.Errors; use Vhdl.Errors; -with Vhdl.Utils; use Vhdl.Utils; -with Vhdl.Std_Package; -with PSL.Nodes; -with PSL.Prints; -with PSL.NFAs; -with PSL.Errors; - -package body Vhdl.Disp_Vhdl is - - -- If True, display extra parenthesis to make priority of operators - -- explicit. - Flag_Parenthesis : constant Boolean := False; - - -- If set, disp after a string literal the type enclosed into brackets. - Flag_Disp_String_Literal_Type: constant Boolean := False; - - -- If set, disp implicit declarations. - Flag_Implicit : constant Boolean := False; - - procedure Disp_Type (Ctxt : in out Ctxt_Class; A_Type: Iir); - procedure Disp_Range (Ctxt : in out Ctxt_Class; Rng : Iir); - procedure Print (Ctxt : in out Ctxt_Class; Expr: Iir); - - procedure Disp_Concurrent_Statement (Ctxt : in out Ctxt_Class; Stmt: Iir); - procedure Disp_Concurrent_Statement_Chain - (Ctxt : in out Ctxt_Class; Parent: Iir); - procedure Disp_Declaration_Chain - (Ctxt : in out Ctxt_Class; Parent : Iir); - procedure Disp_Process_Statement (Ctxt : in out Ctxt_Class; Process: Iir); - procedure Disp_Sequential_Statements - (Ctxt : in out Ctxt_Class; First : Iir); - procedure Disp_Choice (Ctxt : in out Ctxt_Class; Choice: in out Iir); - procedure Disp_Association_Chain (Ctxt : in out Ctxt_Class; Chain : Iir); - procedure Disp_Block_Configuration - (Ctxt : in out Ctxt_Class; Block: Iir_Block_Configuration); - procedure Disp_Subprogram_Declaration - (Ctxt : in out Ctxt_Class; Subprg: Iir; Implicit : Boolean := False); - procedure Disp_Binding_Indication - (Ctxt : in out Ctxt_Class; Bind : Iir); - procedure Disp_Subtype_Indication - (Ctxt : in out Ctxt_Class; Def : Iir; Full_Decl : Boolean := False); - procedure Disp_Parametered_Attribute - (Ctxt : in out Ctxt_Class; Name : Name_Id; Expr : Iir); - procedure Disp_String_Literal - (Ctxt : in out Ctxt_Class; Str : Iir; El_Type : Iir); - procedure Disp_Package_Declaration - (Ctxt : in out Ctxt_Class; Decl: Iir_Package_Declaration); - procedure Disp_Package_Instantiation_Declaration - (Ctxt : in out Ctxt_Class; Decl: Iir); - procedure Disp_Package_Body (Ctxt : in out Ctxt_Class; Decl: Iir); - procedure Disp_Attribute_Name (Ctxt : in out Ctxt_Class; Attr : Iir); - - procedure Disp_Int64 (Ctxt : in out Ctxt_Class; Val: Int64); - procedure Disp_Int32 (Ctxt : in out Ctxt_Class; Val: Iir_Int32); - procedure Disp_Fp64 (Ctxt : in out Ctxt_Class; Val: Fp64); - - procedure Put (Str : String) is - begin - Simple_IO.Put_Err (Str); - end Put; - - procedure Put (C : Character) is - begin - Put ((1 => C)); - end Put; - - procedure New_Line is - begin - Put (ASCII.LF); - end New_Line; - - procedure Put_Line (Str : String) is - begin - Put (Str); - New_Line; - end Put_Line; - - procedure Disp_Token (Ctxt : in out Ctxt_Class; Tok1, Tok2 : Token_Type) is - begin - Disp_Token (Ctxt, Tok1); - Disp_Token (Ctxt, Tok2); - end Disp_Token; - - procedure Disp_Ident (Ctxt : in out Ctxt_Class; Id: Name_Id) is - begin - if Name_Table.Is_Character (Id) then - Start_Lit (Ctxt, Tok_Character); - Disp_Char (Ctxt, '''); - Disp_Char (Ctxt, Name_Table.Get_Character (Id)); - Disp_Char (Ctxt, '''); - Close_Lit (Ctxt); - else - Start_Lit (Ctxt, Tok_Identifier); - if Id = Null_Identifier then - Disp_Str (Ctxt, ""); - else - Disp_Str (Ctxt, Name_Table.Image (Id)); - end if; - Close_Lit (Ctxt); - end if; - end Disp_Ident; - - function Or_Else (L, R : Iir) return Iir is - begin - if L /= Null_Iir then - return L; - end if; - pragma Assert (R /= Null_Iir); - return R; - end Or_Else; - - -- Disp a literal from the sources (so using exactely the same characters). - procedure Disp_From_Source - (Ctxt : in out Ctxt_Class; - Loc : Location_Type; Len : Int32; Tok : Token_Type) - is - use Files_Map; - pragma Assert (Len > 0); - File : Source_File_Entry; - Pos : Source_Ptr; - Buf : File_Buffer_Acc; - begin - Location_To_File_Pos (Loc, File, Pos); - Buf := Get_File_Source (File); - Start_Lit (Ctxt, Tok); - for I in 1 .. Len loop - Disp_Char (Ctxt, Buf (Pos)); - Pos := Pos + 1; - end loop; - Close_Lit (Ctxt); - end Disp_From_Source; - - procedure Disp_Identifier (Ctxt : in out Ctxt_Class; Node : Iir) - is - use Name_Table; - Id : constant Name_Id := Get_Identifier (Node); - Loc : constant Location_Type := Get_Location (Node); - begin - -- Try to display the one from the sources. - if Id /= Null_Identifier - and then not Is_Character (Id) - and then Loc /= No_Location - and then Loc /= Std_Package.Std_Location - then - Disp_From_Source - (Ctxt, Loc, Int32 (Get_Name_Length (Id)), Tok_Identifier); - else - Disp_Ident (Ctxt, Id); - end if; - end Disp_Identifier; - - procedure Disp_Literal_From_Source - (Ctxt : in out Ctxt_Class; Lit : Iir; Tok : Token_Type) is - begin - Disp_From_Source - (Ctxt, Get_Location (Lit), Get_Literal_Length (Lit), Tok); - end Disp_Literal_From_Source; - - procedure Disp_Function_Name (Ctxt : in out Ctxt_Class; Func: Iir) - is - use Name_Table; - Id: Name_Id; - begin - Id := Get_Identifier (Func); - case Id is - when Name_Id_Operators - | Name_Word_Operators - | Name_Logical_Operators - | Name_Xnor - | Name_Shift_Operators => - Start_Lit (Ctxt, Tok_String); - Disp_Char (Ctxt, '"'); - Disp_Str (Ctxt, Image (Id)); - Disp_Char (Ctxt, '"'); - Close_Lit (Ctxt); - when others => - Disp_Ident (Ctxt, Id); - end case; - end Disp_Function_Name; - - -- Disp the name of DECL. - procedure Disp_Name_Of (Ctxt : in out Ctxt_Class; Decl: Iir) is - begin - case Get_Kind (Decl) is - when Iir_Kind_Component_Declaration - | Iir_Kind_Entity_Declaration - | Iir_Kind_Architecture_Body - | Iir_Kind_Configuration_Declaration - | Iir_Kind_Context_Declaration - | Iir_Kinds_Interface_Object_Declaration - | Iir_Kind_Interface_Type_Declaration - | Iir_Kind_Constant_Declaration - | Iir_Kind_Signal_Declaration - | Iir_Kind_Guard_Signal_Declaration - | Iir_Kind_Variable_Declaration - | Iir_Kind_Type_Declaration - | Iir_Kind_File_Declaration - | Iir_Kind_Subtype_Declaration - | Iir_Kind_Element_Declaration - | Iir_Kind_Record_Element_Constraint - | Iir_Kind_Package_Declaration - | Iir_Kind_Object_Alias_Declaration - | Iir_Kind_Non_Object_Alias_Declaration - | Iir_Kind_Iterator_Declaration - | Iir_Kind_Library_Declaration - | Iir_Kind_Unit_Declaration - | Iir_Kind_Nature_Declaration - | Iir_Kind_Terminal_Declaration - | Iir_Kinds_Quantity_Declaration - | Iir_Kind_Group_Template_Declaration - | Iir_Kind_Character_Literal - | Iir_Kinds_Process_Statement => - Disp_Identifier (Ctxt, Decl); - when Iir_Kind_Anonymous_Type_Declaration => - Start_Lit (Ctxt, Tok_Identifier); - Disp_Char (Ctxt, '<'); - Disp_Str (Ctxt, Name_Table.Image (Get_Identifier (Decl))); - Disp_Char (Ctxt, '>'); - Close_Lit (Ctxt); - when Iir_Kind_Function_Declaration => - Disp_Function_Name (Ctxt, Decl); - when Iir_Kind_Procedure_Declaration => - Disp_Identifier (Ctxt, Decl); - when Iir_Kind_Physical_Subtype_Definition - | Iir_Kind_Enumeration_Type_Definition - | Iir_Kind_Physical_Type_Definition - | Iir_Kind_Record_Type_Definition - | Iir_Kind_Protected_Type_Declaration => - -- Used for 'end' DECL_NAME. - Disp_Identifier (Ctxt, Get_Type_Declarator (Decl)); - when Iir_Kind_Component_Instantiation_Statement => - Disp_Ident (Ctxt, Get_Label (Decl)); - when Iir_Kind_Design_Unit => - Disp_Name_Of (Ctxt, Get_Library_Unit (Decl)); - when Iir_Kind_Enumeration_Literal - | Iir_Kind_Simple_Name => - Disp_Identifier (Ctxt, Decl); - when Iir_Kind_Block_Statement - | Iir_Kind_If_Generate_Statement - | Iir_Kind_Case_Generate_Statement - | Iir_Kind_For_Generate_Statement => - Disp_Ident (Ctxt, Get_Label (Decl)); - when Iir_Kind_Package_Body => - Disp_Identifier (Ctxt, Decl); - when Iir_Kind_Procedure_Body - | Iir_Kind_Function_Body => - Disp_Function_Name (Ctxt, Get_Subprogram_Specification (Decl)); - when Iir_Kind_Protected_Type_Body => - Disp_Identifier (Ctxt, Decl); - when others => - Error_Kind ("disp_name_of", Decl); - end case; - end Disp_Name_Of; - - procedure Disp_Name_Attribute - (Ctxt : in out Ctxt_Class; Attr : Iir; Name : Name_Id) is - begin - Print (Ctxt, Get_Prefix (Attr)); - Disp_Token (Ctxt, Tok_Tick); - Disp_Ident (Ctxt, Name); - end Disp_Name_Attribute; - - procedure Disp_Range (Ctxt : in out Ctxt_Class; Rng : Iir) is - begin - case Get_Kind (Rng) is - when Iir_Kind_Range_Expression => - declare - Origin : constant Iir := Get_Range_Origin (Rng); - begin - if Dump_Origin_Flag and then Origin /= Null_Iir then - Print (Ctxt, Origin); - else - Print (Ctxt, Or_Else (Get_Left_Limit_Expr (Rng), - Get_Left_Limit (Rng))); - if Get_Direction (Rng) = Iir_To then - Disp_Token (Ctxt, Tok_To); - else - Disp_Token (Ctxt, Tok_Downto); - end if; - Print (Ctxt, Or_Else (Get_Right_Limit_Expr (Rng), - Get_Right_Limit (Rng))); - end if; - end; - when Iir_Kind_Range_Array_Attribute => - Disp_Parametered_Attribute (Ctxt, Name_Range, Rng); - when Iir_Kind_Reverse_Range_Array_Attribute => - Disp_Parametered_Attribute (Ctxt, Name_Reverse_Range, Rng); - when Iir_Kind_Simple_Name - | Iir_Kind_Selected_Name - | Iir_Kind_Attribute_Name - | Iir_Kind_Parenthesis_Name => - Print (Ctxt, Rng); - when others => - Disp_Subtype_Indication (Ctxt, Rng); - -- Disp_Name_Of (Get_Type_Declarator (Decl)); - end case; - end Disp_Range; - - procedure Disp_After_End - (Ctxt : in out Ctxt_Class; - Decl : Iir; Tok1 : Token_Type; Tok2 : Token_Type := Tok_Invalid) is - begin - if Get_End_Has_Reserved_Id (Decl) then - Disp_Token (Ctxt, Tok1); - if Tok2 /= Tok_Invalid then - Disp_Token (Ctxt, Tok2); - end if; - end if; - if Get_End_Has_Identifier (Decl) then - Disp_Name_Of (Ctxt, Decl); - end if; - end Disp_After_End; - - procedure Disp_End_No_Close - (Ctxt : in out Ctxt_Class; - Decl : Iir; Tok1 : Token_Type; Tok2 : Token_Type := Tok_Invalid) is - begin - Start_Hbox (Ctxt); - Disp_Token (Ctxt, Tok_End); - Disp_After_End (Ctxt, Decl, Tok1, Tok2); - end Disp_End_No_Close; - - procedure Disp_End - (Ctxt : in out Ctxt_Class; - Decl : Iir; Tok1 : Token_Type; Tok2 : Token_Type := Tok_Invalid) is - begin - Disp_End_No_Close (Ctxt, Decl, Tok1, Tok2); - Disp_Token (Ctxt, Tok_Semi_Colon); - Close_Hbox (Ctxt); - end Disp_End; - - procedure Disp_End (Ctxt : in out Ctxt_Class; Tok1 : Token_Type) is - begin - Start_Hbox (Ctxt); - Disp_Token (Ctxt, Tok_End); - Disp_Token (Ctxt, Tok1); - Disp_Token (Ctxt, Tok_Semi_Colon); - Close_Hbox (Ctxt); - end Disp_End; - - procedure Disp_End_Label_No_Close - (Ctxt : in out Ctxt_Class; Stmt : Iir; Tok : Token_Type) is - begin - Start_Hbox (Ctxt); - Disp_Token (Ctxt, Tok_End); - Disp_Token (Ctxt, Tok); - if Get_End_Has_Identifier (Stmt) then - Disp_Ident (Ctxt, Get_Label (Stmt)); - end if; - Disp_Token (Ctxt, Tok_Semi_Colon); - end Disp_End_Label_No_Close; - - procedure Disp_End_Label - (Ctxt : in out Ctxt_Class; Stmt : Iir; Tok : Token_Type) is - begin - Disp_End_Label_No_Close (Ctxt, Stmt, Tok); - Close_Hbox (Ctxt); - end Disp_End_Label; - - procedure Disp_Use_Clause (Ctxt : in out Ctxt_Class; Clause: Iir_Use_Clause) - is - Name : Iir; - begin - Start_Hbox (Ctxt); - Disp_Token (Ctxt, Tok_Use); - Name := Clause; - loop - Print (Ctxt, Get_Selected_Name (Name)); - Name := Get_Use_Clause_Chain (Name); - exit when Name = Null_Iir; - Disp_Token (Ctxt, Tok_Comma); - end loop; - Disp_Token (Ctxt, Tok_Semi_Colon); - Close_Hbox (Ctxt); - end Disp_Use_Clause; - - -- Disp the resolution function (if any) of type definition DEF. - procedure Disp_Resolution_Indication - (Ctxt : in out Ctxt_Class; Subtype_Def: Iir) - is - procedure Inner (Ind : Iir) is - begin - case Get_Kind (Ind) is - when Iir_Kinds_Denoting_Name => - Print (Ctxt, Ind); - when Iir_Kind_Array_Element_Resolution => - declare - Res : constant Iir := Get_Resolution_Indication (Ind); - begin - Disp_Token (Ctxt, Tok_Left_Paren); - if Is_Valid (Res) then - Inner (Res); - else - Print (Ctxt, Get_Resolution_Indication - (Get_Element_Subtype_Indication (Ind))); - end if; - Disp_Token (Ctxt, Tok_Right_Paren); - end; - when others => - Error_Kind ("disp_resolution_indication", Ind); - end case; - end Inner; - - Ind : Iir; - begin - case Get_Kind (Subtype_Def) is - when Iir_Kind_Access_Subtype_Definition => - -- No resolution indication on access subtype. - return; - when others => - Ind := Get_Resolution_Indication (Subtype_Def); - if Ind = Null_Iir then - -- No resolution indication. - return; - end if; - end case; - - if False then - declare - Type_Mark : constant Iir := Get_Denoted_Type_Mark (Subtype_Def); - begin - if Get_Kind (Type_Mark) in Iir_Kinds_Subtype_Definition - and then Get_Resolution_Indication (Type_Mark) = Ind - then - -- Resolution indication was inherited from the type_mark. - return; - end if; - end; - end if; - - Inner (Ind); - end Disp_Resolution_Indication; - - procedure Disp_Element_Constraint - (Ctxt : in out Ctxt_Class; Def : Iir; Type_Mark : Iir); - - procedure Disp_Array_Element_Constraint - (Ctxt : in out Ctxt_Class; Def : Iir; Type_Mark : Iir) - is - Def_El : constant Iir := Get_Element_Subtype (Def); - Tm_El : constant Iir := Get_Element_Subtype (Type_Mark); - Has_Index : constant Boolean := Get_Index_Constraint_Flag (Def); - Has_Own_Element_Subtype : constant Boolean := Def_El /= Tm_El; - Indexes : Iir_Flist; - Index : Iir; - begin - if not Has_Index and not Has_Own_Element_Subtype then - return; - end if; - - if Get_Constraint_State (Type_Mark) /= Fully_Constrained - and then Has_Index - then - Indexes := Get_Index_Constraint_List (Def); - if Indexes = Null_Iir_Flist then - Indexes := Get_Index_Subtype_List (Def); - end if; - Disp_Token (Ctxt, Tok_Left_Paren); - for I in Flist_First .. Flist_Last (Indexes) loop - Index := Get_Nth_Element (Indexes, I); - if I /= 0 then - Disp_Token (Ctxt, Tok_Comma); - end if; - --Print (Get_Range_Constraint (Index)); - Disp_Range (Ctxt, Index); - end loop; - Disp_Token (Ctxt, Tok_Right_Paren); - end if; - - if Has_Own_Element_Subtype - and then Get_Kind (Def_El) in Iir_Kinds_Composite_Type_Definition - then - Disp_Element_Constraint (Ctxt, Def_El, Tm_El); - end if; - end Disp_Array_Element_Constraint; - - procedure Disp_Record_Element_Constraint - (Ctxt : in out Ctxt_Class; Def : Iir) - is - El_List : constant Iir_Flist := Get_Elements_Declaration_List (Def); - El : Iir; - Has_El : Boolean := False; - begin - for I in Flist_First .. Flist_Last (El_List) loop - El := Get_Nth_Element (El_List, I); - if Get_Kind (El) = Iir_Kind_Record_Element_Constraint - and then Get_Parent (El) = Def - then - if Has_El then - Disp_Token (Ctxt, Tok_Comma); - else - Disp_Token (Ctxt, Tok_Left_Paren); - Has_El := True; - end if; - Disp_Name_Of (Ctxt, El); - Disp_Element_Constraint (Ctxt, Get_Type (El), - Get_Base_Type (Get_Type (El))); - end if; - end loop; - if Has_El then - Disp_Token (Ctxt, Tok_Right_Paren); - end if; - end Disp_Record_Element_Constraint; - - procedure Disp_Element_Constraint - (Ctxt : in out Ctxt_Class; Def : Iir; Type_Mark : Iir) is - begin - case Get_Kind (Def) is - when Iir_Kind_Record_Subtype_Definition => - Disp_Record_Element_Constraint (Ctxt, Def); - when Iir_Kind_Array_Subtype_Definition => - Disp_Array_Element_Constraint (Ctxt, Def, Type_Mark); - when others => - Error_Kind ("disp_element_constraint", Def); - end case; - end Disp_Element_Constraint; - - procedure Disp_Tolerance_Opt (Ctxt : in out Ctxt_Class; N : Iir) - is - Tol : constant Iir := Get_Tolerance (N); - begin - if Tol /= Null_Iir then - Disp_Token (Ctxt, Tok_Tolerance); - Print (Ctxt, Tol); - end if; - end Disp_Tolerance_Opt; - - procedure Disp_Subtype_Indication - (Ctxt : in out Ctxt_Class; Def : Iir; Full_Decl : Boolean := False) - is - Type_Mark : Iir; - Base_Type : Iir; - Decl : Iir; - begin - case Get_Kind (Def) is - when Iir_Kinds_Denoting_Name - | Iir_Kind_Subtype_Attribute - | Iir_Kind_Attribute_Name => - Print (Ctxt, Def); - return; - when others => - null; - end case; - - Decl := Get_Type_Declarator (Def); - if not Full_Decl and then Decl /= Null_Iir then - Disp_Name_Of (Ctxt, Decl); - return; - end if; - - -- Resolution function name. - Disp_Resolution_Indication (Ctxt, Def); - - -- type mark. - Type_Mark := Get_Subtype_Type_Mark (Def); - if Type_Mark /= Null_Iir then - Print (Ctxt, Type_Mark); - Type_Mark := Get_Type (Type_Mark); - end if; - - case Get_Kind (Def) is - when Iir_Kind_Array_Subtype_Definition => - Disp_Array_Element_Constraint - (Ctxt, Def, Or_Else (Type_Mark, Def)); - when Iir_Kind_Subtype_Definition => - declare - Rng : constant Iir := Get_Range_Constraint (Def); - begin - if Rng /= Null_Iir then - Disp_Token (Ctxt, Tok_Range); - Print (Ctxt, Get_Range_Constraint (Def)); - end if; - Disp_Tolerance_Opt (Ctxt, Def); - end; - when others => - Base_Type := Get_Base_Type (Def); - case Get_Kind (Base_Type) is - when Iir_Kind_Integer_Type_Definition - | Iir_Kind_Enumeration_Type_Definition - | Iir_Kind_Floating_Type_Definition - | Iir_Kind_Physical_Type_Definition => - if Type_Mark = Null_Iir - or else Get_Range_Constraint (Def) - /= Get_Range_Constraint (Type_Mark) - then - if Type_Mark /= Null_Iir then - Disp_Token (Ctxt, Tok_Range); - end if; - Print (Ctxt, Get_Range_Constraint (Def)); - end if; - if Get_Kind (Base_Type) = Iir_Kind_Floating_Type_Definition - then - Disp_Tolerance_Opt (Ctxt, Def); - end if; - when Iir_Kind_Access_Type_Definition => - declare - Des_Ind : constant Iir := - Get_Designated_Subtype_Indication (Def); - begin - if Des_Ind /= Null_Iir then - pragma Assert (Get_Kind (Des_Ind) - = Iir_Kind_Array_Subtype_Definition); - Disp_Array_Element_Constraint - (Ctxt, Des_Ind, Get_Designated_Type (Base_Type)); - end if; - end; - when Iir_Kind_Array_Type_Definition => - Disp_Array_Element_Constraint - (Ctxt, Def, Or_Else (Type_Mark, Def)); - when Iir_Kind_Record_Type_Definition => - Disp_Record_Element_Constraint (Ctxt, Def); - when others => - Error_Kind ("disp_subtype_indication", Base_Type); - end case; - end case; - end Disp_Subtype_Indication; - - procedure Disp_Enumeration_Type_Definition - (Ctxt : in out Ctxt_Class; Def: Iir_Enumeration_Type_Definition) - is - Lits : constant Iir_Flist := Get_Enumeration_Literal_List (Def); - A_Lit: Iir; --Enumeration_Literal_Acc; - begin - Disp_Token (Ctxt, Tok_Left_Paren); - for I in Flist_First .. Flist_Last (Lits) loop - A_Lit := Get_Nth_Element (Lits, I); - if I > 0 then - Disp_Token (Ctxt, Tok_Comma); - end if; - Disp_Name_Of (Ctxt, A_Lit); - end loop; - Disp_Token (Ctxt, Tok_Right_Paren); - end Disp_Enumeration_Type_Definition; - - procedure Disp_Discrete_Range - (Ctxt : in out Ctxt_Class; Iterator: Iir) is - begin - if Get_Kind (Iterator) in Iir_Kinds_Subtype_Definition then - Disp_Subtype_Indication (Ctxt, Iterator); - else - Disp_Range (Ctxt, Iterator); - end if; - end Disp_Discrete_Range; - - procedure Disp_Array_Type_Definition - (Ctxt : in out Ctxt_Class; Def: Iir_Array_Type_Definition) - is - Indexes : Iir_Flist; - Index: Iir; - begin - Indexes := Get_Index_Subtype_Definition_List (Def); - if Indexes = Null_Iir_Flist then - Indexes := Get_Index_Subtype_List (Def); - end if; - Disp_Token (Ctxt, Tok_Array, Tok_Left_Paren); - for I in Flist_First .. Flist_Last (Indexes) loop - Index := Get_Nth_Element (Indexes, I); - if I /= 0 then - Disp_Token (Ctxt, Tok_Comma); - end if; - Print (Ctxt, Index); - Disp_Token (Ctxt, Tok_Range, Tok_Box); - end loop; - Disp_Token (Ctxt, Tok_Right_Paren, Tok_Of); - Disp_Subtype_Indication (Ctxt, Get_Element_Subtype_Indication (Def)); - end Disp_Array_Type_Definition; - - procedure Disp_Physical_Literal (Ctxt : in out Ctxt_Class; Lit: Iir) - is - Len : constant Int32 := Get_Literal_Length (Lit); - Unit : Iir; - begin - case Iir_Kinds_Physical_Literal (Get_Kind (Lit)) is - when Iir_Kind_Physical_Int_Literal => - if Len /= 0 then - Disp_Literal_From_Source (Ctxt, Lit, Tok_Integer); - else - Disp_Int64 (Ctxt, Get_Value (Lit)); - end if; - when Iir_Kind_Physical_Fp_Literal => - if Len /= 0 then - Disp_Literal_From_Source (Ctxt, Lit, Tok_Real); - else - Disp_Fp64 (Ctxt, Get_Fp_Value (Lit)); - end if; - end case; - - Unit := Get_Unit_Name (Lit); - if Is_Valid (Unit) then - -- No unit in range_constraint of physical type declaration. - Print (Ctxt, Unit); - end if; - end Disp_Physical_Literal; - - procedure Disp_Record_Type_Definition - (Ctxt : in out Ctxt_Class; Def: Iir_Record_Type_Definition) - is - List : constant Iir_Flist := Get_Elements_Declaration_List (Def); - El: Iir_Element_Declaration; - El_Subtype : Iir; - Reindent : Boolean; - begin - Disp_Token (Ctxt, Tok_Record); - Close_Hbox (Ctxt); - Reindent := True; - Start_Vbox (Ctxt); - for I in Flist_First .. Flist_Last (List) loop - El := Get_Nth_Element (List, I); - if Reindent then - El_Subtype := Get_Subtype_Indication (El); - Start_Hbox (Ctxt); - end if; - Disp_Identifier (Ctxt, El); - if Get_Has_Identifier_List (El) then - Disp_Token (Ctxt, Tok_Comma); - Reindent := False; - else - Disp_Token (Ctxt, Tok_Colon); - Disp_Subtype_Indication (Ctxt, Or_Else (El_Subtype, - Get_Type (El))); - Disp_Token (Ctxt, Tok_Semi_Colon); - Close_Hbox (Ctxt); - Reindent := True; - end if; - end loop; - Close_Vbox (Ctxt); - Disp_End_No_Close (Ctxt, Def, Tok_Record); - end Disp_Record_Type_Definition; - - procedure Disp_Designator_List (Ctxt : in out Ctxt_Class; List: Iir_List) - is - El : Iir; - It : List_Iterator; - Is_First : Boolean; - begin - case List is - when Null_Iir_List => - null; - when Iir_List_All => - Disp_Token (Ctxt, Tok_All); - when others => - It := List_Iterate (List); - Is_First := True; - while Is_Valid (It) loop - El := Get_Element (It); - if not Is_First then - Disp_Token (Ctxt, Tok_Comma); - else - Is_First := False; - end if; - Print (Ctxt, El); - Next (It); - end loop; - end case; - end Disp_Designator_List; - - procedure Disp_Array_Subtype_Definition - (Ctxt : in out Ctxt_Class; Def : Iir; El_Def : Iir) - is - Indexes : Iir_Flist; - Index : Iir; - begin - Indexes := Get_Index_Constraint_List (Def); - if Indexes = Null_Iir_Flist then - Indexes := Get_Index_Subtype_List (Def); - end if; - Disp_Token (Ctxt, Tok_Array, Tok_Left_Paren); - for I in Flist_First .. Flist_Last (Indexes) loop - Index := Get_Nth_Element (Indexes, I); - if I /= 0 then - Disp_Token (Ctxt, Tok_Comma); - end if; - Disp_Discrete_Range (Ctxt, Index); - end loop; - Disp_Token (Ctxt, Tok_Right_Paren, Tok_Of); - Disp_Subtype_Indication (Ctxt, El_Def); - end Disp_Array_Subtype_Definition; - - -- Display the full definition of a type, ie the sequence that can create - -- such a type. - procedure Disp_Type_Definition (Ctxt : in out Ctxt_Class; Def: Iir) is - begin - case Get_Kind (Def) is - when Iir_Kind_Enumeration_Type_Definition => - Disp_Enumeration_Type_Definition (Ctxt, Def); - when Iir_Kind_Array_Type_Definition => - Disp_Array_Type_Definition (Ctxt, Def); - when Iir_Kind_Array_Subtype_Definition => - Disp_Array_Subtype_Definition - (Ctxt, Def, Get_Element_Subtype (Get_Base_Type (Def))); - when Iir_Kind_Record_Type_Definition => - Disp_Record_Type_Definition (Ctxt, Def); - when Iir_Kind_Access_Type_Definition => - Disp_Token (Ctxt, Tok_Access); - Disp_Subtype_Indication - (Ctxt, Get_Designated_Subtype_Indication (Def)); - when Iir_Kind_File_Type_Definition => - Disp_Token (Ctxt, Tok_File, Tok_Of); - Disp_Subtype_Indication (Ctxt, Get_File_Type_Mark (Def)); - when Iir_Kind_Protected_Type_Declaration => - Disp_Token (Ctxt, Tok_Protected); - Close_Hbox (Ctxt); - Start_Vbox (Ctxt); - Disp_Declaration_Chain (Ctxt, Def); - Close_Vbox (Ctxt); - Disp_End_No_Close (Ctxt, Def, Tok_Protected); - when Iir_Kind_Attribute_Name - | Iir_Kind_Range_Expression - | Iir_Kind_Parenthesis_Name => - Disp_Token (Ctxt, Tok_Range); - Print (Ctxt, Def); - when others => - Error_Kind ("disp_type_definition", Def); - end case; - end Disp_Type_Definition; - - procedure Disp_Type_Declaration - (Ctxt : in out Ctxt_Class; Decl: Iir_Type_Declaration) - is - Def : constant Iir := Get_Type_Definition (Decl); - begin - Start_Hbox (Ctxt); - Disp_Token (Ctxt, Tok_Type); - Disp_Name_Of (Ctxt, Decl); - if Def /= Null_Iir - and then Get_Kind (Def) /= Iir_Kind_Incomplete_Type_Definition - then - Disp_Token (Ctxt, Tok_Is); - Disp_Type_Definition (Ctxt, Def); - end if; - Disp_Token (Ctxt, Tok_Semi_Colon); - Close_Hbox (Ctxt); - end Disp_Type_Declaration; - - procedure Disp_Physical_Type_Definition - (Ctxt : in out Ctxt_Class; Decl : Iir) - is - Def : constant Iir := Get_Type_Definition (Decl); - St : constant Iir := Get_Subtype_Definition (Decl); - Unit : Iir_Unit_Declaration; - Rng : Iir; - begin - Disp_Token (Ctxt, Tok_Range); - Rng := Or_Else (St, Def); - Print (Ctxt, Get_Range_Constraint (Rng)); - Disp_Token (Ctxt, Tok_Units); - Close_Hbox (Ctxt); - - Start_Vbox (Ctxt); - Unit := Get_Unit_Chain (Def); - Start_Hbox (Ctxt); - Disp_Identifier (Ctxt, Unit); - Disp_Token (Ctxt, Tok_Semi_Colon); - Close_Hbox (Ctxt); - Unit := Get_Chain (Unit); - while Unit /= Null_Iir loop - Start_Hbox (Ctxt); - Disp_Identifier (Ctxt, Unit); - Disp_Token (Ctxt, Tok_Equal); - Print (Ctxt, Get_Physical_Literal (Unit)); - Disp_Token (Ctxt, Tok_Semi_Colon); - Close_Hbox (Ctxt); - Unit := Get_Chain (Unit); - end loop; - Close_Vbox (Ctxt); - Disp_End_No_Close (Ctxt, Def, Tok_Units); - end Disp_Physical_Type_Definition; - - procedure Disp_Anonymous_Type_Declaration - (Ctxt : in out Ctxt_Class; Decl: Iir_Anonymous_Type_Declaration) - is - Def : constant Iir := Get_Type_Definition (Decl); - begin - Start_Hbox (Ctxt); - Disp_Token (Ctxt, Tok_Type); - Disp_Identifier (Ctxt, Decl); - Disp_Token (Ctxt, Tok_Is); - case Get_Kind (Def) is - when Iir_Kind_Array_Type_Definition => - Disp_Array_Subtype_Definition - (Ctxt, Get_Subtype_Definition (Decl), - Get_Element_Subtype_Indication (Def)); - when Iir_Kind_Array_Subtype_Definition => - Disp_Array_Subtype_Definition - (Ctxt, Def, Get_Array_Element_Constraint (Def)); - when Iir_Kind_Physical_Type_Definition => - Disp_Physical_Type_Definition (Ctxt, Decl); - when Iir_Kind_Floating_Type_Definition - | Iir_Kind_Integer_Type_Definition => - declare - St : constant Iir := Get_Subtype_Definition (Decl); - begin - Disp_Token (Ctxt, Tok_Range); - Print (Ctxt, Get_Range_Constraint (St)); - end; - when others => - Disp_Type_Definition (Ctxt, Def); - end case; - Disp_Token (Ctxt, Tok_Semi_Colon); - Close_Hbox (Ctxt); - end Disp_Anonymous_Type_Declaration; - - procedure Disp_Subtype_Declaration - (Ctxt : in out Ctxt_Class; Decl: Iir_Subtype_Declaration) - is - Def : constant Iir := Get_Type (Decl); - begin - -- If the subtype declaration was implicit (added because of a type - -- declaration), put it as a comment. - if Def /= Null_Iir - and then - (Get_Identifier (Decl) - = Get_Identifier (Get_Type_Declarator (Get_Base_Type (Def)))) - then - if Flag_Implicit then - Put ("-- "); - else - return; - end if; - end if; - Start_Hbox (Ctxt); - Disp_Token (Ctxt, Tok_Subtype); - Disp_Name_Of (Ctxt, Decl); - Disp_Token (Ctxt, Tok_Is); - Disp_Subtype_Indication - (Ctxt, Or_Else (Get_Subtype_Indication (Decl), Get_Type (Decl)), True); - Disp_Token (Ctxt, Tok_Semi_Colon); - Close_Hbox (Ctxt); - end Disp_Subtype_Declaration; - - procedure Disp_Type (Ctxt : in out Ctxt_Class; A_Type: Iir) - is - Decl: Iir; - begin - Decl := Get_Type_Declarator (A_Type); - if Decl /= Null_Iir then - Disp_Name_Of (Ctxt, Decl); - else - case Get_Kind (A_Type) is - when Iir_Kind_Enumeration_Type_Definition - | Iir_Kind_Integer_Type_Definition => - raise Program_Error; - when Iir_Kind_Integer_Subtype_Definition - | Iir_Kind_Enumeration_Subtype_Definition - | Iir_Kind_Access_Subtype_Definition => - Disp_Subtype_Indication (Ctxt, A_Type); - when Iir_Kind_Array_Subtype_Definition => - Disp_Subtype_Indication (Ctxt, A_Type); - when others => - Error_Kind ("disp_type", A_Type); - end case; - end if; - end Disp_Type; - - procedure Disp_Nature_Definition (Ctxt : in out Ctxt_Class; Def : Iir) is - begin - case Get_Kind (Def) is - when Iir_Kind_Scalar_Nature_Definition => - Disp_Subtype_Indication (Ctxt, Get_Across_Type (Def)); - Disp_Token (Ctxt, Tok_Across); - Disp_Subtype_Indication (Ctxt, Get_Through_Type (Def)); - Disp_Token (Ctxt, Tok_Through); - Disp_Name_Of (Ctxt, Get_Reference (Def)); - Disp_Token (Ctxt, Tok_Reference); - when others => - Error_Kind ("disp_nature_definition", Def); - end case; - end Disp_Nature_Definition; - - procedure Disp_Nature_Declaration (Ctxt : in out Ctxt_Class; Decl : Iir) is - begin - Start_Hbox (Ctxt); - Disp_Token (Ctxt, Tok_Nature); - Disp_Name_Of (Ctxt, Decl); - Disp_Token (Ctxt, Tok_Is); - Disp_Nature_Definition (Ctxt, Get_Nature (Decl)); - Disp_Token (Ctxt, Tok_Semi_Colon); - Close_Hbox (Ctxt); - end Disp_Nature_Declaration; - - procedure Disp_Subnature_Indication (Ctxt : in out Ctxt_Class; Ind : Iir) - is - Decl: Iir; - begin - case Get_Kind (Ind) is - when Iir_Kinds_Denoting_Name - | Iir_Kind_Subtype_Attribute - | Iir_Kind_Attribute_Name => - Print (Ctxt, Ind); - return; - when others => - null; - end case; - - Decl := Get_Nature_Declarator (Ind); - if Decl /= Null_Iir then - Disp_Name_Of (Ctxt, Decl); - else - Error_Kind ("disp_subnature_indication", Ind); - end if; - end Disp_Subnature_Indication; - - procedure Disp_Mode (Ctxt : in out Ctxt_Class; Mode: Iir_Mode) is - begin - case Mode is - when Iir_In_Mode => - Disp_Token (Ctxt, Tok_In); - when Iir_Out_Mode => - Disp_Token (Ctxt, Tok_Out); - when Iir_Inout_Mode => - Disp_Token (Ctxt, Tok_Inout); - when Iir_Buffer_Mode => - Disp_Token (Ctxt, Tok_Buffer); - when Iir_Linkage_Mode => - Disp_Token (Ctxt, Tok_Linkage); - when Iir_Unknown_Mode => - Put (" "); - end case; - end Disp_Mode; - - procedure Disp_Signal_Kind (Ctxt : in out Ctxt_Class; Sig : Iir) is - begin - if Get_Guarded_Signal_Flag (Sig) then - case Get_Signal_Kind (Sig) is - when Iir_Register_Kind => - Disp_Token (Ctxt, Tok_Register); - when Iir_Bus_Kind => - Disp_Token (Ctxt, Tok_Bus); - end case; - end if; - end Disp_Signal_Kind; - - procedure Disp_Interface_Class (Ctxt : in out Ctxt_Class; Inter: Iir) is - begin - if Get_Has_Class (Inter) then - case Get_Kind (Inter) is - when Iir_Kind_Interface_Signal_Declaration => - Disp_Token (Ctxt, Tok_Signal); - when Iir_Kind_Interface_Variable_Declaration => - Disp_Token (Ctxt, Tok_Variable); - when Iir_Kind_Interface_Constant_Declaration => - Disp_Token (Ctxt, Tok_Constant); - when Iir_Kind_Interface_File_Declaration => - Disp_Token (Ctxt, Tok_File); - when others => - Error_Kind ("disp_interface_class", Inter); - end case; - end if; - end Disp_Interface_Class; - - procedure Disp_Interface_Mode_And_Type - (Ctxt : in out Ctxt_Class; Inter: Iir) - is - Default: constant Iir := Get_Default_Value (Inter); - Ind : constant Iir := Get_Subtype_Indication (Inter); - begin - Disp_Token (Ctxt, Tok_Colon); - if Get_Has_Mode (Inter) then - Disp_Mode (Ctxt, Get_Mode (Inter)); - end if; - if Ind = Null_Iir then - -- For implicit subprogram - Disp_Type (Ctxt, Get_Type (Inter)); - else - Disp_Subtype_Indication (Ctxt, Get_Subtype_Indication (Inter)); - end if; - if Get_Kind (Inter) = Iir_Kind_Interface_Signal_Declaration then - Disp_Signal_Kind (Ctxt, Inter); - end if; - if Default /= Null_Iir then - Disp_Token (Ctxt, Tok_Assign); - Print (Ctxt, Default); - end if; - end Disp_Interface_Mode_And_Type; - - -- Disp interfaces, followed by END_STR (';' in general). - procedure Disp_Interface_Chain (Ctxt : in out Ctxt_Class; Chain: Iir) - is - Inter: Iir; - Next_Inter : Iir; - First_Inter : Iir; - begin - if Chain = Null_Iir then - return; - end if; - Disp_Token (Ctxt, Tok_Left_Paren); - - Inter := Chain; - loop - Next_Inter := Get_Chain (Inter); - - First_Inter := Inter; - - case Get_Kind (Inter) is - when Iir_Kinds_Interface_Object_Declaration => - Disp_Interface_Class (Ctxt, Inter); - Disp_Name_Of (Ctxt, Inter); - while Get_Has_Identifier_List (Inter) loop - Disp_Token (Ctxt, Tok_Comma); - Inter := Next_Inter; - Next_Inter := Get_Chain (Inter); - Disp_Name_Of (Ctxt, Inter); - end loop; - Disp_Interface_Mode_And_Type (Ctxt, First_Inter); - when Iir_Kind_Interface_Package_Declaration => - Disp_Token (Ctxt, Tok_Package); - Disp_Identifier (Ctxt, Inter); - Disp_Token (Ctxt, Tok_Is, Tok_New); - Print (Ctxt, Get_Uninstantiated_Package_Name (Inter)); - Disp_Token (Ctxt, Tok_Generic, Tok_Map); - declare - Assoc_Chain : constant Iir := - Get_Generic_Map_Aspect_Chain (Inter); - begin - if Assoc_Chain = Null_Iir then - Disp_Token (Ctxt, Tok_Left_Paren); - Disp_Token (Ctxt, Tok_Box); - Disp_Token (Ctxt, Tok_Right_Paren); - else - Disp_Association_Chain (Ctxt, Assoc_Chain); - end if; - end; - when Iir_Kind_Interface_Type_Declaration => - Disp_Token (Ctxt, Tok_Type); - Disp_Identifier (Ctxt, Inter); - when Iir_Kinds_Interface_Subprogram_Declaration => - Disp_Subprogram_Declaration (Ctxt, Inter); - when others => - Error_Kind ("disp_interface_chain", Inter); - end case; - - exit when Next_Inter = Null_Iir; - Disp_Token (Ctxt, Tok_Semi_Colon); - - Inter := Next_Inter; - Next_Inter := Get_Chain (Inter); - end loop; - - Disp_Token (Ctxt, Tok_Right_Paren); - end Disp_Interface_Chain; - - procedure Disp_Ports (Ctxt : in out Ctxt_Class; Parent : Iir) - is - Ports : constant Iir := Get_Port_Chain (Parent); - begin - if Ports /= Null_Iir then - Start_Hbox (Ctxt); - Disp_Token (Ctxt, Tok_Port); - Disp_Interface_Chain (Ctxt, Ports); - Disp_Token (Ctxt, Tok_Semi_Colon); - Close_Hbox (Ctxt); - end if; - end Disp_Ports; - - procedure Disp_Generics (Ctxt : in out Ctxt_Class; Parent : Iir) - is - Generics : constant Iir := Get_Generic_Chain (Parent); - begin - if Generics /= Null_Iir then - Start_Hbox (Ctxt); - Disp_Token (Ctxt, Tok_Generic); - Disp_Interface_Chain (Ctxt, Generics); - Disp_Token (Ctxt, Tok_Semi_Colon); - Close_Hbox (Ctxt); - end if; - end Disp_Generics; - - procedure Disp_Entity_Declaration - (Ctxt : in out Ctxt_Class; Decl: Iir_Entity_Declaration) is - begin - Start_Hbox (Ctxt); - Disp_Token (Ctxt, Tok_Entity); - Disp_Name_Of (Ctxt, Decl); - Disp_Token (Ctxt, Tok_Is); - Close_Hbox (Ctxt); - - Start_Vbox (Ctxt); - Disp_Generics (Ctxt, Decl); - Disp_Ports (Ctxt, Decl); - Disp_Declaration_Chain (Ctxt, Decl); - Close_Vbox (Ctxt); - - if Get_Has_Begin (Decl) then - Start_Hbox (Ctxt); - Disp_Token (Ctxt, Tok_Begin); - Close_Hbox (Ctxt); - end if; - if Get_Concurrent_Statement_Chain (Decl) /= Null_Iir then - Start_Vbox (Ctxt); - Disp_Concurrent_Statement_Chain (Ctxt, Decl); - Close_Vbox (Ctxt); - end if; - Disp_End (Ctxt, Decl, Tok_Entity); - end Disp_Entity_Declaration; - - procedure Disp_Component_Declaration - (Ctxt : in out Ctxt_Class; Decl: Iir_Component_Declaration) is - begin - Start_Hbox (Ctxt); - Disp_Token (Ctxt, Tok_Component); - Disp_Name_Of (Ctxt, Decl); - if Get_Has_Is (Decl) then - Disp_Token (Ctxt, Tok_Is); - end if; - Close_Hbox (Ctxt); - - Start_Vbox (Ctxt); - if Get_Generic_Chain (Decl) /= Null_Iir then - Disp_Generics (Ctxt, Decl); - end if; - if Get_Port_Chain (Decl) /= Null_Iir then - Disp_Ports (Ctxt, Decl); - end if; - Close_Vbox (Ctxt); - - Disp_End (Ctxt, Decl, Tok_Component); - end Disp_Component_Declaration; - - procedure Disp_Concurrent_Statement_Chain - (Ctxt : in out Ctxt_Class; Parent : Iir) - is - El: Iir; - begin - El := Get_Concurrent_Statement_Chain (Parent); - while El /= Null_Iir loop - Disp_Concurrent_Statement (Ctxt, El); - El := Get_Chain (El); - end loop; - end Disp_Concurrent_Statement_Chain; - - procedure Disp_Architecture_Body - (Ctxt : in out Ctxt_Class; Arch: Iir_Architecture_Body) is - begin - Start_Hbox (Ctxt); - Disp_Token (Ctxt, Tok_Architecture); - Disp_Name_Of (Ctxt, Arch); - Disp_Token (Ctxt, Tok_Of); - Print (Ctxt, Get_Entity_Name (Arch)); - Disp_Token (Ctxt, Tok_Is); - Close_Hbox (Ctxt); - - Start_Vbox (Ctxt); - Disp_Declaration_Chain (Ctxt, Arch); - Close_Vbox (Ctxt); - - Start_Hbox (Ctxt); - Disp_Token (Ctxt, Tok_Begin); - Close_Hbox (Ctxt); - - Start_Vbox (Ctxt); - Disp_Concurrent_Statement_Chain (Ctxt, Arch); - Close_Vbox (Ctxt); - - Disp_End (Ctxt, Arch, Tok_Architecture); - end Disp_Architecture_Body; - - procedure Disp_Signature (Ctxt : in out Ctxt_Class; Sig : Iir) - is - Prefix : constant Iir := Get_Signature_Prefix (Sig); - List : constant Iir_Flist := Get_Type_Marks_List (Sig); - El : Iir; - begin - if Is_Valid (Prefix) then - -- Only in alias. - Print (Ctxt, Prefix); - end if; - Disp_Token (Ctxt, Tok_Left_Bracket); - if List /= Null_Iir_Flist then - for I in Flist_First .. Flist_Last (List) loop - El := Get_Nth_Element (List, I); - if I /= 0 then - Disp_Token (Ctxt, Tok_Comma); - end if; - Print (Ctxt, El); - end loop; - end if; - El := Get_Return_Type_Mark (Sig); - if El /= Null_Iir then - Disp_Token (Ctxt, Tok_Return); - Print (Ctxt, El); - end if; - Disp_Token (Ctxt, Tok_Right_Bracket); - end Disp_Signature; - - procedure Disp_Object_Alias_Declaration - (Ctxt : in out Ctxt_Class; Decl: Iir_Object_Alias_Declaration) - is - St_Ind : constant Iir := Get_Subtype_Indication (Decl); - Atype : constant Iir := Get_Type (Decl); - begin - Start_Hbox (Ctxt); - Disp_Token (Ctxt, Tok_Alias); - Disp_Function_Name (Ctxt, Decl); - if St_Ind /= Null_Iir or else Atype /= Null_Iir then - Disp_Token (Ctxt, Tok_Colon); - Disp_Subtype_Indication (Ctxt, Or_Else (St_Ind, Atype)); - end if; - Disp_Token (Ctxt, Tok_Is); - Print (Ctxt, Get_Name (Decl)); - Disp_Token (Ctxt, Tok_Semi_Colon); - Close_Hbox (Ctxt); - end Disp_Object_Alias_Declaration; - - procedure Disp_Non_Object_Alias_Declaration - (Ctxt : in out Ctxt_Class; Decl: Iir_Non_Object_Alias_Declaration) - is - Sig : constant Iir := Get_Alias_Signature (Decl); - begin - if Get_Implicit_Alias_Flag (Decl) then - if Flag_Implicit then - Put ("-- "); - else - return; - end if; - end if; - - Start_Hbox (Ctxt); - Disp_Token (Ctxt, Tok_Alias); - Disp_Function_Name (Ctxt, Decl); - Disp_Token (Ctxt, Tok_Is); - Print (Ctxt, Get_Name (Decl)); - if Sig /= Null_Iir then - Disp_Signature (Ctxt, Sig); - end if; - Disp_Token (Ctxt, Tok_Semi_Colon); - Close_Hbox (Ctxt); - end Disp_Non_Object_Alias_Declaration; - - procedure Disp_File_Declaration - (Ctxt : in out Ctxt_Class; Decl: Iir_File_Declaration) - is - Next_Decl : Iir; - Expr: Iir; - begin - Disp_Token (Ctxt, Tok_File); - Disp_Name_Of (Ctxt, Decl); - Next_Decl := Decl; - while Get_Has_Identifier_List (Next_Decl) loop - Next_Decl := Get_Chain (Next_Decl); - Disp_Token (Ctxt, Tok_Comma); - Disp_Name_Of (Ctxt, Next_Decl); - end loop; - Disp_Token (Ctxt, Tok_Colon); - Disp_Subtype_Indication (Ctxt, Or_Else (Get_Subtype_Indication (Decl), - Get_Type (Decl))); - if Vhdl_Std = Vhdl_87 then - Disp_Token (Ctxt, Tok_Is); - if Get_Has_Mode (Decl) then - Disp_Mode (Ctxt, Get_Mode (Decl)); - end if; - Print (Ctxt, Get_File_Logical_Name (Decl)); - else - Expr := Get_File_Open_Kind (Decl); - if Expr /= Null_Iir then - Disp_Token (Ctxt, Tok_Open); - Print (Ctxt, Expr); - end if; - Expr := Get_File_Logical_Name (Decl); - if Expr /= Null_Iir then - Disp_Token (Ctxt, Tok_Is); - Print (Ctxt, Expr); - end if; - end if; - Disp_Token (Ctxt, Tok_Semi_Colon); - end Disp_File_Declaration; - - procedure Disp_Quantity_Declaration (Ctxt : in out Ctxt_Class; Decl: Iir) - is - Expr : Iir; - Term : Iir; - begin - Start_Hbox (Ctxt); - Disp_Token (Ctxt, Tok_Quantity); - Disp_Name_Of (Ctxt, Decl); - - case Get_Kind (Decl) is - when Iir_Kinds_Branch_Quantity_Declaration => - Disp_Tolerance_Opt (Ctxt, Decl); - Expr := Get_Default_Value (Decl); - if Expr /= Null_Iir then - Disp_Token (Ctxt, Tok_Assign); - Print (Ctxt, Expr); - end if; - if Get_Kind (Decl) = Iir_Kind_Across_Quantity_Declaration then - Disp_Token (Ctxt, Tok_Across); - else - Disp_Token (Ctxt, Tok_Through); - end if; - Disp_Name_Of (Ctxt, Get_Plus_Terminal (Decl)); - Term := Get_Minus_Terminal (Decl); - if Term /= Null_Iir then - Disp_Token (Ctxt, Tok_To); - Disp_Name_Of (Ctxt, Term); - end if; - when Iir_Kind_Free_Quantity_Declaration => - Disp_Token (Ctxt, Tok_Colon); - Disp_Subtype_Indication - (Ctxt, Or_Else (Get_Subtype_Indication (Decl), Get_Type (Decl))); - Expr := Get_Default_Value (Decl); - if Expr /= Null_Iir then - Disp_Token (Ctxt, Tok_Assign); - Print (Ctxt, Expr); - end if; - when others => - raise Program_Error; - end case; - Disp_Token (Ctxt, Tok_Semi_Colon); - Close_Hbox (Ctxt); - end Disp_Quantity_Declaration; - - procedure Disp_Terminal_Declaration (Ctxt : in out Ctxt_Class; Decl: Iir) - is - Ndecl : Iir; - begin - Start_Hbox (Ctxt); - Disp_Token (Ctxt, Tok_Terminal); - Disp_Name_Of (Ctxt, Decl); - Ndecl := Decl; - while Get_Has_Identifier_List (Ndecl) loop - Disp_Token (Ctxt, Tok_Comma); - Ndecl := Get_Chain (Ndecl); - Disp_Name_Of (Ctxt, Ndecl); - end loop; - Disp_Token (Ctxt, Tok_Colon); - Disp_Subnature_Indication (Ctxt, Get_Nature (Decl)); - Disp_Token (Ctxt, Tok_Semi_Colon); - Close_Hbox (Ctxt); - end Disp_Terminal_Declaration; - - procedure Disp_Object_Declaration (Ctxt : in out Ctxt_Class; Decl: Iir) - is - Next_Decl : Iir; - begin - Start_Hbox (Ctxt); - case Get_Kind (Decl) is - when Iir_Kind_Variable_Declaration => - if Get_Shared_Flag (Decl) then - Disp_Token (Ctxt, Tok_Shared); - end if; - Disp_Token (Ctxt, Tok_Variable); - when Iir_Kind_Constant_Declaration => - Disp_Token (Ctxt, Tok_Constant); - when Iir_Kind_Signal_Declaration => - Disp_Token (Ctxt, Tok_Signal); - when Iir_Kind_File_Declaration => - Disp_File_Declaration (Ctxt, Decl); - Close_Hbox (Ctxt); - return; - when others => - raise Internal_Error; - end case; - Disp_Name_Of (Ctxt, Decl); - Next_Decl := Decl; - while Get_Has_Identifier_List (Next_Decl) loop - Next_Decl := Get_Chain (Next_Decl); - Disp_Token (Ctxt, Tok_Comma); - Disp_Name_Of (Ctxt, Next_Decl); - end loop; - Disp_Token (Ctxt, Tok_Colon); - Disp_Subtype_Indication (Ctxt, Get_Subtype_Indication (Decl)); - if Get_Kind (Decl) = Iir_Kind_Signal_Declaration then - Disp_Signal_Kind (Ctxt, Decl); - end if; - - if Get_Default_Value (Decl) /= Null_Iir then - Disp_Token (Ctxt, Tok_Assign); - Print (Ctxt, Get_Default_Value (Decl)); - end if; - Disp_Token (Ctxt, Tok_Semi_Colon); - Close_Hbox (Ctxt); - end Disp_Object_Declaration; - - procedure Disp_Pure (Ctxt : in out Ctxt_Class; Subprg : Iir) is - begin - if Get_Pure_Flag (Subprg) then - Disp_Token (Ctxt, Tok_Pure); - else - Disp_Token (Ctxt, Tok_Impure); - end if; - end Disp_Pure; - - procedure Disp_Subprogram_Declaration - (Ctxt : in out Ctxt_Class; Subprg: Iir; Implicit : Boolean := False) - is - Inter : Iir; - begin - if Implicit then - Put ("-- "); - end if; - - case Get_Kind (Subprg) is - when Iir_Kind_Function_Declaration - | Iir_Kind_Interface_Function_Declaration => - if Get_Has_Pure (Subprg) then - Disp_Pure (Ctxt, Subprg); - end if; - Disp_Token (Ctxt, Tok_Function); - when Iir_Kind_Procedure_Declaration - | Iir_Kind_Interface_Procedure_Declaration => - Disp_Token (Ctxt, Tok_Procedure); - when others => - raise Internal_Error; - end case; - - Disp_Function_Name (Ctxt, Subprg); - - if Get_Has_Parameter (Subprg) then - Disp_Token (Ctxt, Tok_Parameter); - end if; - - Inter := Get_Interface_Declaration_Chain (Subprg); - Disp_Interface_Chain (Ctxt, Inter); - - case Get_Kind (Subprg) is - when Iir_Kind_Function_Declaration - | Iir_Kind_Interface_Function_Declaration => - Disp_Token (Ctxt, Tok_Return); - Disp_Subtype_Indication - (Ctxt, Or_Else (Get_Return_Type_Mark (Subprg), - Get_Return_Type (Subprg))); - when Iir_Kind_Procedure_Declaration - | Iir_Kind_Interface_Procedure_Declaration => - null; - when others => - raise Internal_Error; - end case; - end Disp_Subprogram_Declaration; - - procedure Disp_Subprogram_Body (Ctxt : in out Ctxt_Class; Subprg : Iir) is - begin - Start_Vbox (Ctxt); - Disp_Declaration_Chain (Ctxt, Subprg); - Close_Vbox (Ctxt); - Start_Hbox (Ctxt); - Disp_Token (Ctxt, Tok_Begin); - Close_Hbox (Ctxt); - Start_Vbox (Ctxt); - Disp_Sequential_Statements - (Ctxt, Get_Sequential_Statement_Chain (Subprg)); - Close_Vbox (Ctxt); - if Get_Kind (Subprg) = Iir_Kind_Function_Body then - Disp_End (Ctxt, Subprg, Tok_Function); - else - Disp_End (Ctxt, Subprg, Tok_Procedure); - end if; - end Disp_Subprogram_Body; - - procedure Disp_Instantiation_List - (Ctxt : in out Ctxt_Class; Insts: Iir_Flist) - is - El : Iir; - begin - case Insts is - when Iir_Flist_All => - Disp_Token (Ctxt, Tok_All); - when Iir_Flist_Others => - Disp_Token (Ctxt, Tok_Others); - when others => - for I in Flist_First .. Flist_Last (Insts) loop - El := Get_Nth_Element (Insts, I); - if I /= Flist_First then - Disp_Token (Ctxt, Tok_Comma); - end if; - Print (Ctxt, El); - end loop; - end case; - end Disp_Instantiation_List; - - procedure Disp_Configuration_Specification - (Ctxt : in out Ctxt_Class; Spec : Iir_Configuration_Specification) is - begin - Start_Hbox (Ctxt); - Disp_Token (Ctxt, Tok_For); - Disp_Instantiation_List (Ctxt, Get_Instantiation_List (Spec)); - Disp_Token (Ctxt, Tok_Colon); - Print (Ctxt, Get_Component_Name (Spec)); - Disp_Binding_Indication (Ctxt, Get_Binding_Indication (Spec)); - Disp_Token (Ctxt, Tok_Semi_Colon); - Close_Hbox (Ctxt); - end Disp_Configuration_Specification; - - procedure Disp_Disconnection_Specification - (Ctxt : in out Ctxt_Class; Dis : Iir_Disconnection_Specification) is - begin - Start_Hbox (Ctxt); - Disp_Token (Ctxt, Tok_Disconnect); - Disp_Instantiation_List (Ctxt, Get_Signal_List (Dis)); - Disp_Token (Ctxt, Tok_Colon); - Print (Ctxt, Get_Type_Mark (Dis)); - Disp_Token (Ctxt, Tok_After); - Print (Ctxt, Get_Expression (Dis)); - Disp_Token (Ctxt, Tok_Semi_Colon); - Close_Hbox (Ctxt); - end Disp_Disconnection_Specification; - - procedure Disp_Attribute_Declaration - (Ctxt : in out Ctxt_Class; Attr : Iir_Attribute_Declaration) is - begin - Start_Hbox (Ctxt); - Disp_Token (Ctxt, Tok_Attribute); - Disp_Identifier (Ctxt, Attr); - Disp_Token (Ctxt, Tok_Colon); - Print (Ctxt, Get_Type_Mark (Attr)); - Disp_Token (Ctxt, Tok_Semi_Colon); - Close_Hbox (Ctxt); - end Disp_Attribute_Declaration; - - procedure Disp_Attribute_Value (Ctxt : in out Ctxt_Class; Attr : Iir) is - begin - Disp_Name_Of (Ctxt, Get_Designated_Entity (Attr)); - Put ("'"); - Disp_Identifier - (Ctxt, Get_Attribute_Designator (Get_Attribute_Specification (Attr))); - end Disp_Attribute_Value; - - procedure Disp_Attribute_Name (Ctxt : in out Ctxt_Class; Attr : Iir) - is - Sig : constant Iir := Get_Attribute_Signature (Attr); - begin - Print (Ctxt, Get_Prefix (Attr)); - if Sig /= Null_Iir then - Disp_Signature (Ctxt, Sig); - end if; - Disp_Token (Ctxt, Tok_Tick); - Disp_Ident (Ctxt, Get_Identifier (Attr)); - end Disp_Attribute_Name; - - procedure Disp_Entity_Kind (Ctxt : in out Ctxt_Class; Tok : Token_Type) is - begin - Disp_Token (Ctxt, Tok); - end Disp_Entity_Kind; - - procedure Disp_Entity_Name_List (Ctxt : in out Ctxt_Class; List : Iir_Flist) - is - El : Iir; - begin - case List is - when Iir_Flist_All => - Disp_Token (Ctxt, Tok_All); - when Iir_Flist_Others => - Disp_Token (Ctxt, Tok_Others); - when others => - for I in Flist_First .. Flist_Last (List) loop - El := Get_Nth_Element (List, I); - if I /= Flist_First then - Disp_Token (Ctxt, Tok_Comma); - end if; - Print (Ctxt, El); - end loop; - end case; - end Disp_Entity_Name_List; - - procedure Disp_Attribute_Specification - (Ctxt : in out Ctxt_Class; Attr : Iir_Attribute_Specification) is - begin - Start_Hbox (Ctxt); - Disp_Token (Ctxt, Tok_Attribute); - Disp_Identifier (Ctxt, Get_Attribute_Designator (Attr)); - Disp_Token (Ctxt, Tok_Of); - Disp_Entity_Name_List (Ctxt, Get_Entity_Name_List (Attr)); - Disp_Token (Ctxt, Tok_Colon); - Disp_Entity_Kind (Ctxt, Get_Entity_Class (Attr)); - Disp_Token (Ctxt, Tok_Is); - Print (Ctxt, Get_Expression (Attr)); - Disp_Token (Ctxt, Tok_Semi_Colon); - Close_Hbox (Ctxt); - end Disp_Attribute_Specification; - - procedure Disp_Protected_Type_Body - (Ctxt : in out Ctxt_Class; Bod : Iir_Protected_Type_Body) is - begin - Start_Hbox (Ctxt); - Disp_Token (Ctxt, Tok_Type); - Disp_Identifier (Ctxt, Bod); - Disp_Token (Ctxt, Tok_Is); - Disp_Token (Ctxt, Tok_Protected, Tok_Body); - Close_Hbox (Ctxt); - - Start_Vbox (Ctxt); - Disp_Declaration_Chain (Ctxt, Bod); - Close_Vbox (Ctxt); - - Disp_End (Ctxt, Bod, Tok_Protected, Tok_Body); - end Disp_Protected_Type_Body; - - procedure Disp_Group_Template_Declaration - (Ctxt : in out Ctxt_Class; Decl : Iir) - is - Ent : Iir; - begin - Start_Hbox (Ctxt); - Disp_Token (Ctxt, Tok_Group); - Disp_Identifier (Ctxt, Decl); - Disp_Token (Ctxt, Tok_Is, Tok_Left_Paren); - Ent := Get_Entity_Class_Entry_Chain (Decl); - loop - Disp_Entity_Kind (Ctxt, Get_Entity_Class (Ent)); - Ent := Get_Chain (Ent); - exit when Ent = Null_Iir; - if Get_Entity_Class (Ent) = Tok_Box then - Disp_Token (Ctxt, Tok_Box); - exit; - else - Disp_Token (Ctxt, Tok_Comma); - end if; - end loop; - Disp_Token (Ctxt, Tok_Right_Paren, Tok_Semi_Colon); - Close_Hbox (Ctxt); - end Disp_Group_Template_Declaration; - - procedure Disp_Group_Declaration (Ctxt : in out Ctxt_Class; Decl : Iir) - is - List : Iir_Flist; - El : Iir; - begin - Start_Hbox (Ctxt); - Disp_Token (Ctxt, Tok_Group); - Disp_Identifier (Ctxt, Decl); - Disp_Token (Ctxt, Tok_Colon); - Print (Ctxt, Get_Group_Template_Name (Decl)); - Disp_Token (Ctxt, Tok_Left_Paren); - List := Get_Group_Constituent_List (Decl); - for I in Flist_First .. Flist_Last (List) loop - El := Get_Nth_Element (List, I); - if I /= 0 then - Disp_Token (Ctxt, Tok_Comma); - end if; - Disp_Name_Of (Ctxt, El); - end loop; - Disp_Token (Ctxt, Tok_Right_Paren, Tok_Semi_Colon); - Close_Hbox (Ctxt); - end Disp_Group_Declaration; - - procedure Disp_PSL_HDL_Expr - (N : PSL.Nodes.HDL_Node) is - begin - Disp_Expression (Iir (N)); - end Disp_PSL_HDL_Expr; - - procedure Disp_Psl_Expression - (Ctxt : in out Ctxt_Class; Expr : PSL_Node) is - begin - PSL.Prints.HDL_Expr_Printer := Disp_PSL_HDL_Expr'Access; - -- Hack. - Disp_Char (Ctxt, ' '); - PSL.Prints.Print_Property (Expr); - end Disp_Psl_Expression; - - procedure Disp_Psl_Sequence - (Ctxt : in out Ctxt_Class; Expr : PSL_Node) is - begin - PSL.Prints.HDL_Expr_Printer := Disp_PSL_HDL_Expr'Access; - -- Hack. - Disp_Char (Ctxt, ' '); - PSL.Prints.Print_Sequence (Expr); - end Disp_Psl_Sequence; - - procedure Disp_Psl_Default_Clock (Ctxt : in out Ctxt_Class; Stmt : Iir) is - begin - if Vhdl_Std < Vhdl_08 then - Put ("--psl "); - end if; - Start_Hbox (Ctxt); - Disp_Token (Ctxt, Tok_Psl_Default, Tok_Psl_Clock); - Disp_Token (Ctxt, Tok_Is); - Disp_Psl_Expression (Ctxt, Get_Psl_Boolean (Stmt)); - Disp_Token (Ctxt, Tok_Semi_Colon); - Close_Hbox (Ctxt); - end Disp_Psl_Default_Clock; - - procedure Disp_Psl_Declaration (Ctxt : in out Ctxt_Class; Stmt : Iir) - is - use PSL.Nodes; - Decl : constant PSL_Node := Get_Psl_Declaration (Stmt); - begin - if Vhdl_Std < Vhdl_08 then - Put ("--psl "); - end if; - case Get_Kind (Decl) is - when N_Property_Declaration => - Put ("property "); - Disp_Ident (Ctxt, Get_Identifier (Decl)); - Put (" is "); - Disp_Psl_Expression (Ctxt, Get_Property (Decl)); - Put_Line (";"); - when N_Sequence_Declaration => - Put ("sequence "); - Disp_Ident (Ctxt, Get_Identifier (Decl)); - Put (" is "); - Disp_Psl_Sequence (Ctxt, Get_Sequence (Decl)); - Put_Line (";"); - when N_Endpoint_Declaration => - Put ("endpoint "); - Disp_Ident (Ctxt, Get_Identifier (Decl)); - Put (" is "); - Disp_Psl_Sequence (Ctxt, Get_Sequence (Decl)); - Put_Line (";"); - Disp_PSL_NFA (Get_PSL_NFA (Stmt)); - when others => - PSL.Errors.Error_Kind ("disp_psl_declaration", Decl); - end case; - end Disp_Psl_Declaration; - - procedure Disp_Declaration_Chain - (Ctxt : in out Ctxt_Class; Parent : Iir) - is - Decl: Iir; - begin - Decl := Get_Declaration_Chain (Parent); - while Decl /= Null_Iir loop - case Get_Kind (Decl) is - when Iir_Kind_Type_Declaration => - Disp_Type_Declaration (Ctxt, Decl); - when Iir_Kind_Anonymous_Type_Declaration => - Disp_Anonymous_Type_Declaration (Ctxt, Decl); - when Iir_Kind_Subtype_Declaration => - Disp_Subtype_Declaration (Ctxt, Decl); - when Iir_Kind_Use_Clause => - Disp_Use_Clause (Ctxt, Decl); - when Iir_Kind_Component_Declaration => - Disp_Component_Declaration (Ctxt, Decl); - when Iir_Kind_File_Declaration - | Iir_Kind_Signal_Declaration - | Iir_Kind_Constant_Declaration - | Iir_Kind_Variable_Declaration => - Disp_Object_Declaration (Ctxt, Decl); - while Get_Has_Identifier_List (Decl) loop - Decl := Get_Chain (Decl); - end loop; - when Iir_Kind_Object_Alias_Declaration => - Disp_Object_Alias_Declaration (Ctxt, Decl); - when Iir_Kind_Terminal_Declaration => - Disp_Terminal_Declaration (Ctxt, Decl); - while Get_Has_Identifier_List (Decl) loop - Decl := Get_Chain (Decl); - end loop; - when Iir_Kinds_Quantity_Declaration => - Disp_Quantity_Declaration (Ctxt, Decl); - when Iir_Kind_Nature_Declaration => - Disp_Nature_Declaration (Ctxt, Decl); - when Iir_Kind_Non_Object_Alias_Declaration => - Disp_Non_Object_Alias_Declaration (Ctxt, Decl); - when Iir_Kind_Function_Declaration - | Iir_Kind_Procedure_Declaration => - declare - Implicit : constant Boolean := - Is_Implicit_Subprogram (Decl) - and then (Get_Implicit_Definition (Decl) - /= Iir_Predefined_Now_Function); - begin - if not Implicit or else Flag_Implicit then - Start_Hbox (Ctxt); - Disp_Subprogram_Declaration (Ctxt, Decl, Implicit); - if not Get_Has_Body (Decl) then - Disp_Token (Ctxt, Tok_Semi_Colon); - Close_Hbox (Ctxt); - end if; - end if; - end; - when Iir_Kind_Function_Body - | Iir_Kind_Procedure_Body => - -- The declaration was just displayed. - Disp_Token (Ctxt, Tok_Is); - Close_Hbox (Ctxt); - Disp_Subprogram_Body (Ctxt, Decl); - when Iir_Kind_Protected_Type_Body => - Disp_Protected_Type_Body (Ctxt, Decl); - when Iir_Kind_Configuration_Specification => - Disp_Configuration_Specification (Ctxt, Decl); - when Iir_Kind_Disconnection_Specification => - Disp_Disconnection_Specification (Ctxt, Decl); - when Iir_Kind_Attribute_Declaration => - Disp_Attribute_Declaration (Ctxt, Decl); - when Iir_Kind_Attribute_Specification => - Disp_Attribute_Specification (Ctxt, Decl); - when Iir_Kind_Signal_Attribute_Declaration => - null; - when Iir_Kind_Group_Template_Declaration => - Disp_Group_Template_Declaration (Ctxt, Decl); - when Iir_Kind_Group_Declaration => - Disp_Group_Declaration (Ctxt, Decl); - when Iir_Kind_Package_Declaration => - Disp_Package_Declaration (Ctxt, Decl); - when Iir_Kind_Package_Body => - Disp_Package_Body (Ctxt, Decl); - when Iir_Kind_Package_Instantiation_Declaration => - Disp_Package_Instantiation_Declaration (Ctxt, Decl); - when Iir_Kind_Psl_Default_Clock => - Disp_Psl_Default_Clock (Ctxt, Decl); - when others => - Error_Kind ("disp_declaration_chain", Decl); - end case; - Decl := Get_Chain (Decl); - end loop; - end Disp_Declaration_Chain; - - procedure Disp_Waveform - (Ctxt : in out Ctxt_Class; Chain : Iir_Waveform_Element) - is - We: Iir_Waveform_Element; - Val : Iir; - begin - if Chain = Null_Iir then - Put ("null after {disconnection_time}"); - return; - elsif Get_Kind (Chain) = Iir_Kind_Unaffected_Waveform then - Disp_Token (Ctxt, Tok_Unaffected); - return; - end if; - We := Chain; - while We /= Null_Iir loop - if We /= Chain then - Disp_Token (Ctxt, Tok_Comma); - end if; - Val := Get_We_Value (We); - Print (Ctxt, Val); - if Get_Time (We) /= Null_Iir then - Disp_Token (Ctxt, Tok_After); - Print (Ctxt, Get_Time (We)); - end if; - We := Get_Chain (We); - end loop; - end Disp_Waveform; - - procedure Disp_Delay_Mechanism (Ctxt : in out Ctxt_Class; Stmt: Iir) is - Expr: Iir; - begin - case Get_Delay_Mechanism (Stmt) is - when Iir_Transport_Delay => - Disp_Token (Ctxt, Tok_Transport); - when Iir_Inertial_Delay => - Expr := Get_Reject_Time_Expression (Stmt); - if Expr /= Null_Iir then - Disp_Token (Ctxt, Tok_Reject); - Print (Ctxt, Expr); - Disp_Token (Ctxt, Tok_Inertial); - end if; - end case; - end Disp_Delay_Mechanism; - - procedure Disp_Label (Ctxt : in out Ctxt_Class; Stmt : Iir) - is - Label: constant Name_Id := Get_Label (Stmt); - begin - if Label /= Null_Identifier then - Disp_Identifier (Ctxt, Stmt); - Disp_Token (Ctxt, Tok_Colon); - end if; - end Disp_Label; - - procedure Disp_Simple_Signal_Assignment - (Ctxt : in out Ctxt_Class; Stmt: Iir) is - begin - Start_Hbox (Ctxt); - Disp_Label (Ctxt, Stmt); - Print (Ctxt, Get_Target (Stmt)); - Disp_Token (Ctxt, Tok_Less_Equal); - Disp_Delay_Mechanism (Ctxt, Stmt); - Disp_Waveform (Ctxt, Get_Waveform_Chain (Stmt)); - Disp_Token (Ctxt, Tok_Semi_Colon); - Close_Hbox (Ctxt); - end Disp_Simple_Signal_Assignment; - - procedure Disp_Conditional_Waveform (Ctxt : in out Ctxt_Class; Chain : Iir) - is - Cond_Wf : Iir; - Expr : Iir; - begin - Cond_Wf := Chain; - while Cond_Wf /= Null_Iir loop - Disp_Waveform (Ctxt, Get_Waveform_Chain (Cond_Wf)); - Expr := Get_Condition (Cond_Wf); - if Expr /= Null_Iir then - Disp_Token (Ctxt, Tok_When); - Print (Ctxt, Expr); - Disp_Token (Ctxt, Tok_Else); - end if; - Cond_Wf := Get_Chain (Cond_Wf); - end loop; - end Disp_Conditional_Waveform; - - procedure Disp_Conditional_Signal_Assignment - (Ctxt : in out Ctxt_Class; Stmt: Iir) is - begin - Start_Hbox (Ctxt); - Print (Ctxt, Get_Target (Stmt)); - Disp_Token (Ctxt, Tok_Less_Equal); - Disp_Delay_Mechanism (Ctxt, Stmt); - Disp_Conditional_Waveform (Ctxt, Get_Conditional_Waveform_Chain (Stmt)); - Disp_Token (Ctxt, Tok_Semi_Colon); - Close_Hbox (Ctxt); - end Disp_Conditional_Signal_Assignment; - - procedure Disp_Selected_Waveforms - (Ctxt : in out Ctxt_Class; Stmt : Iir) - is - Assoc_Chain : constant Iir := Get_Selected_Waveform_Chain (Stmt); - Assoc: Iir; - begin - Assoc := Assoc_Chain; - while Assoc /= Null_Iir loop - if Assoc /= Assoc_Chain then - Disp_Token (Ctxt, Tok_Comma); - end if; - Disp_Waveform (Ctxt, Get_Associated_Chain (Assoc)); - Disp_Token (Ctxt, Tok_When); - Disp_Choice (Ctxt, Assoc); - end loop; - Disp_Token (Ctxt, Tok_Semi_Colon); - end Disp_Selected_Waveforms; - - procedure Disp_Selected_Waveform_Assignment - (Ctxt : in out Ctxt_Class; Stmt: Iir) is - begin - Start_Hbox (Ctxt); - Disp_Label (Ctxt, Stmt); - Put ("with "); - Print (Ctxt, Get_Expression (Stmt)); - Put (" select "); - Print (Ctxt, Get_Target (Stmt)); - Put (" <= "); - Disp_Delay_Mechanism (Ctxt, Stmt); - Disp_Selected_Waveforms (Ctxt, Stmt); - Close_Hbox (Ctxt); - end Disp_Selected_Waveform_Assignment; - - procedure Disp_Variable_Assignment - (Ctxt : in out Ctxt_Class; Stmt: Iir) is - begin - Start_Hbox (Ctxt); - Disp_Label (Ctxt, Stmt); - Print (Ctxt, Get_Target (Stmt)); - Disp_Token (Ctxt, Tok_Assign); - Print (Ctxt, Get_Expression (Stmt)); - Disp_Token (Ctxt, Tok_Semi_Colon); - Close_Hbox (Ctxt); - end Disp_Variable_Assignment; - - procedure Disp_Conditional_Expression - (Ctxt : in out Ctxt_Class; Exprs : Iir) - is - Expr : Iir; - Cond : Iir; - begin - Expr := Exprs; - loop - Print (Ctxt, Get_Expression (Expr)); - Cond := Get_Condition (Expr); - if Cond /= Null_Iir then - Disp_Token (Ctxt, Tok_When); - Print (Ctxt, Cond); - end if; - Expr := Get_Chain (Expr); - exit when Expr = Null_Iir; - Disp_Token (Ctxt, Tok_Else); - end loop; - end Disp_Conditional_Expression; - - procedure Disp_Conditional_Variable_Assignment - (Ctxt : in out Ctxt_Class; Stmt: Iir) is - begin - Start_Hbox (Ctxt); - Disp_Label (Ctxt, Stmt); - Print (Ctxt, Get_Target (Stmt)); - Disp_Token (Ctxt, Tok_Assign); - Disp_Conditional_Expression (Ctxt, Get_Conditional_Expression (Stmt)); - Disp_Token (Ctxt, Tok_Semi_Colon); - Close_Hbox (Ctxt); - end Disp_Conditional_Variable_Assignment; - - procedure Disp_Postponed (Ctxt : in out Ctxt_Class; Stmt : Iir) is - begin - if Get_Postponed_Flag (Stmt) then - Disp_Token (Ctxt, Tok_Postponed); - end if; - end Disp_Postponed; - - procedure Disp_Concurrent_Simple_Signal_Assignment - (Ctxt : in out Ctxt_Class; Stmt: Iir) is - begin - Start_Hbox (Ctxt); - Disp_Label (Ctxt, Stmt); - Disp_Postponed (Ctxt, Stmt); - Print (Ctxt, Get_Target (Stmt)); - Disp_Token (Ctxt, Tok_Less_Equal); - if Get_Guard (Stmt) /= Null_Iir then - Disp_Token (Ctxt, Tok_Guarded); - end if; - Disp_Delay_Mechanism (Ctxt, Stmt); - Disp_Waveform (Ctxt, Get_Waveform_Chain (Stmt)); - - Disp_Token (Ctxt, Tok_Semi_Colon); - Close_Hbox (Ctxt); - end Disp_Concurrent_Simple_Signal_Assignment; - - procedure Disp_Concurrent_Selected_Signal_Assignment - (Ctxt : in out Ctxt_Class; Stmt: Iir) is - begin - Start_Hbox (Ctxt); - Disp_Label (Ctxt, Stmt); - Disp_Postponed (Ctxt, Stmt); - Disp_Token (Ctxt, Tok_With); - Print (Ctxt, Get_Expression (Stmt)); - Disp_Token (Ctxt, Tok_Select); - Print (Ctxt, Get_Target (Stmt)); - Disp_Token (Ctxt, Tok_Less_Equal); - if Get_Guard (Stmt) /= Null_Iir then - Disp_Token (Ctxt, Tok_Guarded); - end if; - Disp_Delay_Mechanism (Ctxt, Stmt); - Disp_Selected_Waveforms (Ctxt, Stmt); - Close_Hbox (Ctxt); - end Disp_Concurrent_Selected_Signal_Assignment; - - procedure Disp_Concurrent_Conditional_Signal_Assignment - (Ctxt : in out Ctxt_Class; Stmt: Iir) is - begin - Start_Hbox (Ctxt); - Disp_Label (Ctxt, Stmt); - Disp_Postponed (Ctxt, Stmt); - Print (Ctxt, Get_Target (Stmt)); - Disp_Token (Ctxt, Tok_Less_Equal); - if Get_Guard (Stmt) /= Null_Iir then - Disp_Token (Ctxt, Tok_Guarded); - end if; - Disp_Delay_Mechanism (Ctxt, Stmt); - Disp_Conditional_Waveform (Ctxt, Get_Conditional_Waveform_Chain (Stmt)); - Disp_Token (Ctxt, Tok_Semi_Colon); - Close_Hbox (Ctxt); - end Disp_Concurrent_Conditional_Signal_Assignment; - - procedure Disp_Severity_Expression (Ctxt : in out Ctxt_Class; Stmt : Iir) - is - Expr : constant Iir := Get_Severity_Expression (Stmt); - begin - if Expr /= Null_Iir then - Disp_Token (Ctxt, Tok_Severity); - Print (Ctxt, Expr); - end if; - end Disp_Severity_Expression; - - procedure Disp_Report_Expression (Ctxt : in out Ctxt_Class; Stmt : Iir) - is - Expr : constant Iir := Get_Report_Expression (Stmt); - begin - if Expr /= Null_Iir then - Disp_Token (Ctxt, Tok_Report); - Print (Ctxt, Expr); - end if; - end Disp_Report_Expression; - - procedure Disp_Assertion_Statement (Ctxt : in out Ctxt_Class; Stmt: Iir) is - begin - Start_Hbox (Ctxt); - Disp_Label (Ctxt, Stmt); - if Get_Kind (Stmt) = Iir_Kind_Concurrent_Assertion_Statement then - Disp_Postponed (Ctxt, Stmt); - end if; - Disp_Token (Ctxt, Tok_Assert); - Print (Ctxt, Get_Assertion_Condition (Stmt)); - Disp_Report_Expression (Ctxt, Stmt); - Disp_Severity_Expression (Ctxt, Stmt); - Disp_Token (Ctxt, Tok_Semi_Colon); - Close_Hbox (Ctxt); - end Disp_Assertion_Statement; - - procedure Disp_Report_Statement (Ctxt : in out Ctxt_Class; Stmt: Iir) is - begin - Start_Hbox (Ctxt); - Disp_Label (Ctxt, Stmt); - Disp_Token (Ctxt, Tok_Report); - Print (Ctxt, Get_Report_Expression (Stmt)); - Disp_Severity_Expression (Ctxt, Stmt); - Disp_Token (Ctxt, Tok_Semi_Colon); - Close_Hbox (Ctxt); - end Disp_Report_Statement; - - function Get_Operator_Token (Op : Iir) return Token_Type is - begin - case Get_Kind (Op) is - when Iir_Kind_And_Operator - | Iir_Kind_Reduction_And_Operator => - return Tok_And; - when Iir_Kind_Or_Operator - | Iir_Kind_Reduction_Or_Operator => - return Tok_Or; - when Iir_Kind_Nand_Operator - | Iir_Kind_Reduction_Nand_Operator => - return Tok_Nand; - when Iir_Kind_Nor_Operator - | Iir_Kind_Reduction_Nor_Operator => - return Tok_Nor; - when Iir_Kind_Xor_Operator - | Iir_Kind_Reduction_Xor_Operator => - return Tok_Xor; - when Iir_Kind_Xnor_Operator - | Iir_Kind_Reduction_Xnor_Operator => - return Tok_Xnor; - - when Iir_Kind_Equality_Operator => - return Tok_Equal; - when Iir_Kind_Inequality_Operator => - return Tok_Not_Equal; - when Iir_Kind_Less_Than_Operator => - return Tok_Less; - when Iir_Kind_Less_Than_Or_Equal_Operator => - return Tok_Less_Equal; - when Iir_Kind_Greater_Than_Operator => - return Tok_Greater; - when Iir_Kind_Greater_Than_Or_Equal_Operator => - return Tok_Greater_Equal; - - when Iir_Kind_Match_Equality_Operator => - return Tok_Match_Equal; - when Iir_Kind_Match_Inequality_Operator => - return Tok_Match_Not_Equal; - when Iir_Kind_Match_Less_Than_Operator => - return Tok_Match_Less; - when Iir_Kind_Match_Less_Than_Or_Equal_Operator => - return Tok_Match_Less_Equal; - when Iir_Kind_Match_Greater_Than_Operator => - return Tok_Match_Greater; - when Iir_Kind_Match_Greater_Than_Or_Equal_Operator => - return Tok_Match_Greater_Equal; - - when Iir_Kind_Sll_Operator => - return Tok_Sll; - when Iir_Kind_Sla_Operator => - return Tok_Sla; - when Iir_Kind_Srl_Operator => - return Tok_Srl; - when Iir_Kind_Sra_Operator => - return Tok_Sra; - when Iir_Kind_Rol_Operator => - return Tok_Rol; - when Iir_Kind_Ror_Operator => - return Tok_Ror; - - when Iir_Kind_Addition_Operator => - return Tok_Plus; - when Iir_Kind_Substraction_Operator => - return Tok_Minus; - when Iir_Kind_Concatenation_Operator => - return Tok_Ampersand; - when Iir_Kind_Multiplication_Operator => - return Tok_Star; - when Iir_Kind_Division_Operator => - return Tok_Slash; - when Iir_Kind_Modulus_Operator => - return Tok_Mod; - when Iir_Kind_Remainder_Operator => - return Tok_Rem; - when Iir_Kind_Exponentiation_Operator => - return Tok_Double_Star; - when Iir_Kind_Not_Operator => - return Tok_Not; - when Iir_Kind_Negation_Operator => - return Tok_Minus; - when Iir_Kind_Identity_Operator => - return Tok_Plus; - when Iir_Kind_Absolute_Operator => - return Tok_Abs; - when Iir_Kind_Condition_Operator - | Iir_Kind_Implicit_Condition_Operator => - return Tok_Condition; - when others => - raise Internal_Error; - end case; - end Get_Operator_Token; - - procedure Disp_Dyadic_Operator (Ctxt : in out Ctxt_Class; Expr: Iir) is - begin - if Flag_Parenthesis then - Put ("("); - end if; - Print (Ctxt, Get_Left (Expr)); - Disp_Token (Ctxt, Get_Operator_Token (Expr)); - Print (Ctxt, Get_Right (Expr)); - if Flag_Parenthesis then - Put (")"); - end if; - end Disp_Dyadic_Operator; - - procedure Disp_Monadic_Operator (Ctxt : in out Ctxt_Class; Expr: Iir) is - begin - if Get_Kind (Expr) = Iir_Kind_Implicit_Condition_Operator then - Print (Ctxt, Get_Operand (Expr)); - return; - end if; - - Disp_Token (Ctxt, Get_Operator_Token (Expr)); - if Flag_Parenthesis then - Put ('('); - end if; - Print (Ctxt, Get_Operand (Expr)); - if Flag_Parenthesis then - Put (')'); - end if; - end Disp_Monadic_Operator; - - procedure Disp_Case_Statement - (Ctxt : in out Ctxt_Class; Stmt: Iir_Case_Statement) - is - Assoc: Iir; - Sel_Stmt : Iir; - begin - Disp_Token (Ctxt, Tok_Case); - Print (Ctxt, Get_Expression (Stmt)); - Disp_Token (Ctxt, Tok_Is); - Close_Hbox (Ctxt); - - Start_Vbox (Ctxt); - Assoc := Get_Case_Statement_Alternative_Chain (Stmt); - while Assoc /= Null_Iir loop - Start_Hbox (Ctxt); - Disp_Token (Ctxt, Tok_When); - Sel_Stmt := Get_Associated_Chain (Assoc); - Disp_Choice (Ctxt, Assoc); - Disp_Token (Ctxt, Tok_Double_Arrow); - Close_Hbox (Ctxt); - - Start_Vbox (Ctxt); - Disp_Sequential_Statements (Ctxt, Sel_Stmt); - Close_Vbox (Ctxt); - end loop; - Close_Vbox (Ctxt); - - Disp_End_Label_No_Close (Ctxt, Stmt, Tok_Case); - end Disp_Case_Statement; - - procedure Disp_Wait_Statement - (Ctxt : in out Ctxt_Class; Stmt: Iir_Wait_Statement) - is - List: Iir_List; - Expr: Iir; - begin - Start_Hbox (Ctxt); - Disp_Label (Ctxt, Stmt); - Disp_Token (Ctxt, Tok_Wait); - List := Get_Sensitivity_List (Stmt); - if List /= Null_Iir_List then - Disp_Token (Ctxt, Tok_On); - Disp_Designator_List (Ctxt, List); - end if; - Expr := Get_Condition_Clause (Stmt); - if Expr /= Null_Iir then - Disp_Token (Ctxt, Tok_Until); - Print (Ctxt, Expr); - end if; - Expr := Get_Timeout_Clause (Stmt); - if Expr /= Null_Iir then - Disp_Token (Ctxt, Tok_For); - Print (Ctxt, Expr); - end if; - Disp_Token (Ctxt, Tok_Semi_Colon); - Close_Hbox (Ctxt); - end Disp_Wait_Statement; - - procedure Disp_If_Statement - (Ctxt : in out Ctxt_Class; Stmt : Iir_If_Statement) - is - Clause : Iir; - Expr : Iir; - begin - Start_Hbox (Ctxt); - Disp_Label (Ctxt, Stmt); - Disp_Token (Ctxt, Tok_If); - Clause := Stmt; - Print (Ctxt, Get_Condition (Clause)); - Disp_Token (Ctxt, Tok_Then); - Close_Hbox (Ctxt); - while Clause /= Null_Iir loop - Start_Vbox (Ctxt); - Disp_Sequential_Statements - (Ctxt, Get_Sequential_Statement_Chain (Clause)); - Close_Vbox (Ctxt); - Clause := Get_Else_Clause (Clause); - exit when Clause = Null_Iir; - Start_Hbox (Ctxt); - Expr := Get_Condition (Clause); - if Expr /= Null_Iir then - Disp_Token (Ctxt, Tok_Elsif); - Print (Ctxt, Expr); - Disp_Token (Ctxt, Tok_Then); - else - Disp_Token (Ctxt, Tok_Else); - end if; - Close_Hbox (Ctxt); - end loop; - Disp_End_Label (Ctxt, Stmt, Tok_If); - end Disp_If_Statement; - - procedure Disp_Parameter_Specification - (Ctxt : in out Ctxt_Class; Iterator : Iir_Iterator_Declaration) is - begin - Disp_Identifier (Ctxt, Iterator); - Disp_Token (Ctxt, Tok_In); - Disp_Discrete_Range (Ctxt, Or_Else (Get_Discrete_Range (Iterator), - Get_Subtype_Indication (Iterator))); - end Disp_Parameter_Specification; - - procedure Disp_Procedure_Call (Ctxt : in out Ctxt_Class; Stmt : Iir) - is - Call : constant Iir := Get_Procedure_Call (Stmt); - begin - Start_Hbox (Ctxt); - Disp_Label (Ctxt, Stmt); - if Get_Kind (Stmt) = Iir_Kind_Concurrent_Procedure_Call_Statement then - Disp_Postponed (Ctxt, Stmt); - end if; - Print (Ctxt, Get_Prefix (Call)); - Disp_Association_Chain (Ctxt, Get_Parameter_Association_Chain (Call)); - Disp_Token (Ctxt, Tok_Semi_Colon); - Close_Hbox (Ctxt); - end Disp_Procedure_Call; - - procedure Disp_For_Loop_Statement (Ctxt : in out Ctxt_Class; Stmt : Iir) is - begin - Start_Hbox (Ctxt); - Disp_Label (Ctxt, Stmt); - Disp_Token (Ctxt, Tok_For); - Disp_Parameter_Specification (Ctxt, Get_Parameter_Specification (Stmt)); - Disp_Token (Ctxt, Tok_Loop); - Close_Hbox (Ctxt); - - Start_Vbox (Ctxt); - Disp_Sequential_Statements (Ctxt, Get_Sequential_Statement_Chain (Stmt)); - Close_Vbox (Ctxt); - - Disp_End_Label (Ctxt, Stmt, Tok_Loop); - end Disp_For_Loop_Statement; - - procedure Disp_Sequential_Statements (Ctxt : in out Ctxt_Class; First : Iir) - is - Stmt: Iir; - begin - Stmt := First; - while Stmt /= Null_Iir loop - case Iir_Kinds_Sequential_Statement (Get_Kind (Stmt)) is - when Iir_Kind_Null_Statement => - Start_Hbox (Ctxt); - Disp_Label (Ctxt, Stmt); - Disp_Token (Ctxt, Tok_Null, Tok_Semi_Colon); - Close_Hbox (Ctxt); - when Iir_Kind_If_Statement => - Disp_If_Statement (Ctxt, Stmt); - when Iir_Kind_For_Loop_Statement => - Disp_For_Loop_Statement (Ctxt, Stmt); - when Iir_Kind_While_Loop_Statement => - Start_Hbox (Ctxt); - Disp_Label (Ctxt, Stmt); - if Get_Condition (Stmt) /= Null_Iir then - Disp_Token (Ctxt, Tok_While); - Print (Ctxt, Get_Condition (Stmt)); - end if; - Disp_Token (Ctxt, Tok_Loop); - Close_Hbox (Ctxt); - Start_Vbox (Ctxt); - Disp_Sequential_Statements - (Ctxt, Get_Sequential_Statement_Chain (Stmt)); - Close_Vbox (Ctxt); - Disp_End_Label (Ctxt, Stmt, Tok_Loop); - when Iir_Kind_Simple_Signal_Assignment_Statement => - Disp_Simple_Signal_Assignment (Ctxt, Stmt); - when Iir_Kind_Conditional_Signal_Assignment_Statement => - Start_Hbox (Ctxt); - Disp_Label (Ctxt, Stmt); - Disp_Conditional_Signal_Assignment (Ctxt, Stmt); - Close_Hbox (Ctxt); - when Iir_Kind_Selected_Waveform_Assignment_Statement => - Disp_Selected_Waveform_Assignment (Ctxt, Stmt); - when Iir_Kind_Variable_Assignment_Statement => - Disp_Variable_Assignment (Ctxt, Stmt); - when Iir_Kind_Conditional_Variable_Assignment_Statement => - Disp_Conditional_Variable_Assignment (Ctxt, Stmt); - when Iir_Kind_Assertion_Statement => - Disp_Assertion_Statement (Ctxt, Stmt); - when Iir_Kind_Report_Statement => - Disp_Report_Statement (Ctxt, Stmt); - when Iir_Kind_Return_Statement => - Start_Hbox (Ctxt); - Disp_Label (Ctxt, Stmt); - Disp_Token (Ctxt, Tok_Return); - if Get_Expression (Stmt) /= Null_Iir then - Print (Ctxt, Get_Expression (Stmt)); - end if; - Disp_Token (Ctxt, Tok_Semi_Colon); - Close_Hbox (Ctxt); - when Iir_Kind_Case_Statement => - Start_Hbox (Ctxt); - Disp_Label (Ctxt, Stmt); - Disp_Case_Statement (Ctxt, Stmt); - Close_Hbox (Ctxt); - when Iir_Kind_Wait_Statement => - Disp_Wait_Statement (Ctxt, Stmt); - when Iir_Kind_Procedure_Call_Statement => - Disp_Procedure_Call (Ctxt, Stmt); - when Iir_Kind_Exit_Statement - | Iir_Kind_Next_Statement => - declare - Label : constant Iir := Get_Loop_Label (Stmt); - Cond : constant Iir := Get_Condition (Stmt); - begin - Start_Hbox (Ctxt); - Disp_Label (Ctxt, Stmt); - if Get_Kind (Stmt) = Iir_Kind_Exit_Statement then - Disp_Token (Ctxt, Tok_Exit); - else - Disp_Token (Ctxt, Tok_Next); - end if; - if Label /= Null_Iir then - Print (Ctxt, Label); - end if; - if Cond /= Null_Iir then - Disp_Token (Ctxt, Tok_When); - Print (Ctxt, Cond); - end if; - Disp_Token (Ctxt, Tok_Semi_Colon); - Close_Hbox (Ctxt); - end; - end case; - Stmt := Get_Chain (Stmt); - end loop; - end Disp_Sequential_Statements; - - procedure Disp_Process_Statement (Ctxt : in out Ctxt_Class; Process: Iir) is - begin - Start_Hbox (Ctxt); - Disp_Label (Ctxt, Process); - Disp_Postponed (Ctxt, Process); - - Disp_Token (Ctxt, Tok_Process); - if Get_Kind (Process) = Iir_Kind_Sensitized_Process_Statement then - Disp_Token (Ctxt, Tok_Left_Paren); - Disp_Designator_List (Ctxt, Get_Sensitivity_List (Process)); - Disp_Token (Ctxt, Tok_Right_Paren); - end if; - if Get_Has_Is (Process) then - Disp_Token (Ctxt, Tok_Is); - end if; - Close_Hbox (Ctxt); - - Start_Vbox (Ctxt); - Disp_Declaration_Chain (Ctxt, Process); - Close_Vbox (Ctxt); - - Start_Hbox (Ctxt); - Disp_Token (Ctxt, Tok_Begin); - Close_Hbox (Ctxt); - - Start_Vbox (Ctxt); - Disp_Sequential_Statements - (Ctxt, Get_Sequential_Statement_Chain (Process)); - Close_Vbox (Ctxt); - - Start_Hbox (Ctxt); - Disp_Token (Ctxt, Tok_End); - if Get_End_Has_Postponed (Process) then - Disp_Token (Ctxt, Tok_Postponed); - end if; - Disp_After_End (Ctxt, Process, Tok_Process); - Disp_Token (Ctxt, Tok_Semi_Colon); - Close_Hbox (Ctxt); - end Disp_Process_Statement; - - procedure Disp_Conversion (Ctxt : in out Ctxt_Class; Conv : Iir) is - begin - case Get_Kind (Conv) is - when Iir_Kind_Function_Call => - Disp_Function_Name (Ctxt, Get_Implementation (Conv)); - when Iir_Kind_Type_Conversion => - Disp_Name_Of (Ctxt, Get_Type_Mark (Conv)); - when others => - Error_Kind ("disp_conversion", Conv); - end case; - end Disp_Conversion; - - procedure Disp_Association_Chain (Ctxt : in out Ctxt_Class; Chain : Iir) - is - El: Iir; - Formal: Iir; - Need_Comma : Boolean; - Conv : Iir; - begin - if Chain = Null_Iir then - return; - end if; - Disp_Token (Ctxt, Tok_Left_Paren); - Need_Comma := False; - - El := Chain; - while El /= Null_Iir loop - if Get_Kind (El) /= Iir_Kind_Association_Element_By_Individual then - if Need_Comma then - Disp_Token (Ctxt, Tok_Comma); - end if; - - -- Formal part. - if Get_Kind (El) = Iir_Kind_Association_Element_By_Expression then - Conv := Get_Formal_Conversion (El); - if Conv /= Null_Iir then - Disp_Conversion (Ctxt, Conv); - Disp_Token (Ctxt, Tok_Left_Paren); - end if; - else - Conv := Null_Iir; - end if; - Formal := Get_Formal (El); - if Formal /= Null_Iir then - case Get_Kind (El) is - when Iir_Kind_Association_Element_Package - | Iir_Kind_Association_Element_Type - | Iir_Kind_Association_Element_Subprogram => - Print (Ctxt, Formal); - when Iir_Kind_Association_Element_By_Expression - | Iir_Kind_Association_Element_By_Individual - | Iir_Kind_Association_Element_Open => - Print (Ctxt, Formal); - when others => - raise Internal_Error; - end case; - if Conv /= Null_Iir then - Disp_Token (Ctxt, Tok_Right_Paren); - end if; - Disp_Token (Ctxt, Tok_Double_Arrow); - end if; - - case Get_Kind (El) is - when Iir_Kind_Association_Element_Open => - Disp_Token (Ctxt, Tok_Open); - when Iir_Kind_Association_Element_Package - | Iir_Kind_Association_Element_Type - | Iir_Kind_Association_Element_Subprogram => - Print (Ctxt, Get_Actual (El)); - when others => - Conv := Get_Actual_Conversion (El); - if Conv /= Null_Iir then - Disp_Conversion (Ctxt, Conv); - Disp_Token (Ctxt, Tok_Left_Paren); - end if; - Print (Ctxt, Get_Actual (El)); - if Conv /= Null_Iir then - Disp_Token (Ctxt, Tok_Right_Paren); - end if; - end case; - Need_Comma := True; - end if; - El := Get_Chain (El); - end loop; - Disp_Token (Ctxt, Tok_Right_Paren); - end Disp_Association_Chain; - - procedure Disp_Generic_Map_Aspect - (Ctxt : in out Ctxt_Class; Parent : Iir) is - begin - Disp_Token (Ctxt, Tok_Generic, Tok_Map); - Disp_Association_Chain (Ctxt, Get_Generic_Map_Aspect_Chain (Parent)); - end Disp_Generic_Map_Aspect; - - procedure Disp_Port_Map_Aspect (Ctxt : in out Ctxt_Class; Parent : Iir) is - begin - Disp_Token (Ctxt, Tok_Port, Tok_Map); - Disp_Association_Chain (Ctxt, Get_Port_Map_Aspect_Chain (Parent)); - end Disp_Port_Map_Aspect; - - procedure Disp_Entity_Aspect (Ctxt : in out Ctxt_Class; Aspect : Iir) is - Arch : Iir; - begin - case Get_Kind (Aspect) is - when Iir_Kind_Entity_Aspect_Entity => - Disp_Token (Ctxt, Tok_Entity); - Print (Ctxt, Get_Entity_Name (Aspect)); - Arch := Get_Architecture (Aspect); - if Arch /= Null_Iir then - Disp_Token (Ctxt, Tok_Left_Paren); - Disp_Name_Of (Ctxt, Arch); - Disp_Token (Ctxt, Tok_Right_Paren); - end if; - when Iir_Kind_Entity_Aspect_Configuration => - Disp_Token (Ctxt, Tok_Configuration); - Print (Ctxt, Get_Configuration_Name (Aspect)); - when Iir_Kind_Entity_Aspect_Open => - Disp_Token (Ctxt, Tok_Open); - when others => - Error_Kind ("disp_entity_aspect", Aspect); - end case; - end Disp_Entity_Aspect; - - procedure Disp_Component_Instantiation_Statement - (Ctxt : in out Ctxt_Class; Stmt: Iir_Component_Instantiation_Statement) - is - Component: constant Iir := Get_Instantiated_Unit (Stmt); - Gen_Map : constant Iir := Get_Generic_Map_Aspect_Chain (Stmt); - Port_Map : constant Iir := Get_Port_Map_Aspect_Chain (Stmt); - begin - Start_Hbox (Ctxt); - Disp_Label (Ctxt, Stmt); - if Get_Kind (Component) in Iir_Kinds_Denoting_Name then - if Get_Has_Component (Stmt) then - Disp_Token (Ctxt, Tok_Component); - end if; - Print (Ctxt, Component); - else - Disp_Entity_Aspect (Ctxt, Component); - end if; - - if Gen_Map = Null_Iir and Port_Map = Null_Iir then - Disp_Token (Ctxt, Tok_Semi_Colon); - Close_Hbox (Ctxt); - else - Close_Hbox (Ctxt); - - Start_Vbox (Ctxt); - if Gen_Map /= Null_Iir then - Start_Hbox (Ctxt); - Disp_Generic_Map_Aspect (Ctxt, Stmt); - if Port_Map = Null_Iir then - Disp_Token (Ctxt, Tok_Semi_Colon); - end if; - Close_Hbox (Ctxt); - end if; - - if Port_Map /= Null_Iir then - Start_Hbox (Ctxt); - Disp_Port_Map_Aspect (Ctxt, Stmt); - Disp_Token (Ctxt, Tok_Semi_Colon); - Close_Hbox (Ctxt); - end if; - - Close_Vbox (Ctxt); - end if; - end Disp_Component_Instantiation_Statement; - - procedure Disp_Function_Call - (Ctxt : in out Ctxt_Class; Expr: Iir_Function_Call) is - begin - Print (Ctxt, Get_Prefix (Expr)); - Disp_Association_Chain (Ctxt, Get_Parameter_Association_Chain (Expr)); - end Disp_Function_Call; - - procedure Disp_Indexed_Name (Ctxt : in out Ctxt_Class; Indexed: Iir) - is - List : Iir_Flist; - El: Iir; - begin - Print (Ctxt, Get_Prefix (Indexed)); - Disp_Token (Ctxt, Tok_Left_Paren); - List := Get_Index_List (Indexed); - for I in Flist_First .. Flist_Last (List) loop - El := Get_Nth_Element (List, I); - if I /= 0 then - Disp_Token (Ctxt, Tok_Comma); - end if; - Print (Ctxt, El); - end loop; - Disp_Token (Ctxt, Tok_Right_Paren); - end Disp_Indexed_Name; - - procedure Disp_A_Choice (Ctxt : in out Ctxt_Class; Choice : Iir) is - begin - case Iir_Kinds_Choice (Get_Kind (Choice)) is - when Iir_Kind_Choice_By_Others => - Disp_Token (Ctxt, Tok_Others); - when Iir_Kind_Choice_By_None => - null; - when Iir_Kind_Choice_By_Expression => - Print (Ctxt, Get_Choice_Expression (Choice)); - when Iir_Kind_Choice_By_Range => - Disp_Range (Ctxt, Get_Choice_Range (Choice)); - when Iir_Kind_Choice_By_Name => - Disp_Name_Of (Ctxt, Get_Choice_Name (Choice)); - end case; - end Disp_A_Choice; - - procedure Disp_Choice (Ctxt : in out Ctxt_Class; Choice: in out Iir) is - begin - loop - Disp_A_Choice (Ctxt, Choice); - Choice := Get_Chain (Choice); - exit when Choice = Null_Iir; - exit when Get_Same_Alternative_Flag (Choice) = False; - --exit when Choice = Null_Iir; - Disp_Token (Ctxt, Tok_Bar); - end loop; - end Disp_Choice; - - -- EL_TYPE is Null_Iir for record aggregates. - procedure Disp_Aggregate_1 - (Ctxt : in out Ctxt_Class; - Aggr: Iir_Aggregate; Index : Positive; El_Type : Iir) - is - Assoc : Iir; - Expr : Iir; - Is_First : Boolean; - begin - Disp_Token (Ctxt, Tok_Left_Paren); - Assoc := Get_Association_Choices_Chain (Aggr); - Is_First := True; - while Assoc /= Null_Iir loop - if Is_First then - Is_First := False; - else - Disp_Token (Ctxt, Tok_Comma); - end if; - pragma Assert (not Get_Same_Alternative_Flag (Assoc)); - Expr := Get_Associated_Expr (Assoc); - Disp_A_Choice (Ctxt, Assoc); - if Get_Kind (Assoc) /= Iir_Kind_Choice_By_None then - Assoc := Get_Chain (Assoc); - while Assoc /= Null_Iir - and then Get_Same_Alternative_Flag (Assoc) - loop - Disp_Token (Ctxt, Tok_Bar); - Disp_A_Choice (Ctxt, Assoc); - Assoc := Get_Chain (Assoc); - end loop; - Disp_Token (Ctxt, Tok_Double_Arrow); - else - Assoc := Get_Chain (Assoc); - end if; - if Index > 1 then - if Get_Kind (Expr) = Iir_Kind_String_Literal8 then - Disp_String_Literal (Ctxt, Expr, El_Type); - else - Disp_Aggregate_1 (Ctxt, Expr, Index - 1, El_Type); - end if; - else - Print (Ctxt, Expr); - end if; - end loop; - Disp_Token (Ctxt, Tok_Right_Paren); - end Disp_Aggregate_1; - - procedure Disp_Aggregate (Ctxt : in out Ctxt_Class; Aggr: Iir_Aggregate) - is - Aggr_Type : constant Iir := Get_Type (Aggr); - Base_Type : Iir; - begin - if Aggr_Type /= Null_Iir - and then Get_Kind (Aggr_Type) in Iir_Kinds_Array_Type_Definition - then - Base_Type := Get_Base_Type (Aggr_Type); - Disp_Aggregate_1 - (Ctxt, Aggr, Get_Nbr_Elements (Get_Index_Subtype_List (Base_Type)), - Get_Element_Subtype (Base_Type)); - else - Disp_Aggregate_1 (Ctxt, Aggr, 1, Null_Iir); - end if; - end Disp_Aggregate; - - procedure Disp_Simple_Aggregate - (Ctxt : in out Ctxt_Class; Aggr: Iir_Simple_Aggregate) - is - List : constant Iir_Flist := Get_Simple_Aggregate_List (Aggr); - El : Iir; - First : Boolean := True; - begin - Put ("("); - for I in Flist_First .. Flist_Last (List) loop - El := Get_Nth_Element (List, I); - if First then - First := False; - else - Put (", "); - end if; - Print (Ctxt, El); - end loop; - Put (")"); - end Disp_Simple_Aggregate; - - procedure Disp_Parametered_Attribute - (Ctxt : in out Ctxt_Class; Name : Name_Id; Expr : Iir) - is - Param : Iir; - Pfx : Iir; - begin - Pfx := Get_Prefix (Expr); - case Get_Kind (Pfx) is - when Iir_Kind_Type_Declaration - | Iir_Kind_Subtype_Declaration => - Disp_Name_Of (Ctxt, Pfx); - when others => - Print (Ctxt, Pfx); - end case; - Disp_Token (Ctxt, Tok_Tick); - Disp_Ident (Ctxt, Name); - Param := Get_Parameter (Expr); - if Param /= Null_Iir - and then Param /= Vhdl.Std_Package.Universal_Integer_One - then - Disp_Token (Ctxt, Tok_Left_Paren); - Print (Ctxt, Param); - Disp_Token (Ctxt, Tok_Right_Paren); - end if; - end Disp_Parametered_Attribute; - - procedure Disp_Parametered_Type_Attribute - (Ctxt : in out Ctxt_Class; Name : Name_Id; Expr : Iir) is - begin - Print (Ctxt, Get_Prefix (Expr)); - Disp_Token (Ctxt, Tok_Tick); - Disp_Ident (Ctxt, Name); - Disp_Token (Ctxt, Tok_Left_Paren); - Print (Ctxt, Get_Parameter (Expr)); - Disp_Token (Ctxt, Tok_Right_Paren); - end Disp_Parametered_Type_Attribute; - - procedure Disp_String_Literal_Raw - (Ctxt : in out Ctxt_Class; Str : Iir; El_Type : Iir) - is - Str_Id : constant String8_Id := Get_String8_Id (Str); - Len : constant Nat32 := Get_String_Length (Str); - Literal_List : Iir_Flist; - Pos : Nat8; - Lit : Iir; - Id : Name_Id; - C : Character; - begin - if Get_Bit_String_Base (Str) /= Base_None then - Start_Lit (Ctxt, Tok_Bit_String); - if Get_Has_Length (Str) then - Disp_Int32 (Ctxt, Iir_Int32 (Get_String_Length (Str))); - end if; - Disp_Char (Ctxt, 'b'); - else - Start_Lit (Ctxt, Tok_String); - end if; - - Disp_Char (Ctxt, '"'); - - if El_Type /= Null_Iir then - Literal_List := - Get_Enumeration_Literal_List (Get_Base_Type (El_Type)); - else - Literal_List := Null_Iir_Flist; - end if; - - for I in 1 .. Len loop - Pos := Str_Table.Element_String8 (Str_Id, I); - if Literal_List /= Null_Iir_Flist then - Lit := Get_Nth_Element (Literal_List, Natural (Pos)); - Id := Get_Identifier (Lit); - else - Id := Name_Table.Get_Identifier (Character'Val (Pos)); - end if; - pragma Assert (Name_Table.Is_Character (Id)); - C := Name_Table.Get_Character (Id); - if C = '"' then - Disp_Char (Ctxt, C); - end if; - Disp_Char (Ctxt, C); - end loop; - - Disp_Char (Ctxt, '"'); - Close_Lit (Ctxt); - end Disp_String_Literal_Raw; - - procedure Disp_String_Literal - (Ctxt : in out Ctxt_Class; Str : Iir; El_Type : Iir) is - begin - if Get_Literal_Length (Str) /= 0 then - declare - Tkind : Token_Type; - begin - if Get_Bit_String_Base (Str) /= Base_None then - Tkind := Tok_Bit_String; - else - Tkind := Tok_String; - end if; - Disp_Literal_From_Source (Ctxt, Str, Tkind); - end; - else - Disp_String_Literal_Raw (Ctxt, Str, El_Type); - end if; - end Disp_String_Literal; - - procedure Print (Ctxt : in out Ctxt_Class; Expr: Iir) - is - Orig : Iir; - begin - case Get_Kind (Expr) is - when Iir_Kind_Integer_Literal => - Orig := Get_Literal_Origin (Expr); - if Dump_Origin_Flag and then Orig /= Null_Iir then - Print (Ctxt, Orig); - else - if Get_Literal_Length (Expr) /= 0 then - Disp_Literal_From_Source (Ctxt, Expr, Tok_Integer); - else - Disp_Int64 (Ctxt, Get_Value (Expr)); - end if; - end if; - when Iir_Kind_Floating_Point_Literal => - Orig := Get_Literal_Origin (Expr); - if Dump_Origin_Flag and then Orig /= Null_Iir then - Print (Ctxt, Orig); - else - if Get_Literal_Length (Expr) /= 0 then - Disp_Literal_From_Source (Ctxt, Expr, Tok_Real); - else - Disp_Fp64 (Ctxt, Get_Fp_Value (Expr)); - end if; - end if; - when Iir_Kind_String_Literal8 => - Orig := Get_Literal_Origin (Expr); - if Dump_Origin_Flag and then Orig /= Null_Iir then - Print (Ctxt, Orig); - else - declare - Expr_Type : constant Iir := Get_Type (Expr); - El_Type : Iir; - begin - if Expr_Type /= Null_Iir then - El_Type := Get_Element_Subtype (Expr_Type); - else - El_Type := Null_Iir; - end if; - Disp_String_Literal (Ctxt, Expr, El_Type); - if Flag_Disp_String_Literal_Type or Flags.List_Verbose then - Put ("[type: "); - Disp_Type (Ctxt, Expr_Type); - Put ("]"); - end if; - end; - end if; - when Iir_Kind_Physical_Fp_Literal - | Iir_Kind_Physical_Int_Literal => - Orig := Get_Literal_Origin (Expr); - if Dump_Origin_Flag and then Orig /= Null_Iir then - Print (Ctxt, Orig); - else - Disp_Physical_Literal (Ctxt, Expr); - end if; - when Iir_Kind_Enumeration_Literal => - Orig := Get_Literal_Origin (Expr); - if Dump_Origin_Flag and then Orig /= Null_Iir then - Print (Ctxt, Orig); - else - Disp_Name_Of (Ctxt, Expr); - end if; - when Iir_Kind_Overflow_Literal => - Orig := Get_Literal_Origin (Expr); - if Dump_Origin_Flag and then Orig /= Null_Iir then - Print (Ctxt, Orig); - else - Put ("*OVERFLOW*"); - end if; - - when Iir_Kind_Object_Alias_Declaration => - Disp_Name_Of (Ctxt, Expr); - when Iir_Kind_Aggregate => - Disp_Aggregate (Ctxt, Expr); - when Iir_Kind_Null_Literal => - Disp_Token (Ctxt, Tok_Null); - when Iir_Kind_Simple_Aggregate => - Orig := Get_Literal_Origin (Expr); - if Dump_Origin_Flag and then Orig /= Null_Iir then - Print (Ctxt, Orig); - else - Disp_Simple_Aggregate (Ctxt, Expr); - end if; - - when Iir_Kind_Attribute_Value => - Disp_Attribute_Value (Ctxt, Expr); - when Iir_Kind_Attribute_Name => - Disp_Attribute_Name (Ctxt, Expr); - - when Iir_Kind_Element_Declaration => - Disp_Name_Of (Ctxt, Expr); - - when Iir_Kind_Signal_Declaration - | Iir_Kind_Guard_Signal_Declaration - | Iir_Kind_File_Declaration - | Iir_Kind_Iterator_Declaration => - Disp_Name_Of (Ctxt, Expr); - return; - when Iir_Kind_Reference_Name => - declare - Name : constant Iir := Get_Referenced_Name (Expr); - begin - if Is_Valid (Name) then - Print (Ctxt, Name); - else - Print (Ctxt, Get_Named_Entity (Expr)); - end if; - end; - - when Iir_Kinds_Dyadic_Operator => - Disp_Dyadic_Operator (Ctxt, Expr); - when Iir_Kinds_Monadic_Operator => - Disp_Monadic_Operator (Ctxt, Expr); - when Iir_Kind_Function_Call => - Disp_Function_Call (Ctxt, Expr); - when Iir_Kind_Parenthesis_Expression => - Disp_Token (Ctxt, Tok_Left_Paren); - Print (Ctxt, Get_Expression (Expr)); - Disp_Token (Ctxt, Tok_Right_Paren); - when Iir_Kind_Type_Conversion => - Print (Ctxt, Get_Type_Mark (Expr)); - Disp_Token (Ctxt, Tok_Left_Paren); - Print (Ctxt, Get_Expression (Expr)); - Disp_Token (Ctxt, Tok_Right_Paren); - when Iir_Kind_Qualified_Expression => - declare - Qexpr : constant Iir := Get_Expression (Expr); - Has_Paren : constant Boolean := - Get_Kind (Qexpr) = Iir_Kind_Parenthesis_Expression - or else Get_Kind (Qexpr) = Iir_Kind_Aggregate; - begin - Print (Ctxt, Get_Type_Mark (Expr)); - Disp_Token (Ctxt, Tok_Tick); - if not Has_Paren then - Disp_Token (Ctxt, Tok_Left_Paren); - end if; - Print (Ctxt, Qexpr); - if not Has_Paren then - Disp_Token (Ctxt, Tok_Right_Paren); - end if; - end; - when Iir_Kind_Allocator_By_Expression => - Disp_Token (Ctxt, Tok_New); - Print (Ctxt, Get_Expression (Expr)); - when Iir_Kind_Allocator_By_Subtype => - Disp_Token (Ctxt, Tok_New); - Disp_Subtype_Indication (Ctxt, Get_Subtype_Indication (Expr)); - - when Iir_Kind_Indexed_Name => - Disp_Indexed_Name (Ctxt, Expr); - when Iir_Kind_Slice_Name => - Print (Ctxt, Get_Prefix (Expr)); - Disp_Token (Ctxt, Tok_Left_Paren); - Disp_Range (Ctxt, Get_Suffix (Expr)); - Disp_Token (Ctxt, Tok_Right_Paren); - when Iir_Kind_Selected_Element => - Print (Ctxt, Get_Prefix (Expr)); - Disp_Token (Ctxt, Tok_Dot); - Disp_Name_Of (Ctxt, Get_Named_Entity (Expr)); - when Iir_Kind_Implicit_Dereference => - Print (Ctxt, Get_Prefix (Expr)); - - when Iir_Kind_Left_Type_Attribute => - Disp_Name_Attribute (Ctxt, Expr, Name_Left); - when Iir_Kind_Right_Type_Attribute => - Disp_Name_Attribute (Ctxt, Expr, Name_Right); - when Iir_Kind_High_Type_Attribute => - Disp_Name_Attribute (Ctxt, Expr, Name_High); - when Iir_Kind_Low_Type_Attribute => - Disp_Name_Attribute (Ctxt, Expr, Name_Low); - when Iir_Kind_Ascending_Type_Attribute => - Disp_Name_Attribute (Ctxt, Expr, Name_Ascending); - - when Iir_Kind_Stable_Attribute => - Disp_Parametered_Attribute (Ctxt, Name_Stable, Expr); - when Iir_Kind_Quiet_Attribute => - Disp_Parametered_Attribute (Ctxt, Name_Quiet, Expr); - when Iir_Kind_Delayed_Attribute => - Disp_Parametered_Attribute (Ctxt, Name_Delayed, Expr); - when Iir_Kind_Transaction_Attribute => - Disp_Name_Attribute (Ctxt, Expr, Name_Transaction); - when Iir_Kind_Event_Attribute => - Disp_Name_Attribute (Ctxt, Expr, Name_Event); - when Iir_Kind_Active_Attribute => - Disp_Name_Attribute (Ctxt, Expr, Name_Active); - when Iir_Kind_Driving_Attribute => - Disp_Name_Attribute (Ctxt, Expr, Name_Driving); - when Iir_Kind_Driving_Value_Attribute => - Disp_Name_Attribute (Ctxt, Expr, Name_Driving_Value); - when Iir_Kind_Last_Value_Attribute => - Disp_Name_Attribute (Ctxt, Expr, Name_Last_Value); - when Iir_Kind_Last_Active_Attribute => - Disp_Name_Attribute (Ctxt, Expr, Name_Last_Active); - when Iir_Kind_Last_Event_Attribute => - Disp_Name_Attribute (Ctxt, Expr, Name_Last_Event); - - when Iir_Kind_Pos_Attribute => - Disp_Parametered_Type_Attribute (Ctxt, Name_Pos, Expr); - when Iir_Kind_Val_Attribute => - Disp_Parametered_Type_Attribute (Ctxt, Name_Val, Expr); - when Iir_Kind_Succ_Attribute => - Disp_Parametered_Type_Attribute (Ctxt, Name_Succ, Expr); - when Iir_Kind_Pred_Attribute => - Disp_Parametered_Type_Attribute (Ctxt, Name_Pred, Expr); - when Iir_Kind_Leftof_Attribute => - Disp_Parametered_Type_Attribute (Ctxt, Name_Leftof, Expr); - when Iir_Kind_Rightof_Attribute => - Disp_Parametered_Type_Attribute (Ctxt, Name_Rightof, Expr); - - when Iir_Kind_Length_Array_Attribute => - Disp_Parametered_Attribute (Ctxt, Name_Length, Expr); - when Iir_Kind_Range_Array_Attribute => - Disp_Parametered_Attribute (Ctxt, Name_Range, Expr); - when Iir_Kind_Reverse_Range_Array_Attribute => - Disp_Parametered_Attribute (Ctxt, Name_Reverse_Range, Expr); - when Iir_Kind_Left_Array_Attribute => - Disp_Parametered_Attribute (Ctxt, Name_Left, Expr); - when Iir_Kind_Right_Array_Attribute => - Disp_Parametered_Attribute (Ctxt, Name_Right, Expr); - when Iir_Kind_Low_Array_Attribute => - Disp_Parametered_Attribute (Ctxt, Name_Low, Expr); - when Iir_Kind_High_Array_Attribute => - Disp_Parametered_Attribute (Ctxt, Name_High, Expr); - when Iir_Kind_Ascending_Array_Attribute => - Disp_Parametered_Attribute (Ctxt, Name_Ascending, Expr); - - when Iir_Kind_Image_Attribute => - Disp_Parametered_Attribute (Ctxt, Name_Image, Expr); - when Iir_Kind_Value_Attribute => - Disp_Parametered_Attribute (Ctxt, Name_Value, Expr); - when Iir_Kind_Simple_Name_Attribute => - Disp_Name_Attribute (Ctxt, Expr, Name_Simple_Name); - when Iir_Kind_Instance_Name_Attribute => - Disp_Name_Attribute (Ctxt, Expr, Name_Instance_Name); - when Iir_Kind_Path_Name_Attribute => - Disp_Name_Attribute (Ctxt, Expr, Name_Path_Name); - - when Iir_Kinds_Type_And_Subtype_Definition => - Disp_Type (Ctxt, Expr); - - when Iir_Kind_Range_Expression => - Disp_Range (Ctxt, Expr); - - when Iir_Kind_Selected_By_All_Name - | Iir_Kind_Dereference => - Print (Ctxt, Get_Prefix (Expr)); - Disp_Token (Ctxt, Tok_Dot, Tok_All); - when Iir_Kind_Simple_Name - | Iir_Kind_Character_Literal => - Disp_Identifier (Ctxt, Expr); - when Iir_Kind_Operator_Symbol => - Disp_Function_Name (Ctxt, Expr); - when Iir_Kind_Selected_Name => - Print (Ctxt, Get_Prefix (Expr)); - Disp_Token (Ctxt, Tok_Dot); - Disp_Function_Name (Ctxt, Expr); - when Iir_Kind_Parenthesis_Name => - Print (Ctxt, Get_Prefix (Expr)); - Disp_Association_Chain (Ctxt, Get_Association_Chain (Expr)); - when Iir_Kind_Base_Attribute => - Disp_Name_Attribute (Ctxt, Expr, Name_Base); - when Iir_Kind_Subtype_Attribute => - Disp_Name_Attribute (Ctxt, Expr, Name_Subtype); - when Iir_Kind_Type_Declaration - | Iir_Kind_Subtype_Declaration - | Iir_Kind_Unit_Declaration - | Iir_Kinds_Interface_Object_Declaration - | Iir_Kind_Variable_Declaration - | Iir_Kind_Constant_Declaration - | Iir_Kind_Function_Declaration - | Iir_Kind_Procedure_Declaration - | Iir_Kind_Terminal_Declaration - | Iir_Kind_Component_Declaration - | Iir_Kind_Group_Template_Declaration => - Disp_Name_Of (Ctxt, Expr); - - when Iir_Kind_Signature => - Disp_Signature (Ctxt, Expr); - - when others => - Error_Kind ("print", Expr); - end case; - end Print; - - procedure Disp_Block_Header - (Ctxt : in out Ctxt_Class; Header : Iir_Block_Header) - is - Chain : Iir; - begin - if Header = Null_Iir then - return; - end if; - Chain := Get_Generic_Chain (Header); - if Chain /= Null_Iir then - Disp_Generics (Ctxt, Header); - - Chain := Get_Generic_Map_Aspect_Chain (Header); - if Chain /= Null_Iir then - Start_Hbox (Ctxt); - Disp_Generic_Map_Aspect (Ctxt, Header); - Disp_Token (Ctxt, Tok_Semi_Colon); - Close_Hbox (Ctxt); - end if; - end if; - Chain := Get_Port_Chain (Header); - if Chain /= Null_Iir then - Disp_Ports (Ctxt, Header); - - Chain := Get_Port_Map_Aspect_Chain (Header); - if Chain /= Null_Iir then - Start_Hbox (Ctxt); - Disp_Port_Map_Aspect (Ctxt, Header); - Disp_Token (Ctxt, Tok_Semi_Colon); - Close_Hbox (Ctxt); - end if; - end if; - end Disp_Block_Header; - - procedure Disp_Block_Statement - (Ctxt : in out Ctxt_Class; Block: Iir_Block_Statement) - is - Sensitivity: Iir_List; - Guard : Iir_Guard_Signal_Declaration; - begin - Start_Hbox (Ctxt); - Disp_Label (Ctxt, Block); - Disp_Token (Ctxt, Tok_Block); - Guard := Get_Guard_Decl (Block); - if Guard /= Null_Iir then - Disp_Token (Ctxt, Tok_Left_Paren); - Print (Ctxt, Get_Guard_Expression (Guard)); - Disp_Token (Ctxt, Tok_Right_Paren); - end if; - if Get_Has_Is (Block) then - Disp_Token (Ctxt, Tok_Is); - end if; - Close_Hbox (Ctxt); - - if Flags.List_Verbose and then Guard /= Null_Iir then - Sensitivity := Get_Guard_Sensitivity_List (Guard); - if Sensitivity /= Null_Iir_List then - Put ("-- guard sensitivity list "); - Disp_Designator_List (Ctxt, Sensitivity); - end if; - end if; - - Start_Vbox (Ctxt); - Disp_Block_Header (Ctxt, Get_Block_Header (Block)); - Disp_Declaration_Chain (Ctxt, Block); - Close_Vbox (Ctxt); - - Start_Hbox (Ctxt); - Disp_Token (Ctxt, Tok_Begin); - Close_Hbox (Ctxt); - - Start_Vbox (Ctxt); - Disp_Concurrent_Statement_Chain (Ctxt, Block); - Close_Vbox (Ctxt); - - Disp_End (Ctxt, Block, Tok_Block); - end Disp_Block_Statement; - - procedure Disp_Generate_Statement_Body (Ctxt : in out Ctxt_Class; Bod : Iir) - is - Has_Beg : constant Boolean := Get_Has_Begin (Bod); - Has_End : constant Boolean := Get_Has_End (Bod); - begin - Disp_Declaration_Chain (Ctxt, Bod); - if Has_Beg then - Start_Hbox (Ctxt); - Disp_Token (Ctxt, Tok_Begin); - Close_Hbox (Ctxt); - end if; - - if Has_Beg or Has_End then - Start_Vbox (Ctxt); - end if; - Disp_Concurrent_Statement_Chain (Ctxt, Bod); - if Has_Beg or Has_End then - Close_Vbox (Ctxt); - end if; - - if Has_End then - Start_Hbox (Ctxt); - Disp_Token (Ctxt, Tok_End); - if Get_End_Has_Identifier (Bod) then - Disp_Ident (Ctxt, Get_Alternative_Label (Bod)); - end if; - Disp_Token (Ctxt, Tok_Semi_Colon); - Close_Hbox (Ctxt); - end if; - end Disp_Generate_Statement_Body; - - procedure Disp_For_Generate_Statement - (Ctxt : in out Ctxt_Class; Stmt : Iir) is - begin - Start_Hbox (Ctxt); - Disp_Label (Ctxt, Stmt); - Disp_Token (Ctxt, Tok_For); - Disp_Parameter_Specification (Ctxt, Get_Parameter_Specification (Stmt)); - Disp_Token (Ctxt, Tok_Generate); - Close_Hbox (Ctxt); - - Start_Vbox (Ctxt); - Disp_Generate_Statement_Body - (Ctxt, Get_Generate_Statement_Body (Stmt)); - Close_Vbox (Ctxt); - - Disp_End (Ctxt, Stmt, Tok_Generate); - end Disp_For_Generate_Statement; - - procedure Disp_If_Generate_Statement (Ctxt : in out Ctxt_Class; Stmt : Iir) - is - Bod : Iir; - Clause : Iir; - Cond : Iir; - begin - Start_Hbox (Ctxt); - Disp_Label (Ctxt, Stmt); - Disp_Token (Ctxt, Tok_If); - Cond := Get_Condition (Stmt); - Clause := Stmt; - loop - Bod := Get_Generate_Statement_Body (Clause); - if Get_Has_Label (Bod) then - Disp_Ident (Ctxt, Get_Alternative_Label (Bod)); - Disp_Token (Ctxt, Tok_Colon); - end if; - if Cond /= Null_Iir then - Print (Ctxt, Cond); - end if; - Disp_Token (Ctxt, Tok_Generate); - Close_Hbox (Ctxt); - - Start_Vbox (Ctxt); - Disp_Generate_Statement_Body (Ctxt, Bod); - Close_Vbox (Ctxt); - - Clause := Get_Generate_Else_Clause (Clause); - exit when Clause = Null_Iir; - - Start_Hbox (Ctxt); - Cond := Get_Condition (Clause); - if Cond = Null_Iir then - Disp_Token (Ctxt, Tok_Else); - else - Disp_Token (Ctxt, Tok_Elsif); - end if; - end loop; - Disp_End (Ctxt, Stmt, Tok_Generate); - end Disp_If_Generate_Statement; - - procedure Disp_Case_Generate_Statement - (Ctxt : in out Ctxt_Class; Stmt : Iir) - is - Bod : Iir; - Assoc : Iir; - begin - Start_Hbox (Ctxt); - Disp_Label (Ctxt, Stmt); - Disp_Token (Ctxt, Tok_Case); - Print (Ctxt, Get_Expression (Stmt)); - Disp_Token (Ctxt, Tok_Generate); - Close_Hbox (Ctxt); - - Start_Vbox (Ctxt); - Assoc := Get_Case_Statement_Alternative_Chain (Stmt); - while Assoc /= Null_Iir loop - Start_Hbox (Ctxt); - Disp_Token (Ctxt, Tok_When); - Bod := Get_Associated_Block (Assoc); - if Get_Has_Label (Bod) then - Disp_Ident (Ctxt, Get_Alternative_Label (Bod)); - Disp_Token (Ctxt, Tok_Colon); - end if; - Disp_Choice (Ctxt, Assoc); - Disp_Token (Ctxt, Tok_Double_Arrow); - Close_Hbox (Ctxt); - - Start_Vbox (Ctxt); - Disp_Generate_Statement_Body (Ctxt, Bod); - Close_Vbox (Ctxt); - end loop; - Close_Vbox (Ctxt); - Disp_End (Ctxt, Stmt, Tok_Generate); - end Disp_Case_Generate_Statement; - - procedure Disp_PSL_NFA (Ctxt : in out Ctxt_Class; N : PSL.Nodes.NFA) - is - use PSL.NFAs; - - procedure Disp_State (S : NFA_State) is - Str : constant String := Int32'Image (Get_State_Label (S)); - begin - Put (Str (2 .. Str'Last)); - end Disp_State; - - S : NFA_State; - E : NFA_Edge; - begin - if N /= No_NFA then - Put ("-- start: "); - Disp_State (Get_Start_State (N)); - Put (", final: "); - Disp_State (Get_Final_State (N)); - New_Line; - - S := Get_First_State (N); - while S /= No_State loop - E := Get_First_Src_Edge (S); - while E /= No_Edge loop - Put ("-- "); - Disp_State (S); - Put (" -> "); - Disp_State (Get_Edge_Dest (E)); - Put (": "); - Disp_Psl_Expression (Ctxt, Get_Edge_Expr (E)); - New_Line; - E := Get_Next_Src_Edge (E); - end loop; - S := Get_Next_State (S); - end loop; - end if; - end Disp_PSL_NFA; - - procedure Disp_Psl_Assert_Statement - (Ctxt : in out Ctxt_Class; Stmt : Iir) is - begin - Start_Hbox (Ctxt); - if Vhdl_Std < Vhdl_08 then - Put ("--psl "); - end if; - Disp_Label (Ctxt, Stmt); - Disp_Postponed (Ctxt, Stmt); - Disp_Token (Ctxt, Tok_Assert); - Disp_Psl_Expression (Ctxt, Get_Psl_Property (Stmt)); - Disp_Report_Expression (Ctxt, Stmt); - Disp_Severity_Expression (Ctxt, Stmt); - Disp_Token (Ctxt, Tok_Semi_Colon); - Close_Hbox (Ctxt); - Disp_PSL_NFA (Get_PSL_NFA (Stmt)); - end Disp_Psl_Assert_Statement; - - procedure Disp_Psl_Cover_Statement - (Ctxt : in out Ctxt_Class; Stmt : Iir) is - begin - Put ("--psl "); - Disp_Label (Ctxt, Stmt); - Put ("cover "); - Disp_Psl_Sequence (Ctxt, Get_Psl_Sequence (Stmt)); - Put_Line (";"); - Disp_PSL_NFA (Get_PSL_NFA (Stmt)); - end Disp_Psl_Cover_Statement; - - procedure Disp_Simple_Simultaneous_Statement - (Ctxt : in out Ctxt_Class; Stmt : Iir) is - begin - Start_Hbox (Ctxt); - Disp_Label (Ctxt, Stmt); - Print (Ctxt, Get_Simultaneous_Left (Stmt)); - Disp_Token (Ctxt, Tok_Equal_Equal); - Print (Ctxt, Get_Simultaneous_Right (Stmt)); - Disp_Token (Ctxt, Tok_Semi_Colon); - Close_Hbox (Ctxt); - end Disp_Simple_Simultaneous_Statement; - - procedure Disp_Concurrent_Statement (Ctxt : in out Ctxt_Class; Stmt: Iir) is - begin - case Get_Kind (Stmt) is - when Iir_Kind_Concurrent_Simple_Signal_Assignment => - Disp_Concurrent_Simple_Signal_Assignment (Ctxt, Stmt); - when Iir_Kind_Concurrent_Conditional_Signal_Assignment => - Disp_Concurrent_Conditional_Signal_Assignment (Ctxt, Stmt); - when Iir_Kind_Concurrent_Selected_Signal_Assignment => - Disp_Concurrent_Selected_Signal_Assignment (Ctxt, Stmt); - when Iir_Kind_Sensitized_Process_Statement - | Iir_Kind_Process_Statement => - Disp_Process_Statement (Ctxt, Stmt); - when Iir_Kind_Concurrent_Assertion_Statement => - Disp_Assertion_Statement (Ctxt, Stmt); - when Iir_Kind_Component_Instantiation_Statement => - Disp_Component_Instantiation_Statement (Ctxt, Stmt); - when Iir_Kind_Concurrent_Procedure_Call_Statement => - Disp_Procedure_Call (Ctxt, Stmt); - when Iir_Kind_Block_Statement => - Disp_Block_Statement (Ctxt, Stmt); - when Iir_Kind_If_Generate_Statement => - Disp_If_Generate_Statement (Ctxt, Stmt); - when Iir_Kind_Case_Generate_Statement => - Disp_Case_Generate_Statement (Ctxt, Stmt); - when Iir_Kind_For_Generate_Statement => - Disp_For_Generate_Statement (Ctxt, Stmt); - when Iir_Kind_Psl_Default_Clock => - Disp_Psl_Default_Clock (Ctxt, Stmt); - when Iir_Kind_Psl_Declaration - | Iir_Kind_Psl_Endpoint_Declaration => - Disp_Psl_Declaration (Ctxt, Stmt); - when Iir_Kind_Psl_Assert_Statement => - Disp_Psl_Assert_Statement (Ctxt, Stmt); - when Iir_Kind_Psl_Cover_Statement => - Disp_Psl_Cover_Statement (Ctxt, Stmt); - when Iir_Kind_Simple_Simultaneous_Statement => - Disp_Simple_Simultaneous_Statement (Ctxt, Stmt); - when others => - Error_Kind ("disp_concurrent_statement", Stmt); - end case; - end Disp_Concurrent_Statement; - - procedure Disp_Package_Declaration - (Ctxt : in out Ctxt_Class; Decl: Iir_Package_Declaration) - is - Header : constant Iir := Get_Package_Header (Decl); - begin - Start_Hbox (Ctxt); - Disp_Token (Ctxt, Tok_Package); - Disp_Identifier (Ctxt, Decl); - Disp_Token (Ctxt, Tok_Is); - Close_Hbox (Ctxt); - Start_Vbox (Ctxt); - if Header /= Null_Iir then - Disp_Generics (Ctxt, Header); - end if; - Disp_Declaration_Chain (Ctxt, Decl); - Close_Vbox (Ctxt); - Disp_End (Ctxt, Decl, Tok_Package); - end Disp_Package_Declaration; - - procedure Disp_Package_Body (Ctxt : in out Ctxt_Class; Decl: Iir) is - begin - Start_Hbox (Ctxt); - Disp_Token (Ctxt, Tok_Package, Tok_Body); - Disp_Identifier (Ctxt, Decl); - Disp_Token (Ctxt, Tok_Is); - Close_Hbox (Ctxt); - Start_Vbox (Ctxt); - Disp_Declaration_Chain (Ctxt, Decl); - Close_Vbox (Ctxt); - Disp_End (Ctxt, Decl, Tok_Package, Tok_Body); - end Disp_Package_Body; - - procedure Disp_Package_Instantiation_Declaration - (Ctxt : in out Ctxt_Class; Decl: Iir) is - begin - Start_Hbox (Ctxt); - Disp_Token (Ctxt, Tok_Package); - Disp_Identifier (Ctxt, Decl); - Disp_Token (Ctxt, Tok_Is, Tok_New); - Print (Ctxt, Get_Uninstantiated_Package_Name (Decl)); - Disp_Generic_Map_Aspect (Ctxt, Decl); - Disp_Token (Ctxt, Tok_Semi_Colon); - Close_Hbox (Ctxt); - end Disp_Package_Instantiation_Declaration; - - procedure Disp_Binding_Indication (Ctxt : in out Ctxt_Class; Bind : Iir) - is - El : Iir; - begin - El := Get_Entity_Aspect (Bind); - if El /= Null_Iir then - Disp_Token (Ctxt, Tok_Use); - Disp_Entity_Aspect (Ctxt, El); - end if; - El := Get_Generic_Map_Aspect_Chain (Bind); - if El /= Null_Iir then - Disp_Generic_Map_Aspect (Ctxt, Bind); - end if; - El := Get_Port_Map_Aspect_Chain (Bind); - if El /= Null_Iir then - Disp_Port_Map_Aspect (Ctxt, Bind); - end if; - end Disp_Binding_Indication; - - procedure Disp_Component_Configuration - (Ctxt : in out Ctxt_Class; Conf : Iir_Component_Configuration) - is - Block : Iir_Block_Configuration; - Binding : Iir; - begin - Start_Hbox (Ctxt); - Disp_Token (Ctxt, Tok_For); - Disp_Instantiation_List (Ctxt, Get_Instantiation_List (Conf)); - Disp_Token (Ctxt, Tok_Colon); - Print (Ctxt, Get_Component_Name (Conf)); - Close_Hbox (Ctxt); - - Start_Vbox (Ctxt); - Binding := Get_Binding_Indication (Conf); - if Binding /= Null_Iir then - Start_Hbox (Ctxt); - Disp_Binding_Indication (Ctxt, Binding); - Disp_Token (Ctxt, Tok_Semi_Colon); - Close_Hbox (Ctxt); - end if; - Block := Get_Block_Configuration (Conf); - if Block /= Null_Iir then - Disp_Block_Configuration (Ctxt, Block); - end if; - Close_Vbox (Ctxt); - - Disp_End (Ctxt, Tok_For); - end Disp_Component_Configuration; - - procedure Disp_Configuration_Items - (Ctxt : in out Ctxt_Class; Conf : Iir_Block_Configuration) - is - El : Iir; - begin - El := Get_Configuration_Item_Chain (Conf); - while El /= Null_Iir loop - case Get_Kind (El) is - when Iir_Kind_Block_Configuration => - Disp_Block_Configuration (Ctxt, El); - when Iir_Kind_Component_Configuration => - Disp_Component_Configuration (Ctxt, El); - when Iir_Kind_Configuration_Specification => - -- This may be created by canon. - Disp_Configuration_Specification (Ctxt, El); - Put_Line ("end for;"); - when others => - Error_Kind ("disp_configuration_item_list", El); - end case; - El := Get_Chain (El); - end loop; - end Disp_Configuration_Items; - - procedure Disp_Block_Configuration - (Ctxt : in out Ctxt_Class; Block: Iir_Block_Configuration) - is - Spec : Iir; - begin - Start_Hbox (Ctxt); - Disp_Token (Ctxt, Tok_For); - Spec := Get_Block_Specification (Block); - case Get_Kind (Spec) is - when Iir_Kind_Block_Statement - | Iir_Kind_If_Generate_Statement - | Iir_Kind_For_Generate_Statement - | Iir_Kind_Architecture_Body => - Disp_Name_Of (Ctxt, Spec); - when Iir_Kind_Indexed_Name => - declare - Index_List : constant Iir_Flist := Get_Index_List (Spec); - begin - Disp_Name_Of (Ctxt, Get_Prefix (Spec)); - Disp_Token (Ctxt, Tok_Left_Paren); - if Index_List = Iir_Flist_Others then - Put ("others"); - else - Print (Ctxt, Get_Nth_Element (Index_List, 0)); - end if; - Disp_Token (Ctxt, Tok_Right_Paren); - end; - when Iir_Kind_Slice_Name => - Disp_Name_Of (Ctxt, Get_Prefix (Spec)); - Disp_Token (Ctxt, Tok_Left_Paren); - Disp_Range (Ctxt, Get_Suffix (Spec)); - Disp_Token (Ctxt, Tok_Right_Paren); - when Iir_Kind_Simple_Name - | Iir_Kind_Parenthesis_Name => - Print (Ctxt, Spec); - when others => - Error_Kind ("disp_block_configuration", Spec); - end case; - Close_Hbox (Ctxt); - - Start_Vbox (Ctxt); - Disp_Declaration_Chain (Ctxt, Block); - Disp_Configuration_Items (Ctxt, Block); - Close_Vbox (Ctxt); - Disp_End (Ctxt, Tok_For); - end Disp_Block_Configuration; - - procedure Disp_Configuration_Declaration - (Ctxt : in out Ctxt_Class; Decl: Iir_Configuration_Declaration) is - begin - Start_Hbox (Ctxt); - Disp_Token (Ctxt, Tok_Configuration); - Disp_Name_Of (Ctxt, Decl); - Disp_Token (Ctxt, Tok_Of); - Print (Ctxt, Get_Entity_Name (Decl)); - Disp_Token (Ctxt, Tok_Is); - Close_Hbox (Ctxt); - - Start_Vbox (Ctxt); - Disp_Declaration_Chain (Ctxt, Decl); - Disp_Block_Configuration (Ctxt, Get_Block_Configuration (Decl)); - Close_Vbox (Ctxt); - - Disp_End (Ctxt, Decl, Tok_Configuration); - end Disp_Configuration_Declaration; - - procedure Disp_Context_Items (Ctxt : in out Ctxt_Class; First : Iir) - is - Decl: Iir; - Next_Decl : Iir; - begin - Decl := First; - while Decl /= Null_Iir loop - Next_Decl := Get_Chain (Decl); - - case Iir_Kinds_Clause (Get_Kind (Decl)) is - when Iir_Kind_Use_Clause => - Disp_Use_Clause (Ctxt, Decl); - when Iir_Kind_Library_Clause => - Start_Hbox (Ctxt); - Disp_Token (Ctxt, Tok_Library); - Disp_Identifier (Ctxt, Decl); - while Get_Has_Identifier_List (Decl) loop - Decl := Next_Decl; - Next_Decl := Get_Chain (Decl); - Disp_Token (Ctxt, Tok_Comma); - Disp_Identifier (Ctxt, Decl); - end loop; - Disp_Token (Ctxt, Tok_Semi_Colon); - Close_Hbox (Ctxt); - when Iir_Kind_Context_Reference => - Start_Hbox (Ctxt); - Disp_Token (Ctxt, Tok_Context); - declare - Ref : Iir; - begin - Ref := Decl; - loop - Print (Ctxt, Get_Selected_Name (Ref)); - Ref := Get_Context_Reference_Chain (Ref); - exit when Ref = Null_Iir; - Disp_Token (Ctxt, Tok_Comma); - end loop; - Disp_Token (Ctxt, Tok_Semi_Colon); - end; - Close_Hbox (Ctxt); - end case; - Decl := Next_Decl; - end loop; - end Disp_Context_Items; - - procedure Disp_Context_Declaration (Ctxt : in out Ctxt_Class; Decl: Iir) is - begin - Start_Hbox (Ctxt); - Disp_Token (Ctxt, Tok_Context); - Disp_Name_Of (Ctxt, Decl); - Disp_Token (Ctxt, Tok_Is); - Close_Hbox (Ctxt); - Start_Vbox (Ctxt); - Disp_Context_Items (Ctxt, Get_Context_Items (Decl)); - Close_Vbox (Ctxt); - Disp_End (Ctxt, Decl, Tok_Context); - end Disp_Context_Declaration; - - procedure Disp_Design_Unit (Ctxt : in out Ctxt_Class; Unit: Iir_Design_Unit) - is - Decl: Iir; - begin - Disp_Context_Items (Ctxt, Get_Context_Items (Unit)); - - Decl := Get_Library_Unit (Unit); - case Iir_Kinds_Library_Unit (Get_Kind (Decl)) is - when Iir_Kind_Entity_Declaration => - Disp_Entity_Declaration (Ctxt, Decl); - when Iir_Kind_Architecture_Body => - Disp_Architecture_Body (Ctxt, Decl); - when Iir_Kind_Package_Declaration => - Disp_Package_Declaration (Ctxt, Decl); - when Iir_Kind_Package_Body => - Disp_Package_Body (Ctxt, Decl); - when Iir_Kind_Package_Instantiation_Declaration => - Disp_Package_Instantiation_Declaration (Ctxt, Decl); - when Iir_Kind_Configuration_Declaration => - Disp_Configuration_Declaration (Ctxt, Decl); - when Iir_Kind_Context_Declaration => - Disp_Context_Declaration (Ctxt, Decl); - end case; - end Disp_Design_Unit; - - procedure Disp_Vhdl (Ctxt : in out Ctxt_Class; N : Iir) is - begin - case Get_Kind (N) is - when Iir_Kind_Design_File => - declare - Unit : Iir; - begin - Unit := Get_First_Design_Unit (N); - while Unit /= Null_Iir loop - Disp_Vhdl (Ctxt, Unit); - Unit := Get_Chain (Unit); - end loop; - end; - when Iir_Kind_Design_Unit => - Disp_Design_Unit (Ctxt, N); - when Iir_Kind_Enumeration_Type_Definition => - Disp_Enumeration_Type_Definition (Ctxt, N); - when Iir_Kind_Concurrent_Conditional_Signal_Assignment => - Disp_Concurrent_Conditional_Signal_Assignment (Ctxt, N); - when Iir_Kinds_Dyadic_Operator => - Disp_Dyadic_Operator (Ctxt, N); - when Iir_Kind_Interface_Signal_Declaration - | Iir_Kind_Signal_Declaration - | Iir_Kind_Object_Alias_Declaration => - Disp_Name_Of (Ctxt, N); - when Iir_Kind_Enumeration_Literal => - Disp_Identifier (Ctxt, N); - when Iir_Kind_Component_Instantiation_Statement => - Disp_Component_Instantiation_Statement (Ctxt, N); - when Iir_Kind_Array_Type_Definition => - Disp_Array_Type_Definition (Ctxt, N); - when Iir_Kind_Package_Declaration => - Disp_Package_Declaration (Ctxt, N); - when Iir_Kind_Wait_Statement => - Disp_Wait_Statement (Ctxt, N); - when Iir_Kind_Selected_Name - | Iir_Kind_Selected_Element - | Iir_Kind_Indexed_Name - | Iir_Kind_Slice_Name => - Print (Ctxt, N); - when Iir_Kind_Psl_Cover_Statement => - Disp_Psl_Cover_Statement (Ctxt, N); - when others => - Error_Kind ("disp", N); - end case; - end Disp_Vhdl; - - procedure Disp_Int_Trim (Ctxt : in out Ctxt_Class; Str : String) is - begin - Start_Lit (Ctxt, Tok_Integer); - if Str (Str'First) = ' ' then - Disp_Str (Ctxt, Str (Str'First + 1 .. Str'Last)); - else - Disp_Str (Ctxt, Str); - end if; - Close_Lit (Ctxt); - end Disp_Int_Trim; - - procedure Disp_Int64 (Ctxt : in out Ctxt_Class; Val: Int64) is - begin - Disp_Int_Trim (Ctxt, Int64'Image (Val)); - end Disp_Int64; - - procedure Disp_Int32 (Ctxt : in out Ctxt_Class; Val: Iir_Int32) is - begin - Disp_Int_Trim (Ctxt, Iir_Int32'Image (Val)); - end Disp_Int32; - - procedure Disp_Fp64 (Ctxt : in out Ctxt_Class; Val: Fp64) - is - Str: constant String := Fp64'Image (Val); - begin - Start_Lit (Ctxt, Tok_Real); - if Str (Str'First) = ' ' then - Disp_Str (Ctxt, Str (Str'First + 1 .. Str'Last)); - else - Disp_Str (Ctxt, Str); - end if; - Close_Lit (Ctxt); - end Disp_Fp64; - - procedure Disp_Str (Ctxt : in out Ctxt_Class; Str : String) is - begin - for I in Str'Range loop - Disp_Char (Ctxt, Str (I)); - end loop; - end Disp_Str; - - - function Need_Space (Tok, Prev_Tok : Token_Type) return Boolean is - begin - if Prev_Tok = Tok_Newline then - return False; - elsif Prev_Tok >= Tok_First_Keyword then - -- A space after a keyword. - if Tok /= Tok_Semi_Colon - and Tok /= Tok_Dot - then - return True; - end if; - elsif Tok >= Tok_First_Keyword then - -- Space before a keyword. - if Prev_Tok /= Tok_Dot - and Prev_Tok /= Tok_Left_Paren - then - return True; - end if; - elsif (Tok = Tok_Identifier - or Tok = Tok_String) - and (Prev_Tok = Tok_Identifier - or Prev_Tok = Tok_String - or Prev_Tok = Tok_Integer - or Prev_Tok = Tok_Real) - then - -- A space is needed between 2 identifiers. - return True; - elsif Prev_Tok = Tok_Comma - or Prev_Tok = Tok_Semi_Colon - or Prev_Tok = Tok_Colon - or Prev_Tok = Tok_Assign - or Prev_Tok = Tok_Double_Arrow - or Prev_Tok in Token_Relational_Operator_Type - or Prev_Tok in Token_Adding_Operator_Type - or Prev_Tok in Token_Multiplying_Operator_Type - or Prev_Tok = Tok_Bar - then - -- Always a space after ',', ':', ':=' - return True; - elsif Tok = Tok_Left_Paren then - if Prev_Tok /= Tok_Tick and Prev_Tok /= Tok_Left_Paren then - -- A space before '('. - return True; - end if; - elsif Tok = Tok_Left_Bracket - or Tok = Tok_Assign - or Tok = Tok_Double_Arrow - or Tok in Token_Relational_Operator_Type - or Tok in Token_Adding_Operator_Type - or Tok in Token_Multiplying_Operator_Type - or Tok = Tok_Bar - then - -- Always a space before '[', ':='. - return True; - end if; - return False; - end Need_Space; - - package Simple_Disp_Ctxt is - type Simple_Ctxt is new Disp_Ctxt with record - Vnum : Natural; - Hnum : Natural; - Prev_Tok : Token_Type; - end record; - - procedure Init (Ctxt : out Simple_Ctxt); - procedure Start_Hbox (Ctxt : in out Simple_Ctxt); - procedure Close_Hbox (Ctxt : in out Simple_Ctxt); - procedure Start_Vbox (Ctxt : in out Simple_Ctxt); - procedure Close_Vbox (Ctxt : in out Simple_Ctxt); - procedure Disp_Token (Ctxt : in out Simple_Ctxt; Tok : Token_Type); - procedure Start_Lit (Ctxt : in out Simple_Ctxt; Tok : Token_Type); - procedure Disp_Char (Ctxt : in out Simple_Ctxt; C : Character); - procedure Close_Lit (Ctxt : in out Simple_Ctxt); - private - procedure Put (Ctxt : in out Simple_Ctxt; C : Character); - end Simple_Disp_Ctxt; - - package body Simple_Disp_Ctxt is - procedure Init (Ctxt : out Simple_Ctxt) is - begin - Ctxt := (Vnum => 0, - Hnum => 0, - Prev_Tok => Tok_Newline); - end Init; - - procedure Put (Ctxt : in out Simple_Ctxt; C : Character) - is - pragma Unreferenced (Ctxt); - begin - Simple_IO.Put (C); - end Put; - - procedure Start_Hbox (Ctxt : in out Simple_Ctxt) is - begin - if Ctxt.Hnum = 0 then - for I in 1 .. Ctxt.Vnum loop - Put (Ctxt, ' '); - Put (Ctxt, ' '); - end loop; - end if; - Ctxt.Hnum := Ctxt.Hnum + 1; - end Start_Hbox; - - procedure Close_Hbox (Ctxt : in out Simple_Ctxt) is - begin - Ctxt.Hnum := Ctxt.Hnum - 1; - if Ctxt.Hnum = 0 then - Put (Ctxt, ASCII.LF); - Ctxt.Prev_Tok := Tok_Newline; - end if; - end Close_Hbox; - - procedure Start_Vbox (Ctxt : in out Simple_Ctxt) is - begin - pragma Assert (Ctxt.Hnum = 0); - Ctxt.Vnum := Ctxt.Vnum + 1; - end Start_Vbox; - - procedure Close_Vbox (Ctxt : in out Simple_Ctxt) is - begin - Ctxt.Vnum := Ctxt.Vnum - 1; - end Close_Vbox; - - procedure Disp_Space (Ctxt : in out Simple_Ctxt; Tok : Token_Type) - is - Prev_Tok : constant Token_Type := Ctxt.Prev_Tok; - begin - if Need_Space (Tok, Prev_Tok) then - Put (Ctxt, ' '); - end if; - Ctxt.Prev_Tok := Tok; - end Disp_Space; - - procedure Disp_Token (Ctxt : in out Simple_Ctxt; Tok : Token_Type) is - begin - Disp_Space (Ctxt, Tok); - Disp_Str (Ctxt, Image (Tok)); - end Disp_Token; - - procedure Start_Lit (Ctxt : in out Simple_Ctxt; Tok : Token_Type) is - begin - Disp_Space (Ctxt, Tok); - end Start_Lit; - - procedure Disp_Char (Ctxt : in out Simple_Ctxt; C : Character) is - begin - Put (Ctxt, C); - end Disp_Char; - - procedure Close_Lit (Ctxt : in out Simple_Ctxt) is - begin - null; - end Close_Lit; - end Simple_Disp_Ctxt; - - procedure Disp_Vhdl (N : Iir) - is - use Simple_Disp_Ctxt; - Ctxt : Simple_Ctxt; - begin - Init (Ctxt); - Disp_Vhdl (Ctxt, N); - end Disp_Vhdl; - - procedure Disp_Expression (Expr: Iir) - is - use Simple_Disp_Ctxt; - Ctxt : Simple_Ctxt; - begin - Init (Ctxt); - Print (Ctxt, Expr); - end Disp_Expression; - - procedure Disp_PSL_NFA (N : PSL.Nodes.NFA) - is - use Simple_Disp_Ctxt; - Ctxt : Simple_Ctxt; - begin - Init (Ctxt); - Disp_PSL_NFA (Ctxt, N); - end Disp_PSL_NFA; - -end Vhdl.Disp_Vhdl; diff --git a/src/vhdl/vhdl-disp_vhdl.ads b/src/vhdl/vhdl-disp_vhdl.ads deleted file mode 100644 index a1c0b2b3c..000000000 --- a/src/vhdl/vhdl-disp_vhdl.ads +++ /dev/null @@ -1,57 +0,0 @@ --- VHDL regeneration from internal nodes. --- 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 GHDL; see the file COPYING. If not, write to the Free --- Software Foundation, 59 Temple Place - Suite 330, Boston, MA --- 02111-1307, USA. - -with Vhdl.Nodes; use Vhdl.Nodes; -with Vhdl.Tokens; use Vhdl.Tokens; -with PSL.Types; use PSL.Types; - -package Vhdl.Disp_Vhdl is - type Disp_Ctxt is abstract tagged null record; - procedure Start_Hbox (Ctxt : in out Disp_Ctxt) is abstract; - procedure Close_Hbox (Ctxt : in out Disp_Ctxt) is abstract; - procedure Start_Vbox (Ctxt : in out Disp_Ctxt) is abstract; - procedure Close_Vbox (Ctxt : in out Disp_Ctxt) is abstract; - procedure Disp_Token (Ctxt : in out Disp_Ctxt; Tok : Token_Type) - is abstract; - procedure Start_Lit (Ctxt : in out Disp_Ctxt; Tok : Token_Type) - is abstract; - procedure Disp_Char (Ctxt : in out Disp_Ctxt; C : Character) - is abstract; - procedure Close_Lit (Ctxt : in out Disp_Ctxt) - is abstract; - - subtype Ctxt_Class is Disp_Ctxt'Class; - - -- Helper that calls Disp_Char for every character of STR. - procedure Disp_Str (Ctxt : in out Ctxt_Class; Str : String); - - -- Return True if a space should be displayed between PREV_TOK and TOK. - function Need_Space (Tok, Prev_Tok : Token_Type) return Boolean; - - -- General procedure to display a node. - -- Mainly used to dispatch to other functions according to the kind of - -- the node. - procedure Disp_Vhdl (Ctxt : in out Ctxt_Class; N : Iir); - procedure Disp_Vhdl (N : Iir); - - procedure Disp_PSL_NFA (Ctxt : in out Ctxt_Class; N : PSL_NFA); - procedure Disp_PSL_NFA (N : PSL_NFA); - - procedure Disp_Expression (Expr: Iir); - -- Display an expression. -end Vhdl.Disp_Vhdl; diff --git a/src/vhdl/vhdl-flists.ads b/src/vhdl/vhdl-flists.ads index ae92345ad..a7b389369 100644 --- a/src/vhdl/vhdl-flists.ads +++ b/src/vhdl/vhdl-flists.ads @@ -18,4 +18,4 @@ with Vhdl.Types; with Flists; -package Vhdl.Flists is new Standard.Flists (El_Type => Vhdl.Types.Node); +package Vhdl.Flists is new Standard.Flists (El_Type => Vhdl.Types.Vhdl_Node); diff --git a/src/vhdl/vhdl-lists.ads b/src/vhdl/vhdl-lists.ads index 6d16b81bf..7441f9000 100644 --- a/src/vhdl/vhdl-lists.ads +++ b/src/vhdl/vhdl-lists.ads @@ -18,4 +18,4 @@ with Vhdl.Types; with Lists; -package Vhdl.Lists is new Standard.Lists (El_Type => Vhdl.Types.Node); +package Vhdl.Lists is new Standard.Lists (El_Type => Vhdl.Types.Vhdl_Node); diff --git a/src/vhdl/vhdl-nodes.ads b/src/vhdl/vhdl-nodes.ads index 97e7d706f..228b58d68 100644 --- a/src/vhdl/vhdl-nodes.ads +++ b/src/vhdl/vhdl-nodes.ads @@ -5471,8 +5471,10 @@ package Vhdl.Nodes is -- Nodes and lists. subtype Iir is Vhdl.Nodes_Priv.Node_Type; + subtype Node is Vhdl.Nodes_Priv.Node_Type; - Null_Iir : constant Iir := 0; + Null_Iir : constant Iir := Vhdl.Nodes_Priv.Null_Node; + Null_Node : constant Node := Vhdl.Nodes_Priv.Null_Node; -- Return True iff Node is null / not set. function Is_Null (Node : Iir) return Boolean; diff --git a/src/vhdl/vhdl-parse_psl.adb b/src/vhdl/vhdl-parse_psl.adb index 630339c79..561f9caff 100644 --- a/src/vhdl/vhdl-parse_psl.adb +++ b/src/vhdl/vhdl-parse_psl.adb @@ -117,7 +117,7 @@ package body Vhdl.Parse_Psl is function Vhdl_To_Psl (N : Vhdl_Node) return Node is use Vhdl.Nodes; - Res : Node; + Res : PSL_Node; begin Res := Create_Node_Loc (N_HDL_Expr); if N /= Null_Iir then diff --git a/src/vhdl/vhdl-prints.adb b/src/vhdl/vhdl-prints.adb new file mode 100644 index 000000000..a97f413ec --- /dev/null +++ b/src/vhdl/vhdl-prints.adb @@ -0,0 +1,4155 @@ +-- VHDL regeneration from internal nodes. +-- 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 GHDL; see the file COPYING. If not, write to the Free +-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA +-- 02111-1307, USA. + +-- Re-print a tree as VHDL sources. Except for comments and parenthesis, the +-- sequence of tokens displayed is the same as the sequence of tokens in the +-- input file. If parenthesis are kept by the parser, the only differences +-- are comments and layout. +with Types; use Types; +with Simple_IO; +with Flags; use Flags; +with Name_Table; +with Str_Table; +with Std_Names; use Std_Names; +with Files_Map; +with Vhdl.Errors; use Vhdl.Errors; +with Vhdl.Utils; use Vhdl.Utils; +with Vhdl.Std_Package; +with PSL.Nodes; +with PSL.Prints; +with PSL.NFAs; +with PSL.Errors; + +package body Vhdl.Prints is + + -- If True, display extra parenthesis to make priority of operators + -- explicit. + Flag_Parenthesis : constant Boolean := False; + + -- If set, disp after a string literal the type enclosed into brackets. + Flag_Disp_String_Literal_Type: constant Boolean := False; + + -- If set, disp implicit declarations. + Flag_Implicit : constant Boolean := False; + + procedure Disp_Type (Ctxt : in out Ctxt_Class; A_Type: Iir); + procedure Disp_Range (Ctxt : in out Ctxt_Class; Rng : Iir); + procedure Print (Ctxt : in out Ctxt_Class; Expr: Iir); + + procedure Disp_Concurrent_Statement (Ctxt : in out Ctxt_Class; Stmt: Iir); + procedure Disp_Concurrent_Statement_Chain + (Ctxt : in out Ctxt_Class; Parent: Iir); + procedure Disp_Declaration_Chain + (Ctxt : in out Ctxt_Class; Parent : Iir); + procedure Disp_Process_Statement (Ctxt : in out Ctxt_Class; Process: Iir); + procedure Disp_Sequential_Statements + (Ctxt : in out Ctxt_Class; First : Iir); + procedure Disp_Choice (Ctxt : in out Ctxt_Class; Choice: in out Iir); + procedure Disp_Association_Chain (Ctxt : in out Ctxt_Class; Chain : Iir); + procedure Disp_Block_Configuration + (Ctxt : in out Ctxt_Class; Block: Iir_Block_Configuration); + procedure Disp_Subprogram_Declaration + (Ctxt : in out Ctxt_Class; Subprg: Iir; Implicit : Boolean := False); + procedure Disp_Binding_Indication + (Ctxt : in out Ctxt_Class; Bind : Iir); + procedure Disp_Subtype_Indication + (Ctxt : in out Ctxt_Class; Def : Iir; Full_Decl : Boolean := False); + procedure Disp_Parametered_Attribute + (Ctxt : in out Ctxt_Class; Name : Name_Id; Expr : Iir); + procedure Disp_String_Literal + (Ctxt : in out Ctxt_Class; Str : Iir; El_Type : Iir); + procedure Disp_Package_Declaration + (Ctxt : in out Ctxt_Class; Decl: Iir_Package_Declaration); + procedure Disp_Package_Instantiation_Declaration + (Ctxt : in out Ctxt_Class; Decl: Iir); + procedure Disp_Package_Body (Ctxt : in out Ctxt_Class; Decl: Iir); + procedure Disp_Attribute_Name (Ctxt : in out Ctxt_Class; Attr : Iir); + + procedure Disp_Int64 (Ctxt : in out Ctxt_Class; Val: Int64); + procedure Disp_Int32 (Ctxt : in out Ctxt_Class; Val: Iir_Int32); + procedure Disp_Fp64 (Ctxt : in out Ctxt_Class; Val: Fp64); + + procedure Put (Str : String) is + begin + Simple_IO.Put_Err (Str); + end Put; + + procedure Put (C : Character) is + begin + Put ((1 => C)); + end Put; + + procedure New_Line is + begin + Put (ASCII.LF); + end New_Line; + + procedure Put_Line (Str : String) is + begin + Put (Str); + New_Line; + end Put_Line; + + procedure Disp_Token (Ctxt : in out Ctxt_Class; Tok1, Tok2 : Token_Type) is + begin + Disp_Token (Ctxt, Tok1); + Disp_Token (Ctxt, Tok2); + end Disp_Token; + + procedure Disp_Ident (Ctxt : in out Ctxt_Class; Id: Name_Id) is + begin + if Name_Table.Is_Character (Id) then + Start_Lit (Ctxt, Tok_Character); + Disp_Char (Ctxt, '''); + Disp_Char (Ctxt, Name_Table.Get_Character (Id)); + Disp_Char (Ctxt, '''); + Close_Lit (Ctxt); + else + Start_Lit (Ctxt, Tok_Identifier); + if Id = Null_Identifier then + Disp_Str (Ctxt, ""); + else + Disp_Str (Ctxt, Name_Table.Image (Id)); + end if; + Close_Lit (Ctxt); + end if; + end Disp_Ident; + + function Or_Else (L, R : Iir) return Iir is + begin + if L /= Null_Iir then + return L; + end if; + pragma Assert (R /= Null_Iir); + return R; + end Or_Else; + + -- Disp a literal from the sources (so using exactely the same characters). + procedure Disp_From_Source + (Ctxt : in out Ctxt_Class; + Loc : Location_Type; Len : Int32; Tok : Token_Type) + is + use Files_Map; + pragma Assert (Len > 0); + File : Source_File_Entry; + Pos : Source_Ptr; + Buf : File_Buffer_Acc; + begin + Location_To_File_Pos (Loc, File, Pos); + Buf := Get_File_Source (File); + Start_Lit (Ctxt, Tok); + for I in 1 .. Len loop + Disp_Char (Ctxt, Buf (Pos)); + Pos := Pos + 1; + end loop; + Close_Lit (Ctxt); + end Disp_From_Source; + + procedure Disp_Identifier (Ctxt : in out Ctxt_Class; Node : Iir) + is + use Name_Table; + Id : constant Name_Id := Get_Identifier (Node); + Loc : constant Location_Type := Get_Location (Node); + begin + -- Try to display the one from the sources. + if Id /= Null_Identifier + and then not Is_Character (Id) + and then Loc /= No_Location + and then Loc /= Std_Package.Std_Location + then + Disp_From_Source + (Ctxt, Loc, Int32 (Get_Name_Length (Id)), Tok_Identifier); + else + Disp_Ident (Ctxt, Id); + end if; + end Disp_Identifier; + + procedure Disp_Literal_From_Source + (Ctxt : in out Ctxt_Class; Lit : Iir; Tok : Token_Type) is + begin + Disp_From_Source + (Ctxt, Get_Location (Lit), Get_Literal_Length (Lit), Tok); + end Disp_Literal_From_Source; + + procedure Disp_Function_Name (Ctxt : in out Ctxt_Class; Func: Iir) + is + use Name_Table; + Id: Name_Id; + begin + Id := Get_Identifier (Func); + case Id is + when Name_Id_Operators + | Name_Word_Operators + | Name_Logical_Operators + | Name_Xnor + | Name_Shift_Operators => + Start_Lit (Ctxt, Tok_String); + Disp_Char (Ctxt, '"'); + Disp_Str (Ctxt, Image (Id)); + Disp_Char (Ctxt, '"'); + Close_Lit (Ctxt); + when others => + Disp_Ident (Ctxt, Id); + end case; + end Disp_Function_Name; + + -- Disp the name of DECL. + procedure Disp_Name_Of (Ctxt : in out Ctxt_Class; Decl: Iir) is + begin + case Get_Kind (Decl) is + when Iir_Kind_Component_Declaration + | Iir_Kind_Entity_Declaration + | Iir_Kind_Architecture_Body + | Iir_Kind_Configuration_Declaration + | Iir_Kind_Context_Declaration + | Iir_Kinds_Interface_Object_Declaration + | Iir_Kind_Interface_Type_Declaration + | Iir_Kind_Constant_Declaration + | Iir_Kind_Signal_Declaration + | Iir_Kind_Guard_Signal_Declaration + | Iir_Kind_Variable_Declaration + | Iir_Kind_Type_Declaration + | Iir_Kind_File_Declaration + | Iir_Kind_Subtype_Declaration + | Iir_Kind_Element_Declaration + | Iir_Kind_Record_Element_Constraint + | Iir_Kind_Package_Declaration + | Iir_Kind_Object_Alias_Declaration + | Iir_Kind_Non_Object_Alias_Declaration + | Iir_Kind_Iterator_Declaration + | Iir_Kind_Library_Declaration + | Iir_Kind_Unit_Declaration + | Iir_Kind_Nature_Declaration + | Iir_Kind_Terminal_Declaration + | Iir_Kinds_Quantity_Declaration + | Iir_Kind_Group_Template_Declaration + | Iir_Kind_Character_Literal + | Iir_Kinds_Process_Statement => + Disp_Identifier (Ctxt, Decl); + when Iir_Kind_Anonymous_Type_Declaration => + Start_Lit (Ctxt, Tok_Identifier); + Disp_Char (Ctxt, '<'); + Disp_Str (Ctxt, Name_Table.Image (Get_Identifier (Decl))); + Disp_Char (Ctxt, '>'); + Close_Lit (Ctxt); + when Iir_Kind_Function_Declaration => + Disp_Function_Name (Ctxt, Decl); + when Iir_Kind_Procedure_Declaration => + Disp_Identifier (Ctxt, Decl); + when Iir_Kind_Physical_Subtype_Definition + | Iir_Kind_Enumeration_Type_Definition + | Iir_Kind_Physical_Type_Definition + | Iir_Kind_Record_Type_Definition + | Iir_Kind_Protected_Type_Declaration => + -- Used for 'end' DECL_NAME. + Disp_Identifier (Ctxt, Get_Type_Declarator (Decl)); + when Iir_Kind_Component_Instantiation_Statement => + Disp_Ident (Ctxt, Get_Label (Decl)); + when Iir_Kind_Design_Unit => + Disp_Name_Of (Ctxt, Get_Library_Unit (Decl)); + when Iir_Kind_Enumeration_Literal + | Iir_Kind_Simple_Name => + Disp_Identifier (Ctxt, Decl); + when Iir_Kind_Block_Statement + | Iir_Kind_If_Generate_Statement + | Iir_Kind_Case_Generate_Statement + | Iir_Kind_For_Generate_Statement => + Disp_Ident (Ctxt, Get_Label (Decl)); + when Iir_Kind_Package_Body => + Disp_Identifier (Ctxt, Decl); + when Iir_Kind_Procedure_Body + | Iir_Kind_Function_Body => + Disp_Function_Name (Ctxt, Get_Subprogram_Specification (Decl)); + when Iir_Kind_Protected_Type_Body => + Disp_Identifier (Ctxt, Decl); + when others => + Error_Kind ("disp_name_of", Decl); + end case; + end Disp_Name_Of; + + procedure Disp_Name_Attribute + (Ctxt : in out Ctxt_Class; Attr : Iir; Name : Name_Id) is + begin + Print (Ctxt, Get_Prefix (Attr)); + Disp_Token (Ctxt, Tok_Tick); + Disp_Ident (Ctxt, Name); + end Disp_Name_Attribute; + + procedure Disp_Range (Ctxt : in out Ctxt_Class; Rng : Iir) is + begin + case Get_Kind (Rng) is + when Iir_Kind_Range_Expression => + declare + Origin : constant Iir := Get_Range_Origin (Rng); + begin + if Dump_Origin_Flag and then Origin /= Null_Iir then + Print (Ctxt, Origin); + else + Print (Ctxt, Or_Else (Get_Left_Limit_Expr (Rng), + Get_Left_Limit (Rng))); + if Get_Direction (Rng) = Iir_To then + Disp_Token (Ctxt, Tok_To); + else + Disp_Token (Ctxt, Tok_Downto); + end if; + Print (Ctxt, Or_Else (Get_Right_Limit_Expr (Rng), + Get_Right_Limit (Rng))); + end if; + end; + when Iir_Kind_Range_Array_Attribute => + Disp_Parametered_Attribute (Ctxt, Name_Range, Rng); + when Iir_Kind_Reverse_Range_Array_Attribute => + Disp_Parametered_Attribute (Ctxt, Name_Reverse_Range, Rng); + when Iir_Kind_Simple_Name + | Iir_Kind_Selected_Name + | Iir_Kind_Attribute_Name + | Iir_Kind_Parenthesis_Name => + Print (Ctxt, Rng); + when others => + Disp_Subtype_Indication (Ctxt, Rng); + -- Disp_Name_Of (Get_Type_Declarator (Decl)); + end case; + end Disp_Range; + + procedure Disp_After_End + (Ctxt : in out Ctxt_Class; + Decl : Iir; Tok1 : Token_Type; Tok2 : Token_Type := Tok_Invalid) is + begin + if Get_End_Has_Reserved_Id (Decl) then + Disp_Token (Ctxt, Tok1); + if Tok2 /= Tok_Invalid then + Disp_Token (Ctxt, Tok2); + end if; + end if; + if Get_End_Has_Identifier (Decl) then + Disp_Name_Of (Ctxt, Decl); + end if; + end Disp_After_End; + + procedure Disp_End_No_Close + (Ctxt : in out Ctxt_Class; + Decl : Iir; Tok1 : Token_Type; Tok2 : Token_Type := Tok_Invalid) is + begin + Start_Hbox (Ctxt); + Disp_Token (Ctxt, Tok_End); + Disp_After_End (Ctxt, Decl, Tok1, Tok2); + end Disp_End_No_Close; + + procedure Disp_End + (Ctxt : in out Ctxt_Class; + Decl : Iir; Tok1 : Token_Type; Tok2 : Token_Type := Tok_Invalid) is + begin + Disp_End_No_Close (Ctxt, Decl, Tok1, Tok2); + Disp_Token (Ctxt, Tok_Semi_Colon); + Close_Hbox (Ctxt); + end Disp_End; + + procedure Disp_End (Ctxt : in out Ctxt_Class; Tok1 : Token_Type) is + begin + Start_Hbox (Ctxt); + Disp_Token (Ctxt, Tok_End); + Disp_Token (Ctxt, Tok1); + Disp_Token (Ctxt, Tok_Semi_Colon); + Close_Hbox (Ctxt); + end Disp_End; + + procedure Disp_End_Label_No_Close + (Ctxt : in out Ctxt_Class; Stmt : Iir; Tok : Token_Type) is + begin + Start_Hbox (Ctxt); + Disp_Token (Ctxt, Tok_End); + Disp_Token (Ctxt, Tok); + if Get_End_Has_Identifier (Stmt) then + Disp_Ident (Ctxt, Get_Label (Stmt)); + end if; + Disp_Token (Ctxt, Tok_Semi_Colon); + end Disp_End_Label_No_Close; + + procedure Disp_End_Label + (Ctxt : in out Ctxt_Class; Stmt : Iir; Tok : Token_Type) is + begin + Disp_End_Label_No_Close (Ctxt, Stmt, Tok); + Close_Hbox (Ctxt); + end Disp_End_Label; + + procedure Disp_Use_Clause (Ctxt : in out Ctxt_Class; Clause: Iir_Use_Clause) + is + Name : Iir; + begin + Start_Hbox (Ctxt); + Disp_Token (Ctxt, Tok_Use); + Name := Clause; + loop + Print (Ctxt, Get_Selected_Name (Name)); + Name := Get_Use_Clause_Chain (Name); + exit when Name = Null_Iir; + Disp_Token (Ctxt, Tok_Comma); + end loop; + Disp_Token (Ctxt, Tok_Semi_Colon); + Close_Hbox (Ctxt); + end Disp_Use_Clause; + + -- Disp the resolution function (if any) of type definition DEF. + procedure Disp_Resolution_Indication + (Ctxt : in out Ctxt_Class; Subtype_Def: Iir) + is + procedure Inner (Ind : Iir) is + begin + case Get_Kind (Ind) is + when Iir_Kinds_Denoting_Name => + Print (Ctxt, Ind); + when Iir_Kind_Array_Element_Resolution => + declare + Res : constant Iir := Get_Resolution_Indication (Ind); + begin + Disp_Token (Ctxt, Tok_Left_Paren); + if Is_Valid (Res) then + Inner (Res); + else + Print (Ctxt, Get_Resolution_Indication + (Get_Element_Subtype_Indication (Ind))); + end if; + Disp_Token (Ctxt, Tok_Right_Paren); + end; + when others => + Error_Kind ("disp_resolution_indication", Ind); + end case; + end Inner; + + Ind : Iir; + begin + case Get_Kind (Subtype_Def) is + when Iir_Kind_Access_Subtype_Definition => + -- No resolution indication on access subtype. + return; + when others => + Ind := Get_Resolution_Indication (Subtype_Def); + if Ind = Null_Iir then + -- No resolution indication. + return; + end if; + end case; + + if False then + declare + Type_Mark : constant Iir := Get_Denoted_Type_Mark (Subtype_Def); + begin + if Get_Kind (Type_Mark) in Iir_Kinds_Subtype_Definition + and then Get_Resolution_Indication (Type_Mark) = Ind + then + -- Resolution indication was inherited from the type_mark. + return; + end if; + end; + end if; + + Inner (Ind); + end Disp_Resolution_Indication; + + procedure Disp_Element_Constraint + (Ctxt : in out Ctxt_Class; Def : Iir; Type_Mark : Iir); + + procedure Disp_Array_Element_Constraint + (Ctxt : in out Ctxt_Class; Def : Iir; Type_Mark : Iir) + is + Def_El : constant Iir := Get_Element_Subtype (Def); + Tm_El : constant Iir := Get_Element_Subtype (Type_Mark); + Has_Index : constant Boolean := Get_Index_Constraint_Flag (Def); + Has_Own_Element_Subtype : constant Boolean := Def_El /= Tm_El; + Indexes : Iir_Flist; + Index : Iir; + begin + if not Has_Index and not Has_Own_Element_Subtype then + return; + end if; + + if Get_Constraint_State (Type_Mark) /= Fully_Constrained + and then Has_Index + then + Indexes := Get_Index_Constraint_List (Def); + if Indexes = Null_Iir_Flist then + Indexes := Get_Index_Subtype_List (Def); + end if; + Disp_Token (Ctxt, Tok_Left_Paren); + for I in Flist_First .. Flist_Last (Indexes) loop + Index := Get_Nth_Element (Indexes, I); + if I /= 0 then + Disp_Token (Ctxt, Tok_Comma); + end if; + --Print (Get_Range_Constraint (Index)); + Disp_Range (Ctxt, Index); + end loop; + Disp_Token (Ctxt, Tok_Right_Paren); + end if; + + if Has_Own_Element_Subtype + and then Get_Kind (Def_El) in Iir_Kinds_Composite_Type_Definition + then + Disp_Element_Constraint (Ctxt, Def_El, Tm_El); + end if; + end Disp_Array_Element_Constraint; + + procedure Disp_Record_Element_Constraint + (Ctxt : in out Ctxt_Class; Def : Iir) + is + El_List : constant Iir_Flist := Get_Elements_Declaration_List (Def); + El : Iir; + Has_El : Boolean := False; + begin + for I in Flist_First .. Flist_Last (El_List) loop + El := Get_Nth_Element (El_List, I); + if Get_Kind (El) = Iir_Kind_Record_Element_Constraint + and then Get_Parent (El) = Def + then + if Has_El then + Disp_Token (Ctxt, Tok_Comma); + else + Disp_Token (Ctxt, Tok_Left_Paren); + Has_El := True; + end if; + Disp_Name_Of (Ctxt, El); + Disp_Element_Constraint (Ctxt, Get_Type (El), + Get_Base_Type (Get_Type (El))); + end if; + end loop; + if Has_El then + Disp_Token (Ctxt, Tok_Right_Paren); + end if; + end Disp_Record_Element_Constraint; + + procedure Disp_Element_Constraint + (Ctxt : in out Ctxt_Class; Def : Iir; Type_Mark : Iir) is + begin + case Get_Kind (Def) is + when Iir_Kind_Record_Subtype_Definition => + Disp_Record_Element_Constraint (Ctxt, Def); + when Iir_Kind_Array_Subtype_Definition => + Disp_Array_Element_Constraint (Ctxt, Def, Type_Mark); + when others => + Error_Kind ("disp_element_constraint", Def); + end case; + end Disp_Element_Constraint; + + procedure Disp_Tolerance_Opt (Ctxt : in out Ctxt_Class; N : Iir) + is + Tol : constant Iir := Get_Tolerance (N); + begin + if Tol /= Null_Iir then + Disp_Token (Ctxt, Tok_Tolerance); + Print (Ctxt, Tol); + end if; + end Disp_Tolerance_Opt; + + procedure Disp_Subtype_Indication + (Ctxt : in out Ctxt_Class; Def : Iir; Full_Decl : Boolean := False) + is + Type_Mark : Iir; + Base_Type : Iir; + Decl : Iir; + begin + case Get_Kind (Def) is + when Iir_Kinds_Denoting_Name + | Iir_Kind_Subtype_Attribute + | Iir_Kind_Attribute_Name => + Print (Ctxt, Def); + return; + when others => + null; + end case; + + Decl := Get_Type_Declarator (Def); + if not Full_Decl and then Decl /= Null_Iir then + Disp_Name_Of (Ctxt, Decl); + return; + end if; + + -- Resolution function name. + Disp_Resolution_Indication (Ctxt, Def); + + -- type mark. + Type_Mark := Get_Subtype_Type_Mark (Def); + if Type_Mark /= Null_Iir then + Print (Ctxt, Type_Mark); + Type_Mark := Get_Type (Type_Mark); + end if; + + case Get_Kind (Def) is + when Iir_Kind_Array_Subtype_Definition => + Disp_Array_Element_Constraint + (Ctxt, Def, Or_Else (Type_Mark, Def)); + when Iir_Kind_Subtype_Definition => + declare + Rng : constant Iir := Get_Range_Constraint (Def); + begin + if Rng /= Null_Iir then + Disp_Token (Ctxt, Tok_Range); + Print (Ctxt, Get_Range_Constraint (Def)); + end if; + Disp_Tolerance_Opt (Ctxt, Def); + end; + when others => + Base_Type := Get_Base_Type (Def); + case Get_Kind (Base_Type) is + when Iir_Kind_Integer_Type_Definition + | Iir_Kind_Enumeration_Type_Definition + | Iir_Kind_Floating_Type_Definition + | Iir_Kind_Physical_Type_Definition => + if Type_Mark = Null_Iir + or else Get_Range_Constraint (Def) + /= Get_Range_Constraint (Type_Mark) + then + if Type_Mark /= Null_Iir then + Disp_Token (Ctxt, Tok_Range); + end if; + Print (Ctxt, Get_Range_Constraint (Def)); + end if; + if Get_Kind (Base_Type) = Iir_Kind_Floating_Type_Definition + then + Disp_Tolerance_Opt (Ctxt, Def); + end if; + when Iir_Kind_Access_Type_Definition => + declare + Des_Ind : constant Iir := + Get_Designated_Subtype_Indication (Def); + begin + if Des_Ind /= Null_Iir then + pragma Assert (Get_Kind (Des_Ind) + = Iir_Kind_Array_Subtype_Definition); + Disp_Array_Element_Constraint + (Ctxt, Des_Ind, Get_Designated_Type (Base_Type)); + end if; + end; + when Iir_Kind_Array_Type_Definition => + Disp_Array_Element_Constraint + (Ctxt, Def, Or_Else (Type_Mark, Def)); + when Iir_Kind_Record_Type_Definition => + Disp_Record_Element_Constraint (Ctxt, Def); + when others => + Error_Kind ("disp_subtype_indication", Base_Type); + end case; + end case; + end Disp_Subtype_Indication; + + procedure Disp_Enumeration_Type_Definition + (Ctxt : in out Ctxt_Class; Def: Iir_Enumeration_Type_Definition) + is + Lits : constant Iir_Flist := Get_Enumeration_Literal_List (Def); + A_Lit: Iir; --Enumeration_Literal_Acc; + begin + Disp_Token (Ctxt, Tok_Left_Paren); + for I in Flist_First .. Flist_Last (Lits) loop + A_Lit := Get_Nth_Element (Lits, I); + if I > 0 then + Disp_Token (Ctxt, Tok_Comma); + end if; + Disp_Name_Of (Ctxt, A_Lit); + end loop; + Disp_Token (Ctxt, Tok_Right_Paren); + end Disp_Enumeration_Type_Definition; + + procedure Disp_Discrete_Range + (Ctxt : in out Ctxt_Class; Iterator: Iir) is + begin + if Get_Kind (Iterator) in Iir_Kinds_Subtype_Definition then + Disp_Subtype_Indication (Ctxt, Iterator); + else + Disp_Range (Ctxt, Iterator); + end if; + end Disp_Discrete_Range; + + procedure Disp_Array_Type_Definition + (Ctxt : in out Ctxt_Class; Def: Iir_Array_Type_Definition) + is + Indexes : Iir_Flist; + Index: Iir; + begin + Indexes := Get_Index_Subtype_Definition_List (Def); + if Indexes = Null_Iir_Flist then + Indexes := Get_Index_Subtype_List (Def); + end if; + Disp_Token (Ctxt, Tok_Array, Tok_Left_Paren); + for I in Flist_First .. Flist_Last (Indexes) loop + Index := Get_Nth_Element (Indexes, I); + if I /= 0 then + Disp_Token (Ctxt, Tok_Comma); + end if; + Print (Ctxt, Index); + Disp_Token (Ctxt, Tok_Range, Tok_Box); + end loop; + Disp_Token (Ctxt, Tok_Right_Paren, Tok_Of); + Disp_Subtype_Indication (Ctxt, Get_Element_Subtype_Indication (Def)); + end Disp_Array_Type_Definition; + + procedure Disp_Physical_Literal (Ctxt : in out Ctxt_Class; Lit: Iir) + is + Len : constant Int32 := Get_Literal_Length (Lit); + Unit : Iir; + begin + case Iir_Kinds_Physical_Literal (Get_Kind (Lit)) is + when Iir_Kind_Physical_Int_Literal => + if Len /= 0 then + Disp_Literal_From_Source (Ctxt, Lit, Tok_Integer); + else + Disp_Int64 (Ctxt, Get_Value (Lit)); + end if; + when Iir_Kind_Physical_Fp_Literal => + if Len /= 0 then + Disp_Literal_From_Source (Ctxt, Lit, Tok_Real); + else + Disp_Fp64 (Ctxt, Get_Fp_Value (Lit)); + end if; + end case; + + Unit := Get_Unit_Name (Lit); + if Is_Valid (Unit) then + -- No unit in range_constraint of physical type declaration. + Print (Ctxt, Unit); + end if; + end Disp_Physical_Literal; + + procedure Disp_Record_Type_Definition + (Ctxt : in out Ctxt_Class; Def: Iir_Record_Type_Definition) + is + List : constant Iir_Flist := Get_Elements_Declaration_List (Def); + El: Iir_Element_Declaration; + El_Subtype : Iir; + Reindent : Boolean; + begin + Disp_Token (Ctxt, Tok_Record); + Close_Hbox (Ctxt); + Reindent := True; + Start_Vbox (Ctxt); + for I in Flist_First .. Flist_Last (List) loop + El := Get_Nth_Element (List, I); + if Reindent then + El_Subtype := Get_Subtype_Indication (El); + Start_Hbox (Ctxt); + end if; + Disp_Identifier (Ctxt, El); + if Get_Has_Identifier_List (El) then + Disp_Token (Ctxt, Tok_Comma); + Reindent := False; + else + Disp_Token (Ctxt, Tok_Colon); + Disp_Subtype_Indication (Ctxt, Or_Else (El_Subtype, + Get_Type (El))); + Disp_Token (Ctxt, Tok_Semi_Colon); + Close_Hbox (Ctxt); + Reindent := True; + end if; + end loop; + Close_Vbox (Ctxt); + Disp_End_No_Close (Ctxt, Def, Tok_Record); + end Disp_Record_Type_Definition; + + procedure Disp_Designator_List (Ctxt : in out Ctxt_Class; List: Iir_List) + is + El : Iir; + It : List_Iterator; + Is_First : Boolean; + begin + case List is + when Null_Iir_List => + null; + when Iir_List_All => + Disp_Token (Ctxt, Tok_All); + when others => + It := List_Iterate (List); + Is_First := True; + while Is_Valid (It) loop + El := Get_Element (It); + if not Is_First then + Disp_Token (Ctxt, Tok_Comma); + else + Is_First := False; + end if; + Print (Ctxt, El); + Next (It); + end loop; + end case; + end Disp_Designator_List; + + procedure Disp_Array_Subtype_Definition + (Ctxt : in out Ctxt_Class; Def : Iir; El_Def : Iir) + is + Indexes : Iir_Flist; + Index : Iir; + begin + Indexes := Get_Index_Constraint_List (Def); + if Indexes = Null_Iir_Flist then + Indexes := Get_Index_Subtype_List (Def); + end if; + Disp_Token (Ctxt, Tok_Array, Tok_Left_Paren); + for I in Flist_First .. Flist_Last (Indexes) loop + Index := Get_Nth_Element (Indexes, I); + if I /= 0 then + Disp_Token (Ctxt, Tok_Comma); + end if; + Disp_Discrete_Range (Ctxt, Index); + end loop; + Disp_Token (Ctxt, Tok_Right_Paren, Tok_Of); + Disp_Subtype_Indication (Ctxt, El_Def); + end Disp_Array_Subtype_Definition; + + -- Display the full definition of a type, ie the sequence that can create + -- such a type. + procedure Disp_Type_Definition (Ctxt : in out Ctxt_Class; Def: Iir) is + begin + case Get_Kind (Def) is + when Iir_Kind_Enumeration_Type_Definition => + Disp_Enumeration_Type_Definition (Ctxt, Def); + when Iir_Kind_Array_Type_Definition => + Disp_Array_Type_Definition (Ctxt, Def); + when Iir_Kind_Array_Subtype_Definition => + Disp_Array_Subtype_Definition + (Ctxt, Def, Get_Element_Subtype (Get_Base_Type (Def))); + when Iir_Kind_Record_Type_Definition => + Disp_Record_Type_Definition (Ctxt, Def); + when Iir_Kind_Access_Type_Definition => + Disp_Token (Ctxt, Tok_Access); + Disp_Subtype_Indication + (Ctxt, Get_Designated_Subtype_Indication (Def)); + when Iir_Kind_File_Type_Definition => + Disp_Token (Ctxt, Tok_File, Tok_Of); + Disp_Subtype_Indication (Ctxt, Get_File_Type_Mark (Def)); + when Iir_Kind_Protected_Type_Declaration => + Disp_Token (Ctxt, Tok_Protected); + Close_Hbox (Ctxt); + Start_Vbox (Ctxt); + Disp_Declaration_Chain (Ctxt, Def); + Close_Vbox (Ctxt); + Disp_End_No_Close (Ctxt, Def, Tok_Protected); + when Iir_Kind_Attribute_Name + | Iir_Kind_Range_Expression + | Iir_Kind_Parenthesis_Name => + Disp_Token (Ctxt, Tok_Range); + Print (Ctxt, Def); + when others => + Error_Kind ("disp_type_definition", Def); + end case; + end Disp_Type_Definition; + + procedure Disp_Type_Declaration + (Ctxt : in out Ctxt_Class; Decl: Iir_Type_Declaration) + is + Def : constant Iir := Get_Type_Definition (Decl); + begin + Start_Hbox (Ctxt); + Disp_Token (Ctxt, Tok_Type); + Disp_Name_Of (Ctxt, Decl); + if Def /= Null_Iir + and then Get_Kind (Def) /= Iir_Kind_Incomplete_Type_Definition + then + Disp_Token (Ctxt, Tok_Is); + Disp_Type_Definition (Ctxt, Def); + end if; + Disp_Token (Ctxt, Tok_Semi_Colon); + Close_Hbox (Ctxt); + end Disp_Type_Declaration; + + procedure Disp_Physical_Type_Definition + (Ctxt : in out Ctxt_Class; Decl : Iir) + is + Def : constant Iir := Get_Type_Definition (Decl); + St : constant Iir := Get_Subtype_Definition (Decl); + Unit : Iir_Unit_Declaration; + Rng : Iir; + begin + Disp_Token (Ctxt, Tok_Range); + Rng := Or_Else (St, Def); + Print (Ctxt, Get_Range_Constraint (Rng)); + Disp_Token (Ctxt, Tok_Units); + Close_Hbox (Ctxt); + + Start_Vbox (Ctxt); + Unit := Get_Unit_Chain (Def); + Start_Hbox (Ctxt); + Disp_Identifier (Ctxt, Unit); + Disp_Token (Ctxt, Tok_Semi_Colon); + Close_Hbox (Ctxt); + Unit := Get_Chain (Unit); + while Unit /= Null_Iir loop + Start_Hbox (Ctxt); + Disp_Identifier (Ctxt, Unit); + Disp_Token (Ctxt, Tok_Equal); + Print (Ctxt, Get_Physical_Literal (Unit)); + Disp_Token (Ctxt, Tok_Semi_Colon); + Close_Hbox (Ctxt); + Unit := Get_Chain (Unit); + end loop; + Close_Vbox (Ctxt); + Disp_End_No_Close (Ctxt, Def, Tok_Units); + end Disp_Physical_Type_Definition; + + procedure Disp_Anonymous_Type_Declaration + (Ctxt : in out Ctxt_Class; Decl: Iir_Anonymous_Type_Declaration) + is + Def : constant Iir := Get_Type_Definition (Decl); + begin + Start_Hbox (Ctxt); + Disp_Token (Ctxt, Tok_Type); + Disp_Identifier (Ctxt, Decl); + Disp_Token (Ctxt, Tok_Is); + case Get_Kind (Def) is + when Iir_Kind_Array_Type_Definition => + Disp_Array_Subtype_Definition + (Ctxt, Get_Subtype_Definition (Decl), + Get_Element_Subtype_Indication (Def)); + when Iir_Kind_Array_Subtype_Definition => + Disp_Array_Subtype_Definition + (Ctxt, Def, Get_Array_Element_Constraint (Def)); + when Iir_Kind_Physical_Type_Definition => + Disp_Physical_Type_Definition (Ctxt, Decl); + when Iir_Kind_Floating_Type_Definition + | Iir_Kind_Integer_Type_Definition => + declare + St : constant Iir := Get_Subtype_Definition (Decl); + begin + Disp_Token (Ctxt, Tok_Range); + Print (Ctxt, Get_Range_Constraint (St)); + end; + when others => + Disp_Type_Definition (Ctxt, Def); + end case; + Disp_Token (Ctxt, Tok_Semi_Colon); + Close_Hbox (Ctxt); + end Disp_Anonymous_Type_Declaration; + + procedure Disp_Subtype_Declaration + (Ctxt : in out Ctxt_Class; Decl: Iir_Subtype_Declaration) + is + Def : constant Iir := Get_Type (Decl); + begin + -- If the subtype declaration was implicit (added because of a type + -- declaration), put it as a comment. + if Def /= Null_Iir + and then + (Get_Identifier (Decl) + = Get_Identifier (Get_Type_Declarator (Get_Base_Type (Def)))) + then + if Flag_Implicit then + Put ("-- "); + else + return; + end if; + end if; + Start_Hbox (Ctxt); + Disp_Token (Ctxt, Tok_Subtype); + Disp_Name_Of (Ctxt, Decl); + Disp_Token (Ctxt, Tok_Is); + Disp_Subtype_Indication + (Ctxt, Or_Else (Get_Subtype_Indication (Decl), Get_Type (Decl)), True); + Disp_Token (Ctxt, Tok_Semi_Colon); + Close_Hbox (Ctxt); + end Disp_Subtype_Declaration; + + procedure Disp_Type (Ctxt : in out Ctxt_Class; A_Type: Iir) + is + Decl: Iir; + begin + Decl := Get_Type_Declarator (A_Type); + if Decl /= Null_Iir then + Disp_Name_Of (Ctxt, Decl); + else + case Get_Kind (A_Type) is + when Iir_Kind_Enumeration_Type_Definition + | Iir_Kind_Integer_Type_Definition => + raise Program_Error; + when Iir_Kind_Integer_Subtype_Definition + | Iir_Kind_Enumeration_Subtype_Definition + | Iir_Kind_Access_Subtype_Definition => + Disp_Subtype_Indication (Ctxt, A_Type); + when Iir_Kind_Array_Subtype_Definition => + Disp_Subtype_Indication (Ctxt, A_Type); + when others => + Error_Kind ("disp_type", A_Type); + end case; + end if; + end Disp_Type; + + procedure Disp_Nature_Definition (Ctxt : in out Ctxt_Class; Def : Iir) is + begin + case Get_Kind (Def) is + when Iir_Kind_Scalar_Nature_Definition => + Disp_Subtype_Indication (Ctxt, Get_Across_Type (Def)); + Disp_Token (Ctxt, Tok_Across); + Disp_Subtype_Indication (Ctxt, Get_Through_Type (Def)); + Disp_Token (Ctxt, Tok_Through); + Disp_Name_Of (Ctxt, Get_Reference (Def)); + Disp_Token (Ctxt, Tok_Reference); + when others => + Error_Kind ("disp_nature_definition", Def); + end case; + end Disp_Nature_Definition; + + procedure Disp_Nature_Declaration (Ctxt : in out Ctxt_Class; Decl : Iir) is + begin + Start_Hbox (Ctxt); + Disp_Token (Ctxt, Tok_Nature); + Disp_Name_Of (Ctxt, Decl); + Disp_Token (Ctxt, Tok_Is); + Disp_Nature_Definition (Ctxt, Get_Nature (Decl)); + Disp_Token (Ctxt, Tok_Semi_Colon); + Close_Hbox (Ctxt); + end Disp_Nature_Declaration; + + procedure Disp_Subnature_Indication (Ctxt : in out Ctxt_Class; Ind : Iir) + is + Decl: Iir; + begin + case Get_Kind (Ind) is + when Iir_Kinds_Denoting_Name + | Iir_Kind_Subtype_Attribute + | Iir_Kind_Attribute_Name => + Print (Ctxt, Ind); + return; + when others => + null; + end case; + + Decl := Get_Nature_Declarator (Ind); + if Decl /= Null_Iir then + Disp_Name_Of (Ctxt, Decl); + else + Error_Kind ("disp_subnature_indication", Ind); + end if; + end Disp_Subnature_Indication; + + procedure Disp_Mode (Ctxt : in out Ctxt_Class; Mode: Iir_Mode) is + begin + case Mode is + when Iir_In_Mode => + Disp_Token (Ctxt, Tok_In); + when Iir_Out_Mode => + Disp_Token (Ctxt, Tok_Out); + when Iir_Inout_Mode => + Disp_Token (Ctxt, Tok_Inout); + when Iir_Buffer_Mode => + Disp_Token (Ctxt, Tok_Buffer); + when Iir_Linkage_Mode => + Disp_Token (Ctxt, Tok_Linkage); + when Iir_Unknown_Mode => + Put (" "); + end case; + end Disp_Mode; + + procedure Disp_Signal_Kind (Ctxt : in out Ctxt_Class; Sig : Iir) is + begin + if Get_Guarded_Signal_Flag (Sig) then + case Get_Signal_Kind (Sig) is + when Iir_Register_Kind => + Disp_Token (Ctxt, Tok_Register); + when Iir_Bus_Kind => + Disp_Token (Ctxt, Tok_Bus); + end case; + end if; + end Disp_Signal_Kind; + + procedure Disp_Interface_Class (Ctxt : in out Ctxt_Class; Inter: Iir) is + begin + if Get_Has_Class (Inter) then + case Get_Kind (Inter) is + when Iir_Kind_Interface_Signal_Declaration => + Disp_Token (Ctxt, Tok_Signal); + when Iir_Kind_Interface_Variable_Declaration => + Disp_Token (Ctxt, Tok_Variable); + when Iir_Kind_Interface_Constant_Declaration => + Disp_Token (Ctxt, Tok_Constant); + when Iir_Kind_Interface_File_Declaration => + Disp_Token (Ctxt, Tok_File); + when others => + Error_Kind ("disp_interface_class", Inter); + end case; + end if; + end Disp_Interface_Class; + + procedure Disp_Interface_Mode_And_Type + (Ctxt : in out Ctxt_Class; Inter: Iir) + is + Default: constant Iir := Get_Default_Value (Inter); + Ind : constant Iir := Get_Subtype_Indication (Inter); + begin + Disp_Token (Ctxt, Tok_Colon); + if Get_Has_Mode (Inter) then + Disp_Mode (Ctxt, Get_Mode (Inter)); + end if; + if Ind = Null_Iir then + -- For implicit subprogram + Disp_Type (Ctxt, Get_Type (Inter)); + else + Disp_Subtype_Indication (Ctxt, Get_Subtype_Indication (Inter)); + end if; + if Get_Kind (Inter) = Iir_Kind_Interface_Signal_Declaration then + Disp_Signal_Kind (Ctxt, Inter); + end if; + if Default /= Null_Iir then + Disp_Token (Ctxt, Tok_Assign); + Print (Ctxt, Default); + end if; + end Disp_Interface_Mode_And_Type; + + -- Disp interfaces, followed by END_STR (';' in general). + procedure Disp_Interface_Chain (Ctxt : in out Ctxt_Class; Chain: Iir) + is + Inter: Iir; + Next_Inter : Iir; + First_Inter : Iir; + begin + if Chain = Null_Iir then + return; + end if; + Disp_Token (Ctxt, Tok_Left_Paren); + + Inter := Chain; + loop + Next_Inter := Get_Chain (Inter); + + First_Inter := Inter; + + case Get_Kind (Inter) is + when Iir_Kinds_Interface_Object_Declaration => + Disp_Interface_Class (Ctxt, Inter); + Disp_Name_Of (Ctxt, Inter); + while Get_Has_Identifier_List (Inter) loop + Disp_Token (Ctxt, Tok_Comma); + Inter := Next_Inter; + Next_Inter := Get_Chain (Inter); + Disp_Name_Of (Ctxt, Inter); + end loop; + Disp_Interface_Mode_And_Type (Ctxt, First_Inter); + when Iir_Kind_Interface_Package_Declaration => + Disp_Token (Ctxt, Tok_Package); + Disp_Identifier (Ctxt, Inter); + Disp_Token (Ctxt, Tok_Is, Tok_New); + Print (Ctxt, Get_Uninstantiated_Package_Name (Inter)); + Disp_Token (Ctxt, Tok_Generic, Tok_Map); + declare + Assoc_Chain : constant Iir := + Get_Generic_Map_Aspect_Chain (Inter); + begin + if Assoc_Chain = Null_Iir then + Disp_Token (Ctxt, Tok_Left_Paren); + Disp_Token (Ctxt, Tok_Box); + Disp_Token (Ctxt, Tok_Right_Paren); + else + Disp_Association_Chain (Ctxt, Assoc_Chain); + end if; + end; + when Iir_Kind_Interface_Type_Declaration => + Disp_Token (Ctxt, Tok_Type); + Disp_Identifier (Ctxt, Inter); + when Iir_Kinds_Interface_Subprogram_Declaration => + Disp_Subprogram_Declaration (Ctxt, Inter); + when others => + Error_Kind ("disp_interface_chain", Inter); + end case; + + exit when Next_Inter = Null_Iir; + Disp_Token (Ctxt, Tok_Semi_Colon); + + Inter := Next_Inter; + Next_Inter := Get_Chain (Inter); + end loop; + + Disp_Token (Ctxt, Tok_Right_Paren); + end Disp_Interface_Chain; + + procedure Disp_Ports (Ctxt : in out Ctxt_Class; Parent : Iir) + is + Ports : constant Iir := Get_Port_Chain (Parent); + begin + if Ports /= Null_Iir then + Start_Hbox (Ctxt); + Disp_Token (Ctxt, Tok_Port); + Disp_Interface_Chain (Ctxt, Ports); + Disp_Token (Ctxt, Tok_Semi_Colon); + Close_Hbox (Ctxt); + end if; + end Disp_Ports; + + procedure Disp_Generics (Ctxt : in out Ctxt_Class; Parent : Iir) + is + Generics : constant Iir := Get_Generic_Chain (Parent); + begin + if Generics /= Null_Iir then + Start_Hbox (Ctxt); + Disp_Token (Ctxt, Tok_Generic); + Disp_Interface_Chain (Ctxt, Generics); + Disp_Token (Ctxt, Tok_Semi_Colon); + Close_Hbox (Ctxt); + end if; + end Disp_Generics; + + procedure Disp_Entity_Declaration + (Ctxt : in out Ctxt_Class; Decl: Iir_Entity_Declaration) is + begin + Start_Hbox (Ctxt); + Disp_Token (Ctxt, Tok_Entity); + Disp_Name_Of (Ctxt, Decl); + Disp_Token (Ctxt, Tok_Is); + Close_Hbox (Ctxt); + + Start_Vbox (Ctxt); + Disp_Generics (Ctxt, Decl); + Disp_Ports (Ctxt, Decl); + Disp_Declaration_Chain (Ctxt, Decl); + Close_Vbox (Ctxt); + + if Get_Has_Begin (Decl) then + Start_Hbox (Ctxt); + Disp_Token (Ctxt, Tok_Begin); + Close_Hbox (Ctxt); + end if; + if Get_Concurrent_Statement_Chain (Decl) /= Null_Iir then + Start_Vbox (Ctxt); + Disp_Concurrent_Statement_Chain (Ctxt, Decl); + Close_Vbox (Ctxt); + end if; + Disp_End (Ctxt, Decl, Tok_Entity); + end Disp_Entity_Declaration; + + procedure Disp_Component_Declaration + (Ctxt : in out Ctxt_Class; Decl: Iir_Component_Declaration) is + begin + Start_Hbox (Ctxt); + Disp_Token (Ctxt, Tok_Component); + Disp_Name_Of (Ctxt, Decl); + if Get_Has_Is (Decl) then + Disp_Token (Ctxt, Tok_Is); + end if; + Close_Hbox (Ctxt); + + Start_Vbox (Ctxt); + if Get_Generic_Chain (Decl) /= Null_Iir then + Disp_Generics (Ctxt, Decl); + end if; + if Get_Port_Chain (Decl) /= Null_Iir then + Disp_Ports (Ctxt, Decl); + end if; + Close_Vbox (Ctxt); + + Disp_End (Ctxt, Decl, Tok_Component); + end Disp_Component_Declaration; + + procedure Disp_Concurrent_Statement_Chain + (Ctxt : in out Ctxt_Class; Parent : Iir) + is + El: Iir; + begin + El := Get_Concurrent_Statement_Chain (Parent); + while El /= Null_Iir loop + Disp_Concurrent_Statement (Ctxt, El); + El := Get_Chain (El); + end loop; + end Disp_Concurrent_Statement_Chain; + + procedure Disp_Architecture_Body + (Ctxt : in out Ctxt_Class; Arch: Iir_Architecture_Body) is + begin + Start_Hbox (Ctxt); + Disp_Token (Ctxt, Tok_Architecture); + Disp_Name_Of (Ctxt, Arch); + Disp_Token (Ctxt, Tok_Of); + Print (Ctxt, Get_Entity_Name (Arch)); + Disp_Token (Ctxt, Tok_Is); + Close_Hbox (Ctxt); + + Start_Vbox (Ctxt); + Disp_Declaration_Chain (Ctxt, Arch); + Close_Vbox (Ctxt); + + Start_Hbox (Ctxt); + Disp_Token (Ctxt, Tok_Begin); + Close_Hbox (Ctxt); + + Start_Vbox (Ctxt); + Disp_Concurrent_Statement_Chain (Ctxt, Arch); + Close_Vbox (Ctxt); + + Disp_End (Ctxt, Arch, Tok_Architecture); + end Disp_Architecture_Body; + + procedure Disp_Signature (Ctxt : in out Ctxt_Class; Sig : Iir) + is + Prefix : constant Iir := Get_Signature_Prefix (Sig); + List : constant Iir_Flist := Get_Type_Marks_List (Sig); + El : Iir; + begin + if Is_Valid (Prefix) then + -- Only in alias. + Print (Ctxt, Prefix); + end if; + Disp_Token (Ctxt, Tok_Left_Bracket); + if List /= Null_Iir_Flist then + for I in Flist_First .. Flist_Last (List) loop + El := Get_Nth_Element (List, I); + if I /= 0 then + Disp_Token (Ctxt, Tok_Comma); + end if; + Print (Ctxt, El); + end loop; + end if; + El := Get_Return_Type_Mark (Sig); + if El /= Null_Iir then + Disp_Token (Ctxt, Tok_Return); + Print (Ctxt, El); + end if; + Disp_Token (Ctxt, Tok_Right_Bracket); + end Disp_Signature; + + procedure Disp_Object_Alias_Declaration + (Ctxt : in out Ctxt_Class; Decl: Iir_Object_Alias_Declaration) + is + St_Ind : constant Iir := Get_Subtype_Indication (Decl); + Atype : constant Iir := Get_Type (Decl); + begin + Start_Hbox (Ctxt); + Disp_Token (Ctxt, Tok_Alias); + Disp_Function_Name (Ctxt, Decl); + if St_Ind /= Null_Iir or else Atype /= Null_Iir then + Disp_Token (Ctxt, Tok_Colon); + Disp_Subtype_Indication (Ctxt, Or_Else (St_Ind, Atype)); + end if; + Disp_Token (Ctxt, Tok_Is); + Print (Ctxt, Get_Name (Decl)); + Disp_Token (Ctxt, Tok_Semi_Colon); + Close_Hbox (Ctxt); + end Disp_Object_Alias_Declaration; + + procedure Disp_Non_Object_Alias_Declaration + (Ctxt : in out Ctxt_Class; Decl: Iir_Non_Object_Alias_Declaration) + is + Sig : constant Iir := Get_Alias_Signature (Decl); + begin + if Get_Implicit_Alias_Flag (Decl) then + if Flag_Implicit then + Put ("-- "); + else + return; + end if; + end if; + + Start_Hbox (Ctxt); + Disp_Token (Ctxt, Tok_Alias); + Disp_Function_Name (Ctxt, Decl); + Disp_Token (Ctxt, Tok_Is); + Print (Ctxt, Get_Name (Decl)); + if Sig /= Null_Iir then + Disp_Signature (Ctxt, Sig); + end if; + Disp_Token (Ctxt, Tok_Semi_Colon); + Close_Hbox (Ctxt); + end Disp_Non_Object_Alias_Declaration; + + procedure Disp_File_Declaration + (Ctxt : in out Ctxt_Class; Decl: Iir_File_Declaration) + is + Next_Decl : Iir; + Expr: Iir; + begin + Disp_Token (Ctxt, Tok_File); + Disp_Name_Of (Ctxt, Decl); + Next_Decl := Decl; + while Get_Has_Identifier_List (Next_Decl) loop + Next_Decl := Get_Chain (Next_Decl); + Disp_Token (Ctxt, Tok_Comma); + Disp_Name_Of (Ctxt, Next_Decl); + end loop; + Disp_Token (Ctxt, Tok_Colon); + Disp_Subtype_Indication (Ctxt, Or_Else (Get_Subtype_Indication (Decl), + Get_Type (Decl))); + if Vhdl_Std = Vhdl_87 then + Disp_Token (Ctxt, Tok_Is); + if Get_Has_Mode (Decl) then + Disp_Mode (Ctxt, Get_Mode (Decl)); + end if; + Print (Ctxt, Get_File_Logical_Name (Decl)); + else + Expr := Get_File_Open_Kind (Decl); + if Expr /= Null_Iir then + Disp_Token (Ctxt, Tok_Open); + Print (Ctxt, Expr); + end if; + Expr := Get_File_Logical_Name (Decl); + if Expr /= Null_Iir then + Disp_Token (Ctxt, Tok_Is); + Print (Ctxt, Expr); + end if; + end if; + Disp_Token (Ctxt, Tok_Semi_Colon); + end Disp_File_Declaration; + + procedure Disp_Quantity_Declaration (Ctxt : in out Ctxt_Class; Decl: Iir) + is + Expr : Iir; + Term : Iir; + begin + Start_Hbox (Ctxt); + Disp_Token (Ctxt, Tok_Quantity); + Disp_Name_Of (Ctxt, Decl); + + case Get_Kind (Decl) is + when Iir_Kinds_Branch_Quantity_Declaration => + Disp_Tolerance_Opt (Ctxt, Decl); + Expr := Get_Default_Value (Decl); + if Expr /= Null_Iir then + Disp_Token (Ctxt, Tok_Assign); + Print (Ctxt, Expr); + end if; + if Get_Kind (Decl) = Iir_Kind_Across_Quantity_Declaration then + Disp_Token (Ctxt, Tok_Across); + else + Disp_Token (Ctxt, Tok_Through); + end if; + Disp_Name_Of (Ctxt, Get_Plus_Terminal (Decl)); + Term := Get_Minus_Terminal (Decl); + if Term /= Null_Iir then + Disp_Token (Ctxt, Tok_To); + Disp_Name_Of (Ctxt, Term); + end if; + when Iir_Kind_Free_Quantity_Declaration => + Disp_Token (Ctxt, Tok_Colon); + Disp_Subtype_Indication + (Ctxt, Or_Else (Get_Subtype_Indication (Decl), Get_Type (Decl))); + Expr := Get_Default_Value (Decl); + if Expr /= Null_Iir then + Disp_Token (Ctxt, Tok_Assign); + Print (Ctxt, Expr); + end if; + when others => + raise Program_Error; + end case; + Disp_Token (Ctxt, Tok_Semi_Colon); + Close_Hbox (Ctxt); + end Disp_Quantity_Declaration; + + procedure Disp_Terminal_Declaration (Ctxt : in out Ctxt_Class; Decl: Iir) + is + Ndecl : Iir; + begin + Start_Hbox (Ctxt); + Disp_Token (Ctxt, Tok_Terminal); + Disp_Name_Of (Ctxt, Decl); + Ndecl := Decl; + while Get_Has_Identifier_List (Ndecl) loop + Disp_Token (Ctxt, Tok_Comma); + Ndecl := Get_Chain (Ndecl); + Disp_Name_Of (Ctxt, Ndecl); + end loop; + Disp_Token (Ctxt, Tok_Colon); + Disp_Subnature_Indication (Ctxt, Get_Nature (Decl)); + Disp_Token (Ctxt, Tok_Semi_Colon); + Close_Hbox (Ctxt); + end Disp_Terminal_Declaration; + + procedure Disp_Object_Declaration (Ctxt : in out Ctxt_Class; Decl: Iir) + is + Next_Decl : Iir; + begin + Start_Hbox (Ctxt); + case Get_Kind (Decl) is + when Iir_Kind_Variable_Declaration => + if Get_Shared_Flag (Decl) then + Disp_Token (Ctxt, Tok_Shared); + end if; + Disp_Token (Ctxt, Tok_Variable); + when Iir_Kind_Constant_Declaration => + Disp_Token (Ctxt, Tok_Constant); + when Iir_Kind_Signal_Declaration => + Disp_Token (Ctxt, Tok_Signal); + when Iir_Kind_File_Declaration => + Disp_File_Declaration (Ctxt, Decl); + Close_Hbox (Ctxt); + return; + when others => + raise Internal_Error; + end case; + Disp_Name_Of (Ctxt, Decl); + Next_Decl := Decl; + while Get_Has_Identifier_List (Next_Decl) loop + Next_Decl := Get_Chain (Next_Decl); + Disp_Token (Ctxt, Tok_Comma); + Disp_Name_Of (Ctxt, Next_Decl); + end loop; + Disp_Token (Ctxt, Tok_Colon); + Disp_Subtype_Indication (Ctxt, Get_Subtype_Indication (Decl)); + if Get_Kind (Decl) = Iir_Kind_Signal_Declaration then + Disp_Signal_Kind (Ctxt, Decl); + end if; + + if Get_Default_Value (Decl) /= Null_Iir then + Disp_Token (Ctxt, Tok_Assign); + Print (Ctxt, Get_Default_Value (Decl)); + end if; + Disp_Token (Ctxt, Tok_Semi_Colon); + Close_Hbox (Ctxt); + end Disp_Object_Declaration; + + procedure Disp_Pure (Ctxt : in out Ctxt_Class; Subprg : Iir) is + begin + if Get_Pure_Flag (Subprg) then + Disp_Token (Ctxt, Tok_Pure); + else + Disp_Token (Ctxt, Tok_Impure); + end if; + end Disp_Pure; + + procedure Disp_Subprogram_Declaration + (Ctxt : in out Ctxt_Class; Subprg: Iir; Implicit : Boolean := False) + is + Inter : Iir; + begin + if Implicit then + Put ("-- "); + end if; + + case Get_Kind (Subprg) is + when Iir_Kind_Function_Declaration + | Iir_Kind_Interface_Function_Declaration => + if Get_Has_Pure (Subprg) then + Disp_Pure (Ctxt, Subprg); + end if; + Disp_Token (Ctxt, Tok_Function); + when Iir_Kind_Procedure_Declaration + | Iir_Kind_Interface_Procedure_Declaration => + Disp_Token (Ctxt, Tok_Procedure); + when others => + raise Internal_Error; + end case; + + Disp_Function_Name (Ctxt, Subprg); + + if Get_Has_Parameter (Subprg) then + Disp_Token (Ctxt, Tok_Parameter); + end if; + + Inter := Get_Interface_Declaration_Chain (Subprg); + Disp_Interface_Chain (Ctxt, Inter); + + case Get_Kind (Subprg) is + when Iir_Kind_Function_Declaration + | Iir_Kind_Interface_Function_Declaration => + Disp_Token (Ctxt, Tok_Return); + Disp_Subtype_Indication + (Ctxt, Or_Else (Get_Return_Type_Mark (Subprg), + Get_Return_Type (Subprg))); + when Iir_Kind_Procedure_Declaration + | Iir_Kind_Interface_Procedure_Declaration => + null; + when others => + raise Internal_Error; + end case; + end Disp_Subprogram_Declaration; + + procedure Disp_Subprogram_Body (Ctxt : in out Ctxt_Class; Subprg : Iir) is + begin + Start_Vbox (Ctxt); + Disp_Declaration_Chain (Ctxt, Subprg); + Close_Vbox (Ctxt); + Start_Hbox (Ctxt); + Disp_Token (Ctxt, Tok_Begin); + Close_Hbox (Ctxt); + Start_Vbox (Ctxt); + Disp_Sequential_Statements + (Ctxt, Get_Sequential_Statement_Chain (Subprg)); + Close_Vbox (Ctxt); + if Get_Kind (Subprg) = Iir_Kind_Function_Body then + Disp_End (Ctxt, Subprg, Tok_Function); + else + Disp_End (Ctxt, Subprg, Tok_Procedure); + end if; + end Disp_Subprogram_Body; + + procedure Disp_Instantiation_List + (Ctxt : in out Ctxt_Class; Insts: Iir_Flist) + is + El : Iir; + begin + case Insts is + when Iir_Flist_All => + Disp_Token (Ctxt, Tok_All); + when Iir_Flist_Others => + Disp_Token (Ctxt, Tok_Others); + when others => + for I in Flist_First .. Flist_Last (Insts) loop + El := Get_Nth_Element (Insts, I); + if I /= Flist_First then + Disp_Token (Ctxt, Tok_Comma); + end if; + Print (Ctxt, El); + end loop; + end case; + end Disp_Instantiation_List; + + procedure Disp_Configuration_Specification + (Ctxt : in out Ctxt_Class; Spec : Iir_Configuration_Specification) is + begin + Start_Hbox (Ctxt); + Disp_Token (Ctxt, Tok_For); + Disp_Instantiation_List (Ctxt, Get_Instantiation_List (Spec)); + Disp_Token (Ctxt, Tok_Colon); + Print (Ctxt, Get_Component_Name (Spec)); + Disp_Binding_Indication (Ctxt, Get_Binding_Indication (Spec)); + Disp_Token (Ctxt, Tok_Semi_Colon); + Close_Hbox (Ctxt); + end Disp_Configuration_Specification; + + procedure Disp_Disconnection_Specification + (Ctxt : in out Ctxt_Class; Dis : Iir_Disconnection_Specification) is + begin + Start_Hbox (Ctxt); + Disp_Token (Ctxt, Tok_Disconnect); + Disp_Instantiation_List (Ctxt, Get_Signal_List (Dis)); + Disp_Token (Ctxt, Tok_Colon); + Print (Ctxt, Get_Type_Mark (Dis)); + Disp_Token (Ctxt, Tok_After); + Print (Ctxt, Get_Expression (Dis)); + Disp_Token (Ctxt, Tok_Semi_Colon); + Close_Hbox (Ctxt); + end Disp_Disconnection_Specification; + + procedure Disp_Attribute_Declaration + (Ctxt : in out Ctxt_Class; Attr : Iir_Attribute_Declaration) is + begin + Start_Hbox (Ctxt); + Disp_Token (Ctxt, Tok_Attribute); + Disp_Identifier (Ctxt, Attr); + Disp_Token (Ctxt, Tok_Colon); + Print (Ctxt, Get_Type_Mark (Attr)); + Disp_Token (Ctxt, Tok_Semi_Colon); + Close_Hbox (Ctxt); + end Disp_Attribute_Declaration; + + procedure Disp_Attribute_Value (Ctxt : in out Ctxt_Class; Attr : Iir) is + begin + Disp_Name_Of (Ctxt, Get_Designated_Entity (Attr)); + Put ("'"); + Disp_Identifier + (Ctxt, Get_Attribute_Designator (Get_Attribute_Specification (Attr))); + end Disp_Attribute_Value; + + procedure Disp_Attribute_Name (Ctxt : in out Ctxt_Class; Attr : Iir) + is + Sig : constant Iir := Get_Attribute_Signature (Attr); + begin + Print (Ctxt, Get_Prefix (Attr)); + if Sig /= Null_Iir then + Disp_Signature (Ctxt, Sig); + end if; + Disp_Token (Ctxt, Tok_Tick); + Disp_Ident (Ctxt, Get_Identifier (Attr)); + end Disp_Attribute_Name; + + procedure Disp_Entity_Kind (Ctxt : in out Ctxt_Class; Tok : Token_Type) is + begin + Disp_Token (Ctxt, Tok); + end Disp_Entity_Kind; + + procedure Disp_Entity_Name_List (Ctxt : in out Ctxt_Class; List : Iir_Flist) + is + El : Iir; + begin + case List is + when Iir_Flist_All => + Disp_Token (Ctxt, Tok_All); + when Iir_Flist_Others => + Disp_Token (Ctxt, Tok_Others); + when others => + for I in Flist_First .. Flist_Last (List) loop + El := Get_Nth_Element (List, I); + if I /= Flist_First then + Disp_Token (Ctxt, Tok_Comma); + end if; + Print (Ctxt, El); + end loop; + end case; + end Disp_Entity_Name_List; + + procedure Disp_Attribute_Specification + (Ctxt : in out Ctxt_Class; Attr : Iir_Attribute_Specification) is + begin + Start_Hbox (Ctxt); + Disp_Token (Ctxt, Tok_Attribute); + Disp_Identifier (Ctxt, Get_Attribute_Designator (Attr)); + Disp_Token (Ctxt, Tok_Of); + Disp_Entity_Name_List (Ctxt, Get_Entity_Name_List (Attr)); + Disp_Token (Ctxt, Tok_Colon); + Disp_Entity_Kind (Ctxt, Get_Entity_Class (Attr)); + Disp_Token (Ctxt, Tok_Is); + Print (Ctxt, Get_Expression (Attr)); + Disp_Token (Ctxt, Tok_Semi_Colon); + Close_Hbox (Ctxt); + end Disp_Attribute_Specification; + + procedure Disp_Protected_Type_Body + (Ctxt : in out Ctxt_Class; Bod : Iir_Protected_Type_Body) is + begin + Start_Hbox (Ctxt); + Disp_Token (Ctxt, Tok_Type); + Disp_Identifier (Ctxt, Bod); + Disp_Token (Ctxt, Tok_Is); + Disp_Token (Ctxt, Tok_Protected, Tok_Body); + Close_Hbox (Ctxt); + + Start_Vbox (Ctxt); + Disp_Declaration_Chain (Ctxt, Bod); + Close_Vbox (Ctxt); + + Disp_End (Ctxt, Bod, Tok_Protected, Tok_Body); + end Disp_Protected_Type_Body; + + procedure Disp_Group_Template_Declaration + (Ctxt : in out Ctxt_Class; Decl : Iir) + is + Ent : Iir; + begin + Start_Hbox (Ctxt); + Disp_Token (Ctxt, Tok_Group); + Disp_Identifier (Ctxt, Decl); + Disp_Token (Ctxt, Tok_Is, Tok_Left_Paren); + Ent := Get_Entity_Class_Entry_Chain (Decl); + loop + Disp_Entity_Kind (Ctxt, Get_Entity_Class (Ent)); + Ent := Get_Chain (Ent); + exit when Ent = Null_Iir; + if Get_Entity_Class (Ent) = Tok_Box then + Disp_Token (Ctxt, Tok_Box); + exit; + else + Disp_Token (Ctxt, Tok_Comma); + end if; + end loop; + Disp_Token (Ctxt, Tok_Right_Paren, Tok_Semi_Colon); + Close_Hbox (Ctxt); + end Disp_Group_Template_Declaration; + + procedure Disp_Group_Declaration (Ctxt : in out Ctxt_Class; Decl : Iir) + is + List : Iir_Flist; + El : Iir; + begin + Start_Hbox (Ctxt); + Disp_Token (Ctxt, Tok_Group); + Disp_Identifier (Ctxt, Decl); + Disp_Token (Ctxt, Tok_Colon); + Print (Ctxt, Get_Group_Template_Name (Decl)); + Disp_Token (Ctxt, Tok_Left_Paren); + List := Get_Group_Constituent_List (Decl); + for I in Flist_First .. Flist_Last (List) loop + El := Get_Nth_Element (List, I); + if I /= 0 then + Disp_Token (Ctxt, Tok_Comma); + end if; + Disp_Name_Of (Ctxt, El); + end loop; + Disp_Token (Ctxt, Tok_Right_Paren, Tok_Semi_Colon); + Close_Hbox (Ctxt); + end Disp_Group_Declaration; + + procedure Disp_PSL_HDL_Expr + (N : PSL.Nodes.HDL_Node) is + begin + Disp_Expression (Iir (N)); + end Disp_PSL_HDL_Expr; + + procedure Disp_Psl_Expression + (Ctxt : in out Ctxt_Class; Expr : PSL_Node) is + begin + PSL.Prints.HDL_Expr_Printer := Disp_PSL_HDL_Expr'Access; + -- Hack. + Disp_Char (Ctxt, ' '); + PSL.Prints.Print_Property (Expr); + end Disp_Psl_Expression; + + procedure Disp_Psl_Sequence + (Ctxt : in out Ctxt_Class; Expr : PSL_Node) is + begin + PSL.Prints.HDL_Expr_Printer := Disp_PSL_HDL_Expr'Access; + -- Hack. + Disp_Char (Ctxt, ' '); + PSL.Prints.Print_Sequence (Expr); + end Disp_Psl_Sequence; + + procedure Disp_Psl_Default_Clock (Ctxt : in out Ctxt_Class; Stmt : Iir) is + begin + if Vhdl_Std < Vhdl_08 then + Put ("--psl "); + end if; + Start_Hbox (Ctxt); + Disp_Token (Ctxt, Tok_Psl_Default, Tok_Psl_Clock); + Disp_Token (Ctxt, Tok_Is); + Disp_Psl_Expression (Ctxt, Get_Psl_Boolean (Stmt)); + Disp_Token (Ctxt, Tok_Semi_Colon); + Close_Hbox (Ctxt); + end Disp_Psl_Default_Clock; + + procedure Disp_Psl_Declaration (Ctxt : in out Ctxt_Class; Stmt : Iir) + is + use PSL.Nodes; + Decl : constant PSL_Node := Get_Psl_Declaration (Stmt); + begin + if Vhdl_Std < Vhdl_08 then + Put ("--psl "); + end if; + case Get_Kind (Decl) is + when N_Property_Declaration => + Put ("property "); + Disp_Ident (Ctxt, Get_Identifier (Decl)); + Put (" is "); + Disp_Psl_Expression (Ctxt, Get_Property (Decl)); + Put_Line (";"); + when N_Sequence_Declaration => + Put ("sequence "); + Disp_Ident (Ctxt, Get_Identifier (Decl)); + Put (" is "); + Disp_Psl_Sequence (Ctxt, Get_Sequence (Decl)); + Put_Line (";"); + when N_Endpoint_Declaration => + Put ("endpoint "); + Disp_Ident (Ctxt, Get_Identifier (Decl)); + Put (" is "); + Disp_Psl_Sequence (Ctxt, Get_Sequence (Decl)); + Put_Line (";"); + Disp_PSL_NFA (Get_PSL_NFA (Stmt)); + when others => + PSL.Errors.Error_Kind ("disp_psl_declaration", Decl); + end case; + end Disp_Psl_Declaration; + + procedure Disp_Declaration_Chain + (Ctxt : in out Ctxt_Class; Parent : Iir) + is + Decl: Iir; + begin + Decl := Get_Declaration_Chain (Parent); + while Decl /= Null_Iir loop + case Get_Kind (Decl) is + when Iir_Kind_Type_Declaration => + Disp_Type_Declaration (Ctxt, Decl); + when Iir_Kind_Anonymous_Type_Declaration => + Disp_Anonymous_Type_Declaration (Ctxt, Decl); + when Iir_Kind_Subtype_Declaration => + Disp_Subtype_Declaration (Ctxt, Decl); + when Iir_Kind_Use_Clause => + Disp_Use_Clause (Ctxt, Decl); + when Iir_Kind_Component_Declaration => + Disp_Component_Declaration (Ctxt, Decl); + when Iir_Kind_File_Declaration + | Iir_Kind_Signal_Declaration + | Iir_Kind_Constant_Declaration + | Iir_Kind_Variable_Declaration => + Disp_Object_Declaration (Ctxt, Decl); + while Get_Has_Identifier_List (Decl) loop + Decl := Get_Chain (Decl); + end loop; + when Iir_Kind_Object_Alias_Declaration => + Disp_Object_Alias_Declaration (Ctxt, Decl); + when Iir_Kind_Terminal_Declaration => + Disp_Terminal_Declaration (Ctxt, Decl); + while Get_Has_Identifier_List (Decl) loop + Decl := Get_Chain (Decl); + end loop; + when Iir_Kinds_Quantity_Declaration => + Disp_Quantity_Declaration (Ctxt, Decl); + when Iir_Kind_Nature_Declaration => + Disp_Nature_Declaration (Ctxt, Decl); + when Iir_Kind_Non_Object_Alias_Declaration => + Disp_Non_Object_Alias_Declaration (Ctxt, Decl); + when Iir_Kind_Function_Declaration + | Iir_Kind_Procedure_Declaration => + declare + Implicit : constant Boolean := + Is_Implicit_Subprogram (Decl) + and then (Get_Implicit_Definition (Decl) + /= Iir_Predefined_Now_Function); + begin + if not Implicit or else Flag_Implicit then + Start_Hbox (Ctxt); + Disp_Subprogram_Declaration (Ctxt, Decl, Implicit); + if not Get_Has_Body (Decl) then + Disp_Token (Ctxt, Tok_Semi_Colon); + Close_Hbox (Ctxt); + end if; + end if; + end; + when Iir_Kind_Function_Body + | Iir_Kind_Procedure_Body => + -- The declaration was just displayed. + Disp_Token (Ctxt, Tok_Is); + Close_Hbox (Ctxt); + Disp_Subprogram_Body (Ctxt, Decl); + when Iir_Kind_Protected_Type_Body => + Disp_Protected_Type_Body (Ctxt, Decl); + when Iir_Kind_Configuration_Specification => + Disp_Configuration_Specification (Ctxt, Decl); + when Iir_Kind_Disconnection_Specification => + Disp_Disconnection_Specification (Ctxt, Decl); + when Iir_Kind_Attribute_Declaration => + Disp_Attribute_Declaration (Ctxt, Decl); + when Iir_Kind_Attribute_Specification => + Disp_Attribute_Specification (Ctxt, Decl); + when Iir_Kind_Signal_Attribute_Declaration => + null; + when Iir_Kind_Group_Template_Declaration => + Disp_Group_Template_Declaration (Ctxt, Decl); + when Iir_Kind_Group_Declaration => + Disp_Group_Declaration (Ctxt, Decl); + when Iir_Kind_Package_Declaration => + Disp_Package_Declaration (Ctxt, Decl); + when Iir_Kind_Package_Body => + Disp_Package_Body (Ctxt, Decl); + when Iir_Kind_Package_Instantiation_Declaration => + Disp_Package_Instantiation_Declaration (Ctxt, Decl); + when Iir_Kind_Psl_Default_Clock => + Disp_Psl_Default_Clock (Ctxt, Decl); + when others => + Error_Kind ("disp_declaration_chain", Decl); + end case; + Decl := Get_Chain (Decl); + end loop; + end Disp_Declaration_Chain; + + procedure Disp_Waveform + (Ctxt : in out Ctxt_Class; Chain : Iir_Waveform_Element) + is + We: Iir_Waveform_Element; + Val : Iir; + begin + if Chain = Null_Iir then + Put ("null after {disconnection_time}"); + return; + elsif Get_Kind (Chain) = Iir_Kind_Unaffected_Waveform then + Disp_Token (Ctxt, Tok_Unaffected); + return; + end if; + We := Chain; + while We /= Null_Iir loop + if We /= Chain then + Disp_Token (Ctxt, Tok_Comma); + end if; + Val := Get_We_Value (We); + Print (Ctxt, Val); + if Get_Time (We) /= Null_Iir then + Disp_Token (Ctxt, Tok_After); + Print (Ctxt, Get_Time (We)); + end if; + We := Get_Chain (We); + end loop; + end Disp_Waveform; + + procedure Disp_Delay_Mechanism (Ctxt : in out Ctxt_Class; Stmt: Iir) is + Expr: Iir; + begin + case Get_Delay_Mechanism (Stmt) is + when Iir_Transport_Delay => + Disp_Token (Ctxt, Tok_Transport); + when Iir_Inertial_Delay => + Expr := Get_Reject_Time_Expression (Stmt); + if Expr /= Null_Iir then + Disp_Token (Ctxt, Tok_Reject); + Print (Ctxt, Expr); + Disp_Token (Ctxt, Tok_Inertial); + end if; + end case; + end Disp_Delay_Mechanism; + + procedure Disp_Label (Ctxt : in out Ctxt_Class; Stmt : Iir) + is + Label: constant Name_Id := Get_Label (Stmt); + begin + if Label /= Null_Identifier then + Disp_Identifier (Ctxt, Stmt); + Disp_Token (Ctxt, Tok_Colon); + end if; + end Disp_Label; + + procedure Disp_Simple_Signal_Assignment + (Ctxt : in out Ctxt_Class; Stmt: Iir) is + begin + Start_Hbox (Ctxt); + Disp_Label (Ctxt, Stmt); + Print (Ctxt, Get_Target (Stmt)); + Disp_Token (Ctxt, Tok_Less_Equal); + Disp_Delay_Mechanism (Ctxt, Stmt); + Disp_Waveform (Ctxt, Get_Waveform_Chain (Stmt)); + Disp_Token (Ctxt, Tok_Semi_Colon); + Close_Hbox (Ctxt); + end Disp_Simple_Signal_Assignment; + + procedure Disp_Conditional_Waveform (Ctxt : in out Ctxt_Class; Chain : Iir) + is + Cond_Wf : Iir; + Expr : Iir; + begin + Cond_Wf := Chain; + while Cond_Wf /= Null_Iir loop + Disp_Waveform (Ctxt, Get_Waveform_Chain (Cond_Wf)); + Expr := Get_Condition (Cond_Wf); + if Expr /= Null_Iir then + Disp_Token (Ctxt, Tok_When); + Print (Ctxt, Expr); + Disp_Token (Ctxt, Tok_Else); + end if; + Cond_Wf := Get_Chain (Cond_Wf); + end loop; + end Disp_Conditional_Waveform; + + procedure Disp_Conditional_Signal_Assignment + (Ctxt : in out Ctxt_Class; Stmt: Iir) is + begin + Start_Hbox (Ctxt); + Print (Ctxt, Get_Target (Stmt)); + Disp_Token (Ctxt, Tok_Less_Equal); + Disp_Delay_Mechanism (Ctxt, Stmt); + Disp_Conditional_Waveform (Ctxt, Get_Conditional_Waveform_Chain (Stmt)); + Disp_Token (Ctxt, Tok_Semi_Colon); + Close_Hbox (Ctxt); + end Disp_Conditional_Signal_Assignment; + + procedure Disp_Selected_Waveforms + (Ctxt : in out Ctxt_Class; Stmt : Iir) + is + Assoc_Chain : constant Iir := Get_Selected_Waveform_Chain (Stmt); + Assoc: Iir; + begin + Assoc := Assoc_Chain; + while Assoc /= Null_Iir loop + if Assoc /= Assoc_Chain then + Disp_Token (Ctxt, Tok_Comma); + end if; + Disp_Waveform (Ctxt, Get_Associated_Chain (Assoc)); + Disp_Token (Ctxt, Tok_When); + Disp_Choice (Ctxt, Assoc); + end loop; + Disp_Token (Ctxt, Tok_Semi_Colon); + end Disp_Selected_Waveforms; + + procedure Disp_Selected_Waveform_Assignment + (Ctxt : in out Ctxt_Class; Stmt: Iir) is + begin + Start_Hbox (Ctxt); + Disp_Label (Ctxt, Stmt); + Put ("with "); + Print (Ctxt, Get_Expression (Stmt)); + Put (" select "); + Print (Ctxt, Get_Target (Stmt)); + Put (" <= "); + Disp_Delay_Mechanism (Ctxt, Stmt); + Disp_Selected_Waveforms (Ctxt, Stmt); + Close_Hbox (Ctxt); + end Disp_Selected_Waveform_Assignment; + + procedure Disp_Variable_Assignment + (Ctxt : in out Ctxt_Class; Stmt: Iir) is + begin + Start_Hbox (Ctxt); + Disp_Label (Ctxt, Stmt); + Print (Ctxt, Get_Target (Stmt)); + Disp_Token (Ctxt, Tok_Assign); + Print (Ctxt, Get_Expression (Stmt)); + Disp_Token (Ctxt, Tok_Semi_Colon); + Close_Hbox (Ctxt); + end Disp_Variable_Assignment; + + procedure Disp_Conditional_Expression + (Ctxt : in out Ctxt_Class; Exprs : Iir) + is + Expr : Iir; + Cond : Iir; + begin + Expr := Exprs; + loop + Print (Ctxt, Get_Expression (Expr)); + Cond := Get_Condition (Expr); + if Cond /= Null_Iir then + Disp_Token (Ctxt, Tok_When); + Print (Ctxt, Cond); + end if; + Expr := Get_Chain (Expr); + exit when Expr = Null_Iir; + Disp_Token (Ctxt, Tok_Else); + end loop; + end Disp_Conditional_Expression; + + procedure Disp_Conditional_Variable_Assignment + (Ctxt : in out Ctxt_Class; Stmt: Iir) is + begin + Start_Hbox (Ctxt); + Disp_Label (Ctxt, Stmt); + Print (Ctxt, Get_Target (Stmt)); + Disp_Token (Ctxt, Tok_Assign); + Disp_Conditional_Expression (Ctxt, Get_Conditional_Expression (Stmt)); + Disp_Token (Ctxt, Tok_Semi_Colon); + Close_Hbox (Ctxt); + end Disp_Conditional_Variable_Assignment; + + procedure Disp_Postponed (Ctxt : in out Ctxt_Class; Stmt : Iir) is + begin + if Get_Postponed_Flag (Stmt) then + Disp_Token (Ctxt, Tok_Postponed); + end if; + end Disp_Postponed; + + procedure Disp_Concurrent_Simple_Signal_Assignment + (Ctxt : in out Ctxt_Class; Stmt: Iir) is + begin + Start_Hbox (Ctxt); + Disp_Label (Ctxt, Stmt); + Disp_Postponed (Ctxt, Stmt); + Print (Ctxt, Get_Target (Stmt)); + Disp_Token (Ctxt, Tok_Less_Equal); + if Get_Guard (Stmt) /= Null_Iir then + Disp_Token (Ctxt, Tok_Guarded); + end if; + Disp_Delay_Mechanism (Ctxt, Stmt); + Disp_Waveform (Ctxt, Get_Waveform_Chain (Stmt)); + + Disp_Token (Ctxt, Tok_Semi_Colon); + Close_Hbox (Ctxt); + end Disp_Concurrent_Simple_Signal_Assignment; + + procedure Disp_Concurrent_Selected_Signal_Assignment + (Ctxt : in out Ctxt_Class; Stmt: Iir) is + begin + Start_Hbox (Ctxt); + Disp_Label (Ctxt, Stmt); + Disp_Postponed (Ctxt, Stmt); + Disp_Token (Ctxt, Tok_With); + Print (Ctxt, Get_Expression (Stmt)); + Disp_Token (Ctxt, Tok_Select); + Print (Ctxt, Get_Target (Stmt)); + Disp_Token (Ctxt, Tok_Less_Equal); + if Get_Guard (Stmt) /= Null_Iir then + Disp_Token (Ctxt, Tok_Guarded); + end if; + Disp_Delay_Mechanism (Ctxt, Stmt); + Disp_Selected_Waveforms (Ctxt, Stmt); + Close_Hbox (Ctxt); + end Disp_Concurrent_Selected_Signal_Assignment; + + procedure Disp_Concurrent_Conditional_Signal_Assignment + (Ctxt : in out Ctxt_Class; Stmt: Iir) is + begin + Start_Hbox (Ctxt); + Disp_Label (Ctxt, Stmt); + Disp_Postponed (Ctxt, Stmt); + Print (Ctxt, Get_Target (Stmt)); + Disp_Token (Ctxt, Tok_Less_Equal); + if Get_Guard (Stmt) /= Null_Iir then + Disp_Token (Ctxt, Tok_Guarded); + end if; + Disp_Delay_Mechanism (Ctxt, Stmt); + Disp_Conditional_Waveform (Ctxt, Get_Conditional_Waveform_Chain (Stmt)); + Disp_Token (Ctxt, Tok_Semi_Colon); + Close_Hbox (Ctxt); + end Disp_Concurrent_Conditional_Signal_Assignment; + + procedure Disp_Severity_Expression (Ctxt : in out Ctxt_Class; Stmt : Iir) + is + Expr : constant Iir := Get_Severity_Expression (Stmt); + begin + if Expr /= Null_Iir then + Disp_Token (Ctxt, Tok_Severity); + Print (Ctxt, Expr); + end if; + end Disp_Severity_Expression; + + procedure Disp_Report_Expression (Ctxt : in out Ctxt_Class; Stmt : Iir) + is + Expr : constant Iir := Get_Report_Expression (Stmt); + begin + if Expr /= Null_Iir then + Disp_Token (Ctxt, Tok_Report); + Print (Ctxt, Expr); + end if; + end Disp_Report_Expression; + + procedure Disp_Assertion_Statement (Ctxt : in out Ctxt_Class; Stmt: Iir) is + begin + Start_Hbox (Ctxt); + Disp_Label (Ctxt, Stmt); + if Get_Kind (Stmt) = Iir_Kind_Concurrent_Assertion_Statement then + Disp_Postponed (Ctxt, Stmt); + end if; + Disp_Token (Ctxt, Tok_Assert); + Print (Ctxt, Get_Assertion_Condition (Stmt)); + Disp_Report_Expression (Ctxt, Stmt); + Disp_Severity_Expression (Ctxt, Stmt); + Disp_Token (Ctxt, Tok_Semi_Colon); + Close_Hbox (Ctxt); + end Disp_Assertion_Statement; + + procedure Disp_Report_Statement (Ctxt : in out Ctxt_Class; Stmt: Iir) is + begin + Start_Hbox (Ctxt); + Disp_Label (Ctxt, Stmt); + Disp_Token (Ctxt, Tok_Report); + Print (Ctxt, Get_Report_Expression (Stmt)); + Disp_Severity_Expression (Ctxt, Stmt); + Disp_Token (Ctxt, Tok_Semi_Colon); + Close_Hbox (Ctxt); + end Disp_Report_Statement; + + function Get_Operator_Token (Op : Iir) return Token_Type is + begin + case Get_Kind (Op) is + when Iir_Kind_And_Operator + | Iir_Kind_Reduction_And_Operator => + return Tok_And; + when Iir_Kind_Or_Operator + | Iir_Kind_Reduction_Or_Operator => + return Tok_Or; + when Iir_Kind_Nand_Operator + | Iir_Kind_Reduction_Nand_Operator => + return Tok_Nand; + when Iir_Kind_Nor_Operator + | Iir_Kind_Reduction_Nor_Operator => + return Tok_Nor; + when Iir_Kind_Xor_Operator + | Iir_Kind_Reduction_Xor_Operator => + return Tok_Xor; + when Iir_Kind_Xnor_Operator + | Iir_Kind_Reduction_Xnor_Operator => + return Tok_Xnor; + + when Iir_Kind_Equality_Operator => + return Tok_Equal; + when Iir_Kind_Inequality_Operator => + return Tok_Not_Equal; + when Iir_Kind_Less_Than_Operator => + return Tok_Less; + when Iir_Kind_Less_Than_Or_Equal_Operator => + return Tok_Less_Equal; + when Iir_Kind_Greater_Than_Operator => + return Tok_Greater; + when Iir_Kind_Greater_Than_Or_Equal_Operator => + return Tok_Greater_Equal; + + when Iir_Kind_Match_Equality_Operator => + return Tok_Match_Equal; + when Iir_Kind_Match_Inequality_Operator => + return Tok_Match_Not_Equal; + when Iir_Kind_Match_Less_Than_Operator => + return Tok_Match_Less; + when Iir_Kind_Match_Less_Than_Or_Equal_Operator => + return Tok_Match_Less_Equal; + when Iir_Kind_Match_Greater_Than_Operator => + return Tok_Match_Greater; + when Iir_Kind_Match_Greater_Than_Or_Equal_Operator => + return Tok_Match_Greater_Equal; + + when Iir_Kind_Sll_Operator => + return Tok_Sll; + when Iir_Kind_Sla_Operator => + return Tok_Sla; + when Iir_Kind_Srl_Operator => + return Tok_Srl; + when Iir_Kind_Sra_Operator => + return Tok_Sra; + when Iir_Kind_Rol_Operator => + return Tok_Rol; + when Iir_Kind_Ror_Operator => + return Tok_Ror; + + when Iir_Kind_Addition_Operator => + return Tok_Plus; + when Iir_Kind_Substraction_Operator => + return Tok_Minus; + when Iir_Kind_Concatenation_Operator => + return Tok_Ampersand; + when Iir_Kind_Multiplication_Operator => + return Tok_Star; + when Iir_Kind_Division_Operator => + return Tok_Slash; + when Iir_Kind_Modulus_Operator => + return Tok_Mod; + when Iir_Kind_Remainder_Operator => + return Tok_Rem; + when Iir_Kind_Exponentiation_Operator => + return Tok_Double_Star; + when Iir_Kind_Not_Operator => + return Tok_Not; + when Iir_Kind_Negation_Operator => + return Tok_Minus; + when Iir_Kind_Identity_Operator => + return Tok_Plus; + when Iir_Kind_Absolute_Operator => + return Tok_Abs; + when Iir_Kind_Condition_Operator + | Iir_Kind_Implicit_Condition_Operator => + return Tok_Condition; + when others => + raise Internal_Error; + end case; + end Get_Operator_Token; + + procedure Disp_Dyadic_Operator (Ctxt : in out Ctxt_Class; Expr: Iir) is + begin + if Flag_Parenthesis then + Put ("("); + end if; + Print (Ctxt, Get_Left (Expr)); + Disp_Token (Ctxt, Get_Operator_Token (Expr)); + Print (Ctxt, Get_Right (Expr)); + if Flag_Parenthesis then + Put (")"); + end if; + end Disp_Dyadic_Operator; + + procedure Disp_Monadic_Operator (Ctxt : in out Ctxt_Class; Expr: Iir) is + begin + if Get_Kind (Expr) = Iir_Kind_Implicit_Condition_Operator then + Print (Ctxt, Get_Operand (Expr)); + return; + end if; + + Disp_Token (Ctxt, Get_Operator_Token (Expr)); + if Flag_Parenthesis then + Put ('('); + end if; + Print (Ctxt, Get_Operand (Expr)); + if Flag_Parenthesis then + Put (')'); + end if; + end Disp_Monadic_Operator; + + procedure Disp_Case_Statement + (Ctxt : in out Ctxt_Class; Stmt: Iir_Case_Statement) + is + Assoc: Iir; + Sel_Stmt : Iir; + begin + Disp_Token (Ctxt, Tok_Case); + Print (Ctxt, Get_Expression (Stmt)); + Disp_Token (Ctxt, Tok_Is); + Close_Hbox (Ctxt); + + Start_Vbox (Ctxt); + Assoc := Get_Case_Statement_Alternative_Chain (Stmt); + while Assoc /= Null_Iir loop + Start_Hbox (Ctxt); + Disp_Token (Ctxt, Tok_When); + Sel_Stmt := Get_Associated_Chain (Assoc); + Disp_Choice (Ctxt, Assoc); + Disp_Token (Ctxt, Tok_Double_Arrow); + Close_Hbox (Ctxt); + + Start_Vbox (Ctxt); + Disp_Sequential_Statements (Ctxt, Sel_Stmt); + Close_Vbox (Ctxt); + end loop; + Close_Vbox (Ctxt); + + Disp_End_Label_No_Close (Ctxt, Stmt, Tok_Case); + end Disp_Case_Statement; + + procedure Disp_Wait_Statement + (Ctxt : in out Ctxt_Class; Stmt: Iir_Wait_Statement) + is + List: Iir_List; + Expr: Iir; + begin + Start_Hbox (Ctxt); + Disp_Label (Ctxt, Stmt); + Disp_Token (Ctxt, Tok_Wait); + List := Get_Sensitivity_List (Stmt); + if List /= Null_Iir_List then + Disp_Token (Ctxt, Tok_On); + Disp_Designator_List (Ctxt, List); + end if; + Expr := Get_Condition_Clause (Stmt); + if Expr /= Null_Iir then + Disp_Token (Ctxt, Tok_Until); + Print (Ctxt, Expr); + end if; + Expr := Get_Timeout_Clause (Stmt); + if Expr /= Null_Iir then + Disp_Token (Ctxt, Tok_For); + Print (Ctxt, Expr); + end if; + Disp_Token (Ctxt, Tok_Semi_Colon); + Close_Hbox (Ctxt); + end Disp_Wait_Statement; + + procedure Disp_If_Statement + (Ctxt : in out Ctxt_Class; Stmt : Iir_If_Statement) + is + Clause : Iir; + Expr : Iir; + begin + Start_Hbox (Ctxt); + Disp_Label (Ctxt, Stmt); + Disp_Token (Ctxt, Tok_If); + Clause := Stmt; + Print (Ctxt, Get_Condition (Clause)); + Disp_Token (Ctxt, Tok_Then); + Close_Hbox (Ctxt); + while Clause /= Null_Iir loop + Start_Vbox (Ctxt); + Disp_Sequential_Statements + (Ctxt, Get_Sequential_Statement_Chain (Clause)); + Close_Vbox (Ctxt); + Clause := Get_Else_Clause (Clause); + exit when Clause = Null_Iir; + Start_Hbox (Ctxt); + Expr := Get_Condition (Clause); + if Expr /= Null_Iir then + Disp_Token (Ctxt, Tok_Elsif); + Print (Ctxt, Expr); + Disp_Token (Ctxt, Tok_Then); + else + Disp_Token (Ctxt, Tok_Else); + end if; + Close_Hbox (Ctxt); + end loop; + Disp_End_Label (Ctxt, Stmt, Tok_If); + end Disp_If_Statement; + + procedure Disp_Parameter_Specification + (Ctxt : in out Ctxt_Class; Iterator : Iir_Iterator_Declaration) is + begin + Disp_Identifier (Ctxt, Iterator); + Disp_Token (Ctxt, Tok_In); + Disp_Discrete_Range (Ctxt, Or_Else (Get_Discrete_Range (Iterator), + Get_Subtype_Indication (Iterator))); + end Disp_Parameter_Specification; + + procedure Disp_Procedure_Call (Ctxt : in out Ctxt_Class; Stmt : Iir) + is + Call : constant Iir := Get_Procedure_Call (Stmt); + begin + Start_Hbox (Ctxt); + Disp_Label (Ctxt, Stmt); + if Get_Kind (Stmt) = Iir_Kind_Concurrent_Procedure_Call_Statement then + Disp_Postponed (Ctxt, Stmt); + end if; + Print (Ctxt, Get_Prefix (Call)); + Disp_Association_Chain (Ctxt, Get_Parameter_Association_Chain (Call)); + Disp_Token (Ctxt, Tok_Semi_Colon); + Close_Hbox (Ctxt); + end Disp_Procedure_Call; + + procedure Disp_For_Loop_Statement (Ctxt : in out Ctxt_Class; Stmt : Iir) is + begin + Start_Hbox (Ctxt); + Disp_Label (Ctxt, Stmt); + Disp_Token (Ctxt, Tok_For); + Disp_Parameter_Specification (Ctxt, Get_Parameter_Specification (Stmt)); + Disp_Token (Ctxt, Tok_Loop); + Close_Hbox (Ctxt); + + Start_Vbox (Ctxt); + Disp_Sequential_Statements (Ctxt, Get_Sequential_Statement_Chain (Stmt)); + Close_Vbox (Ctxt); + + Disp_End_Label (Ctxt, Stmt, Tok_Loop); + end Disp_For_Loop_Statement; + + procedure Disp_Sequential_Statements (Ctxt : in out Ctxt_Class; First : Iir) + is + Stmt: Iir; + begin + Stmt := First; + while Stmt /= Null_Iir loop + case Iir_Kinds_Sequential_Statement (Get_Kind (Stmt)) is + when Iir_Kind_Null_Statement => + Start_Hbox (Ctxt); + Disp_Label (Ctxt, Stmt); + Disp_Token (Ctxt, Tok_Null, Tok_Semi_Colon); + Close_Hbox (Ctxt); + when Iir_Kind_If_Statement => + Disp_If_Statement (Ctxt, Stmt); + when Iir_Kind_For_Loop_Statement => + Disp_For_Loop_Statement (Ctxt, Stmt); + when Iir_Kind_While_Loop_Statement => + Start_Hbox (Ctxt); + Disp_Label (Ctxt, Stmt); + if Get_Condition (Stmt) /= Null_Iir then + Disp_Token (Ctxt, Tok_While); + Print (Ctxt, Get_Condition (Stmt)); + end if; + Disp_Token (Ctxt, Tok_Loop); + Close_Hbox (Ctxt); + Start_Vbox (Ctxt); + Disp_Sequential_Statements + (Ctxt, Get_Sequential_Statement_Chain (Stmt)); + Close_Vbox (Ctxt); + Disp_End_Label (Ctxt, Stmt, Tok_Loop); + when Iir_Kind_Simple_Signal_Assignment_Statement => + Disp_Simple_Signal_Assignment (Ctxt, Stmt); + when Iir_Kind_Conditional_Signal_Assignment_Statement => + Start_Hbox (Ctxt); + Disp_Label (Ctxt, Stmt); + Disp_Conditional_Signal_Assignment (Ctxt, Stmt); + Close_Hbox (Ctxt); + when Iir_Kind_Selected_Waveform_Assignment_Statement => + Disp_Selected_Waveform_Assignment (Ctxt, Stmt); + when Iir_Kind_Variable_Assignment_Statement => + Disp_Variable_Assignment (Ctxt, Stmt); + when Iir_Kind_Conditional_Variable_Assignment_Statement => + Disp_Conditional_Variable_Assignment (Ctxt, Stmt); + when Iir_Kind_Assertion_Statement => + Disp_Assertion_Statement (Ctxt, Stmt); + when Iir_Kind_Report_Statement => + Disp_Report_Statement (Ctxt, Stmt); + when Iir_Kind_Return_Statement => + Start_Hbox (Ctxt); + Disp_Label (Ctxt, Stmt); + Disp_Token (Ctxt, Tok_Return); + if Get_Expression (Stmt) /= Null_Iir then + Print (Ctxt, Get_Expression (Stmt)); + end if; + Disp_Token (Ctxt, Tok_Semi_Colon); + Close_Hbox (Ctxt); + when Iir_Kind_Case_Statement => + Start_Hbox (Ctxt); + Disp_Label (Ctxt, Stmt); + Disp_Case_Statement (Ctxt, Stmt); + Close_Hbox (Ctxt); + when Iir_Kind_Wait_Statement => + Disp_Wait_Statement (Ctxt, Stmt); + when Iir_Kind_Procedure_Call_Statement => + Disp_Procedure_Call (Ctxt, Stmt); + when Iir_Kind_Exit_Statement + | Iir_Kind_Next_Statement => + declare + Label : constant Iir := Get_Loop_Label (Stmt); + Cond : constant Iir := Get_Condition (Stmt); + begin + Start_Hbox (Ctxt); + Disp_Label (Ctxt, Stmt); + if Get_Kind (Stmt) = Iir_Kind_Exit_Statement then + Disp_Token (Ctxt, Tok_Exit); + else + Disp_Token (Ctxt, Tok_Next); + end if; + if Label /= Null_Iir then + Print (Ctxt, Label); + end if; + if Cond /= Null_Iir then + Disp_Token (Ctxt, Tok_When); + Print (Ctxt, Cond); + end if; + Disp_Token (Ctxt, Tok_Semi_Colon); + Close_Hbox (Ctxt); + end; + end case; + Stmt := Get_Chain (Stmt); + end loop; + end Disp_Sequential_Statements; + + procedure Disp_Process_Statement (Ctxt : in out Ctxt_Class; Process: Iir) is + begin + Start_Hbox (Ctxt); + Disp_Label (Ctxt, Process); + Disp_Postponed (Ctxt, Process); + + Disp_Token (Ctxt, Tok_Process); + if Get_Kind (Process) = Iir_Kind_Sensitized_Process_Statement then + Disp_Token (Ctxt, Tok_Left_Paren); + Disp_Designator_List (Ctxt, Get_Sensitivity_List (Process)); + Disp_Token (Ctxt, Tok_Right_Paren); + end if; + if Get_Has_Is (Process) then + Disp_Token (Ctxt, Tok_Is); + end if; + Close_Hbox (Ctxt); + + Start_Vbox (Ctxt); + Disp_Declaration_Chain (Ctxt, Process); + Close_Vbox (Ctxt); + + Start_Hbox (Ctxt); + Disp_Token (Ctxt, Tok_Begin); + Close_Hbox (Ctxt); + + Start_Vbox (Ctxt); + Disp_Sequential_Statements + (Ctxt, Get_Sequential_Statement_Chain (Process)); + Close_Vbox (Ctxt); + + Start_Hbox (Ctxt); + Disp_Token (Ctxt, Tok_End); + if Get_End_Has_Postponed (Process) then + Disp_Token (Ctxt, Tok_Postponed); + end if; + Disp_After_End (Ctxt, Process, Tok_Process); + Disp_Token (Ctxt, Tok_Semi_Colon); + Close_Hbox (Ctxt); + end Disp_Process_Statement; + + procedure Disp_Conversion (Ctxt : in out Ctxt_Class; Conv : Iir) is + begin + case Get_Kind (Conv) is + when Iir_Kind_Function_Call => + Disp_Function_Name (Ctxt, Get_Implementation (Conv)); + when Iir_Kind_Type_Conversion => + Disp_Name_Of (Ctxt, Get_Type_Mark (Conv)); + when others => + Error_Kind ("disp_conversion", Conv); + end case; + end Disp_Conversion; + + procedure Disp_Association_Chain (Ctxt : in out Ctxt_Class; Chain : Iir) + is + El: Iir; + Formal: Iir; + Need_Comma : Boolean; + Conv : Iir; + begin + if Chain = Null_Iir then + return; + end if; + Disp_Token (Ctxt, Tok_Left_Paren); + Need_Comma := False; + + El := Chain; + while El /= Null_Iir loop + if Get_Kind (El) /= Iir_Kind_Association_Element_By_Individual then + if Need_Comma then + Disp_Token (Ctxt, Tok_Comma); + end if; + + -- Formal part. + if Get_Kind (El) = Iir_Kind_Association_Element_By_Expression then + Conv := Get_Formal_Conversion (El); + if Conv /= Null_Iir then + Disp_Conversion (Ctxt, Conv); + Disp_Token (Ctxt, Tok_Left_Paren); + end if; + else + Conv := Null_Iir; + end if; + Formal := Get_Formal (El); + if Formal /= Null_Iir then + case Get_Kind (El) is + when Iir_Kind_Association_Element_Package + | Iir_Kind_Association_Element_Type + | Iir_Kind_Association_Element_Subprogram => + Print (Ctxt, Formal); + when Iir_Kind_Association_Element_By_Expression + | Iir_Kind_Association_Element_By_Individual + | Iir_Kind_Association_Element_Open => + Print (Ctxt, Formal); + when others => + raise Internal_Error; + end case; + if Conv /= Null_Iir then + Disp_Token (Ctxt, Tok_Right_Paren); + end if; + Disp_Token (Ctxt, Tok_Double_Arrow); + end if; + + case Get_Kind (El) is + when Iir_Kind_Association_Element_Open => + Disp_Token (Ctxt, Tok_Open); + when Iir_Kind_Association_Element_Package + | Iir_Kind_Association_Element_Type + | Iir_Kind_Association_Element_Subprogram => + Print (Ctxt, Get_Actual (El)); + when others => + Conv := Get_Actual_Conversion (El); + if Conv /= Null_Iir then + Disp_Conversion (Ctxt, Conv); + Disp_Token (Ctxt, Tok_Left_Paren); + end if; + Print (Ctxt, Get_Actual (El)); + if Conv /= Null_Iir then + Disp_Token (Ctxt, Tok_Right_Paren); + end if; + end case; + Need_Comma := True; + end if; + El := Get_Chain (El); + end loop; + Disp_Token (Ctxt, Tok_Right_Paren); + end Disp_Association_Chain; + + procedure Disp_Generic_Map_Aspect + (Ctxt : in out Ctxt_Class; Parent : Iir) is + begin + Disp_Token (Ctxt, Tok_Generic, Tok_Map); + Disp_Association_Chain (Ctxt, Get_Generic_Map_Aspect_Chain (Parent)); + end Disp_Generic_Map_Aspect; + + procedure Disp_Port_Map_Aspect (Ctxt : in out Ctxt_Class; Parent : Iir) is + begin + Disp_Token (Ctxt, Tok_Port, Tok_Map); + Disp_Association_Chain (Ctxt, Get_Port_Map_Aspect_Chain (Parent)); + end Disp_Port_Map_Aspect; + + procedure Disp_Entity_Aspect (Ctxt : in out Ctxt_Class; Aspect : Iir) is + Arch : Iir; + begin + case Get_Kind (Aspect) is + when Iir_Kind_Entity_Aspect_Entity => + Disp_Token (Ctxt, Tok_Entity); + Print (Ctxt, Get_Entity_Name (Aspect)); + Arch := Get_Architecture (Aspect); + if Arch /= Null_Iir then + Disp_Token (Ctxt, Tok_Left_Paren); + Disp_Name_Of (Ctxt, Arch); + Disp_Token (Ctxt, Tok_Right_Paren); + end if; + when Iir_Kind_Entity_Aspect_Configuration => + Disp_Token (Ctxt, Tok_Configuration); + Print (Ctxt, Get_Configuration_Name (Aspect)); + when Iir_Kind_Entity_Aspect_Open => + Disp_Token (Ctxt, Tok_Open); + when others => + Error_Kind ("disp_entity_aspect", Aspect); + end case; + end Disp_Entity_Aspect; + + procedure Disp_Component_Instantiation_Statement + (Ctxt : in out Ctxt_Class; Stmt: Iir_Component_Instantiation_Statement) + is + Component: constant Iir := Get_Instantiated_Unit (Stmt); + Gen_Map : constant Iir := Get_Generic_Map_Aspect_Chain (Stmt); + Port_Map : constant Iir := Get_Port_Map_Aspect_Chain (Stmt); + begin + Start_Hbox (Ctxt); + Disp_Label (Ctxt, Stmt); + if Get_Kind (Component) in Iir_Kinds_Denoting_Name then + if Get_Has_Component (Stmt) then + Disp_Token (Ctxt, Tok_Component); + end if; + Print (Ctxt, Component); + else + Disp_Entity_Aspect (Ctxt, Component); + end if; + + if Gen_Map = Null_Iir and Port_Map = Null_Iir then + Disp_Token (Ctxt, Tok_Semi_Colon); + Close_Hbox (Ctxt); + else + Close_Hbox (Ctxt); + + Start_Vbox (Ctxt); + if Gen_Map /= Null_Iir then + Start_Hbox (Ctxt); + Disp_Generic_Map_Aspect (Ctxt, Stmt); + if Port_Map = Null_Iir then + Disp_Token (Ctxt, Tok_Semi_Colon); + end if; + Close_Hbox (Ctxt); + end if; + + if Port_Map /= Null_Iir then + Start_Hbox (Ctxt); + Disp_Port_Map_Aspect (Ctxt, Stmt); + Disp_Token (Ctxt, Tok_Semi_Colon); + Close_Hbox (Ctxt); + end if; + + Close_Vbox (Ctxt); + end if; + end Disp_Component_Instantiation_Statement; + + procedure Disp_Function_Call + (Ctxt : in out Ctxt_Class; Expr: Iir_Function_Call) is + begin + Print (Ctxt, Get_Prefix (Expr)); + Disp_Association_Chain (Ctxt, Get_Parameter_Association_Chain (Expr)); + end Disp_Function_Call; + + procedure Disp_Indexed_Name (Ctxt : in out Ctxt_Class; Indexed: Iir) + is + List : Iir_Flist; + El: Iir; + begin + Print (Ctxt, Get_Prefix (Indexed)); + Disp_Token (Ctxt, Tok_Left_Paren); + List := Get_Index_List (Indexed); + for I in Flist_First .. Flist_Last (List) loop + El := Get_Nth_Element (List, I); + if I /= 0 then + Disp_Token (Ctxt, Tok_Comma); + end if; + Print (Ctxt, El); + end loop; + Disp_Token (Ctxt, Tok_Right_Paren); + end Disp_Indexed_Name; + + procedure Disp_A_Choice (Ctxt : in out Ctxt_Class; Choice : Iir) is + begin + case Iir_Kinds_Choice (Get_Kind (Choice)) is + when Iir_Kind_Choice_By_Others => + Disp_Token (Ctxt, Tok_Others); + when Iir_Kind_Choice_By_None => + null; + when Iir_Kind_Choice_By_Expression => + Print (Ctxt, Get_Choice_Expression (Choice)); + when Iir_Kind_Choice_By_Range => + Disp_Range (Ctxt, Get_Choice_Range (Choice)); + when Iir_Kind_Choice_By_Name => + Disp_Name_Of (Ctxt, Get_Choice_Name (Choice)); + end case; + end Disp_A_Choice; + + procedure Disp_Choice (Ctxt : in out Ctxt_Class; Choice: in out Iir) is + begin + loop + Disp_A_Choice (Ctxt, Choice); + Choice := Get_Chain (Choice); + exit when Choice = Null_Iir; + exit when Get_Same_Alternative_Flag (Choice) = False; + --exit when Choice = Null_Iir; + Disp_Token (Ctxt, Tok_Bar); + end loop; + end Disp_Choice; + + -- EL_TYPE is Null_Iir for record aggregates. + procedure Disp_Aggregate_1 + (Ctxt : in out Ctxt_Class; + Aggr: Iir_Aggregate; Index : Positive; El_Type : Iir) + is + Assoc : Iir; + Expr : Iir; + Is_First : Boolean; + begin + Disp_Token (Ctxt, Tok_Left_Paren); + Assoc := Get_Association_Choices_Chain (Aggr); + Is_First := True; + while Assoc /= Null_Iir loop + if Is_First then + Is_First := False; + else + Disp_Token (Ctxt, Tok_Comma); + end if; + pragma Assert (not Get_Same_Alternative_Flag (Assoc)); + Expr := Get_Associated_Expr (Assoc); + Disp_A_Choice (Ctxt, Assoc); + if Get_Kind (Assoc) /= Iir_Kind_Choice_By_None then + Assoc := Get_Chain (Assoc); + while Assoc /= Null_Iir + and then Get_Same_Alternative_Flag (Assoc) + loop + Disp_Token (Ctxt, Tok_Bar); + Disp_A_Choice (Ctxt, Assoc); + Assoc := Get_Chain (Assoc); + end loop; + Disp_Token (Ctxt, Tok_Double_Arrow); + else + Assoc := Get_Chain (Assoc); + end if; + if Index > 1 then + if Get_Kind (Expr) = Iir_Kind_String_Literal8 then + Disp_String_Literal (Ctxt, Expr, El_Type); + else + Disp_Aggregate_1 (Ctxt, Expr, Index - 1, El_Type); + end if; + else + Print (Ctxt, Expr); + end if; + end loop; + Disp_Token (Ctxt, Tok_Right_Paren); + end Disp_Aggregate_1; + + procedure Disp_Aggregate (Ctxt : in out Ctxt_Class; Aggr: Iir_Aggregate) + is + Aggr_Type : constant Iir := Get_Type (Aggr); + Base_Type : Iir; + begin + if Aggr_Type /= Null_Iir + and then Get_Kind (Aggr_Type) in Iir_Kinds_Array_Type_Definition + then + Base_Type := Get_Base_Type (Aggr_Type); + Disp_Aggregate_1 + (Ctxt, Aggr, Get_Nbr_Elements (Get_Index_Subtype_List (Base_Type)), + Get_Element_Subtype (Base_Type)); + else + Disp_Aggregate_1 (Ctxt, Aggr, 1, Null_Iir); + end if; + end Disp_Aggregate; + + procedure Disp_Simple_Aggregate + (Ctxt : in out Ctxt_Class; Aggr: Iir_Simple_Aggregate) + is + List : constant Iir_Flist := Get_Simple_Aggregate_List (Aggr); + El : Iir; + First : Boolean := True; + begin + Put ("("); + for I in Flist_First .. Flist_Last (List) loop + El := Get_Nth_Element (List, I); + if First then + First := False; + else + Put (", "); + end if; + Print (Ctxt, El); + end loop; + Put (")"); + end Disp_Simple_Aggregate; + + procedure Disp_Parametered_Attribute + (Ctxt : in out Ctxt_Class; Name : Name_Id; Expr : Iir) + is + Param : Iir; + Pfx : Iir; + begin + Pfx := Get_Prefix (Expr); + case Get_Kind (Pfx) is + when Iir_Kind_Type_Declaration + | Iir_Kind_Subtype_Declaration => + Disp_Name_Of (Ctxt, Pfx); + when others => + Print (Ctxt, Pfx); + end case; + Disp_Token (Ctxt, Tok_Tick); + Disp_Ident (Ctxt, Name); + Param := Get_Parameter (Expr); + if Param /= Null_Iir + and then Param /= Vhdl.Std_Package.Universal_Integer_One + then + Disp_Token (Ctxt, Tok_Left_Paren); + Print (Ctxt, Param); + Disp_Token (Ctxt, Tok_Right_Paren); + end if; + end Disp_Parametered_Attribute; + + procedure Disp_Parametered_Type_Attribute + (Ctxt : in out Ctxt_Class; Name : Name_Id; Expr : Iir) is + begin + Print (Ctxt, Get_Prefix (Expr)); + Disp_Token (Ctxt, Tok_Tick); + Disp_Ident (Ctxt, Name); + Disp_Token (Ctxt, Tok_Left_Paren); + Print (Ctxt, Get_Parameter (Expr)); + Disp_Token (Ctxt, Tok_Right_Paren); + end Disp_Parametered_Type_Attribute; + + procedure Disp_String_Literal_Raw + (Ctxt : in out Ctxt_Class; Str : Iir; El_Type : Iir) + is + Str_Id : constant String8_Id := Get_String8_Id (Str); + Len : constant Nat32 := Get_String_Length (Str); + Literal_List : Iir_Flist; + Pos : Nat8; + Lit : Iir; + Id : Name_Id; + C : Character; + begin + if Get_Bit_String_Base (Str) /= Base_None then + Start_Lit (Ctxt, Tok_Bit_String); + if Get_Has_Length (Str) then + Disp_Int32 (Ctxt, Iir_Int32 (Get_String_Length (Str))); + end if; + Disp_Char (Ctxt, 'b'); + else + Start_Lit (Ctxt, Tok_String); + end if; + + Disp_Char (Ctxt, '"'); + + if El_Type /= Null_Iir then + Literal_List := + Get_Enumeration_Literal_List (Get_Base_Type (El_Type)); + else + Literal_List := Null_Iir_Flist; + end if; + + for I in 1 .. Len loop + Pos := Str_Table.Element_String8 (Str_Id, I); + if Literal_List /= Null_Iir_Flist then + Lit := Get_Nth_Element (Literal_List, Natural (Pos)); + Id := Get_Identifier (Lit); + else + Id := Name_Table.Get_Identifier (Character'Val (Pos)); + end if; + pragma Assert (Name_Table.Is_Character (Id)); + C := Name_Table.Get_Character (Id); + if C = '"' then + Disp_Char (Ctxt, C); + end if; + Disp_Char (Ctxt, C); + end loop; + + Disp_Char (Ctxt, '"'); + Close_Lit (Ctxt); + end Disp_String_Literal_Raw; + + procedure Disp_String_Literal + (Ctxt : in out Ctxt_Class; Str : Iir; El_Type : Iir) is + begin + if Get_Literal_Length (Str) /= 0 then + declare + Tkind : Token_Type; + begin + if Get_Bit_String_Base (Str) /= Base_None then + Tkind := Tok_Bit_String; + else + Tkind := Tok_String; + end if; + Disp_Literal_From_Source (Ctxt, Str, Tkind); + end; + else + Disp_String_Literal_Raw (Ctxt, Str, El_Type); + end if; + end Disp_String_Literal; + + procedure Print (Ctxt : in out Ctxt_Class; Expr: Iir) + is + Orig : Iir; + begin + case Get_Kind (Expr) is + when Iir_Kind_Integer_Literal => + Orig := Get_Literal_Origin (Expr); + if Dump_Origin_Flag and then Orig /= Null_Iir then + Print (Ctxt, Orig); + else + if Get_Literal_Length (Expr) /= 0 then + Disp_Literal_From_Source (Ctxt, Expr, Tok_Integer); + else + Disp_Int64 (Ctxt, Get_Value (Expr)); + end if; + end if; + when Iir_Kind_Floating_Point_Literal => + Orig := Get_Literal_Origin (Expr); + if Dump_Origin_Flag and then Orig /= Null_Iir then + Print (Ctxt, Orig); + else + if Get_Literal_Length (Expr) /= 0 then + Disp_Literal_From_Source (Ctxt, Expr, Tok_Real); + else + Disp_Fp64 (Ctxt, Get_Fp_Value (Expr)); + end if; + end if; + when Iir_Kind_String_Literal8 => + Orig := Get_Literal_Origin (Expr); + if Dump_Origin_Flag and then Orig /= Null_Iir then + Print (Ctxt, Orig); + else + declare + Expr_Type : constant Iir := Get_Type (Expr); + El_Type : Iir; + begin + if Expr_Type /= Null_Iir then + El_Type := Get_Element_Subtype (Expr_Type); + else + El_Type := Null_Iir; + end if; + Disp_String_Literal (Ctxt, Expr, El_Type); + if Flag_Disp_String_Literal_Type or Flags.List_Verbose then + Put ("[type: "); + Disp_Type (Ctxt, Expr_Type); + Put ("]"); + end if; + end; + end if; + when Iir_Kind_Physical_Fp_Literal + | Iir_Kind_Physical_Int_Literal => + Orig := Get_Literal_Origin (Expr); + if Dump_Origin_Flag and then Orig /= Null_Iir then + Print (Ctxt, Orig); + else + Disp_Physical_Literal (Ctxt, Expr); + end if; + when Iir_Kind_Enumeration_Literal => + Orig := Get_Literal_Origin (Expr); + if Dump_Origin_Flag and then Orig /= Null_Iir then + Print (Ctxt, Orig); + else + Disp_Name_Of (Ctxt, Expr); + end if; + when Iir_Kind_Overflow_Literal => + Orig := Get_Literal_Origin (Expr); + if Dump_Origin_Flag and then Orig /= Null_Iir then + Print (Ctxt, Orig); + else + Put ("*OVERFLOW*"); + end if; + + when Iir_Kind_Object_Alias_Declaration => + Disp_Name_Of (Ctxt, Expr); + when Iir_Kind_Aggregate => + Disp_Aggregate (Ctxt, Expr); + when Iir_Kind_Null_Literal => + Disp_Token (Ctxt, Tok_Null); + when Iir_Kind_Simple_Aggregate => + Orig := Get_Literal_Origin (Expr); + if Dump_Origin_Flag and then Orig /= Null_Iir then + Print (Ctxt, Orig); + else + Disp_Simple_Aggregate (Ctxt, Expr); + end if; + + when Iir_Kind_Attribute_Value => + Disp_Attribute_Value (Ctxt, Expr); + when Iir_Kind_Attribute_Name => + Disp_Attribute_Name (Ctxt, Expr); + + when Iir_Kind_Element_Declaration => + Disp_Name_Of (Ctxt, Expr); + + when Iir_Kind_Signal_Declaration + | Iir_Kind_Guard_Signal_Declaration + | Iir_Kind_File_Declaration + | Iir_Kind_Iterator_Declaration => + Disp_Name_Of (Ctxt, Expr); + return; + when Iir_Kind_Reference_Name => + declare + Name : constant Iir := Get_Referenced_Name (Expr); + begin + if Is_Valid (Name) then + Print (Ctxt, Name); + else + Print (Ctxt, Get_Named_Entity (Expr)); + end if; + end; + + when Iir_Kinds_Dyadic_Operator => + Disp_Dyadic_Operator (Ctxt, Expr); + when Iir_Kinds_Monadic_Operator => + Disp_Monadic_Operator (Ctxt, Expr); + when Iir_Kind_Function_Call => + Disp_Function_Call (Ctxt, Expr); + when Iir_Kind_Parenthesis_Expression => + Disp_Token (Ctxt, Tok_Left_Paren); + Print (Ctxt, Get_Expression (Expr)); + Disp_Token (Ctxt, Tok_Right_Paren); + when Iir_Kind_Type_Conversion => + Print (Ctxt, Get_Type_Mark (Expr)); + Disp_Token (Ctxt, Tok_Left_Paren); + Print (Ctxt, Get_Expression (Expr)); + Disp_Token (Ctxt, Tok_Right_Paren); + when Iir_Kind_Qualified_Expression => + declare + Qexpr : constant Iir := Get_Expression (Expr); + Has_Paren : constant Boolean := + Get_Kind (Qexpr) = Iir_Kind_Parenthesis_Expression + or else Get_Kind (Qexpr) = Iir_Kind_Aggregate; + begin + Print (Ctxt, Get_Type_Mark (Expr)); + Disp_Token (Ctxt, Tok_Tick); + if not Has_Paren then + Disp_Token (Ctxt, Tok_Left_Paren); + end if; + Print (Ctxt, Qexpr); + if not Has_Paren then + Disp_Token (Ctxt, Tok_Right_Paren); + end if; + end; + when Iir_Kind_Allocator_By_Expression => + Disp_Token (Ctxt, Tok_New); + Print (Ctxt, Get_Expression (Expr)); + when Iir_Kind_Allocator_By_Subtype => + Disp_Token (Ctxt, Tok_New); + Disp_Subtype_Indication (Ctxt, Get_Subtype_Indication (Expr)); + + when Iir_Kind_Indexed_Name => + Disp_Indexed_Name (Ctxt, Expr); + when Iir_Kind_Slice_Name => + Print (Ctxt, Get_Prefix (Expr)); + Disp_Token (Ctxt, Tok_Left_Paren); + Disp_Range (Ctxt, Get_Suffix (Expr)); + Disp_Token (Ctxt, Tok_Right_Paren); + when Iir_Kind_Selected_Element => + Print (Ctxt, Get_Prefix (Expr)); + Disp_Token (Ctxt, Tok_Dot); + Disp_Name_Of (Ctxt, Get_Named_Entity (Expr)); + when Iir_Kind_Implicit_Dereference => + Print (Ctxt, Get_Prefix (Expr)); + + when Iir_Kind_Left_Type_Attribute => + Disp_Name_Attribute (Ctxt, Expr, Name_Left); + when Iir_Kind_Right_Type_Attribute => + Disp_Name_Attribute (Ctxt, Expr, Name_Right); + when Iir_Kind_High_Type_Attribute => + Disp_Name_Attribute (Ctxt, Expr, Name_High); + when Iir_Kind_Low_Type_Attribute => + Disp_Name_Attribute (Ctxt, Expr, Name_Low); + when Iir_Kind_Ascending_Type_Attribute => + Disp_Name_Attribute (Ctxt, Expr, Name_Ascending); + + when Iir_Kind_Stable_Attribute => + Disp_Parametered_Attribute (Ctxt, Name_Stable, Expr); + when Iir_Kind_Quiet_Attribute => + Disp_Parametered_Attribute (Ctxt, Name_Quiet, Expr); + when Iir_Kind_Delayed_Attribute => + Disp_Parametered_Attribute (Ctxt, Name_Delayed, Expr); + when Iir_Kind_Transaction_Attribute => + Disp_Name_Attribute (Ctxt, Expr, Name_Transaction); + when Iir_Kind_Event_Attribute => + Disp_Name_Attribute (Ctxt, Expr, Name_Event); + when Iir_Kind_Active_Attribute => + Disp_Name_Attribute (Ctxt, Expr, Name_Active); + when Iir_Kind_Driving_Attribute => + Disp_Name_Attribute (Ctxt, Expr, Name_Driving); + when Iir_Kind_Driving_Value_Attribute => + Disp_Name_Attribute (Ctxt, Expr, Name_Driving_Value); + when Iir_Kind_Last_Value_Attribute => + Disp_Name_Attribute (Ctxt, Expr, Name_Last_Value); + when Iir_Kind_Last_Active_Attribute => + Disp_Name_Attribute (Ctxt, Expr, Name_Last_Active); + when Iir_Kind_Last_Event_Attribute => + Disp_Name_Attribute (Ctxt, Expr, Name_Last_Event); + + when Iir_Kind_Pos_Attribute => + Disp_Parametered_Type_Attribute (Ctxt, Name_Pos, Expr); + when Iir_Kind_Val_Attribute => + Disp_Parametered_Type_Attribute (Ctxt, Name_Val, Expr); + when Iir_Kind_Succ_Attribute => + Disp_Parametered_Type_Attribute (Ctxt, Name_Succ, Expr); + when Iir_Kind_Pred_Attribute => + Disp_Parametered_Type_Attribute (Ctxt, Name_Pred, Expr); + when Iir_Kind_Leftof_Attribute => + Disp_Parametered_Type_Attribute (Ctxt, Name_Leftof, Expr); + when Iir_Kind_Rightof_Attribute => + Disp_Parametered_Type_Attribute (Ctxt, Name_Rightof, Expr); + + when Iir_Kind_Length_Array_Attribute => + Disp_Parametered_Attribute (Ctxt, Name_Length, Expr); + when Iir_Kind_Range_Array_Attribute => + Disp_Parametered_Attribute (Ctxt, Name_Range, Expr); + when Iir_Kind_Reverse_Range_Array_Attribute => + Disp_Parametered_Attribute (Ctxt, Name_Reverse_Range, Expr); + when Iir_Kind_Left_Array_Attribute => + Disp_Parametered_Attribute (Ctxt, Name_Left, Expr); + when Iir_Kind_Right_Array_Attribute => + Disp_Parametered_Attribute (Ctxt, Name_Right, Expr); + when Iir_Kind_Low_Array_Attribute => + Disp_Parametered_Attribute (Ctxt, Name_Low, Expr); + when Iir_Kind_High_Array_Attribute => + Disp_Parametered_Attribute (Ctxt, Name_High, Expr); + when Iir_Kind_Ascending_Array_Attribute => + Disp_Parametered_Attribute (Ctxt, Name_Ascending, Expr); + + when Iir_Kind_Image_Attribute => + Disp_Parametered_Attribute (Ctxt, Name_Image, Expr); + when Iir_Kind_Value_Attribute => + Disp_Parametered_Attribute (Ctxt, Name_Value, Expr); + when Iir_Kind_Simple_Name_Attribute => + Disp_Name_Attribute (Ctxt, Expr, Name_Simple_Name); + when Iir_Kind_Instance_Name_Attribute => + Disp_Name_Attribute (Ctxt, Expr, Name_Instance_Name); + when Iir_Kind_Path_Name_Attribute => + Disp_Name_Attribute (Ctxt, Expr, Name_Path_Name); + + when Iir_Kinds_Type_And_Subtype_Definition => + Disp_Type (Ctxt, Expr); + + when Iir_Kind_Range_Expression => + Disp_Range (Ctxt, Expr); + + when Iir_Kind_Selected_By_All_Name + | Iir_Kind_Dereference => + Print (Ctxt, Get_Prefix (Expr)); + Disp_Token (Ctxt, Tok_Dot, Tok_All); + when Iir_Kind_Simple_Name + | Iir_Kind_Character_Literal => + Disp_Identifier (Ctxt, Expr); + when Iir_Kind_Operator_Symbol => + Disp_Function_Name (Ctxt, Expr); + when Iir_Kind_Selected_Name => + Print (Ctxt, Get_Prefix (Expr)); + Disp_Token (Ctxt, Tok_Dot); + Disp_Function_Name (Ctxt, Expr); + when Iir_Kind_Parenthesis_Name => + Print (Ctxt, Get_Prefix (Expr)); + Disp_Association_Chain (Ctxt, Get_Association_Chain (Expr)); + when Iir_Kind_Base_Attribute => + Disp_Name_Attribute (Ctxt, Expr, Name_Base); + when Iir_Kind_Subtype_Attribute => + Disp_Name_Attribute (Ctxt, Expr, Name_Subtype); + when Iir_Kind_Type_Declaration + | Iir_Kind_Subtype_Declaration + | Iir_Kind_Unit_Declaration + | Iir_Kinds_Interface_Object_Declaration + | Iir_Kind_Variable_Declaration + | Iir_Kind_Constant_Declaration + | Iir_Kind_Function_Declaration + | Iir_Kind_Procedure_Declaration + | Iir_Kind_Terminal_Declaration + | Iir_Kind_Component_Declaration + | Iir_Kind_Group_Template_Declaration => + Disp_Name_Of (Ctxt, Expr); + + when Iir_Kind_Signature => + Disp_Signature (Ctxt, Expr); + + when others => + Error_Kind ("print", Expr); + end case; + end Print; + + procedure Disp_Block_Header + (Ctxt : in out Ctxt_Class; Header : Iir_Block_Header) + is + Chain : Iir; + begin + if Header = Null_Iir then + return; + end if; + Chain := Get_Generic_Chain (Header); + if Chain /= Null_Iir then + Disp_Generics (Ctxt, Header); + + Chain := Get_Generic_Map_Aspect_Chain (Header); + if Chain /= Null_Iir then + Start_Hbox (Ctxt); + Disp_Generic_Map_Aspect (Ctxt, Header); + Disp_Token (Ctxt, Tok_Semi_Colon); + Close_Hbox (Ctxt); + end if; + end if; + Chain := Get_Port_Chain (Header); + if Chain /= Null_Iir then + Disp_Ports (Ctxt, Header); + + Chain := Get_Port_Map_Aspect_Chain (Header); + if Chain /= Null_Iir then + Start_Hbox (Ctxt); + Disp_Port_Map_Aspect (Ctxt, Header); + Disp_Token (Ctxt, Tok_Semi_Colon); + Close_Hbox (Ctxt); + end if; + end if; + end Disp_Block_Header; + + procedure Disp_Block_Statement + (Ctxt : in out Ctxt_Class; Block: Iir_Block_Statement) + is + Sensitivity: Iir_List; + Guard : Iir_Guard_Signal_Declaration; + begin + Start_Hbox (Ctxt); + Disp_Label (Ctxt, Block); + Disp_Token (Ctxt, Tok_Block); + Guard := Get_Guard_Decl (Block); + if Guard /= Null_Iir then + Disp_Token (Ctxt, Tok_Left_Paren); + Print (Ctxt, Get_Guard_Expression (Guard)); + Disp_Token (Ctxt, Tok_Right_Paren); + end if; + if Get_Has_Is (Block) then + Disp_Token (Ctxt, Tok_Is); + end if; + Close_Hbox (Ctxt); + + if Flags.List_Verbose and then Guard /= Null_Iir then + Sensitivity := Get_Guard_Sensitivity_List (Guard); + if Sensitivity /= Null_Iir_List then + Put ("-- guard sensitivity list "); + Disp_Designator_List (Ctxt, Sensitivity); + end if; + end if; + + Start_Vbox (Ctxt); + Disp_Block_Header (Ctxt, Get_Block_Header (Block)); + Disp_Declaration_Chain (Ctxt, Block); + Close_Vbox (Ctxt); + + Start_Hbox (Ctxt); + Disp_Token (Ctxt, Tok_Begin); + Close_Hbox (Ctxt); + + Start_Vbox (Ctxt); + Disp_Concurrent_Statement_Chain (Ctxt, Block); + Close_Vbox (Ctxt); + + Disp_End (Ctxt, Block, Tok_Block); + end Disp_Block_Statement; + + procedure Disp_Generate_Statement_Body (Ctxt : in out Ctxt_Class; Bod : Iir) + is + Has_Beg : constant Boolean := Get_Has_Begin (Bod); + Has_End : constant Boolean := Get_Has_End (Bod); + begin + Disp_Declaration_Chain (Ctxt, Bod); + if Has_Beg then + Start_Hbox (Ctxt); + Disp_Token (Ctxt, Tok_Begin); + Close_Hbox (Ctxt); + end if; + + if Has_Beg or Has_End then + Start_Vbox (Ctxt); + end if; + Disp_Concurrent_Statement_Chain (Ctxt, Bod); + if Has_Beg or Has_End then + Close_Vbox (Ctxt); + end if; + + if Has_End then + Start_Hbox (Ctxt); + Disp_Token (Ctxt, Tok_End); + if Get_End_Has_Identifier (Bod) then + Disp_Ident (Ctxt, Get_Alternative_Label (Bod)); + end if; + Disp_Token (Ctxt, Tok_Semi_Colon); + Close_Hbox (Ctxt); + end if; + end Disp_Generate_Statement_Body; + + procedure Disp_For_Generate_Statement + (Ctxt : in out Ctxt_Class; Stmt : Iir) is + begin + Start_Hbox (Ctxt); + Disp_Label (Ctxt, Stmt); + Disp_Token (Ctxt, Tok_For); + Disp_Parameter_Specification (Ctxt, Get_Parameter_Specification (Stmt)); + Disp_Token (Ctxt, Tok_Generate); + Close_Hbox (Ctxt); + + Start_Vbox (Ctxt); + Disp_Generate_Statement_Body + (Ctxt, Get_Generate_Statement_Body (Stmt)); + Close_Vbox (Ctxt); + + Disp_End (Ctxt, Stmt, Tok_Generate); + end Disp_For_Generate_Statement; + + procedure Disp_If_Generate_Statement (Ctxt : in out Ctxt_Class; Stmt : Iir) + is + Bod : Iir; + Clause : Iir; + Cond : Iir; + begin + Start_Hbox (Ctxt); + Disp_Label (Ctxt, Stmt); + Disp_Token (Ctxt, Tok_If); + Cond := Get_Condition (Stmt); + Clause := Stmt; + loop + Bod := Get_Generate_Statement_Body (Clause); + if Get_Has_Label (Bod) then + Disp_Ident (Ctxt, Get_Alternative_Label (Bod)); + Disp_Token (Ctxt, Tok_Colon); + end if; + if Cond /= Null_Iir then + Print (Ctxt, Cond); + end if; + Disp_Token (Ctxt, Tok_Generate); + Close_Hbox (Ctxt); + + Start_Vbox (Ctxt); + Disp_Generate_Statement_Body (Ctxt, Bod); + Close_Vbox (Ctxt); + + Clause := Get_Generate_Else_Clause (Clause); + exit when Clause = Null_Iir; + + Start_Hbox (Ctxt); + Cond := Get_Condition (Clause); + if Cond = Null_Iir then + Disp_Token (Ctxt, Tok_Else); + else + Disp_Token (Ctxt, Tok_Elsif); + end if; + end loop; + Disp_End (Ctxt, Stmt, Tok_Generate); + end Disp_If_Generate_Statement; + + procedure Disp_Case_Generate_Statement + (Ctxt : in out Ctxt_Class; Stmt : Iir) + is + Bod : Iir; + Assoc : Iir; + begin + Start_Hbox (Ctxt); + Disp_Label (Ctxt, Stmt); + Disp_Token (Ctxt, Tok_Case); + Print (Ctxt, Get_Expression (Stmt)); + Disp_Token (Ctxt, Tok_Generate); + Close_Hbox (Ctxt); + + Start_Vbox (Ctxt); + Assoc := Get_Case_Statement_Alternative_Chain (Stmt); + while Assoc /= Null_Iir loop + Start_Hbox (Ctxt); + Disp_Token (Ctxt, Tok_When); + Bod := Get_Associated_Block (Assoc); + if Get_Has_Label (Bod) then + Disp_Ident (Ctxt, Get_Alternative_Label (Bod)); + Disp_Token (Ctxt, Tok_Colon); + end if; + Disp_Choice (Ctxt, Assoc); + Disp_Token (Ctxt, Tok_Double_Arrow); + Close_Hbox (Ctxt); + + Start_Vbox (Ctxt); + Disp_Generate_Statement_Body (Ctxt, Bod); + Close_Vbox (Ctxt); + end loop; + Close_Vbox (Ctxt); + Disp_End (Ctxt, Stmt, Tok_Generate); + end Disp_Case_Generate_Statement; + + procedure Disp_PSL_NFA (Ctxt : in out Ctxt_Class; N : PSL.Nodes.NFA) + is + use PSL.NFAs; + + procedure Disp_State (S : NFA_State) is + Str : constant String := Int32'Image (Get_State_Label (S)); + begin + Put (Str (2 .. Str'Last)); + end Disp_State; + + S : NFA_State; + E : NFA_Edge; + begin + if N /= No_NFA then + Put ("-- start: "); + Disp_State (Get_Start_State (N)); + Put (", final: "); + Disp_State (Get_Final_State (N)); + New_Line; + + S := Get_First_State (N); + while S /= No_State loop + E := Get_First_Src_Edge (S); + while E /= No_Edge loop + Put ("-- "); + Disp_State (S); + Put (" -> "); + Disp_State (Get_Edge_Dest (E)); + Put (": "); + Disp_Psl_Expression (Ctxt, Get_Edge_Expr (E)); + New_Line; + E := Get_Next_Src_Edge (E); + end loop; + S := Get_Next_State (S); + end loop; + end if; + end Disp_PSL_NFA; + + procedure Disp_Psl_Assert_Statement + (Ctxt : in out Ctxt_Class; Stmt : Iir) is + begin + Start_Hbox (Ctxt); + if Vhdl_Std < Vhdl_08 then + Put ("--psl "); + end if; + Disp_Label (Ctxt, Stmt); + Disp_Postponed (Ctxt, Stmt); + Disp_Token (Ctxt, Tok_Assert); + Disp_Psl_Expression (Ctxt, Get_Psl_Property (Stmt)); + Disp_Report_Expression (Ctxt, Stmt); + Disp_Severity_Expression (Ctxt, Stmt); + Disp_Token (Ctxt, Tok_Semi_Colon); + Close_Hbox (Ctxt); + Disp_PSL_NFA (Get_PSL_NFA (Stmt)); + end Disp_Psl_Assert_Statement; + + procedure Disp_Psl_Cover_Statement + (Ctxt : in out Ctxt_Class; Stmt : Iir) is + begin + Put ("--psl "); + Disp_Label (Ctxt, Stmt); + Put ("cover "); + Disp_Psl_Sequence (Ctxt, Get_Psl_Sequence (Stmt)); + Put_Line (";"); + Disp_PSL_NFA (Get_PSL_NFA (Stmt)); + end Disp_Psl_Cover_Statement; + + procedure Disp_Simple_Simultaneous_Statement + (Ctxt : in out Ctxt_Class; Stmt : Iir) is + begin + Start_Hbox (Ctxt); + Disp_Label (Ctxt, Stmt); + Print (Ctxt, Get_Simultaneous_Left (Stmt)); + Disp_Token (Ctxt, Tok_Equal_Equal); + Print (Ctxt, Get_Simultaneous_Right (Stmt)); + Disp_Token (Ctxt, Tok_Semi_Colon); + Close_Hbox (Ctxt); + end Disp_Simple_Simultaneous_Statement; + + procedure Disp_Concurrent_Statement (Ctxt : in out Ctxt_Class; Stmt: Iir) is + begin + case Get_Kind (Stmt) is + when Iir_Kind_Concurrent_Simple_Signal_Assignment => + Disp_Concurrent_Simple_Signal_Assignment (Ctxt, Stmt); + when Iir_Kind_Concurrent_Conditional_Signal_Assignment => + Disp_Concurrent_Conditional_Signal_Assignment (Ctxt, Stmt); + when Iir_Kind_Concurrent_Selected_Signal_Assignment => + Disp_Concurrent_Selected_Signal_Assignment (Ctxt, Stmt); + when Iir_Kind_Sensitized_Process_Statement + | Iir_Kind_Process_Statement => + Disp_Process_Statement (Ctxt, Stmt); + when Iir_Kind_Concurrent_Assertion_Statement => + Disp_Assertion_Statement (Ctxt, Stmt); + when Iir_Kind_Component_Instantiation_Statement => + Disp_Component_Instantiation_Statement (Ctxt, Stmt); + when Iir_Kind_Concurrent_Procedure_Call_Statement => + Disp_Procedure_Call (Ctxt, Stmt); + when Iir_Kind_Block_Statement => + Disp_Block_Statement (Ctxt, Stmt); + when Iir_Kind_If_Generate_Statement => + Disp_If_Generate_Statement (Ctxt, Stmt); + when Iir_Kind_Case_Generate_Statement => + Disp_Case_Generate_Statement (Ctxt, Stmt); + when Iir_Kind_For_Generate_Statement => + Disp_For_Generate_Statement (Ctxt, Stmt); + when Iir_Kind_Psl_Default_Clock => + Disp_Psl_Default_Clock (Ctxt, Stmt); + when Iir_Kind_Psl_Declaration + | Iir_Kind_Psl_Endpoint_Declaration => + Disp_Psl_Declaration (Ctxt, Stmt); + when Iir_Kind_Psl_Assert_Statement => + Disp_Psl_Assert_Statement (Ctxt, Stmt); + when Iir_Kind_Psl_Cover_Statement => + Disp_Psl_Cover_Statement (Ctxt, Stmt); + when Iir_Kind_Simple_Simultaneous_Statement => + Disp_Simple_Simultaneous_Statement (Ctxt, Stmt); + when others => + Error_Kind ("disp_concurrent_statement", Stmt); + end case; + end Disp_Concurrent_Statement; + + procedure Disp_Package_Declaration + (Ctxt : in out Ctxt_Class; Decl: Iir_Package_Declaration) + is + Header : constant Iir := Get_Package_Header (Decl); + begin + Start_Hbox (Ctxt); + Disp_Token (Ctxt, Tok_Package); + Disp_Identifier (Ctxt, Decl); + Disp_Token (Ctxt, Tok_Is); + Close_Hbox (Ctxt); + Start_Vbox (Ctxt); + if Header /= Null_Iir then + Disp_Generics (Ctxt, Header); + end if; + Disp_Declaration_Chain (Ctxt, Decl); + Close_Vbox (Ctxt); + Disp_End (Ctxt, Decl, Tok_Package); + end Disp_Package_Declaration; + + procedure Disp_Package_Body (Ctxt : in out Ctxt_Class; Decl: Iir) is + begin + Start_Hbox (Ctxt); + Disp_Token (Ctxt, Tok_Package, Tok_Body); + Disp_Identifier (Ctxt, Decl); + Disp_Token (Ctxt, Tok_Is); + Close_Hbox (Ctxt); + Start_Vbox (Ctxt); + Disp_Declaration_Chain (Ctxt, Decl); + Close_Vbox (Ctxt); + Disp_End (Ctxt, Decl, Tok_Package, Tok_Body); + end Disp_Package_Body; + + procedure Disp_Package_Instantiation_Declaration + (Ctxt : in out Ctxt_Class; Decl: Iir) is + begin + Start_Hbox (Ctxt); + Disp_Token (Ctxt, Tok_Package); + Disp_Identifier (Ctxt, Decl); + Disp_Token (Ctxt, Tok_Is, Tok_New); + Print (Ctxt, Get_Uninstantiated_Package_Name (Decl)); + Disp_Generic_Map_Aspect (Ctxt, Decl); + Disp_Token (Ctxt, Tok_Semi_Colon); + Close_Hbox (Ctxt); + end Disp_Package_Instantiation_Declaration; + + procedure Disp_Binding_Indication (Ctxt : in out Ctxt_Class; Bind : Iir) + is + El : Iir; + begin + El := Get_Entity_Aspect (Bind); + if El /= Null_Iir then + Disp_Token (Ctxt, Tok_Use); + Disp_Entity_Aspect (Ctxt, El); + end if; + El := Get_Generic_Map_Aspect_Chain (Bind); + if El /= Null_Iir then + Disp_Generic_Map_Aspect (Ctxt, Bind); + end if; + El := Get_Port_Map_Aspect_Chain (Bind); + if El /= Null_Iir then + Disp_Port_Map_Aspect (Ctxt, Bind); + end if; + end Disp_Binding_Indication; + + procedure Disp_Component_Configuration + (Ctxt : in out Ctxt_Class; Conf : Iir_Component_Configuration) + is + Block : Iir_Block_Configuration; + Binding : Iir; + begin + Start_Hbox (Ctxt); + Disp_Token (Ctxt, Tok_For); + Disp_Instantiation_List (Ctxt, Get_Instantiation_List (Conf)); + Disp_Token (Ctxt, Tok_Colon); + Print (Ctxt, Get_Component_Name (Conf)); + Close_Hbox (Ctxt); + + Start_Vbox (Ctxt); + Binding := Get_Binding_Indication (Conf); + if Binding /= Null_Iir then + Start_Hbox (Ctxt); + Disp_Binding_Indication (Ctxt, Binding); + Disp_Token (Ctxt, Tok_Semi_Colon); + Close_Hbox (Ctxt); + end if; + Block := Get_Block_Configuration (Conf); + if Block /= Null_Iir then + Disp_Block_Configuration (Ctxt, Block); + end if; + Close_Vbox (Ctxt); + + Disp_End (Ctxt, Tok_For); + end Disp_Component_Configuration; + + procedure Disp_Configuration_Items + (Ctxt : in out Ctxt_Class; Conf : Iir_Block_Configuration) + is + El : Iir; + begin + El := Get_Configuration_Item_Chain (Conf); + while El /= Null_Iir loop + case Get_Kind (El) is + when Iir_Kind_Block_Configuration => + Disp_Block_Configuration (Ctxt, El); + when Iir_Kind_Component_Configuration => + Disp_Component_Configuration (Ctxt, El); + when Iir_Kind_Configuration_Specification => + -- This may be created by canon. + Disp_Configuration_Specification (Ctxt, El); + Put_Line ("end for;"); + when others => + Error_Kind ("disp_configuration_item_list", El); + end case; + El := Get_Chain (El); + end loop; + end Disp_Configuration_Items; + + procedure Disp_Block_Configuration + (Ctxt : in out Ctxt_Class; Block: Iir_Block_Configuration) + is + Spec : Iir; + begin + Start_Hbox (Ctxt); + Disp_Token (Ctxt, Tok_For); + Spec := Get_Block_Specification (Block); + case Get_Kind (Spec) is + when Iir_Kind_Block_Statement + | Iir_Kind_If_Generate_Statement + | Iir_Kind_For_Generate_Statement + | Iir_Kind_Architecture_Body => + Disp_Name_Of (Ctxt, Spec); + when Iir_Kind_Indexed_Name => + declare + Index_List : constant Iir_Flist := Get_Index_List (Spec); + begin + Disp_Name_Of (Ctxt, Get_Prefix (Spec)); + Disp_Token (Ctxt, Tok_Left_Paren); + if Index_List = Iir_Flist_Others then + Put ("others"); + else + Print (Ctxt, Get_Nth_Element (Index_List, 0)); + end if; + Disp_Token (Ctxt, Tok_Right_Paren); + end; + when Iir_Kind_Slice_Name => + Disp_Name_Of (Ctxt, Get_Prefix (Spec)); + Disp_Token (Ctxt, Tok_Left_Paren); + Disp_Range (Ctxt, Get_Suffix (Spec)); + Disp_Token (Ctxt, Tok_Right_Paren); + when Iir_Kind_Simple_Name + | Iir_Kind_Parenthesis_Name => + Print (Ctxt, Spec); + when others => + Error_Kind ("disp_block_configuration", Spec); + end case; + Close_Hbox (Ctxt); + + Start_Vbox (Ctxt); + Disp_Declaration_Chain (Ctxt, Block); + Disp_Configuration_Items (Ctxt, Block); + Close_Vbox (Ctxt); + Disp_End (Ctxt, Tok_For); + end Disp_Block_Configuration; + + procedure Disp_Configuration_Declaration + (Ctxt : in out Ctxt_Class; Decl: Iir_Configuration_Declaration) is + begin + Start_Hbox (Ctxt); + Disp_Token (Ctxt, Tok_Configuration); + Disp_Name_Of (Ctxt, Decl); + Disp_Token (Ctxt, Tok_Of); + Print (Ctxt, Get_Entity_Name (Decl)); + Disp_Token (Ctxt, Tok_Is); + Close_Hbox (Ctxt); + + Start_Vbox (Ctxt); + Disp_Declaration_Chain (Ctxt, Decl); + Disp_Block_Configuration (Ctxt, Get_Block_Configuration (Decl)); + Close_Vbox (Ctxt); + + Disp_End (Ctxt, Decl, Tok_Configuration); + end Disp_Configuration_Declaration; + + procedure Disp_Context_Items (Ctxt : in out Ctxt_Class; First : Iir) + is + Decl: Iir; + Next_Decl : Iir; + begin + Decl := First; + while Decl /= Null_Iir loop + Next_Decl := Get_Chain (Decl); + + case Iir_Kinds_Clause (Get_Kind (Decl)) is + when Iir_Kind_Use_Clause => + Disp_Use_Clause (Ctxt, Decl); + when Iir_Kind_Library_Clause => + Start_Hbox (Ctxt); + Disp_Token (Ctxt, Tok_Library); + Disp_Identifier (Ctxt, Decl); + while Get_Has_Identifier_List (Decl) loop + Decl := Next_Decl; + Next_Decl := Get_Chain (Decl); + Disp_Token (Ctxt, Tok_Comma); + Disp_Identifier (Ctxt, Decl); + end loop; + Disp_Token (Ctxt, Tok_Semi_Colon); + Close_Hbox (Ctxt); + when Iir_Kind_Context_Reference => + Start_Hbox (Ctxt); + Disp_Token (Ctxt, Tok_Context); + declare + Ref : Iir; + begin + Ref := Decl; + loop + Print (Ctxt, Get_Selected_Name (Ref)); + Ref := Get_Context_Reference_Chain (Ref); + exit when Ref = Null_Iir; + Disp_Token (Ctxt, Tok_Comma); + end loop; + Disp_Token (Ctxt, Tok_Semi_Colon); + end; + Close_Hbox (Ctxt); + end case; + Decl := Next_Decl; + end loop; + end Disp_Context_Items; + + procedure Disp_Context_Declaration (Ctxt : in out Ctxt_Class; Decl: Iir) is + begin + Start_Hbox (Ctxt); + Disp_Token (Ctxt, Tok_Context); + Disp_Name_Of (Ctxt, Decl); + Disp_Token (Ctxt, Tok_Is); + Close_Hbox (Ctxt); + Start_Vbox (Ctxt); + Disp_Context_Items (Ctxt, Get_Context_Items (Decl)); + Close_Vbox (Ctxt); + Disp_End (Ctxt, Decl, Tok_Context); + end Disp_Context_Declaration; + + procedure Disp_Design_Unit (Ctxt : in out Ctxt_Class; Unit: Iir_Design_Unit) + is + Decl: Iir; + begin + Disp_Context_Items (Ctxt, Get_Context_Items (Unit)); + + Decl := Get_Library_Unit (Unit); + case Iir_Kinds_Library_Unit (Get_Kind (Decl)) is + when Iir_Kind_Entity_Declaration => + Disp_Entity_Declaration (Ctxt, Decl); + when Iir_Kind_Architecture_Body => + Disp_Architecture_Body (Ctxt, Decl); + when Iir_Kind_Package_Declaration => + Disp_Package_Declaration (Ctxt, Decl); + when Iir_Kind_Package_Body => + Disp_Package_Body (Ctxt, Decl); + when Iir_Kind_Package_Instantiation_Declaration => + Disp_Package_Instantiation_Declaration (Ctxt, Decl); + when Iir_Kind_Configuration_Declaration => + Disp_Configuration_Declaration (Ctxt, Decl); + when Iir_Kind_Context_Declaration => + Disp_Context_Declaration (Ctxt, Decl); + end case; + end Disp_Design_Unit; + + procedure Disp_Vhdl (Ctxt : in out Ctxt_Class; N : Iir) is + begin + case Get_Kind (N) is + when Iir_Kind_Design_File => + declare + Unit : Iir; + begin + Unit := Get_First_Design_Unit (N); + while Unit /= Null_Iir loop + Disp_Vhdl (Ctxt, Unit); + Unit := Get_Chain (Unit); + end loop; + end; + when Iir_Kind_Design_Unit => + Disp_Design_Unit (Ctxt, N); + when Iir_Kind_Enumeration_Type_Definition => + Disp_Enumeration_Type_Definition (Ctxt, N); + when Iir_Kind_Concurrent_Conditional_Signal_Assignment => + Disp_Concurrent_Conditional_Signal_Assignment (Ctxt, N); + when Iir_Kinds_Dyadic_Operator => + Disp_Dyadic_Operator (Ctxt, N); + when Iir_Kind_Interface_Signal_Declaration + | Iir_Kind_Signal_Declaration + | Iir_Kind_Object_Alias_Declaration => + Disp_Name_Of (Ctxt, N); + when Iir_Kind_Enumeration_Literal => + Disp_Identifier (Ctxt, N); + when Iir_Kind_Component_Instantiation_Statement => + Disp_Component_Instantiation_Statement (Ctxt, N); + when Iir_Kind_Array_Type_Definition => + Disp_Array_Type_Definition (Ctxt, N); + when Iir_Kind_Package_Declaration => + Disp_Package_Declaration (Ctxt, N); + when Iir_Kind_Wait_Statement => + Disp_Wait_Statement (Ctxt, N); + when Iir_Kind_Selected_Name + | Iir_Kind_Selected_Element + | Iir_Kind_Indexed_Name + | Iir_Kind_Slice_Name => + Print (Ctxt, N); + when Iir_Kind_Psl_Cover_Statement => + Disp_Psl_Cover_Statement (Ctxt, N); + when others => + Error_Kind ("disp", N); + end case; + end Disp_Vhdl; + + procedure Disp_Int_Trim (Ctxt : in out Ctxt_Class; Str : String) is + begin + Start_Lit (Ctxt, Tok_Integer); + if Str (Str'First) = ' ' then + Disp_Str (Ctxt, Str (Str'First + 1 .. Str'Last)); + else + Disp_Str (Ctxt, Str); + end if; + Close_Lit (Ctxt); + end Disp_Int_Trim; + + procedure Disp_Int64 (Ctxt : in out Ctxt_Class; Val: Int64) is + begin + Disp_Int_Trim (Ctxt, Int64'Image (Val)); + end Disp_Int64; + + procedure Disp_Int32 (Ctxt : in out Ctxt_Class; Val: Iir_Int32) is + begin + Disp_Int_Trim (Ctxt, Iir_Int32'Image (Val)); + end Disp_Int32; + + procedure Disp_Fp64 (Ctxt : in out Ctxt_Class; Val: Fp64) + is + Str: constant String := Fp64'Image (Val); + begin + Start_Lit (Ctxt, Tok_Real); + if Str (Str'First) = ' ' then + Disp_Str (Ctxt, Str (Str'First + 1 .. Str'Last)); + else + Disp_Str (Ctxt, Str); + end if; + Close_Lit (Ctxt); + end Disp_Fp64; + + procedure Disp_Str (Ctxt : in out Ctxt_Class; Str : String) is + begin + for I in Str'Range loop + Disp_Char (Ctxt, Str (I)); + end loop; + end Disp_Str; + + + function Need_Space (Tok, Prev_Tok : Token_Type) return Boolean is + begin + if Prev_Tok = Tok_Newline then + return False; + elsif Prev_Tok >= Tok_First_Keyword then + -- A space after a keyword. + if Tok /= Tok_Semi_Colon + and Tok /= Tok_Dot + then + return True; + end if; + elsif Tok >= Tok_First_Keyword then + -- Space before a keyword. + if Prev_Tok /= Tok_Dot + and Prev_Tok /= Tok_Left_Paren + then + return True; + end if; + elsif (Tok = Tok_Identifier + or Tok = Tok_String) + and (Prev_Tok = Tok_Identifier + or Prev_Tok = Tok_String + or Prev_Tok = Tok_Integer + or Prev_Tok = Tok_Real) + then + -- A space is needed between 2 identifiers. + return True; + elsif Prev_Tok = Tok_Comma + or Prev_Tok = Tok_Semi_Colon + or Prev_Tok = Tok_Colon + or Prev_Tok = Tok_Assign + or Prev_Tok = Tok_Double_Arrow + or Prev_Tok in Token_Relational_Operator_Type + or Prev_Tok in Token_Adding_Operator_Type + or Prev_Tok in Token_Multiplying_Operator_Type + or Prev_Tok = Tok_Bar + then + -- Always a space after ',', ':', ':=' + return True; + elsif Tok = Tok_Left_Paren then + if Prev_Tok /= Tok_Tick and Prev_Tok /= Tok_Left_Paren then + -- A space before '('. + return True; + end if; + elsif Tok = Tok_Left_Bracket + or Tok = Tok_Assign + or Tok = Tok_Double_Arrow + or Tok in Token_Relational_Operator_Type + or Tok in Token_Adding_Operator_Type + or Tok in Token_Multiplying_Operator_Type + or Tok = Tok_Bar + then + -- Always a space before '[', ':='. + return True; + end if; + return False; + end Need_Space; + + package Simple_Disp_Ctxt is + type Simple_Ctxt is new Disp_Ctxt with record + Vnum : Natural; + Hnum : Natural; + Prev_Tok : Token_Type; + end record; + + procedure Init (Ctxt : out Simple_Ctxt); + procedure Start_Hbox (Ctxt : in out Simple_Ctxt); + procedure Close_Hbox (Ctxt : in out Simple_Ctxt); + procedure Start_Vbox (Ctxt : in out Simple_Ctxt); + procedure Close_Vbox (Ctxt : in out Simple_Ctxt); + procedure Disp_Token (Ctxt : in out Simple_Ctxt; Tok : Token_Type); + procedure Start_Lit (Ctxt : in out Simple_Ctxt; Tok : Token_Type); + procedure Disp_Char (Ctxt : in out Simple_Ctxt; C : Character); + procedure Close_Lit (Ctxt : in out Simple_Ctxt); + private + procedure Put (Ctxt : in out Simple_Ctxt; C : Character); + end Simple_Disp_Ctxt; + + package body Simple_Disp_Ctxt is + procedure Init (Ctxt : out Simple_Ctxt) is + begin + Ctxt := (Vnum => 0, + Hnum => 0, + Prev_Tok => Tok_Newline); + end Init; + + procedure Put (Ctxt : in out Simple_Ctxt; C : Character) + is + pragma Unreferenced (Ctxt); + begin + Simple_IO.Put (C); + end Put; + + procedure Start_Hbox (Ctxt : in out Simple_Ctxt) is + begin + if Ctxt.Hnum = 0 then + for I in 1 .. Ctxt.Vnum loop + Put (Ctxt, ' '); + Put (Ctxt, ' '); + end loop; + end if; + Ctxt.Hnum := Ctxt.Hnum + 1; + end Start_Hbox; + + procedure Close_Hbox (Ctxt : in out Simple_Ctxt) is + begin + Ctxt.Hnum := Ctxt.Hnum - 1; + if Ctxt.Hnum = 0 then + Put (Ctxt, ASCII.LF); + Ctxt.Prev_Tok := Tok_Newline; + end if; + end Close_Hbox; + + procedure Start_Vbox (Ctxt : in out Simple_Ctxt) is + begin + pragma Assert (Ctxt.Hnum = 0); + Ctxt.Vnum := Ctxt.Vnum + 1; + end Start_Vbox; + + procedure Close_Vbox (Ctxt : in out Simple_Ctxt) is + begin + Ctxt.Vnum := Ctxt.Vnum - 1; + end Close_Vbox; + + procedure Disp_Space (Ctxt : in out Simple_Ctxt; Tok : Token_Type) + is + Prev_Tok : constant Token_Type := Ctxt.Prev_Tok; + begin + if Need_Space (Tok, Prev_Tok) then + Put (Ctxt, ' '); + end if; + Ctxt.Prev_Tok := Tok; + end Disp_Space; + + procedure Disp_Token (Ctxt : in out Simple_Ctxt; Tok : Token_Type) is + begin + Disp_Space (Ctxt, Tok); + Disp_Str (Ctxt, Image (Tok)); + end Disp_Token; + + procedure Start_Lit (Ctxt : in out Simple_Ctxt; Tok : Token_Type) is + begin + Disp_Space (Ctxt, Tok); + end Start_Lit; + + procedure Disp_Char (Ctxt : in out Simple_Ctxt; C : Character) is + begin + Put (Ctxt, C); + end Disp_Char; + + procedure Close_Lit (Ctxt : in out Simple_Ctxt) is + begin + null; + end Close_Lit; + end Simple_Disp_Ctxt; + + procedure Disp_Vhdl (N : Iir) + is + use Simple_Disp_Ctxt; + Ctxt : Simple_Ctxt; + begin + Init (Ctxt); + Disp_Vhdl (Ctxt, N); + end Disp_Vhdl; + + procedure Disp_Expression (Expr: Iir) + is + use Simple_Disp_Ctxt; + Ctxt : Simple_Ctxt; + begin + Init (Ctxt); + Print (Ctxt, Expr); + end Disp_Expression; + + procedure Disp_PSL_NFA (N : PSL.Nodes.NFA) + is + use Simple_Disp_Ctxt; + Ctxt : Simple_Ctxt; + begin + Init (Ctxt); + Disp_PSL_NFA (Ctxt, N); + end Disp_PSL_NFA; + +end Vhdl.Prints; diff --git a/src/vhdl/vhdl-prints.ads b/src/vhdl/vhdl-prints.ads new file mode 100644 index 000000000..285d1354e --- /dev/null +++ b/src/vhdl/vhdl-prints.ads @@ -0,0 +1,57 @@ +-- VHDL regeneration from internal nodes. +-- 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 GHDL; see the file COPYING. If not, write to the Free +-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA +-- 02111-1307, USA. + +with Vhdl.Nodes; use Vhdl.Nodes; +with Vhdl.Tokens; use Vhdl.Tokens; +with PSL.Types; use PSL.Types; + +package Vhdl.Prints is + type Disp_Ctxt is abstract tagged null record; + procedure Start_Hbox (Ctxt : in out Disp_Ctxt) is abstract; + procedure Close_Hbox (Ctxt : in out Disp_Ctxt) is abstract; + procedure Start_Vbox (Ctxt : in out Disp_Ctxt) is abstract; + procedure Close_Vbox (Ctxt : in out Disp_Ctxt) is abstract; + procedure Disp_Token (Ctxt : in out Disp_Ctxt; Tok : Token_Type) + is abstract; + procedure Start_Lit (Ctxt : in out Disp_Ctxt; Tok : Token_Type) + is abstract; + procedure Disp_Char (Ctxt : in out Disp_Ctxt; C : Character) + is abstract; + procedure Close_Lit (Ctxt : in out Disp_Ctxt) + is abstract; + + subtype Ctxt_Class is Disp_Ctxt'Class; + + -- Helper that calls Disp_Char for every character of STR. + procedure Disp_Str (Ctxt : in out Ctxt_Class; Str : String); + + -- Return True if a space should be displayed between PREV_TOK and TOK. + function Need_Space (Tok, Prev_Tok : Token_Type) return Boolean; + + -- General procedure to display a node. + -- Mainly used to dispatch to other functions according to the kind of + -- the node. + procedure Disp_Vhdl (Ctxt : in out Ctxt_Class; N : Iir); + procedure Disp_Vhdl (N : Iir); + + procedure Disp_PSL_NFA (Ctxt : in out Ctxt_Class; N : PSL_NFA); + procedure Disp_PSL_NFA (N : PSL_NFA); + + procedure Disp_Expression (Expr: Iir); + -- Display an expression. +end Vhdl.Prints; diff --git a/src/vhdl/vhdl-sem_lib.adb b/src/vhdl/vhdl-sem_lib.adb index e3ff86ed8..c09f1a7a2 100644 --- a/src/vhdl/vhdl-sem_lib.adb +++ b/src/vhdl/vhdl-sem_lib.adb @@ -25,7 +25,7 @@ with Libraries; use Libraries; with Vhdl.Scanner; with Vhdl.Parse; with Vhdl.Disp_Tree; -with Vhdl.Disp_Vhdl; +with Vhdl.Prints; with Vhdl.Sem; with Vhdl.Post_Sems; with Vhdl.Canon; @@ -104,7 +104,7 @@ package body Vhdl.Sem_Lib is end if; if (Main or Flags.List_All) and then Flags.List_Sem then - Vhdl.Disp_Vhdl.Disp_Vhdl (Unit); + Vhdl.Prints.Disp_Vhdl (Unit); end if; if Flags.Check_Ast_Level > 0 then @@ -139,7 +139,7 @@ package body Vhdl.Sem_Lib is end if; if (Main or Flags.List_All) and then Flags.List_Canon then - Vhdl.Disp_Vhdl.Disp_Vhdl (Unit); + Vhdl.Prints.Disp_Vhdl (Unit); end if; if Flags.Check_Ast_Level > 0 then diff --git a/src/vhdl/vhdl-sem_psl.adb b/src/vhdl/vhdl-sem_psl.adb index 28541e7cc..a1afddd44 100644 --- a/src/vhdl/vhdl-sem_psl.adb +++ b/src/vhdl/vhdl-sem_psl.adb @@ -37,7 +37,7 @@ with Vhdl.Errors; use Vhdl.Errors; with Vhdl.Xrefs; use Vhdl.Xrefs; package body Vhdl.Sem_Psl is - procedure Sem_Psl_Directive_Clock (Stmt : Iir; Prop : in out Node); + procedure Sem_Psl_Directive_Clock (Stmt : Iir; Prop : in out PSL_Node); -- Return TRUE iff Atype is a PSL boolean type. -- See PSL1.1 5.1.2 Boolean expressions @@ -61,7 +61,7 @@ package body Vhdl.Sem_Psl is end Is_Psl_Bool_Expr; -- Convert VHDL and/or/not nodes to PSL nodes. - function Convert_Bool (Expr : Iir) return Node + function Convert_Bool (Expr : Iir) return PSL_Node is use Std_Names; Impl : Iir; @@ -72,9 +72,9 @@ package body Vhdl.Sem_Psl is Left : Iir; Right : Iir; - function Build_Op (Kind : Nkind) return Node + function Build_Op (Kind : Nkind) return PSL_Node is - N : Node; + N : PSL_Node; begin N := Create_Node (Kind); Set_Location (N, Get_Location (Expr)); @@ -102,9 +102,9 @@ package body Vhdl.Sem_Psl is declare Operand : Iir; - function Build_Op (Kind : Nkind) return Node + function Build_Op (Kind : Nkind) return PSL_Node is - N : Node; + N : PSL_Node; begin N := Create_Node (Kind); Set_Location (N, Get_Location (Expr)); @@ -141,14 +141,14 @@ package body Vhdl.Sem_Psl is -- Analyze an HDL expression. This may mostly a wrapper except in the -- case when the expression is in fact a PSL expression. - function Sem_Hdl_Expr (N : Node) return Node + function Sem_Hdl_Expr (N : PSL_Node) return PSL_Node is use Sem_Names; Expr : Iir; Name : Iir; - Decl : Node; - Res : Node; + Decl : PSL_Node; + Res : PSL_Node; begin Expr := Get_HDL_Node (N); if Get_Kind (Expr) in Iir_Kinds_Name then @@ -184,7 +184,7 @@ package body Vhdl.Sem_Psl is end case; Set_Location (Res, Get_Location (N)); Set_Declaration (Res, Decl); - if Get_Parameter_List (Decl) /= Null_Node then + if Get_Parameter_List (Decl) /= Null_PSL_Node then Error_Msg_Sem (+Res, "no actual for instantiation"); end if; Free_Node (N); @@ -225,7 +225,7 @@ package body Vhdl.Sem_Psl is end Sem_Hdl_Expr; -- Sem a boolean node. - function Sem_Boolean (Bool : Node) return Node is + function Sem_Boolean (Bool : PSL_Node) return PSL_Node is begin case Get_Kind (Bool) is when N_HDL_Expr => @@ -240,9 +240,9 @@ package body Vhdl.Sem_Psl is end case; end Sem_Boolean; - procedure Sem_Boolean (N : Node) + procedure Sem_Boolean (N : PSL_Node) is - Bool : Node; + Bool : PSL_Node; begin Bool := Get_Boolean (N); Bool := Sem_Boolean (Bool); @@ -251,10 +251,10 @@ package body Vhdl.Sem_Psl is -- Used by Sem_Property to rewrite a property logical operator to a -- boolean logical operator. - function Reduce_Logic_Binary_Node (Prop : Node; Bool_Kind : Nkind) - return Node + function Reduce_Logic_Binary_Node (Prop : PSL_Node; Bool_Kind : Nkind) + return PSL_Node is - Res : Node; + Res : PSL_Node; begin Res := Create_Node (Bool_Kind); Set_Location (Res, Get_Location (Prop)); @@ -264,10 +264,10 @@ package body Vhdl.Sem_Psl is return Res; end Reduce_Logic_Binary_Node; - function Reduce_Logic_Unary_Node (Prop : Node; Bool_Kind : Nkind) - return Node + function Reduce_Logic_Unary_Node (Prop : PSL_Node; Bool_Kind : Nkind) + return PSL_Node is - Res : Node; + Res : PSL_Node; begin Res := Create_Node (Bool_Kind); Set_Location (Res, Get_Location (Prop)); @@ -276,10 +276,10 @@ package body Vhdl.Sem_Psl is return Res; end Reduce_Logic_Unary_Node; - function Sem_Sequence (Seq : Node) return Node + function Sem_Sequence (Seq : PSL_Node) return PSL_Node is - Res : Node; - L, R : Node; + Res : PSL_Node; + L, R : PSL_Node; begin case Get_Kind (Seq) is when N_Braced_SERE => @@ -304,7 +304,7 @@ package body Vhdl.Sem_Psl is return Seq; when N_Star_Repeat_Seq => Res := Get_Sequence (Seq); - if Res /= Null_Node then + if Res /= Null_PSL_Node then Res := Sem_Sequence (Get_Sequence (Seq)); Set_Sequence (Seq, Res); end if; @@ -312,7 +312,7 @@ package body Vhdl.Sem_Psl is return Seq; when N_Plus_Repeat_Seq => Res := Get_Sequence (Seq); - if Res /= Null_Node then + if Res /= Null_PSL_Node then Res := Sem_Sequence (Get_Sequence (Seq)); Set_Sequence (Seq, Res); end if; @@ -341,20 +341,21 @@ package body Vhdl.Sem_Psl is end case; end Sem_Sequence; - function Sem_Property (Prop : Node; Top : Boolean := False) return Node; + function Sem_Property (Prop : PSL_Node; Top : Boolean := False) + return PSL_Node; - procedure Sem_Property (N : Node; Top : Boolean := False) + procedure Sem_Property (N : PSL_Node; Top : Boolean := False) is - Prop : Node; + Prop : PSL_Node; begin Prop := Get_Property (N); Prop := Sem_Property (Prop, Top); Set_Property (N, Prop); end Sem_Property; - procedure Sem_Number (N : Node) + procedure Sem_Number (N : PSL_Node) is - Num : Node; + Num : PSL_Node; begin Num := Get_Number (N); -- FIXME: todo @@ -362,9 +363,10 @@ package body Vhdl.Sem_Psl is Set_Number (N, Num); end Sem_Number; - function Sem_Property (Prop : Node; Top : Boolean := False) return Node + function Sem_Property (Prop : PSL_Node; Top : Boolean := False) + return PSL_Node is - Res : Node; + Res : PSL_Node; begin case Get_Kind (Prop) is when N_Braced_SERE => @@ -400,7 +402,7 @@ package body Vhdl.Sem_Psl is | N_And_Prop | N_Or_Prop => declare - L, R : Node; + L, R : PSL_Node; begin L := Sem_Property (Get_Left (Prop)); Set_Left (Prop, L); @@ -431,7 +433,7 @@ package body Vhdl.Sem_Psl is return Prop; when N_Paren_Prop => declare - Op : Node; + Op : PSL_Node; begin Op := Get_Property (Prop); Op := Sem_Property (Op); @@ -459,10 +461,10 @@ package body Vhdl.Sem_Psl is Res := Sem_Hdl_Expr (Prop); if not Top and then Get_Kind (Res) = N_Property_Instance then declare - Decl : constant Node := Get_Declaration (Res); + Decl : constant PSL_Node := Get_Declaration (Res); begin - if Decl /= Null_Node - and then Get_Global_Clock (Decl) /= Null_Node + if Decl /= Null_PSL_Node + and then Get_Global_Clock (Decl) /= Null_PSL_Node then Error_Msg_Sem (+Prop, "property instance already has a clock"); @@ -476,11 +478,11 @@ package body Vhdl.Sem_Psl is end Sem_Property; -- Extract the clock from PROP. - procedure Extract_Clock (Prop : in out Node; Clk : out Node) + procedure Extract_Clock (Prop : in out PSL_Node; Clk : out PSL_Node) is - Child : Node; + Child : PSL_Node; begin - Clk := Null_Node; + Clk := Null_PSL_Node; case Get_Kind (Prop) is when N_Clock_Event => Clk := Get_Boolean (Prop); @@ -507,10 +509,10 @@ package body Vhdl.Sem_Psl is procedure Sem_Psl_Declaration (Stmt : Iir) is use Sem_Scopes; - Decl : constant Node := Get_Psl_Declaration (Stmt); - Prop : Node; - Clk : Node; - Formal : Node; + Decl : constant PSL_Node := Get_Psl_Declaration (Stmt); + Prop : PSL_Node; + Clk : PSL_Node; + Formal : PSL_Node; El : Iir; begin Sem_Scopes.Add_Name (Stmt); @@ -520,7 +522,7 @@ package body Vhdl.Sem_Psl is -- Make formal parameters visible. Formal := Get_Parameter_List (Decl); - while Formal /= Null_Node loop + while Formal /= Null_PSL_Node loop El := Create_Iir (Iir_Kind_Psl_Declaration); Set_Location (El, Get_Location (Formal)); Set_Identifier (El, Get_Identifier (Formal)); @@ -560,13 +562,13 @@ package body Vhdl.Sem_Psl is procedure Sem_Psl_Endpoint_Declaration (Stmt : Iir) is - Decl : constant Node := Get_Psl_Declaration (Stmt); - Prop : Node; + Decl : constant PSL_Node := Get_Psl_Declaration (Stmt); + Prop : PSL_Node; begin Sem_Scopes.Add_Name (Stmt); Xref_Decl (Stmt); - pragma Assert (Get_Parameter_List (Decl) = Null_Node); + pragma Assert (Get_Parameter_List (Decl) = Null_PSL_Node); pragma Assert (Get_Kind (Decl) = N_Endpoint_Declaration); Prop := Get_Sequence (Decl); @@ -584,10 +586,10 @@ package body Vhdl.Sem_Psl is Set_Visible_Flag (Stmt, True); end Sem_Psl_Endpoint_Declaration; - function Rewrite_As_Boolean_Expression (Prop : Node) return Iir + function Rewrite_As_Boolean_Expression (Prop : PSL_Node) return Iir is function Rewrite_Dyadic_Operator - (Expr : Node; Kind : Iir_Kind) return Iir + (Expr : PSL_Node; Kind : Iir_Kind) return Iir is Res : Iir; begin @@ -599,7 +601,7 @@ package body Vhdl.Sem_Psl is end Rewrite_Dyadic_Operator; function Rewrite_Monadic_Operator - (Expr : Node; Kind : Iir_Kind) return Iir + (Expr : PSL_Node; Kind : Iir_Kind) return Iir is Res : Iir; begin @@ -665,7 +667,7 @@ package body Vhdl.Sem_Psl is end Rewrite_As_Concurrent_Assertion; -- Return True iff EXPR is a boolean expression. - function Is_Boolean_Assertion (Expr : Node) return Boolean is + function Is_Boolean_Assertion (Expr : PSL_Node) return Boolean is begin case Get_Kind (Expr) is when N_HDL_Expr => @@ -677,15 +679,15 @@ package body Vhdl.Sem_Psl is end case; end Is_Boolean_Assertion; - procedure Sem_Psl_Directive_Clock (Stmt : Iir; Prop : in out Node) + procedure Sem_Psl_Directive_Clock (Stmt : Iir; Prop : in out PSL_Node) is - Clk : Node; + Clk : PSL_Node; begin Extract_Clock (Prop, Clk); - if Clk = Null_Node then + if Clk = Null_PSL_Node then if Current_Psl_Default_Clock = Null_Iir then Error_Msg_Sem (+Stmt, "no clock for PSL directive"); - Clk := Null_Node; + Clk := Null_PSL_Node; else Clk := Get_Psl_Boolean (Current_Psl_Default_Clock); end if; @@ -695,7 +697,7 @@ package body Vhdl.Sem_Psl is function Sem_Psl_Assert_Statement (Stmt : Iir) return Iir is - Prop : Node; + Prop : PSL_Node; Res : Iir; begin pragma Assert (Get_Kind (Stmt) = Iir_Kind_Psl_Assert_Statement); @@ -732,7 +734,7 @@ package body Vhdl.Sem_Psl is procedure Sem_Psl_Cover_Statement (Stmt : Iir) is - Seq : Node; + Seq : PSL_Node; begin -- Sem report and severity expressions. Sem_Report_Statement (Stmt); @@ -750,7 +752,7 @@ package body Vhdl.Sem_Psl is procedure Sem_Psl_Default_Clock (Stmt : Iir) is - Expr : Node; + Expr : PSL_Node; begin if Current_Psl_Default_Clock /= Null_Iir and then Get_Parent (Current_Psl_Default_Clock) = Get_Parent (Stmt) @@ -772,14 +774,14 @@ package body Vhdl.Sem_Psl is is Prefix : constant Iir := Get_Prefix (Name); Ent : constant Iir := Get_Named_Entity (Prefix); - Decl : constant Node := Get_Psl_Declaration (Ent); - Formal : Node; + Decl : constant PSL_Node := Get_Psl_Declaration (Ent); + Formal : PSL_Node; Assoc : Iir; - Res : Node; - Last_Assoc : Node; - Assoc2 : Node; + Res : PSL_Node; + Last_Assoc : PSL_Node; + Assoc2 : PSL_Node; Actual : Iir; - Psl_Actual : Node; + Psl_Actual : PSL_Node; Res2 : Iir; begin pragma Assert (Get_Kind (Ent) = Iir_Kind_Psl_Declaration @@ -799,9 +801,9 @@ package body Vhdl.Sem_Psl is Set_Location (Res, Get_Location (Name)); Formal := Get_Parameter_List (Decl); Assoc := Get_Association_Chain (Name); - Last_Assoc := Null_Node; + Last_Assoc := Null_PSL_Node; - while Formal /= Null_Node loop + while Formal /= Null_PSL_Node loop if Assoc = Null_Iir then Error_Msg_Sem (+Name, "not enough association"); exit; @@ -825,7 +827,7 @@ package body Vhdl.Sem_Psl is Set_Location (Assoc2, Get_Location (Assoc)); Set_Formal (Assoc2, Formal); Set_Actual (Assoc2, Psl_Actual); - if Last_Assoc = Null_Node then + if Last_Assoc = Null_PSL_Node then Set_Association_Chain (Res, Assoc2); else Set_Chain (Last_Assoc, Assoc2); diff --git a/src/vhdl/vhdl-types.ads b/src/vhdl/vhdl-types.ads index b9fd673b5..ecd2367ca 100644 --- a/src/vhdl/vhdl-types.ads +++ b/src/vhdl/vhdl-types.ads @@ -21,5 +21,6 @@ with Vhdl.Nodes_Priv; package Vhdl.Types is pragma Preelaborate (Vhdl.Types); - subtype Node is Vhdl.Nodes_Priv.Node_Type; + subtype Vhdl_Node is Vhdl.Nodes_Priv.Node_Type; + Null_Vhdl_Node : constant Vhdl_Node := Vhdl.Nodes_Priv.Null_Node; end Vhdl.Types; -- cgit v1.2.3