-- Iir to ortho translator.
-- Copyright (C) 2002 - 2014 Tristan Gingold
--
-- GHDL is free software; you can redistribute it and/or modify it under
-- the terms of the GNU General Public License as published by the Free
-- Software Foundation; either version 2, or (at your option) any later
-- version.
--
-- GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
-- WARRANTY; without even the implied warranty of MERCHANTABILITY or
-- FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
-- for more details.
--
-- You should have received a copy of the GNU General Public License
-- along with GCC; see the file COPYING. If not, write to the Free
-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-- 02111-1307, USA.
with Iirs_Utils; use Iirs_Utils;
with Errorout; use Errorout;
with Std_Package; use Std_Package;
with Flags;
with Libraries;
with Canon;
with Canon_PSL;
with Trans_Analyzes;
with Nodes_Meta;
with PSL.Nodes;
with PSL.NFAs;
with PSL.NFAs.Utils;
with Ieee.Std_Logic_1164;
with Trans.Chap1;
with Trans.Chap3;
with Trans.Chap4;
with Trans.Chap5;
with Trans.Chap6;
with Trans.Chap7;
with Trans.Chap8;
with Trans.Rtis;
with Translation; use Translation;
with Trans_Decls; use Trans_Decls;
with Trans.Helpers2; use Trans.Helpers2;
with Trans.Foreach_Non_Composite;
package body Trans.Chap9 is
use Trans.Helpers;
procedure Set_Direct_Drivers (Proc : Iir)
is
Proc_Info : constant Proc_Info_Acc := Get_Info (Proc);
Drivers : constant Direct_Drivers_Acc := Proc_Info.Process_Drivers;
Info : Ortho_Info_Acc;
Var : Var_Type;
Sig : Iir;
begin
for I in Drivers.all'Range loop
Var := Drivers (I).Var;
if Var /= Null_Var then
Sig := Get_Object_Prefix (Drivers (I).Sig);
Info := Get_Info (Sig);
case Info.Kind is
when Kind_Signal =>
Info.Signal_Driver := Var;
when Kind_Alias =>
null;
when others =>
raise Internal_Error;
end case;
end if;
end loop;
end Set_Direct_Drivers;
procedure Reset_Direct_Drivers (Proc : Iir)
is
Proc_Info : constant Proc_Info_Acc := Get_Info (Proc);
Drivers : constant Direct_Drivers_Acc := Proc_Info.Process_Drivers;
Info : Ortho_Info_Acc;
Var : Var_Type;
Sig : Iir;
begin
for I in Drivers.all'Range loop
Var := Drivers (I).Var;
if Var /= Null_Var then
Sig := Get_Object_Prefix (Drivers (I).Sig);
Info := Get_Info (Sig);
case Info.Kind is
when Kind_Signal =>
Info.Signal_Driver := Null_Var;
when Kind_Alias =>
null;
when others =>
raise Internal_Error;
end case;
end if;
end loop;
end Reset_Direct_Drivers;
procedure Translate_Process_Statement (Proc : Iir; Base : Block_Info_Acc)
is
use Trans.Chap8;
Info : constant Proc_Info_Acc := Get_Info (Proc);
Is_Non_Sensitized : constant Boolean :=
Get_Kind (Proc) = Iir_Kind_Process_Statement;
Inter_List : O_Inter_List;
Instance : O_Dnode;
begin
Start_Procedure_Decl (Inter_List, Create_Identifier ("PROC"),
O_Storage_Private);
New_Interface_Decl (Inter_List, Instance, Wki_Instance,
Base.Block_Decls_Ptr_Type);
Finish_Subprogram_Decl (Inter_List, Info.Process_Subprg);
Start_Subprogram_Body (Info.Process_Subprg);
Push_Local_Factory;
-- Push scope for architecture declarations.
Set_Scope_Via_Param_Ptr (Base.Block_Scope, Instance);
if Is_Non_Sensitized then
Chap8.State_Entry (Info);
end if;
Chap8.Translate_Statements_Chain
(Get_Sequential_Statement_Chain (Proc));
if Is_Non_Sensitized then
Chap8.State_Jump (State_Init);
Chap8.State_Leave (Proc);
end if;
Clear_Scope (Base.Block_Scope);
Pop_Local_Factory;
Finish_Subprogram_Body;
end Translate_Process_Statement;
procedure Translate_Implicit_Guard_Signal
(Guard : Iir; Base : Block_Info_Acc)
is
Guard_Expr : constant Iir := Get_Guard_Expression (Guard);
Info : constant Signal_Info_Acc := Get_Info (Guard);
Inter_List : O_Inter_List;
Instance : O_Dnode;
begin
-- Create the subprogram to compute the value of GUARD.
Start_Function_Decl (Inter_List, Create_Identifier ("_GUARD_PROC"),
O_Storage_Private, Std_Boolean_Type_Node);
New_Interface_Decl (Inter_List, Instance, Wki_Instance,
Base.Block_Decls_Ptr_Type);
Finish_Subprogram_Decl (Inter_List, Info.Signal_Function);
Start_Subprogram_Body (Info.Signal_Function);
Push_Local_Factory;
Set_Scope_Via_Param_Ptr (Base.Block_Scope, Instance);
Open_Temp;
New_Return_Stmt (Chap7.Translate_Expression (Guard_Expr));
Close_Temp;
Clear_Scope (Base.Block_Scope);
Pop_Local_Factory;
Finish_Subprogram_Body;
end Translate_Implicit_Guard_Signal;
procedure Translate_Component_Instantiation_Statement (Inst : Iir)
is
Comp : constant Iir := Get_Instantiated_Unit (Inst);
Info : Block_Info_Acc;
Comp_Info : Comp_Info_Acc;
Mark, Mark2 : Id_Mark_Type;
Assoc, Conv, In_Type : Iir;
Has_Conv_Record : Boolean := False;
begin
Info := Add_Info (Inst, Kind_Block);
Push_Identifier_Prefix (Mark, Get_Label (Inst));
if Is_Component_Instantiation (Inst) then
-- Via a component declaration.
Comp_Info := Get_Info (Get_Named_Entity (Comp));
Info.Block_Link_Field := Add_Instance_Factory_Field
(Create_Identifier_Without_Prefix (Inst),
Get_Scope_Type (Comp_Info.Comp_Scope));
else
-- Direct instantiation.
Info.Block_Link_Field := Add_Instance_Factory_Field
(Create_Identifier_Without_Prefix (Inst),
Rtis.Ghdl_Component_Link_Type);
end if;
-- When conversions are used, the subtype of the actual (or of the
-- formal for out conversions) may not be yet translated. This
-- can happen if the name is a slice.
-- We need to translate it and create variables in the instance
-- because it will be referenced by the conversion subprogram.
Assoc := Get_Port_Map_Aspect_Chain (Inst);
while Assoc /= Null_Iir loop
if Get_Kind (Assoc) = Iir_Kind_Association_Element_By_Expression
then
Conv := Get_In_Conversion (Assoc);
In_Type := Get_Type (Get_Actual (Assoc));
if Conv /= Null_Iir
and then Is_Anonymous_Type_Definition (In_Type)
then
-- Lazy creation of the record.
if not Has_Conv_Record then
Has_Conv_Record := True;
Push_Instance_Factory (Info.Block_Scope'Access);
end if;
-- FIXME: handle with overload multiple case on the same
-- formal.
Push_Identifier_Prefix
(Mark2,
Get_Identifier (Get_Association_Interface (Assoc)));
Chap3.Translate_Type_Definition (In_Type, True);
Pop_Identifier_Prefix (Mark2);
end if;
end if;
Assoc := Get_Chain (Assoc);
end loop;
if Has_Conv_Record then
Pop_Instance_Factory (Info.Block_Scope'Access);
New_Type_Decl
(Create_Identifier (Get_Identifier (Inst), "__CONVS"),
Get_Scope_Type (Info.Block_Scope));
Info.Block_Parent_Field := Add_Instance_Factory_Field
(Create_Identifier_Without_Prefix (Get_Identifier (Inst),
"__CONVS"),
Get_Scope_Type (Info.Block_Scope));
end if;
Pop_Identifier_Prefix (Mark);
end Translate_Component_Instantiation_Statement;
procedure Translate_Process_Declarations (Proc : Iir)
is
Mark : Id_Mark_Type;
Info : Ortho_Info_Acc;
Drivers : Iir_List;
Nbr_Drivers : Natural;
Sig : Iir;
begin
Info := Add_Info (Proc, Kind_Process);
-- Create process record.
Push_Identifier_Prefix (Mark, Get_Identifier (Proc));
Push_Instance_Factory (Info.Process_Scope'Access);
Chap4.Translate_Declaration_Chain (Proc);
if Get_Kind (Proc) = Iir_Kind_Process_Statement then
-- The state variable.
Info.Process_State := Create_Var (Create_Var_Identifier ("STATE"),
Ghdl_Index_Type, O_Storage_Local);
-- Add declarations for statements (iterator, call) and state.
Chap4.Translate_Statements_Chain_State_Declaration
(Get_Sequential_Statement_Chain (Proc),
Info.Process_Locvar_Scope'Access);
Add_Scope_Field (Wki_Locvars, Info.Process_Locvar_Scope);
end if;
if Flag_Direct_Drivers then
-- Create direct drivers.
Drivers := Trans_Analyzes.Extract_Drivers (Proc);
if Flag_Dump_Drivers then
Trans_Analyzes.Dump_Drivers (Proc, Drivers);
end if;
Nbr_Drivers := Get_Nbr_Elements (Drivers);
Info.Process_Drivers := new Direct_Driver_Arr (1 .. Nbr_Drivers);
for I in 1 .. Nbr_Drivers loop
Sig := Get_Nth_Element (Drivers, I - 1);
Info.Process_Drivers (I) := (Sig => Sig, Var => Null_Var);
Sig := Get_Object_Prefix (Sig);
if Get_Kind (Sig) /= Iir_Kind_Object_Alias_Declaration
and then not Get_After_Drivers_Flag (Sig)
then
Info.Process_Drivers (I).Var :=
Create_Var (Create_Var_Identifier (Sig, "_DDRV", I),
Chap4.Get_Object_Type
(Get_Info (Get_Type (Sig)), Mode_Value));
-- Do not create driver severals times.
Set_After_Drivers_Flag (Sig, True);
end if;
end loop;
Trans_Analyzes.Free_Drivers_List (Drivers);
end if;
Pop_Instance_Factory (Info.Process_Scope'Access);
New_Type_Decl (Create_Identifier ("INSTTYPE"),
Get_Scope_Type (Info.Process_Scope));
Pop_Identifier_Prefix (Mark);
-- Create a field in the parent record.
Add_Scope_Field (Create_Identifier_Without_Prefix (Proc),
Info.Process_Scope);
end Translate_Process_Declarations;
procedure Translate_Psl_Directive_Declarations (Stmt : Iir)
is
use PSL.Nodes;
use PSL.NFAs;
N : constant NFA := Get_PSL_NFA (Stmt);
Mark : Id_Mark_Type;
Info : Ortho_Info_Acc;
begin
Info := Add_Info (Stmt, Kind_Psl_Directive);
-- Create process record.
Push_Identifier_Prefix (Mark, Get_Identifier (Stmt));
Push_Instance_Factory (Info.Psl_Scope'Access);
Labelize_States (N, Info.Psl_Vect_Len);
Info.Psl_Vect_Type := New_Constrained_Array_Type
(Std_Boolean_Array_Type,
New_Unsigned_Literal (Ghdl_Index_Type,
Unsigned_64 (Info.Psl_Vect_Len)));
New_Type_Decl (Create_Identifier ("VECTTYPE"), Info.Psl_Vect_Type);
Info.Psl_Vect_Var := Create_Var
(Create_Var_Identifier ("VECT"), Info.Psl_Vect_Type);
if Get_Kind (Stmt) = Iir_Kind_Psl_Cover_Statement then
Info.Psl_Bool_Var := Create_Var
(Create_Var_Identifier ("BOOL"), Ghdl_Bool_Type);
end if;
Pop_Instance_Factory (Info.Psl_Scope'Access);
New_Type_Decl (Create_Identifier ("INSTTYPE"),
Get_Scope_Type (Info.Psl_Scope));
Pop_Identifier_Prefix (Mark);
-- Create a field in the parent record.
Add_Scope_Field
(Create_Identifier_Without_Prefix (Stmt), Info.Psl_Scope);
end Translate_Psl_Directive_Declarations;
function Translate_Psl_Expr (Expr : PSL_Node; Eos : Boolean)
return O_Enode
is
use PSL.Nodes;
begin
case Get_Kind (Expr) is
when N_HDL_Expr =>
declare
E : Iir;
Rtype : Iir;
Res : O_Enode;
begin
E := Get_HDL_Node (Expr);
Rtype := Get_Base_Type (Get_Type (E));
Res := Chap7.Translate_Expression (E);
if Rtype = Boolean_Type_Definition then
return Res;
elsif Rtype = Ieee.Std_Logic_1164.Std_Ulogic_Type then
return New_Value
(New_Indexed_Element
(New_Obj (Ghdl_Std_Ulogic_To_Boolean_Array),
New_Convert_Ov (Res, Ghdl_Index_Type)));
else
Error_Kind ("translate_psl_expr/hdl_expr", Expr);
end if;
end;
when N_True =>
return New_Lit (Std_Boolean_True_Node);
when N_EOS =>
if Eos then
return New_Lit (Std_Boolean_True_Node);
else
return New_Lit (Std_Boolean_False_Node);
end if;
when N_Not_Bool =>
return New_Monadic_Op
(ON_Not,
Translate_Psl_Expr (Get_Boolean (Expr), Eos));
when N_And_Bool =>
return New_Dyadic_Op
(ON_And,
Translate_Psl_Expr (Get_Left (Expr), Eos),
Translate_Psl_Expr (Get_Right (Expr), Eos));
when N_Or_Bool =>
return New_Dyadic_Op
(ON_Or,
Translate_Psl_Expr (Get_Left (Expr), Eos),
Translate_Psl_Expr (Get_Right (Expr), Eos));
when others =>
Error_Kind ("translate_psl_expr", Expr);
end case;
end Translate_Psl_Expr;
-- Return TRUE iff NFA has an edge with an EOS.
-- If so, we need to create a finalizer.
function Psl_Need_Finalizer (Nfa : PSL_NFA) return Boolean
is
use PSL.NFAs;
S : NFA_State;
E : NFA_Edge;
begin
S := Get_Final_State (Nfa);
E := Get_First_Dest_Edge (S);
while E /= No_Edge loop
if PSL.NFAs.Utils.Has_EOS (Get_Edge_Expr (E)) then
return True;
end if;
E := Get_Next_Dest_Edge (E);
end loop;
return False;
end Psl_Need_Finalizer;
procedure Create_Psl_Final_Proc
(Stmt : Iir; Base : Block_Info_Acc; Instance : out O_Dnode)
is
Inter_List : O_Inter_List;
Info : constant Psl_Info_Acc := Get_Info (Stmt);
begin
Start_Procedure_Decl (Inter_List, Create_Identifier ("FINALPROC"),
O_Storage_Private);
New_Interface_Decl (Inter_List, Instance, Wki_Instance,
Base.Block_Decls_Ptr_Type);
Finish_Subprogram_Decl (Inter_List, Info.Psl_Proc_Final_Subprg);
end Create_Psl_Final_Proc;
procedure Translate_Psl_Directive_Statement
(Stmt : Iir; Base : Block_Info_Acc)
is
use PSL.NFAs;
Inter_List : O_Inter_List;
Instance : O_Dnode;
Info : constant Psl_Info_Acc := Get_Info (Stmt);
Var_I : O_Dnode;
Var_Nvec : O_Dnode;
Label : O_Snode;
Clk_Blk : O_If_Block;
S_Blk : O_If_Block;
E_Blk : O_If_Block;
S : NFA_State;
S_Num : Int32;
E : NFA_Edge;
Sd : NFA_State;
Cond : O_Enode;
NFA : PSL_NFA;
D_Lit : O_Cnode;
begin
Start_Procedure_Decl (Inter_List, Create_Identifier ("PROC"),
O_Storage_Private);
New_Interface_Decl (Inter_List, Instance, Wki_Instance,
Base.Block_Decls_Ptr_Type);
Finish_Subprogram_Decl (Inter_List, Info.Psl_Proc_Subprg);
Start_Subprogram_Body (Info.Psl_Proc_Subprg);
Push_Local_Factory;
-- Push scope for architecture declarations.
Set_Scope_Via_Param_Ptr (Base.Block_Scope, Instance);
-- New state vector.
New_Var_Decl (Var_Nvec, Wki_Res, O_Storage_Local, Info.Psl_Vect_Type);
-- For cover directive, return now if already covered.
case Get_Kind (Stmt) is
when Iir_Kind_Psl_Assert_Statement =>
null;
when Iir_Kind_Psl_Cover_Statement =>
Start_If_Stmt (S_Blk, New_Value (Get_Var (Info.Psl_Bool_Var)));
New_Return_Stmt;
Finish_If_Stmt (S_Blk);
when others =>
Error_Kind ("Translate_Psl_Directive_Statement(1)", Stmt);
end case;
-- Initialize the new state vector.
Start_Declare_Stmt;
New_Var_Decl (Var_I, Wki_I, O_Storage_Local, Ghdl_Index_Type);
Init_Var (Var_I);
Start_Loop_Stmt (Label);
Gen_Exit_When
(Label,
New_Compare_Op (ON_Ge,
New_Obj_Value (Var_I),
New_Lit (New_Unsigned_Literal
(Ghdl_Index_Type,
Unsigned_64 (Info.Psl_Vect_Len))),
Ghdl_Bool_Type));
New_Assign_Stmt (New_Indexed_Element (New_Obj (Var_Nvec),
New_Obj_Value (Var_I)),
New_Lit (Std_Boolean_False_Node));
Inc_Var (Var_I);
Finish_Loop_Stmt (Label);
Finish_Declare_Stmt;
-- Global if statement for the clock.
Open_Temp;
Start_If_Stmt (Clk_Blk,
Translate_Psl_Expr (Get_PSL_Clock (Stmt), False));
-- For each state: if set, evaluate all outgoing edges.
NFA := Get_PSL_NFA (Stmt);
S := Get_First_State (NFA);
while S /= No_State loop
S_Num := Get_State_Label (S);
Open_Temp;
Start_If_Stmt
(S_Blk,
New_Value
(New_Indexed_Element (Get_Var (Info.Psl_Vect_Var),
New_Lit (New_Index_Lit
(Unsigned_64 (S_Num))))));
E := Get_First_Src_Edge (S);
while E /= No_Edge loop
Sd := Get_Edge_Dest (E);
Open_Temp;
D_Lit := New_Index_Lit (Unsigned_64 (Get_State_Label (Sd)));
Cond := New_Monadic_Op
(ON_Not,
New_Value (New_Indexed_Element (New_Obj (Var_Nvec),
New_Lit (D_Lit))));
Cond := New_Dyadic_Op
(ON_And, Cond, Translate_Psl_Expr (Get_Edge_Expr (E), False));
Start_If_Stmt (E_Blk, Cond);
New_Assign_Stmt
(New_Indexed_Element (New_Obj (Var_Nvec), New_Lit (D_Lit)),
New_Lit (Std_Boolean_True_Node));
Finish_If_Stmt (E_Blk);
Close_Temp;
E := Get_Next_Src_Edge (E);
end loop;
Finish_If_Stmt (S_Blk);
Close_Temp;
S := Get_Next_State (S);
end loop;
-- Check fail state.
S := Get_Final_State (NFA);
S_Num := Get_State_Label (S);
pragma Assert (Integer (S_Num) = Info.Psl_Vect_Len - 1);
Start_If_Stmt
(S_Blk,
New_Value (New_Indexed_Element (New_Obj (Var_Nvec),
New_Lit (New_Index_Lit
(Unsigned_64 (S_Num))))));
Open_Temp;
case Get_Kind (Stmt) is
when Iir_Kind_Psl_Assert_Statement =>
Chap8.Translate_Report
(Stmt, Ghdl_Psl_Assert_Failed, Severity_Level_Error);
when Iir_Kind_Psl_Cover_Statement =>
Chap8.Translate_Report
(Stmt, Ghdl_Psl_Cover, Severity_Level_Note);
New_Assign_Stmt (Get_Var (Info.Psl_Bool_Var),
New_Lit (Ghdl_Bool_True_Node));
when others =>
Error_Kind ("Translate_Psl_Directive_Statement", Stmt);
end case;
Close_Temp;
Finish_If_Stmt (S_Blk);
-- Assign state vector.
Start_Declare_Stmt;
New_Var_Decl (Var_I, Wki_I, O_Storage_Local, Ghdl_Index_Type);
Init_Var (Var_I);
Start_Loop_Stmt (Label);
Gen_Exit_When
(Label,
New_Compare_Op (ON_Ge,
New_Obj_Value (Var_I),
New_Lit (New_Unsigned_Literal
(Ghdl_Index_Type,
Unsigned_64 (Info.Psl_Vect_Len))),
Ghdl_Bool_Type));
New_Assign_Stmt
(New_Indexed_Element (Get_Var (Info.Psl_Vect_Var),
New_Obj_Value (Var_I)),
New_Value (New_Indexed_Element (New_Obj (Var_Nvec),
New_Obj_Value (Var_I))));
Inc_Var (Var_I);
Finish_Loop_Stmt (Label);
Finish_Declare_Stmt;
Close_Temp;
Finish_If_Stmt (Clk_Blk);
Clear_Scope (Base.Block_Scope);
Pop_Local_Factory;
Finish_Subprogram_Body;
-- The finalizer.
case Get_Kind (Stmt) is
when Iir_Kind_Psl_Assert_Statement =>
if Psl_Need_Finalizer (NFA) then
Create_Psl_Final_Proc (Stmt, Base, Instance);
Start_Subprogram_Body (Info.Psl_Proc_Final_Subprg);
Push_Local_Factory;
-- Push scope for architecture declarations.
Set_Scope_Via_Param_Ptr (Base.Block_Scope, Instance);
S := Get_Final_State (NFA);
E := Get_First_Dest_Edge (S);
while E /= No_Edge loop
Sd := Get_Edge_Src (E);
if PSL.NFAs.Utils.Has_EOS (Get_Edge_Expr (E)) then
S_Num := Get_State_Label (Sd);
Open_Temp;
Cond := New_Value
(New_Indexed_Element
(Get_Var (Info.Psl_Vect_Var),
New_Lit (New_Index_Lit (Unsigned_64 (S_Num)))));
Cond := New_Dyadic_Op
(ON_And, Cond,
Translate_Psl_Expr (Get_Edge_Expr (E), True));
Start_If_Stmt (E_Blk, Cond);
Chap8.Translate_Report
(Stmt, Ghdl_Psl_Assert_Failed, Severity_Level_Error);
New_Return_Stmt;
Finish_If_Stmt (E_Blk);
Close_Temp;
end if;
E := Get_Next_Dest_Edge (E);
end loop;
Clear_Scope (Base.Block_Scope);
Pop_Local_Factory;
Finish_Subprogram_Body;
else
Info.Psl_Proc_Final_Subprg := O_Dnode_Null;
end if;
when Iir_Kind_Psl_Cover_Statement =>
Create_Psl_Final_Proc (Stmt, Base, Instance);
Start_Subprogram_Body (Info.Psl_Proc_Final_Subprg);
Push_Local_Factory;
-- Push scope for architecture declarations.
Set_Scope_Via_Param_Ptr (Base.Block_Scope, Instance);
Start_If_Stmt
(S_Blk,
New_Monadic_Op (ON_Not,
New_Value (Get_Var (Info.Psl_Bool_Var))));
Chap8.Translate_Report
(Stmt, Ghdl_Psl_Cover_Failed, Severity_Level_Error);
Finish_If_Stmt (S_Blk);
Clear_Scope (Base.Block_Scope);
Pop_Local_Factory;
Finish_Subprogram_Body;
when others =>
Error_Kind ("Translate_Psl_Directive_Statement(3)", Stmt);
end case;
end Translate_Psl_Directive_Statement;
procedure Translate_If_Generate_Statement (Stmt : Iir; Origin : Iir)
is
Clause : Iir;
Bod : Iir;
Info : Block_Info_Acc;
Stmt_Info : Ortho_Info_Acc;
Mark : Id_Mark_Type;
Mark2 : Id_Mark_Type;
Num : Int32;
begin
Push_Identifier_Prefix (Mark, Get_Identifier (Stmt));
Stmt_Info := Add_Info (Stmt, Kind_Generate);
Stmt_Info.Generate_Parent_Field := Add_Instance_Factory_Field
(Create_Identifier_Without_Prefix (Stmt), Ghdl_Ptr_Type);
Stmt_Info.Generate_Body_Id := Add_Instance_Factory_Field
(Create_Identifier_Without_Prefix (Get_Identifier (Stmt), "_ID"),
Ghdl_Index_Type);
-- Translate generate statement body.
Num := 0;
Clause := Stmt;
while Clause /= Null_Iir loop
Bod := Get_Generate_Statement_Body (Clause);
Info := Add_Info (Bod, Kind_Block);
Push_Identifier_Prefix (Mark2, Get_Alternative_Label (Bod));
Chap1.Start_Block_Decl (Bod);
Push_Instance_Factory (Info.Block_Scope'Access);
-- Add a parent field in the current instance.
Info.Block_Origin_Field := Add_Instance_Factory_Field
(Get_Identifier ("ORIGIN"),
Get_Info (Origin).Block_Decls_Ptr_Type);
Info.Block_Id := Num;
Chap9.Translate_Block_Declarations (Bod, Bod);
Pop_Instance_Factory (Info.Block_Scope'Access);
Pop_Identifier_Prefix (Mark2);
Clause := Get_Generate_Else_Clause (Clause);
Num := Num + 1;
end loop;
Pop_Identifier_Prefix (Mark);
end Translate_If_Generate_Statement;
procedure Translate_For_Generate_Statement (Stmt : Iir; Origin : Iir)
is
Bod : constant Iir := Get_Generate_Statement_Body (Stmt);
Param : constant Iir := Get_Parameter_Specification (Stmt);
Iter_Type : constant Iir := Get_Type (Param);
Info : Block_Info_Acc;
Mark : Id_Mark_Type;
It_Info : Ortho_Info_Acc;
begin
Push_Identifier_Prefix (Mark, Get_Identifier (Stmt));
Chap3.Translate_Object_Subtype (Param, True);
Info := Add_Info (Bod, Kind_Block);
Chap1.Start_Block_Decl (Bod);
Push_Instance_Factory (Info.Block_Scope'Access);
-- Add a parent field in the current instance. This is
-- the first field (known by GRT).
Info.Block_Origin_Field := Add_Instance_Factory_Field
(Get_Identifier ("ORIGIN"),
Get_Info (Origin).Block_Decls_Ptr_Type);
-- Flag (if block was configured).
Info.Block_Configured_Field := Add_Instance_Factory_Field
(Get_Identifier ("CONFIGURED"), Ghdl_Bool_Type);
-- Iterator.
It_Info := Add_Info (Param, Kind_Iterator);
It_Info.Iterator_Var := Create_Var
(Create_Var_Identifier (Param),
Get_Info (Get_Base_Type (Iter_Type)).Ortho_Type (Mode_Value));
Chap9.Translate_Block_Declarations (Bod, Bod);
Pop_Instance_Factory (Info.Block_Scope'Access);
-- Create array type of block_decls_type
Info.Block_Decls_Array_Type := New_Array_Type
(Get_Scope_Type (Info.Block_Scope), Ghdl_Index_Type);
New_Type_Decl (Create_Identifier ("INSTARRTYPE"),
Info.Block_Decls_Array_Type);
-- Create access to the array type.
Info.Block_Decls_Array_Ptr_Type := New_Access_Type
(Info.Block_Decls_Array_Type);
New_Type_Decl (Create_Identifier ("INSTARRPTR"),
Info.Block_Decls_Array_Ptr_Type);
-- Add a field in the parent instance (Pop_Instance_Factory
-- has already been called). This is a pointer INSTARRPTR
-- to an array INSTARRTYPE of instace. The size of each
-- element is stored in the RTI.
Info.Block_Parent_Field := Add_Instance_Factory_Field
(Create_Identifier_Without_Prefix (Stmt),
Info.Block_Decls_Array_Ptr_Type);
Pop_Identifier_Prefix (Mark);
end Translate_For_Generate_Statement;
procedure Translate_Block_Statement (Stmt : Iir; Origin : Iir)
is
Hdr : constant Iir_Block_Header := Get_Block_Header (Stmt);
Guard : constant Iir := Get_Guard_Decl (Stmt);
Info : Block_Info_Acc;
Mark : Id_Mark_Type;
begin
Push_Identifier_Prefix (Mark, Get_Identifier (Stmt));
Info := Add_Info (Stmt, Kind_Block);
Chap1.Start_Block_Decl (Stmt);
Push_Instance_Factory (Info.Block_Scope'Access);
-- Implicit guard signal.
if Guard /= Null_Iir then
Chap4.Translate_Declaration (Guard);
end if;
-- generics, ports.
if Hdr /= Null_Iir then
Chap4.Translate_Generic_Chain (Hdr);
Chap4.Translate_Port_Chain (Hdr);
end if;
Chap9.Translate_Block_Declarations (Stmt, Origin);
Pop_Instance_Factory (Info.Block_Scope'Access);
Pop_Identifier_Prefix (Mark);
-- Create a field in the parent record.
Add_Scope_Field (Create_Identifier_Without_Prefix (Stmt),
Info.Block_Scope);
end Translate_Block_Statement;
-- Create the instance for block BLOCK.
-- ORIGIN can be either an entity, an architecture or a block statement.
procedure Translate_Block_Declarations (Block : Iir; Origin : Iir)
is
El : Iir;
begin
Chap4.Translate_Declaration_Chain (Block);
El := Get_Concurrent_Statement_Chain (Block);
while El /= Null_Iir loop
case Get_Kind (El) is
when Iir_Kind_Process_Statement
| Iir_Kind_Sensitized_Process_Statement =>
Translate_Process_Declarations (El);
when Iir_Kind_Psl_Default_Clock =>
null;
when Iir_Kind_Psl_Declaration =>
null;
when Iir_Kind_Psl_Assert_Statement
| Iir_Kind_Psl_Cover_Statement =>
Translate_Psl_Directive_Declarations (El);
when Iir_Kind_Component_Instantiation_Statement =>
Translate_Component_Instantiation_Statement (El);
when Iir_Kind_Block_Statement =>
Translate_Block_Statement (El, Origin);
when Iir_Kind_For_Generate_Statement =>
Translate_For_Generate_Statement (El, Origin);
when Iir_Kind_If_Generate_Statement =>
Translate_If_Generate_Statement (El, Origin);
when others =>
Error_Kind ("translate_block_declarations", El);
end case;
El := Get_Chain (El);
end loop;
end Translate_Block_Declarations;
procedure Translate_Component_Instantiation_Subprogram
(Stmt : Iir; Base : Block_Info_Acc)
is
procedure Set_Component_Link (Ref_Scope : Var_Scope_Type;
Comp_Field : O_Fnode)
is
begin
New_Assign_Stmt
(New_Selected_Element
(New_Selected_Element (Get_Instance_Ref (Ref_Scope),
Comp_Field),
Rtis.Ghdl_Component_Link_Stmt),
New_Lit (Rtis.Get_Context_Rti (Stmt)));
end Set_Component_Link;
Info : constant Block_Info_Acc := Get_Info (Stmt);
Parent : constant Iir := Get_Parent (Stmt);
Parent_Info : constant Block_Info_Acc := Get_Info (Parent);
Comp : Iir;
Comp_Info : Comp_Info_Acc;
Inter_List : O_Inter_List;
Instance : O_Dnode;
begin
-- Create the elaborator for the instantiation.
Start_Procedure_Decl (Inter_List, Create_Identifier ("ELAB"),
O_Storage_Private);
New_Interface_Decl (Inter_List, Instance, Wki_Instance,
Base.Block_Decls_Ptr_Type);
Finish_Subprogram_Decl (Inter_List, Info.Block_Elab_Subprg);
Start_Subprogram_Body (Info.Block_Elab_Subprg);
Push_Local_Factory;
Set_Scope_Via_Param_Ptr (Base.Block_Scope, Instance);
New_Debug_Line_Stmt (Get_Line_Number (Stmt));
-- Add access to the instantiation-specific data.
-- This is used only for anonymous subtype variables.
if Has_Scope_Type (Info.Block_Scope) then
Set_Scope_Via_Field (Info.Block_Scope,
Info.Block_Parent_Field,
Parent_Info.Block_Scope'Access);
end if;
Comp := Get_Instantiated_Unit (Stmt);
if Is_Entity_Instantiation (Stmt) then
-- This is a direct instantiation.
Set_Component_Link (Parent_Info.Block_Scope,
Info.Block_Link_Field);
Translate_Entity_Instantiation (Comp, Stmt, Stmt, Null_Iir);
else
Comp := Get_Named_Entity (Comp);
Comp_Info := Get_Info (Comp);
Set_Scope_Via_Field (Comp_Info.Comp_Scope,
Info.Block_Link_Field,
Parent_Info.Block_Scope'Access);
-- Set the link from component declaration to component
-- instantiation statement.
Set_Component_Link (Comp_Info.Comp_Scope, Comp_Info.Comp_Link);
Chap5.Elab_Map_Aspect (Stmt, Comp);
Clear_Scope (Comp_Info.Comp_Scope);
end if;
if Has_Scope_Type (Info.Block_Scope) then
Clear_Scope (Info.Block_Scope);
end if;
Clear_Scope (Base.Block_Scope);
Pop_Local_Factory;
Finish_Subprogram_Body;
end Translate_Component_Instantiation_Subprogram;
procedure Translate_Generate_Statement_Body_Subprograms
(Bod : Iir; Base_Info : Block_Info_Acc)
is
Info : constant Block_Info_Acc := Get_Info (Bod);
Prev_Subprg_Instance : Subprgs.Subprg_Instance_Stack;
begin
Subprgs.Push_Subprg_Instance (Info.Block_Scope'Access,
Info.Block_Decls_Ptr_Type,
Wki_Instance,
Prev_Subprg_Instance);
Set_Scope_Via_Field_Ptr (Base_Info.Block_Scope,
Info.Block_Origin_Field,
Info.Block_Scope'Access);
Translate_Block_Subprograms (Bod, Bod);
Clear_Scope (Base_Info.Block_Scope);
Subprgs.Pop_Subprg_Instance (Wki_Instance, Prev_Subprg_Instance);
end Translate_Generate_Statement_Body_Subprograms;
-- Translate concurrent statements into subprograms.
procedure Translate_Block_Subprograms (Block : Iir; Base_Block : Iir)
is
Base_Info : constant Block_Info_Acc := Get_Info (Base_Block);
Stmt : Iir;
Mark : Id_Mark_Type;
begin
Chap4.Translate_Declaration_Chain_Subprograms (Block);
Stmt := Get_Concurrent_Statement_Chain (Block);
while Stmt /= Null_Iir loop
Push_Identifier_Prefix (Mark, Get_Identifier (Stmt));
case Get_Kind (Stmt) is
when Iir_Kind_Process_Statement
| Iir_Kind_Sensitized_Process_Statement =>
if Flag_Direct_Drivers then
Chap9.Set_Direct_Drivers (Stmt);
end if;
Chap4.Translate_Declaration_Chain_Subprograms (Stmt);
Translate_Process_Statement (Stmt, Base_Info);
if Flag_Direct_Drivers then
Chap9.Reset_Direct_Drivers (Stmt);
end if;
when Iir_Kind_Psl_Default_Clock =>
null;
when Iir_Kind_Psl_Declaration =>
null;
when Iir_Kind_Psl_Assert_Statement
| Iir_Kind_Psl_Cover_Statement =>
Translate_Psl_Directive_Statement (Stmt, Base_Info);
when Iir_Kind_Component_Instantiation_Statement =>
Chap4.Translate_Association_Subprograms
(Stmt, Block, Base_Block,
Get_Entity_From_Entity_Aspect
(Get_Instantiated_Unit (Stmt)));
Translate_Component_Instantiation_Subprogram
(Stmt, Base_Info);
when Iir_Kind_Block_Statement =>
declare
Guard : constant Iir := Get_Guard_Decl (Stmt);
Hdr : constant Iir := Get_Block_Header (Stmt);
begin
if Guard /= Null_Iir then
Translate_Implicit_Guard_Signal (Guard, Base_Info);
end if;
if Hdr /= Null_Iir then
Chap4.Translate_Association_Subprograms
(Hdr, Block, Base_Block, Null_Iir);
end if;
Translate_Block_Subprograms (Stmt, Base_Block);
end;
when Iir_Kind_For_Generate_Statement =>
Translate_Generate_Statement_Body_Subprograms
(Get_Generate_Statement_Body (Stmt), Base_Info);
when Iir_Kind_If_Generate_Statement =>
declare
Clause : Iir;
Bod : Iir;
Mark2 : Id_Mark_Type;
begin
Clause := Stmt;
while Clause /= Null_Iir loop
Bod := Get_Generate_Statement_Body (Clause);
Push_Identifier_Prefix
(Mark2, Get_Alternative_Label (Bod));
Translate_Generate_Statement_Body_Subprograms
(Bod, Base_Info);
Pop_Identifier_Prefix (Mark2);
Clause := Get_Generate_Else_Clause (Clause);
end loop;
end;
when others =>
Error_Kind ("translate_block_subprograms", Stmt);
end case;
Pop_Identifier_Prefix (Mark);
Stmt := Get_Chain (Stmt);
end loop;
end Translate_Block_Subprograms;
-- Remove anonymous and implicit type definitions in a list of names.
-- Such type definitions are created during slice translations, however
-- variables created are defined in the translation scope.
-- If the type is referenced again, the variables must be reachable.
-- This is not the case for elaborator subprogram (which may references
-- slices in the sensitivity or driver list) and the process subprg.
procedure Destroy_Types_In_Chain (Chain : Iir)
is
N : Iir;
begin
N := Chain;
while N /= Null_Iir loop
Destroy_Types (N);
N := Get_Chain (N);
end loop;
end Destroy_Types_In_Chain;
procedure Destroy_Types_In_List (L : Iir_List)
is
El : Iir;
begin
case L is
when Null_Iir_List
| Iir_List_All
| Iir_List_Others =>
return;
when others =>
for I in Natural loop
El := Get_Nth_Element (L, I);
exit when El = Null_Iir;
Destroy_Types (El);
end loop;
end case;
end Destroy_Types_In_List;
procedure Destroy_Types (N : Iir) is
begin
-- Nothing to do for null node.
if N = Null_Iir then
return;
end if;
declare
use Nodes_Meta;
Kind : constant Iir_Kind := Get_Kind (N);
Fields : constant Fields_Array := Get_Fields (Kind);
F : Fields_Enum;
begin
for I in Fields'Range loop
F := Fields (I);
case F is
when Field_Literal_Subtype
| Field_Slice_Subtype
| Field_Allocator_Subtype =>
declare
T : constant Iir := Get_Iir (N, F);
Info : Type_Info_Acc;
begin
Info := Get_Info (T);
if Info /= null then
Free_Type_Info (Info);
Clear_Info (T);
end if;
end;
when others =>
null;
end case;
case Get_Field_Type (F) is
when Type_Iir =>
case Get_Field_Attribute (F) is
when Attr_None =>
Destroy_Types (Get_Iir (N, F));
when Attr_Ref =>
null;
when Attr_Maybe_Ref =>
if not Get_Is_Ref (N) then
Destroy_Types (Get_Iir (N, F));
end if;
when Attr_Chain =>
Destroy_Types_In_Chain (Get_Iir (N, F));
when Attr_Chain_Next =>
null;
when Attr_Of_Ref =>
raise Internal_Error;
end case;
when Type_Iir_List =>
case Get_Field_Attribute (F) is
when Attr_None =>
Destroy_Types_In_List (Get_Iir_List (N, F));
when Attr_Ref
| Attr_Of_Ref =>
null;
when others =>
raise Internal_Error;
end case;
when Type_PSL_NFA
| Type_PSL_Node =>
-- TODO
raise Internal_Error;
when Type_Date_Type
| Type_Date_State_Type
| Type_Time_Stamp_Id
| Type_File_Checksum_Id
| Type_String8_Id
| Type_Source_Ptr
| Type_Base_Type
| Type_Iir_Constraint
| Type_Iir_Mode
| Type_Iir_Index32
| Type_Iir_Int64
| Type_Boolean
| Type_Iir_Staticness
| Type_Iir_All_Sensitized
| Type_Iir_Signal_Kind
| Type_Tri_State_Type
| Type_Iir_Pure_State
| Type_Iir_Delay_Mechanism
| Type_Iir_Predefined_Functions
| Type_Iir_Direction
| Type_Location_Type
| Type_Iir_Int32
| Type_Int32
| Type_Iir_Fp64
| Type_Token_Type
| Type_Name_Id =>
null;
end case;
end loop;
end;
end Destroy_Types;
procedure Gen_Register_Direct_Driver_Non_Composite
(Targ : Mnode; Targ_Type : Iir; Drv : Mnode)
is
pragma Unreferenced (Targ_Type);
Constr : O_Assoc_List;
begin
Start_Association (Constr, Ghdl_Signal_Add_Direct_Driver);
New_Association
(Constr, New_Convert_Ov (New_Value (M2Lv (Targ)), Ghdl_Signal_Ptr));
New_Association
(Constr, New_Unchecked_Address (M2Lv (Drv), Ghdl_Ptr_Type));
New_Procedure_Call (Constr);
end Gen_Register_Direct_Driver_Non_Composite;
function Gen_Register_Direct_Driver_Prepare_Data_Composite
(Targ : Mnode; Targ_Type : Iir; Val : Mnode)
return Mnode
is
pragma Unreferenced (Targ, Targ_Type);
begin
return Val;
end Gen_Register_Direct_Driver_Prepare_Data_Composite;
function Gen_Register_Direct_Driver_Prepare_Data_Record
(Targ : Mnode; Targ_Type : Iir; Val : Mnode)
return Mnode
is
pragma Unreferenced (Targ, Targ_Type);
begin
return Stabilize (Val);
end Gen_Register_Direct_Driver_Prepare_Data_Record;
function Gen_Register_Direct_Driver_Update_Data_Array
(Val : Mnode; Targ_Type : Iir; Index : O_Dnode)
return Mnode
is
begin
return Chap3.Index_Base (Chap3.Get_Array_Base (Val),
Targ_Type, New_Obj_Value (Index));
end Gen_Register_Direct_Driver_Update_Data_Array;
function Gen_Register_Direct_Driver_Update_Data_Record
(Val : Mnode; Targ_Type : Iir; El : Iir_Element_Declaration)
return Mnode
is
pragma Unreferenced (Targ_Type);
begin
return Chap6.Translate_Selected_Element (Val, El);
end Gen_Register_Direct_Driver_Update_Data_Record;
procedure Gen_Register_Direct_Driver_Finish_Data_Composite
(Data : in out Mnode)
is
pragma Unreferenced (Data);
begin
null;
end Gen_Register_Direct_Driver_Finish_Data_Composite;
procedure Gen_Register_Direct_Driver is new Foreach_Non_Composite
(Data_Type => Mnode,
Composite_Data_Type => Mnode,
Do_Non_Composite => Gen_Register_Direct_Driver_Non_Composite,
Prepare_Data_Array =>
Gen_Register_Direct_Driver_Prepare_Data_Composite,
Update_Data_Array => Gen_Register_Direct_Driver_Update_Data_Array,
Finish_Data_Array => Gen_Register_Direct_Driver_Finish_Data_Composite,
Prepare_Data_Record => Gen_Register_Direct_Driver_Prepare_Data_Record,
Update_Data_Record => Gen_Register_Direct_Driver_Update_Data_Record,
Finish_Data_Record =>
Gen_Register_Direct_Driver_Finish_Data_Composite);
-- procedure Register_Scalar_Direct_Driver (Sig : Mnode;
-- Sig_Type : Iir;
-- Drv : Mnode)
-- is
-- pragma Unreferenced (Sig_Type);
-- Constr : O_Assoc_List;
-- begin
-- Start_Association (Constr, Ghdl_Signal_Add_Direct_Driver);
-- New_Association
-- (Constr, New_Convert_Ov (New_Value (M2Lv (Sig)), Ghdl_Signal_Ptr));
-- New_Association
-- (Constr, New_Unchecked_Address (M2Lv (Drv), Ghdl_Ptr_Type));
-- New_Procedure_Call (Constr);
-- end Register_Scalar_Direct_Driver;
-- PROC: the process to be elaborated
-- BASE_INFO: info for the global block
procedure Elab_Process (Proc : Iir; Base_Info : Block_Info_Acc)
is
Info : constant Proc_Info_Acc := Get_Info (Proc);
Is_Sensitized : constant Boolean :=
Get_Kind (Proc) = Iir_Kind_Sensitized_Process_Statement;
Subprg : O_Dnode;
Constr : O_Assoc_List;
List : Iir_List;
List_Orig : Iir_List;
Final : Boolean;
begin
New_Debug_Line_Stmt (Get_Line_Number (Proc));
-- Register process.
if Is_Sensitized then
if Get_Postponed_Flag (Proc) then
Subprg := Ghdl_Postponed_Sensitized_Process_Register;
else
Subprg := Ghdl_Sensitized_Process_Register;
end if;
else
if Get_Postponed_Flag (Proc) then
Subprg := Ghdl_Postponed_Process_Register;
else
Subprg := Ghdl_Process_Register;
end if;
end if;
Start_Association (Constr, Subprg);
New_Association
(Constr, New_Unchecked_Address
(Get_Instance_Ref (Base_Info.Block_Scope), Ghdl_Ptr_Type));
New_Association
(Constr,
New_Lit (New_Subprogram_Address (Info.Process_Subprg,
Ghdl_Ptr_Type)));
Rtis.Associate_Rti_Context (Constr, Proc);
New_Procedure_Call (Constr);
-- First elaborate declarations since a driver may depend on
-- an alias declaration.
-- Also, with vhdl 08 a sensitivity element may depend on an alias.
Open_Temp;
Chap4.Elab_Declaration_Chain (Proc, Final);
Close_Temp;
-- Register drivers.
if Flag_Direct_Drivers then
Chap9.Set_Direct_Drivers (Proc);
declare
Sig : Iir;
Base : Iir;
Sig_Node, Drv_Node : Mnode;
begin
for I in Info.Process_Drivers.all'Range loop
Sig := Info.Process_Drivers (I).Sig;
Open_Temp;
Base := Get_Object_Prefix (Sig);
if Info.Process_Drivers (I).Var /= Null_Var then
-- Elaborate direct driver. Done only once.
Chap4.Elab_Direct_Driver_Declaration_Storage (Base);
end if;
if Chap4.Has_Direct_Driver (Base) then
-- Signal has a direct driver.
Chap6.Translate_Direct_Driver (Sig, Sig_Node, Drv_Node);
Gen_Register_Direct_Driver
(Sig_Node, Get_Type (Sig), Drv_Node);
else
Register_Signal (Chap6.Translate_Name (Sig, Mode_Signal),
Get_Type (Sig),
Ghdl_Process_Add_Driver);
end if;
Chap9.Destroy_Types (Sig);
Close_Temp;
end loop;
end;
Chap9.Reset_Direct_Drivers (Proc);
else
List := Trans_Analyzes.Extract_Drivers (Proc);
Destroy_Types_In_List (List);
Register_Signal_List (List, Ghdl_Process_Add_Driver);
if Flag_Dump_Drivers then
Trans_Analyzes.Dump_Drivers (Proc, List);
end if;
Trans_Analyzes.Free_Drivers_List (List);
end if;
if Is_Sensitized then
List_Orig := Get_Sensitivity_List (Proc);
if List_Orig = Iir_List_All then
List := Canon.Canon_Extract_Process_Sensitivity (Proc);
else
List := List_Orig;
end if;
-- For extracted sensitivity, any signal can appear in the list.
-- Remove transient types now.
Destroy_Types_In_List (List);
Register_Signal_List (List, Ghdl_Process_Add_Sensitivity);
if List_Orig = Iir_List_All then
Destroy_Iir_List (List);
end if;
else
-- Initialize state.
New_Assign_Stmt
(Get_Var (Info.Process_State), New_Lit (Ghdl_Index_0));
end if;
end Elab_Process;
-- PROC: the process to be elaborated
-- BLOCK: the block containing the process (its parent)
-- BASE_INFO: info for the global block
procedure Elab_Psl_Directive (Stmt : Iir;
Base_Info : Block_Info_Acc)
is
Info : constant Psl_Info_Acc := Get_Info (Stmt);
Constr : O_Assoc_List;
List : Iir_List;
Clk : PSL_Node;
Var_I : O_Dnode;
Label : O_Snode;
begin
New_Debug_Line_Stmt (Get_Line_Number (Stmt));
-- Register process.
Start_Association (Constr, Ghdl_Sensitized_Process_Register);
New_Association
(Constr, New_Unchecked_Address
(Get_Instance_Ref (Base_Info.Block_Scope), Ghdl_Ptr_Type));
New_Association
(Constr,
New_Lit (New_Subprogram_Address (Info.Psl_Proc_Subprg,
Ghdl_Ptr_Type)));
Rtis.Associate_Rti_Context (Constr, Stmt);
New_Procedure_Call (Constr);
-- Register clock sensitivity.
Clk := Get_PSL_Clock (Stmt);
List := Create_Iir_List;
Canon_PSL.Canon_Extract_Sensitivity (Clk, List);
Destroy_Types_In_List (List);
Register_Signal_List (List, Ghdl_Process_Add_Sensitivity);
Destroy_Iir_List (List);
-- Register finalizer (if any).
if Info.Psl_Proc_Final_Subprg /= O_Dnode_Null then
Start_Association (Constr, Ghdl_Finalize_Register);
New_Association
(Constr, New_Unchecked_Address
(Get_Instance_Ref (Base_Info.Block_Scope),
Ghdl_Ptr_Type));
New_Association
(Constr,
New_Lit (New_Subprogram_Address (Info.Psl_Proc_Final_Subprg,
Ghdl_Ptr_Type)));
New_Procedure_Call (Constr);
end if;
-- Initialize state vector.
Start_Declare_Stmt;
New_Var_Decl (Var_I, Wki_I, O_Storage_Local, Ghdl_Index_Type);
New_Assign_Stmt (New_Indexed_Element (Get_Var (Info.Psl_Vect_Var),
New_Lit (Ghdl_Index_0)),
New_Lit (Std_Boolean_True_Node));
New_Assign_Stmt (New_Obj (Var_I), New_Lit (Ghdl_Index_1));
Start_Loop_Stmt (Label);
Gen_Exit_When
(Label,
New_Compare_Op (ON_Ge,
New_Obj_Value (Var_I),
New_Lit (New_Unsigned_Literal
(Ghdl_Index_Type,
Unsigned_64 (Info.Psl_Vect_Len))),
Ghdl_Bool_Type));
New_Assign_Stmt (New_Indexed_Element (Get_Var (Info.Psl_Vect_Var),
New_Obj_Value (Var_I)),
New_Lit (Std_Boolean_False_Node));
Inc_Var (Var_I);
Finish_Loop_Stmt (Label);
Finish_Declare_Stmt;
if Info.Psl_Bool_Var /= Null_Var then
New_Assign_Stmt (Get_Var (Info.Psl_Bool_Var),
New_Lit (Ghdl_Bool_False_Node));
end if;
end Elab_Psl_Directive;
procedure Elab_Implicit_Guard_Signal
(Block : Iir_Block_Statement; Block_Info : Block_Info_Acc)
is
Guard : constant Iir := Get_Guard_Decl (Block);
Info : constant Signal_Info_Acc := Get_Info (Guard);
Type_Info : constant Type_Info_Acc := Get_Info (Get_Type (Guard));
Constr : O_Assoc_List;
begin
-- Create the guard signal.
Start_Association (Constr, Ghdl_Signal_Create_Guard);
New_Association
(Constr, New_Unchecked_Address (Get_Var (Info.Signal_Val),
Ghdl_Ptr_Type));
New_Association
(Constr, New_Unchecked_Address
(Get_Instance_Ref (Block_Info.Block_Scope), Ghdl_Ptr_Type));
New_Association
(Constr,
New_Lit (New_Subprogram_Address (Info.Signal_Function,
Ghdl_Ptr_Type)));
-- New_Association (Constr, Chap6.Get_Instance_Name_Ref (Block));
New_Assign_Stmt (Get_Var (Info.Signal_Sig),
New_Convert_Ov (New_Function_Call (Constr),
Type_Info.Ortho_Type (Mode_Signal)));
-- Register sensitivity list of the guard signal.
Register_Signal_List (Get_Guard_Sensitivity_List (Guard),
Ghdl_Signal_Guard_Dependence);
end Elab_Implicit_Guard_Signal;
procedure Translate_Entity_Instantiation
(Aspect : Iir; Mapping : Iir; Parent : Iir; Config_Override : Iir)
is
Entity_Unit : Iir_Design_Unit;
Config : Iir;
Arch : Iir;
Entity : Iir_Entity_Declaration;
Entity_Info : Block_Info_Acc;
Arch_Info : Block_Info_Acc;
Instance_Size : O_Dnode;
Arch_Elab : O_Dnode;
Arch_Config : O_Dnode;
Arch_Config_Type : O_Tnode;
Var_Sub : O_Dnode;
begin
-- Extract entity, architecture and configuration from
-- binding aspect.
case Get_Kind (Aspect) is
when Iir_Kind_Entity_Aspect_Entity =>
Entity := Get_Entity (Aspect);
Arch := Get_Architecture (Aspect);
if Flags.Flag_Elaborate and then Arch = Null_Iir then
-- This is valid only during elaboration.
Arch := Libraries.Get_Latest_Architecture (Entity);
end if;
Config := Null_Iir;
when Iir_Kind_Entity_Aspect_Configuration =>
Config := Get_Configuration (Aspect);
Entity := Get_Entity (Config);
Arch := Strip_Denoting_Name
(Get_Block_Specification (Get_Block_Configuration (Config)));
when Iir_Kind_Entity_Aspect_Open =>
return;
when others =>
Error_Kind ("translate_entity_instantiation", Aspect);
end case;
Entity_Unit := Get_Design_Unit (Entity);
Entity_Info := Get_Info (Entity);
if Config_Override /= Null_Iir then
Config := Config_Override;
if Get_Kind (Arch) = Iir_Kind_Simple_Name then
Arch := Get_Block_Specification
(Get_Block_Configuration (Config));
end if;
end if;
-- 1) Create instance for the arch
if Arch /= Null_Iir then
Arch_Info := Get_Info (Arch);
if Config = Null_Iir
and then Get_Kind (Arch) = Iir_Kind_Architecture_Body
then
Config := Get_Default_Configuration_Declaration (Arch);
if Config /= Null_Iir then
Config := Get_Library_Unit (Config);
end if;
end if;
else
Arch_Info := null;
end if;
if Arch_Info = null or Config = Null_Iir then
declare
function Get_Arch_Name return String is
begin
if Arch /= Null_Iir then
return "ARCH__" & Identifier_To_String (Arch);
else
return "LASTARCH";
end if;
end Get_Arch_Name;
Entity_Library : constant Iir :=
Get_Library (Get_Design_File (Entity_Unit));
Str : constant String :=
Identifier_To_String (Entity_Library) & "__"
& Identifier_To_String (Entity) & "__"
& Get_Arch_Name & "__";
Sub_Inter : O_Inter_List;
Arg : O_Dnode;
begin
if Arch_Info = null then
New_Const_Decl
(Instance_Size, Get_Identifier (Str & "INSTSIZE"),
O_Storage_External, Ghdl_Index_Type);
Start_Procedure_Decl
(Sub_Inter, Get_Identifier (Str & "ELAB"),
O_Storage_External);
New_Interface_Decl (Sub_Inter, Arg, Wki_Instance,
Entity_Info.Block_Decls_Ptr_Type);
Finish_Subprogram_Decl (Sub_Inter, Arch_Elab);
end if;
if Config = Null_Iir then
Start_Procedure_Decl
(Sub_Inter, Get_Identifier (Str & "DEFAULT_CONFIG"),
O_Storage_External);
New_Interface_Decl (Sub_Inter, Arg, Wki_Instance,
Entity_Info.Block_Decls_Ptr_Type);
Finish_Subprogram_Decl (Sub_Inter, Arch_Config);
Arch_Config_Type := Entity_Info.Block_Decls_Ptr_Type;
end if;
end;
end if;
if Arch_Info = null then
if Config /= Null_Iir then
-- Architecture is unknown, but we know how to configure
-- the block inside it.
raise Internal_Error;
end if;
else
Instance_Size := Arch_Info.Block_Instance_Size;
Arch_Elab := Arch_Info.Block_Elab_Subprg;
if Config /= Null_Iir then
Arch_Config := Get_Info (Config).Config_Subprg;
Arch_Config_Type := Arch_Info.Block_Decls_Ptr_Type;
end if;
end if;
-- Create the instance variable and allocate storage.
New_Var_Decl (Var_Sub, Get_Identifier ("SUB_INSTANCE"),
O_Storage_Local, Entity_Info.Block_Decls_Ptr_Type);
New_Assign_Stmt
(New_Obj (Var_Sub),
Gen_Alloc (Alloc_System, New_Obj_Value (Instance_Size),
Entity_Info.Block_Decls_Ptr_Type));
-- 1.5) link instance.
declare
procedure Set_Links (Ref_Scope : Var_Scope_Type;
Link_Field : O_Fnode)
is
begin
-- Set the ghdl_component_link_instance field.
New_Assign_Stmt
(New_Selected_Element
(New_Selected_Element (Get_Instance_Ref (Ref_Scope),
Link_Field),
Rtis.Ghdl_Component_Link_Instance),
New_Address (New_Selected_Acc_Value
(New_Obj (Var_Sub),
Entity_Info.Block_Link_Field),
Rtis.Ghdl_Entity_Link_Acc));
-- Set the ghdl_entity_link_parent field.
New_Assign_Stmt
(New_Selected_Element
(New_Selected_Acc_Value (New_Obj (Var_Sub),
Entity_Info.Block_Link_Field),
Rtis.Ghdl_Entity_Link_Parent),
New_Address
(New_Selected_Element (Get_Instance_Ref (Ref_Scope),
Link_Field),
Rtis.Ghdl_Component_Link_Acc));
end Set_Links;
begin
case Get_Kind (Parent) is
when Iir_Kind_Component_Declaration =>
-- Instantiation via a component declaration.
declare
Comp_Info : constant Comp_Info_Acc := Get_Info (Parent);
begin
Set_Links (Comp_Info.Comp_Scope, Comp_Info.Comp_Link);
end;
when Iir_Kind_Component_Instantiation_Statement =>
-- Direct instantiation.
declare
Parent_Info : constant Block_Info_Acc :=
Get_Info (Get_Parent (Parent));
begin
Set_Links (Parent_Info.Block_Scope,
Get_Info (Parent).Block_Link_Field);
end;
when others =>
Error_Kind ("translate_entity_instantiation(1)", Parent);
end case;
end;
-- Elab entity packages.
declare
Assoc : O_Assoc_List;
begin
Start_Association (Assoc, Entity_Info.Block_Elab_Pkg_Subprg);
New_Procedure_Call (Assoc);
end;
-- Elab map aspects.
Set_Scope_Via_Param_Ptr (Entity_Info.Block_Scope, Var_Sub);
Chap5.Elab_Map_Aspect (Mapping, Entity);
Clear_Scope (Entity_Info.Block_Scope);
-- 3) Elab instance.
declare
Assoc : O_Assoc_List;
begin
Start_Association (Assoc, Arch_Elab);
New_Association (Assoc, New_Obj_Value (Var_Sub));
New_Procedure_Call (Assoc);
end;
-- 5) Configure
declare
Assoc : O_Assoc_List;
begin
Start_Association (Assoc, Arch_Config);
New_Association (Assoc, New_Convert_Ov (New_Obj_Value (Var_Sub),
Arch_Config_Type));
New_Procedure_Call (Assoc);
end;
end Translate_Entity_Instantiation;
procedure Elab_If_Generate_Statement
(Stmt : Iir_Generate_Statement; Parent : Iir; Base_Block : Iir)
is
Parent_Info : constant Block_Info_Acc := Get_Info (Parent);
-- Used to get Block_Parent_Field, set in the first generate statement
-- body.
Stmt_Info : constant Generate_Info_Acc := Get_Info (Stmt);
-- Set the instance field in the parent.
procedure Set_Parent_Field (Val : O_Enode; Num : Nat32)
is
V : O_Lnode;
begin
V := Get_Instance_Ref (Parent_Info.Block_Scope);
V := New_Selected_Element (V, Stmt_Info.Generate_Parent_Field);
New_Assign_Stmt (V, Val);
V := Get_Instance_Ref (Parent_Info.Block_Scope);
V := New_Selected_Element (V, Stmt_Info.Generate_Body_Id);
New_Assign_Stmt (V, New_Lit (New_Index_Lit (Unsigned_64 (Num))));
end Set_Parent_Field;
procedure Elab_If_Clause (Clause : Iir)
is
Condition : constant Iir := Get_Condition (Clause);
Bod : constant Iir := Get_Generate_Statement_Body (Clause);
Info : constant Block_Info_Acc := Get_Info (Bod);
Var : O_Dnode;
Blk : O_If_Block;
N_Clause : Iir;
begin
Open_Temp;
Var := Create_Temp (Info.Block_Decls_Ptr_Type);
if Condition /= Null_Iir then
Start_If_Stmt (Blk, Chap7.Translate_Expression (Condition));
end if;
New_Assign_Stmt
(New_Obj (Var),
Gen_Alloc (Alloc_System,
New_Lit (Get_Scope_Size (Info.Block_Scope)),
Info.Block_Decls_Ptr_Type));
-- Add a link to child in parent. This must be done before
-- elaboration, in case of use.
Set_Parent_Field
(New_Convert_Ov (New_Obj_Value (Var), Ghdl_Ptr_Type),
Info.Block_Id);
-- Add a link to parent in child.
New_Assign_Stmt
(New_Selected_Acc_Value (New_Obj (Var), Info.Block_Origin_Field),
Get_Instance_Access (Base_Block));
-- Elaborate block
Set_Scope_Via_Param_Ptr (Info.Block_Scope, Var);
Elab_Block_Declarations (Bod, Bod);
Clear_Scope (Info.Block_Scope);
if Condition /= Null_Iir then
New_Else_Stmt (Blk);
N_Clause := Get_Generate_Else_Clause (Clause);
if N_Clause /= Null_Iir then
Elab_If_Clause (N_Clause);
else
Set_Parent_Field
(New_Lit (New_Null_Access (Ghdl_Ptr_Type)),
Info.Block_Id + 1);
end if;
Finish_If_Stmt (Blk);
end if;
Close_Temp;
end Elab_If_Clause;
begin
Elab_If_Clause (Stmt);
end Elab_If_Generate_Statement;
procedure Elab_For_Generate_Statement
(Stmt : Iir_Generate_Statement; Parent : Iir; Base_Block : Iir)
is
Iter : constant Iir := Get_Parameter_Specification (Stmt);
Iter_Type : constant Iir := Get_Type (Iter);
Iter_Base_Type : constant Iir := Get_Base_Type (Iter_Type);
Iter_Type_Info : constant Type_Info_Acc := Get_Info (Iter_Base_Type);
Bod : constant Iir := Get_Generate_Statement_Body (Stmt);
Info : constant Block_Info_Acc := Get_Info (Bod);
Parent_Info : constant Block_Info_Acc := Get_Info (Parent);
-- Base_Info : constant Block_Info_Acc := Get_Info (Base_Block);
Var_Inst : O_Dnode;
Var_I : O_Dnode;
Label : O_Snode;
V : O_Lnode;
Var : O_Dnode;
Range_Ptr : O_Dnode;
begin
Open_Temp;
-- Evaluate iterator range.
Chap3.Elab_Object_Subtype (Iter_Type);
Range_Ptr := Create_Temp_Ptr
(Iter_Type_Info.T.Range_Ptr_Type,
Get_Var (Get_Info (Iter_Type).T.Range_Var));
-- Allocate instances.
Var_Inst := Create_Temp (Info.Block_Decls_Array_Ptr_Type);
New_Assign_Stmt
(New_Obj (Var_Inst),
Gen_Alloc
(Alloc_System,
New_Dyadic_Op (ON_Mul_Ov,
New_Value_Selected_Acc_Value
(New_Obj (Range_Ptr),
Iter_Type_Info.T.Range_Length),
New_Lit (Get_Scope_Size (Info.Block_Scope))),
Info.Block_Decls_Array_Ptr_Type));
-- Add a link to child in parent.
V := Get_Instance_Ref (Parent_Info.Block_Scope);
V := New_Selected_Element (V, Info.Block_Parent_Field);
New_Assign_Stmt (V, New_Obj_Value (Var_Inst));
-- Start loop.
Var_I := Create_Temp (Ghdl_Index_Type);
Init_Var (Var_I);
Start_Loop_Stmt (Label);
Gen_Exit_When
(Label,
New_Compare_Op (ON_Eq,
New_Obj_Value (Var_I),
New_Value_Selected_Acc_Value
(New_Obj (Range_Ptr),
Iter_Type_Info.T.Range_Length),
Ghdl_Bool_Type));
Var := Create_Temp_Ptr
(Info.Block_Decls_Ptr_Type,
New_Indexed_Element (New_Acc_Value (New_Obj (Var_Inst)),
New_Obj_Value (Var_I)));
-- Add a link to parent in child.
New_Assign_Stmt
(New_Selected_Acc_Value (New_Obj (Var), Info.Block_Origin_Field),
Get_Instance_Access (Base_Block));
-- Mark the block as not (yet) configured.
New_Assign_Stmt
(New_Selected_Acc_Value (New_Obj (Var),
Info.Block_Configured_Field),
New_Lit (Ghdl_Bool_False_Node));
-- Elaborate block
Set_Scope_Via_Param_Ptr (Info.Block_Scope, Var);
-- Set_Scope_Via_Field_Ptr (Base_Info.Block_Scope,
-- Info.Block_Origin_Field,
-- Info.Block_Scope'Access);
-- Set iterator value.
-- FIXME: this could be slighly optimized...
declare
Val : O_Dnode;
If_Blk : O_If_Block;
begin
Val := Create_Temp (Iter_Type_Info.Ortho_Type (Mode_Value));
Start_If_Stmt
(If_Blk,
New_Compare_Op (ON_Eq,
New_Value_Selected_Acc_Value
(New_Obj (Range_Ptr),
Iter_Type_Info.T.Range_Dir),
New_Lit (Ghdl_Dir_To_Node),
Ghdl_Bool_Type));
New_Assign_Stmt (New_Obj (Val), New_Value_Selected_Acc_Value
(New_Obj (Range_Ptr),
Iter_Type_Info.T.Range_Left));
New_Else_Stmt (If_Blk);
New_Assign_Stmt (New_Obj (Val), New_Value_Selected_Acc_Value
(New_Obj (Range_Ptr),
Iter_Type_Info.T.Range_Right));
Finish_If_Stmt (If_Blk);
New_Assign_Stmt
(Get_Var (Get_Info (Iter).Iterator_Var),
New_Dyadic_Op
(ON_Add_Ov,
New_Obj_Value (Val),
New_Convert_Ov (New_Obj_Value (Var_I),
Iter_Type_Info.Ortho_Type (Mode_Value))));
end;
-- Elaboration.
Elab_Block_Declarations (Bod, Bod);
-- Clear_Scope (Base_Info.Block_Scope);
Clear_Scope (Info.Block_Scope);
Inc_Var (Var_I);
Finish_Loop_Stmt (Label);
Close_Temp;
end Elab_For_Generate_Statement;
type Merge_Signals_Data is record
Sig : Iir;
Set_Init : Boolean;
Has_Val : Boolean;
Val : Mnode;
end record;
procedure Merge_Signals_Rti_Non_Composite (Targ : Mnode;
Targ_Type : Iir;
Data : Merge_Signals_Data)
is
Type_Info : Type_Info_Acc;
Sig : Mnode;
Init_Subprg : O_Dnode;
Conv : O_Tnode;
Assoc : O_Assoc_List;
Init_Val : O_Enode;
begin
Type_Info := Get_Info (Targ_Type);
Open_Temp;
if Data.Set_Init then
case Type_Info.Type_Mode is
when Type_Mode_B1 =>
Init_Subprg := Ghdl_Signal_Init_B1;
Conv := Ghdl_Bool_Type;
when Type_Mode_E8 =>
Init_Subprg := Ghdl_Signal_Init_E8;
Conv := Ghdl_I32_Type;
when Type_Mode_E32 =>
Init_Subprg := Ghdl_Signal_Init_E32;
Conv := Ghdl_I32_Type;
when Type_Mode_I32
| Type_Mode_P32 =>
Init_Subprg := Ghdl_Signal_Init_I32;
Conv := Ghdl_I32_Type;
when Type_Mode_P64
| Type_Mode_I64 =>
Init_Subprg := Ghdl_Signal_Init_I64;
Conv := Ghdl_I64_Type;
when Type_Mode_F64 =>
Init_Subprg := Ghdl_Signal_Init_F64;
Conv := Ghdl_Real_Type;
when others =>
Error_Kind ("merge_signals_rti_non_composite", Targ_Type);
end case;
Sig := Stabilize (Targ, True);
-- Init the signal.
Start_Association (Assoc, Init_Subprg);
New_Association
(Assoc,
New_Convert_Ov (New_Value (M2Lv (Sig)), Ghdl_Signal_Ptr));
if Data.Has_Val then
Init_Val := M2E (Data.Val);
else
Init_Val := Chap4.Get_Scalar_Initial_Value (Targ_Type);
end if;
New_Association (Assoc, New_Convert_Ov (Init_Val, Conv));
New_Procedure_Call (Assoc);
else
Sig := Targ;
end if;
Start_Association (Assoc, Ghdl_Signal_Merge_Rti);
New_Association
(Assoc, New_Convert_Ov (New_Value (M2Lv (Sig)), Ghdl_Signal_Ptr));
New_Association
(Assoc,
New_Lit (New_Global_Unchecked_Address
(Get_Info (Data.Sig).Signal_Rti,
Rtis.Ghdl_Rti_Access)));
New_Procedure_Call (Assoc);
Close_Temp;
end Merge_Signals_Rti_Non_Composite;
function Merge_Signals_Rti_Prepare
(Targ : Mnode; Targ_Type : Iir; Data : Merge_Signals_Data)
return Merge_Signals_Data
is
pragma Unreferenced (Targ);
pragma Unreferenced (Targ_Type);
Res : Merge_Signals_Data;
begin
Res := Data;
if Data.Has_Val then
if Get_Type_Info (Data.Val).Type_Mode = Type_Mode_Record then
Res.Val := Stabilize (Data.Val);
else
Res.Val := Chap3.Get_Array_Base (Data.Val);
end if;
end if;
return Res;
end Merge_Signals_Rti_Prepare;
function Merge_Signals_Rti_Update_Data_Array
(Data : Merge_Signals_Data; Targ_Type : Iir; Index : O_Dnode)
return Merge_Signals_Data
is
begin
if not Data.Has_Val then
return Data;
else
return Merge_Signals_Data'
(Sig => Data.Sig,
Val => Chap3.Index_Base (Data.Val, Targ_Type,
New_Obj_Value (Index)),
Has_Val => True,
Set_Init => Data.Set_Init);
end if;
end Merge_Signals_Rti_Update_Data_Array;
procedure Merge_Signals_Rti_Finish_Data_Composite
(Data : in out Merge_Signals_Data)
is
pragma Unreferenced (Data);
begin
null;
end Merge_Signals_Rti_Finish_Data_Composite;
function Merge_Signals_Rti_Update_Data_Record
(Data : Merge_Signals_Data;
Targ_Type : Iir;
El : Iir_Element_Declaration) return Merge_Signals_Data
is
pragma Unreferenced (Targ_Type);
begin
if not Data.Has_Val then
return Data;
else
return Merge_Signals_Data'
(Sig => Data.Sig,
Val => Chap6.Translate_Selected_Element (Data.Val, El),
Has_Val => True,
Set_Init => Data.Set_Init);
end if;
end Merge_Signals_Rti_Update_Data_Record;
pragma Inline (Merge_Signals_Rti_Finish_Data_Composite);
procedure Merge_Signals_Rti is new Foreach_Non_Composite
(Data_Type => Merge_Signals_Data,
Composite_Data_Type => Merge_Signals_Data,
Do_Non_Composite => Merge_Signals_Rti_Non_Composite,
Prepare_Data_Array => Merge_Signals_Rti_Prepare,
Update_Data_Array => Merge_Signals_Rti_Update_Data_Array,
Finish_Data_Array => Merge_Signals_Rti_Finish_Data_Composite,
Prepare_Data_Record => Merge_Signals_Rti_Prepare,
Update_Data_Record => Merge_Signals_Rti_Update_Data_Record,
Finish_Data_Record => Merge_Signals_Rti_Finish_Data_Composite);
procedure Merge_Signals_Rti_Of_Port_Chain (Chain : Iir)
is
Port : Iir;
Port_Type : Iir;
Data : Merge_Signals_Data;
Val : Iir;
begin
Port := Chain;
while Port /= Null_Iir loop
Port_Type := Get_Type (Port);
Data.Sig := Port;
Open_Temp;
case Get_Mode (Port) is
when Iir_Buffer_Mode
| Iir_Out_Mode
| Iir_Inout_Mode =>
Data.Set_Init := True;
Val := Get_Default_Value (Port);
if Val = Null_Iir then
Data.Has_Val := False;
else
Data.Has_Val := True;
Data.Val := E2M (Chap7.Translate_Expression (Val, Port_Type),
Get_Info (Port_Type),
Mode_Value);
end if;
when others =>
Data.Set_Init := False;
Data.Has_Val := False;
end case;
Merge_Signals_Rti
(Chap6.Translate_Name (Port, Mode_Signal), Port_Type, Data);
Close_Temp;
Port := Get_Chain (Port);
end loop;
end Merge_Signals_Rti_Of_Port_Chain;
procedure Elab_Block_Declarations (Block : Iir; Base_Block : Iir)
is
Base_Info : constant Block_Info_Acc := Get_Info (Base_Block);
Stmt : Iir;
Final : Boolean;
begin
New_Debug_Line_Stmt (Get_Line_Number (Block));
case Get_Kind (Block) is
when Iir_Kind_Entity_Declaration =>
Merge_Signals_Rti_Of_Port_Chain (Get_Port_Chain (Block));
when Iir_Kind_Architecture_Body =>
null;
when Iir_Kind_Block_Statement =>
declare
Header : constant Iir_Block_Header :=
Get_Block_Header (Block);
Guard : constant Iir := Get_Guard_Decl (Block);
begin
if Guard /= Null_Iir then
New_Debug_Line_Stmt (Get_Line_Number (Guard));
Elab_Implicit_Guard_Signal (Block, Base_Info);
end if;
if Header /= Null_Iir then
New_Debug_Line_Stmt (Get_Line_Number (Header));
Chap5.Elab_Map_Aspect (Header, Block);
Merge_Signals_Rti_Of_Port_Chain (Get_Port_Chain (Header));
end if;
end;
when Iir_Kind_Generate_Statement_Body =>
null;
when others =>
Error_Kind ("elab_block_declarations", Block);
end case;
Open_Temp;
Chap4.Elab_Declaration_Chain (Block, Final);
Close_Temp;
Stmt := Get_Concurrent_Statement_Chain (Block);
while Stmt /= Null_Iir loop
case Get_Kind (Stmt) is
when Iir_Kind_Process_Statement
| Iir_Kind_Sensitized_Process_Statement =>
Elab_Process (Stmt, Base_Info);
when Iir_Kind_Psl_Default_Clock =>
null;
when Iir_Kind_Psl_Declaration =>
null;
when Iir_Kind_Psl_Assert_Statement
| Iir_Kind_Psl_Cover_Statement =>
Elab_Psl_Directive (Stmt, Base_Info);
when Iir_Kind_Component_Instantiation_Statement =>
declare
Info : constant Block_Info_Acc := Get_Info (Stmt);
Constr : O_Assoc_List;
begin
Start_Association (Constr, Info.Block_Elab_Subprg);
New_Association
(Constr, Get_Instance_Access (Base_Block));
New_Procedure_Call (Constr);
end;
when Iir_Kind_Block_Statement =>
declare
Mark : Id_Mark_Type;
begin
Push_Identifier_Prefix (Mark, Get_Identifier (Stmt));
Elab_Block_Declarations (Stmt, Base_Block);
Pop_Identifier_Prefix (Mark);
end;
when Iir_Kind_If_Generate_Statement =>
declare
Mark : Id_Mark_Type;
begin
Push_Identifier_Prefix (Mark, Get_Identifier (Stmt));
Elab_If_Generate_Statement (Stmt, Block, Base_Block);
Pop_Identifier_Prefix (Mark);
end;
when Iir_Kind_For_Generate_Statement =>
declare
Mark : Id_Mark_Type;
begin
Push_Identifier_Prefix (Mark, Get_Identifier (Stmt));
Elab_For_Generate_Statement (Stmt, Block, Base_Block);
Pop_Identifier_Prefix (Mark);
end;
when others =>
Error_Kind ("elab_block_declarations", Stmt);
end case;
Stmt := Get_Chain (Stmt);
end loop;
end Elab_Block_Declarations;
end Trans.Chap9;