/*
ChibiOS/RT - Copyright (C) 2006,2007,2008,2009,2010,
2011,2012 Giovanni Di Sirio.
This file is part of ChibiOS/RT.
ChibiOS/RT 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 3 of the License, or
(at your option) any later version.
ChibiOS/RT is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program. If not, see
-- 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.Types; use Vhdl.Types;
with Vhdl.Errors; use Vhdl.Errors;
with Vhdl.Utils; use Vhdl.Utils;
with Vhdl.Std_Package;
with PSL.Priorities; use PSL.Priorities;
with PSL.Nodes; use 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_Simultaneous_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_Subnature_Indication (Ctxt : in out Ctxt_Class; Ind : Iir);
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 Print_Property (Ctxt : in out Ctxt_Class;
Prop : PSL_Node;
Parent_Prio : Priority := Prio_Lowest);
procedure Print_Sequence (Ctxt : in out Ctxt_Class;
Seq : PSL_Node;
Parent_Prio : Priority := Prio_Lowest);
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);
package OOB is
procedure Put (Str : String);
procedure New_Line;
end OOB;
package body OOB is
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;
end OOB;
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, "<anonymous>");
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_Verification_Unit
| Iir_Kinds_Interface_Object_Declaration
| Iir_Kind_Interface_Terminal_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_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_Sub_Definition_Indexes
(Ctxt : in out Ctxt_Class; 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_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);
end Disp_Array_Sub_Definition_Indexes;
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;
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
Disp_Array_Sub_Definition_Indexes (Ctxt, Def);
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;
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_Array_Definition_Indexes
(Ctxt : in out Ctxt_Class; Def: Iir)
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);
end Disp_Array_Definition_Indexes;
procedure Disp_Array_Type_Definition
(Ctxt : in out Ctxt_Class; Def: Iir_Array_Type_Definition) is
begin
Disp_Array_Definition_Indexes (Ctxt, Def);
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
begin
Disp_Token (Ctxt, Tok_Array);
Disp_Array_Sub_Definition_Indexes (Ctxt, Def);
Disp_Token (Ctxt, 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
OOB.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_Scalar_Nature_Definition
(Ctxt : in out Ctxt_Class; Def : Iir) is
begin
Print (Ctxt, Get_Across_Type_Mark (Def));
Disp_Token (Ctxt, Tok_Across);
Print (Ctxt, Get_Through_Type_Mark (Def));
Disp_Token (Ctxt, Tok_Through);
Disp_Name_Of (Ctxt, Get_Reference (Def));
Disp_Token (Ctxt, Tok_Reference);
end Disp_Scalar_Nature_Definition;
procedure Disp_Array_Nature_Definition
(Ctxt : in out Ctxt_Class; Def: Iir) is
begin
Disp_Array_Definition_Indexes (Ctxt, Def);
Disp_Subnature_Indication (Ctxt, Get_Element_Subnature_Indication (Def));
end Disp_Array_Nature_Definition;
procedure Disp_Record_Nature_Definition
(Ctxt : in out Ctxt_Class; Def : Iir)
is
List : constant Iir_Flist := Get_Elements_Declaration_List (Def);
El: Iir_Element_Declaration;
El_Subnature : 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_Subnature := Get_Subnature_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_Subnature_Indication (Ctxt, El_Subnature);
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_Nature_Definition;
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_Scalar_Nature_Definition (Ctxt, Def);
when Iir_Kind_Record_Nature_Definition =>
Disp_Record_Nature_Definition (Ctxt, Def);
when Iir_Kind_Array_Nature_Definition =>
Disp_Array_Nature_Definition (Ctxt, Def);
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
begin
case Get_Kind (Ind) is
when Iir_Kinds_Denoting_Name
| Iir_Kind_Subtype_Attribute
| Iir_Kind_Attribute_Name =>
Print (Ctxt, Ind);
when Iir_Kind_Array_Subnature_Definition =>
Print (Ctxt, Get_Subnature_Nature_Mark (Ind));
Disp_Array_Sub_Definition_Indexes (Ctxt, Ind);
when others =>
Error_Kind ("disp_subnature_indication", Ind);
end case;
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 =>
null;
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 Iir_Kind_Interface_Terminal_Declaration =>
Disp_Token (Ctxt, Tok_Terminal);
when Iir_Kind_Interface_Quantity_Declaration =>
Disp_Token (Ctxt, Tok_Quantity);
when others =>
Error_Kind ("disp_interface_class", Inter);
end case;
end if;
end Disp_Interface_Class;
procedure Disp_Default_Value_Opt (Ctxt : in out Ctxt_Class; Obj : Iir)
is
Default: constant Iir := Get_Default_Value (Obj);
begin
if Default /= Null_Iir then
Disp_Token (Ctxt, Tok_Assign);
Print (Ctxt, Default);
end if;
end Disp_Default_Value_Opt;
procedure Disp_Interface_Mode_And_Type
(Ctxt : in out Ctxt_Class; Inter: Iir)
is
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;
Disp_Default_Value_Opt (Ctxt, Inter);
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; With_Box : Boolean)
is
Inter: Iir;
Next_Inter : Iir;
First_Inter : Iir;
begin
if Chain = Null_Iir then
return;
end if;
Disp_Token (Ctxt, Tok_Left_Paren);
if With_Box then
Close_Hbox (Ctxt);
Start_Vbox (Ctxt);
end if;
Inter := Chain;
loop
Next_Inter := Get_Chain (Inter);
First_Inter := Inter;
if With_Box then
Start_Hbox (Ctxt);
end if;
case Iir_Kinds_Interface_Declaration (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_Terminal_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_Token (Ctxt, Tok_Colon);
Disp_Subnature_Indication
(Ctxt, Get_Subnature_Indication (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;
if Next_Inter /= Null_Iir then
Disp_Token (Ctxt, Tok_Semi_Colon);
end if;
if With_Box then
Close_Hbox (Ctxt);
end if;
exit when Next_Inter = Null_Iir;
Inter := Next_Inter;
Next_Inter := Get_Chain (Inter);
end loop;
if With_Box then
Close_Vbox (Ctxt);
Start_Hbox (Ctxt);
end if;
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, True);
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, True);
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_Simultaneous_Statement_Chain
(Ctxt : in out Ctxt_Class; Parent : Iir)
is
El: Iir;
begin
El := Get_Simultaneous_Statement_Chain (Parent);
while El /= Null_Iir loop
Disp_Concurrent_Statement (Ctxt, El);
El := Get_Chain (El);
end loop;
end Disp_Simultaneous_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));
Close_Hbox (Ctxt);
Start_Hbox (Ctxt);
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);
begin
Start_Hbox (Ctxt);
Disp_Token (Ctxt, Tok_Alias);
Disp_Function_Name (Ctxt, Decl);
if St_Ind /= Null_Iir then
Disp_Token (Ctxt, Tok_Colon);
Disp_Subtype_Indication (Ctxt, St_Ind);
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
OOB.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_Branch_Quantity_Declaration
(Ctxt : in out Ctxt_Class; Head : Iir)
is
Term : Iir;
Decl : Iir;
First_Decl : Iir;
begin
Start_Hbox (Ctxt);
Disp_Token (Ctxt, Tok_Quantity);
Decl := Head;
if Get_Kind (Decl) = Iir_Kind_Across_Quantity_Declaration then
loop
Disp_Name_Of (Ctxt, Decl);
if not Get_Has_Identifier_List (Decl) then
Decl := Null_Iir;
exit;
end if;
Decl := Get_Chain (Decl);
exit when Get_Kind (Decl) /= Iir_Kind_Across_Quantity_Declaration;
Disp_Token (Ctxt, Tok_Comma);
end loop;
Disp_Tolerance_Opt (Ctxt, Head);
Disp_Default_Value_Opt (Ctxt, Head);
Disp_Token (Ctxt, Tok_Across);
end if;
if Decl /= Null_Iir then
pragma Assert
(Get_Kind (Decl) = Iir_Kind_Through_Quantity_Declaration);
First_Decl := Decl;
loop
Disp_Name_Of (Ctxt, Decl);
if not Get_Has_Identifier_List (Decl) then
Decl := Null_Iir;
exit;
end if;
Decl := Get_Chain (Decl);
exit when Get_Kind (Decl) /= Iir_Kind_Through_Quantity_Declaration;
Disp_Token (Ctxt, Tok_Comma);
end loop;
Disp_Tolerance_Opt (Ctxt, First_Decl);
Disp_Default_Value_Opt (Ctxt, First_Decl);
Disp_Token (Ctxt, Tok_Through);
end if;
Print (Ctxt, Get_Plus_Terminal_Name (Head));
Term := Get_Minus_Terminal_Name (Head);
if Term /= Null_Iir then
Disp_Token (Ctxt, Tok_To);
Print (Ctxt, Term);
end if;
Disp_Token (Ctxt, Tok_Semi_Colon);
Close_Hbox (Ctxt);
end Disp_Branch_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_Subnature_Indication (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 Iir_Kind_Free_Quantity_Declaration
| Iir_Kinds_Source_Quantity_Declaration =>
Disp_Token (Ctxt, Tok_Quantity);
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;
case Get_Kind (Decl) is
when Iir_Kind_Spectrum_Quantity_Declaration =>
Disp_Token (Ctxt, Tok_Spectrum);
Print (Ctxt, Get_Magnitude_Expression (Decl));
Disp_Token (Ctxt, Tok_Comma);
Print (Ctxt, Get_Phase_Expression (Decl));
when Iir_Kind_Noise_Quantity_Declaration =>
Disp_Token (Ctxt, Tok_Noise);
Print (Ctxt, Get_Power_Expression (Decl));
when others =>
Disp_Default_Value_Opt (Ctxt, Decl);
end case;
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
OOB.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, False);
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_Step_Limit_Specification
(Ctxt : in out Ctxt_Class; Limit : Iir) is
begin
Start_Hbox (Ctxt);
Disp_Token (Ctxt, Tok_Limit);
Disp_Instantiation_List (Ctxt, Get_Quantity_List (Limit));
Disp_Token (Ctxt, Tok_Colon);
Print (Ctxt, Get_Type_Mark (Limit));
Disp_Token (Ctxt, Tok_With);
Print (Ctxt, Get_Expression (Limit));
Disp_Token (Ctxt, Tok_Semi_Colon);
Close_Hbox (Ctxt);
end Disp_Step_Limit_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));
Disp_Token (Ctxt, Tok_Tick);
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);