-- Statements synthesis. -- Copyright (C) 2017 Tristan Gingold -- -- This file is part of GHDL. -- -- This program 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 of the License, or -- (at your option) any later version. -- -- This program 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, write to the Free Software -- Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston, -- MA 02110-1301, USA. with Ada.Unchecked_Deallocation; with Grt.Algos; with Areapools; with Vhdl.Errors; use Vhdl.Errors; with Vhdl.Types; with Vhdl.Sem_Expr; with Vhdl.Utils; use Vhdl.Utils; with Vhdl.Ieee.Std_Logic_1164; with Vhdl.Evaluation; with PSL.Types; with PSL.Nodes; with PSL.NFAs; with PSL.Errors; with Synth.Types; use Synth.Types; with Synth.Errors; use Synth.Errors; with Synth.Decls; use Synth.Decls; with Synth.Expr; use Synth.Expr; with Synth.Environment; use Synth.Environment; with Synth.Insts; use Synth.Insts; with Vhdl.Annotations; use Vhdl.Annotations; with Netlists; use Netlists; with Netlists.Builders; use Netlists.Builders; with Netlists.Gates; package body Synth.Stmts is function Synth_Waveform (Syn_Inst : Synth_Instance_Acc; Wf : Node; Targ_Type : Node) return Value_Acc is begin if Get_Kind (Wf) = Iir_Kind_Unaffected_Waveform then -- TODO raise Internal_Error; end if; if Get_Chain (Wf) /= Null_Node then -- Warning. null; end if; if Get_Time (Wf) /= Null_Node then -- Warning null; end if; return Synth_Expression_With_Type (Syn_Inst, Get_We_Value (Wf), Targ_Type); end Synth_Waveform; procedure Synth_Assign (Dest : Value_Acc; Val : Value_Acc; Vtype : Node) is begin case Dest.Kind is when Value_Wire => Phi_Assign (Dest.W, Get_Net (Val, Vtype)); when others => raise Internal_Error; end case; end Synth_Assign; procedure Synth_Assignment_Aggregate (Syn_Inst : Synth_Instance_Acc; Target : Node; Val : Value_Acc) is Targ_Type : constant Node := Get_Type (Target); Bnd : Value_Bound_Acc; Choice : Node; Assoc : Node; Pos : Uns32; begin if Is_Vector_Type (Targ_Type) then Bnd := Expr.Synth_Array_Bounds (Syn_Inst, Targ_Type, 0); Choice := Get_Association_Choices_Chain (Target); Pos := Bnd.Len; while Is_Valid (Choice) loop Assoc := Get_Associated_Expr (Choice); case Get_Kind (Choice) is when Iir_Kind_Choice_By_None => Pos := Pos - 1; Synth_Assignment (Syn_Inst, Assoc, Bit_Extract (Val, Pos, Target)); when others => Error_Kind ("synth_assignment_aggregate", Choice); end case; Choice := Get_Chain (Choice); end loop; else raise Internal_Error; end if; end Synth_Assignment_Aggregate; procedure Synth_Assignment (Syn_Inst : Synth_Instance_Acc; Target : Node; Val : Value_Acc) is begin case Get_Kind (Target) is when Iir_Kind_Simple_Name => Synth_Assignment (Syn_Inst, Get_Named_Entity (Target), Val); when Iir_Kind_Interface_Signal_Declaration | Iir_Kind_Variable_Declaration | Iir_Kind_Signal_Declaration | Iir_Kind_Anonymous_Signal_Declaration => Synth_Assign (Get_Value (Syn_Inst, Target), Val, Get_Type (Target)); when Iir_Kind_Aggregate => Synth_Assignment_Aggregate (Syn_Inst, Target, Val); when Iir_Kind_Indexed_Name => declare Pfx : constant Node := Get_Prefix (Target); Targ : constant Value_Acc := Get_Value (Syn_Inst, Get_Base_Name (Pfx)); Indexes : constant Node_Flist := Get_Index_List (Target); N_Idx : Node; Idx : Value_Acc; Targ_Net : Net; V : Net; begin if Get_Nbr_Elements (Indexes) /= 1 or else Targ.Kind /= Value_Wire then -- Only support assignment of vector. raise Internal_Error; end if; N_Idx := Get_Nth_Element (Indexes, 0); Idx := Synth_Expression_With_Type (Syn_Inst, N_Idx, Get_Type (N_Idx)); if Is_Const (Idx) then -- FIXME: check index. Targ_Net := Get_Last_Assigned_Value (Targ.W); V := Build_Insert (Build_Context, Targ_Net, Get_Net (Val, Get_Type (Target)), Index_To_Offset (Targ, Idx.Scal, Target)); Set_Location (V, Target); else raise Internal_Error; end if; Synth_Assign (Targ, Create_Value_Net (V, null), Get_Type (Pfx)); end; when Iir_Kind_Slice_Name => declare Pfx : constant Node := Get_Prefix (Target); Targ : constant Value_Acc := Get_Value (Syn_Inst, Get_Base_Name (Pfx)); Res_Bnd : Value_Bound_Acc; Targ_Net : Net; Inp : Net; Step : Uns32; Off : Int32; Wd : Uns32; V : Net; Res : Net; begin if Targ.Kind /= Value_Wire then -- Only support assignment of vector. raise Internal_Error; end if; Synth_Slice_Suffix (Syn_Inst, Target, Extract_Bound (Targ), Res_Bnd, Inp, Step, Off, Wd); Targ_Net := Get_Last_Assigned_Value (Targ.W); V := Get_Net (Val, Get_Type (Target)); if Inp /= No_Net then Res := Build_Dyn_Insert (Build_Context, Targ_Net, V, Inp, Step, Off); else Res := Build_Insert (Build_Context, Targ_Net, V, Uns32 (Off)); end if; Set_Location (Res, Target); Synth_Assign (Targ, Create_Value_Net (Res, Res_Bnd), Get_Type (Pfx)); end; when others => Error_Kind ("synth_assignment", Target); end case; end Synth_Assignment; -- Concurrent or sequential simple signal assignment procedure Synth_Simple_Signal_Assignment (Syn_Inst : Synth_Instance_Acc; Stmt : Node) is Target : constant Node := Get_Target (Stmt); Val : Value_Acc; begin Val := Synth_Waveform (Syn_Inst, Get_Waveform_Chain (Stmt), Get_Type (Target)); Synth_Assignment (Syn_Inst, Target, Val); end Synth_Simple_Signal_Assignment; procedure Synth_Conditional_Signal_Assignment (Syn_Inst : Synth_Instance_Acc; Stmt : Node) is Target : constant Node := Get_Target (Stmt); Targ_Type : constant Node := Get_Type (Target); Cond : Node; Cwf : Node; Val, Cond_Val : Value_Acc; First, Last : Value_Acc; begin Last := null; Cwf := Get_Conditional_Waveform_Chain (Stmt); while Cwf /= Null_Node loop Val := Synth_Waveform (Syn_Inst, Get_Waveform_Chain (Cwf), Targ_Type); Cond := Get_Condition (Cwf); if Cond /= Null_Node then Cond_Val := Synth_Expression (Syn_Inst, Cond); Val := Create_Value_Mux2 (Cond_Val, Val, null); end if; if Last /= null then Last.M_F := Val; else First := Val; end if; Last := Val; Cwf := Get_Chain (Cwf); end loop; Synth_Assignment (Syn_Inst, Target, First); end Synth_Conditional_Signal_Assignment; procedure Synth_Variable_Assignment (Syn_Inst : Synth_Instance_Acc; Stmt : Node) is Target : constant Node := Get_Target (Stmt); Val : Value_Acc; begin Val := Synth_Expression_With_Type (Syn_Inst, Get_Expression (Stmt), Get_Type (Target)); Synth_Assignment (Syn_Inst, Target, Val); end Synth_Variable_Assignment; procedure Synth_If_Statement (Syn_Inst : Synth_Instance_Acc; Stmt : Node) is Cond : constant Node := Get_Condition (Stmt); Els : constant Node := Get_Else_Clause (Stmt); Cond_Val : Value_Acc; Phi_True : Phi_Type; Phi_False : Phi_Type; begin Cond_Val := Synth_Expression (Syn_Inst, Cond); if Is_Const (Cond_Val) then if Cond_Val.Scal = 1 then -- True. Synth_Sequential_Statements (Syn_Inst, Get_Sequential_Statement_Chain (Stmt)); else pragma Assert (Cond_Val.Scal = 0); if Is_Valid (Els) then -- Else part if Is_Null (Get_Condition (Els)) then -- Final else part. Synth_Sequential_Statements (Syn_Inst, Get_Sequential_Statement_Chain (Els)); else -- Elsif. Handled as a nested if. Synth_If_Statement (Syn_Inst, Els); end if; end if; end if; else Push_Phi; Synth_Sequential_Statements (Syn_Inst, Get_Sequential_Statement_Chain (Stmt)); Pop_Phi (Phi_True); Push_Phi; if Is_Valid (Els) then if Is_Null (Get_Condition (Els)) then -- Final else part. Synth_Sequential_Statements (Syn_Inst, Get_Sequential_Statement_Chain (Els)); else -- Elsif. Handled as a nested if. Synth_If_Statement (Syn_Inst, Els); end if; end if; Pop_Phi (Phi_False); Merge_Phis (Build_Context, Get_Net (Cond_Val, Get_Type (Cond)), Phi_True, Phi_False); end if; end Synth_If_Statement; procedure Convert_Bv_To_Uns64 (Expr : Node; Val : out Uns64; Dc : out Uns64) is El_Type : constant Node := Get_Base_Type (Get_Element_Subtype (Get_Type (Expr))); begin if El_Type = Vhdl.Ieee.Std_Logic_1164.Std_Ulogic_Type then declare use Vhdl.Evaluation.String_Utils; Info : constant Str_Info := Get_Str_Info (Expr); begin if Info.Len > 64 then raise Internal_Error; end if; Val := 0; Dc := 0; for I in 0 .. Info.Len - 1 loop Val := Shift_Left (Val, 1); Dc := Shift_Left (Dc, 1); case Get_Pos (Info, I) is when Vhdl.Ieee.Std_Logic_1164.Std_Logic_0_Pos => Val := Val or 0; when Vhdl.Ieee.Std_Logic_1164.Std_Logic_1_Pos => Val := Val or 1; when Vhdl.Ieee.Std_Logic_1164.Std_Logic_U_Pos | Vhdl.Ieee.Std_Logic_1164.Std_Logic_X_Pos | Vhdl.Ieee.Std_Logic_1164.Std_Logic_Z_Pos | Vhdl.Ieee.Std_Logic_1164.Std_Logic_W_Pos | Vhdl.Ieee.Std_Logic_1164.Std_Logic_D_Pos | Vhdl.Ieee.Std_Logic_1164.Std_Logic_L_Pos | Vhdl.Ieee.Std_Logic_1164.Std_Logic_H_Pos => Dc := Dc or 1; when others => raise Internal_Error; end case; end loop; end; else raise Internal_Error; end if; end Convert_Bv_To_Uns64; -- EXPR is a choice, so a locally static literal. procedure Convert_To_Uns64 (Expr : Node; Val : out Uns64; Dc : out Uns64) is Expr_Type : constant Node := Get_Type (Expr); begin case Get_Kind (Expr_Type) is when Iir_Kind_Array_Type_Definition | Iir_Kind_Array_Subtype_Definition => Convert_Bv_To_Uns64 (Expr, Val, Dc); when Iir_Kind_Enumeration_Type_Definition => Dc := 0; Val := Uns64 (Get_Enum_Pos (Strip_Denoting_Name (Expr))); when Iir_Kind_Integer_Type_Definition => -- TODO: signed values. Dc := 0; Val := Uns64 (Get_Value (Expr)); when others => Error_Kind ("convert_to_uns64", Expr_Type); end case; end Convert_To_Uns64; type Alternative_Index is new Int32; type Choice_Data_Type is record -- Value of the choice Val : Uns64; -- Corresponding alternative Alt : Alternative_Index; end record; type Choice_Data_Array is array (Natural range <>) of Choice_Data_Type; type Choice_Data_Array_Acc is access Choice_Data_Array; procedure Free_Choice_Data_Array is new Ada.Unchecked_Deallocation (Choice_Data_Array, Choice_Data_Array_Acc); type Alternative_Data_Type is record Asgns : Seq_Assign; Val : Net; end record; type Alternative_Data_Array is array (Alternative_Index range <>) of Alternative_Data_Type; type Alternative_Data_Acc is access Alternative_Data_Array; procedure Free_Alternative_Data_Array is new Ada.Unchecked_Deallocation (Alternative_Data_Array, Alternative_Data_Acc); type Wire_Id_Array is array (Natural range <>) of Wire_Id; type Wire_Id_Array_Acc is access Wire_Id_Array; procedure Free_Wire_Id_Array is new Ada.Unchecked_Deallocation (Wire_Id_Array, Wire_Id_Array_Acc); procedure Sort_Wire_Id_Array (Arr : in out Wire_Id_Array) is function Lt (Op1, Op2 : Natural) return Boolean is begin return Is_Lt (Arr (Op1), Arr (Op2)); end Lt; procedure Swap (From : Natural; To : Natural) is T : Wire_Id; begin T := Arr (From); Arr (From) := Arr (To); Arr (To) := T; end Swap; procedure Wid_Heap_Sort is new Grt.Algos.Heap_Sort (Lt => Lt, Swap => Swap); begin Wid_Heap_Sort (Arr'Length); end Sort_Wire_Id_Array; function Count_Wires_In_Alternatives (Alts : Alternative_Data_Array) return Natural is Res : Natural; Asgn : Seq_Assign; W : Wire_Id; begin Res := 0; for I in Alts'Range loop Asgn := Alts (I).Asgns; while Asgn /= No_Seq_Assign loop W := Get_Wire_Id (Asgn); if not Get_Wire_Mark (W) then Res := Res + 1; Set_Wire_Mark (W, True); end if; Asgn := Get_Assign_Chain (Asgn); end loop; end loop; return Res; end Count_Wires_In_Alternatives; procedure Fill_Wire_Id_Array (Arr : out Wire_Id_Array; Alts : Alternative_Data_Array) is Idx : Natural; Asgn : Seq_Assign; W : Wire_Id; begin Idx := Arr'First; for I in Alts'Range loop Asgn := Alts (I).Asgns; while Asgn /= No_Seq_Assign loop W := Get_Wire_Id (Asgn); if Get_Wire_Mark (W) then Arr (Idx) := W; Idx := Idx + 1; Set_Wire_Mark (W, False); end if; Asgn := Get_Assign_Chain (Asgn); end loop; end loop; pragma Assert (Idx = Arr'Last + 1); end Fill_Wire_Id_Array; type Case_Element is record Sel : Uns64; Val : Net; end record; type Case_Element_Array is array (Natural range <>) of Case_Element; type Case_Element_Array_Acc is access Case_Element_Array; procedure Free_Case_Element_Array is new Ada.Unchecked_Deallocation (Case_Element_Array, Case_Element_Array_Acc); -- Generate a netlist for a 'big' mux selected by SEL. The inputs are -- described by ELS: E.Val must be selected when SEL = E.Sel; if there -- is no E in Els for a value, DEFAULT is selected. -- The result of the netlist is stored in RES. -- -- A tree of MUX4 is built. -- -- ELS must be sorted by SEL values. -- ELS is overwritten/modified so after the call it contains garbage. The -- reason is that ELS might be large, so temporary arrays are not allocated -- on the stack, and ELS is expected to be built only for this subprogram. procedure Synth_Case (Sel : Net; Els : in out Case_Element_Array; Default : Net; Res : out Net) is Wd : constant Width := Get_Width (Sel); Mask : Uns64; Sub_Sel : Net; Lels : Natural; Iels : Natural; Oels : Natural; begin Lels := Els'Last; Iels := Els'First; if Lels < Iels then -- No choices Res := Default; return; end if; -- Handle SEL bits by 2, so group case_element by 4. for I in 1 .. Natural (Wd / 2) loop -- Extract 2 bits from the selector. Sub_Sel := Build_Extract (Build_Context, Sel, Width (2 * (I - 1)), 2); Mask := Shift_Left (not 0, Natural (2 * I)); Iels := Els'First; Oels := Els'First; while Iels <= Lels loop declare type Net4 is array (0 .. 3) of Net; G : Net4; S_Group : constant Uns64 := Els (Iels).Sel and Mask; S_El : Uns64; El_Idx : Natural; Rsel : Net; begin G := (others => Default); for K in 0 .. 3 loop exit when Iels > Lels; S_El := Els (Iels).Sel; exit when (S_El and Mask) /= S_Group; El_Idx := Natural (Shift_Right (S_El, Natural (2 * (I - 1))) and 3); G (El_Idx) := Els (Iels).Val; Iels := Iels + 1; end loop; if G (3) /= No_Net then Rsel := Build_Mux4 (Build_Context, Sub_Sel, G (0), G (1), G (2), G (3)); elsif G (2) /= No_Net then Rsel := Build_Mux2 (Build_Context, Build_Extract_Bit (Build_Context, Sel, Width (2 * (I - 1)) + 1), Build_Mux2 (Build_Context, Build_Extract_Bit (Build_Context, Sel, Width (2 * (I - 1))), G (0), G (1)), G (2)); elsif G (1) /= No_Net then Rsel := Build_Mux2 (Build_Context, Build_Extract_Bit (Build_Context, Sel, Width (2 * (I - 1))), G (0), G (1)); else Rsel := G (0); end if; Els (Oels) := (Sel => S_Group, Val => Rsel); Oels := Oels + 1; end; end loop; Lels := Oels - 1; end loop; -- If the width is not a multiple of 2, handle the last level. if Wd mod 2 = 1 then if Wd = 1 then Sub_Sel := Sel; else Sub_Sel := Build_Extract_Bit (Build_Context, Sel, Wd - 1); end if; Iels := Els'First; Oels := Els'First; while Iels <= Lels loop declare type Net2 is array (0 .. 1) of Net; G : Net2; S_Group : constant Uns64 := Els (Iels).Sel and Mask; S_El : Uns64; El_Idx : Natural; begin G := (others => Default); for K in 0 .. 1 loop exit when Iels > Lels; S_El := Els (Iels).Sel; El_Idx := Natural (Shift_Right (S_El, Natural (Wd - 1)) and 1); G (El_Idx) := Els (Iels).Val; Iels := Iels + 1; end loop; Els (Oels) := (Sel => S_Group, Val => Build_Mux2 (Build_Context, Sub_Sel, G (0), G (1))); Oels := Oels + 1; end; end loop; Lels := Oels - 1; end if; pragma Assert (Lels = Els'First); Res := Els (Els'First).Val; end Synth_Case; procedure Synth_Case_Statement (Syn_Inst : Synth_Instance_Acc; Stmt : Node) is use Vhdl.Sem_Expr; Expr : constant Node := Get_Expression (Stmt); Choices : constant Node := Get_Case_Statement_Alternative_Chain (Stmt); Choice : Node; Case_Info : Choice_Info_Type; Annex_Arr : Annex_Array_Acc; -- Array of alternatives Alts : Alternative_Data_Acc; Alt_Idx : Alternative_Index; Others_Alt_Idx : Alternative_Index; -- Array of choices. Contains tuple of (Value, Alternative). Choice_Data : Choice_Data_Array_Acc; Choice_Idx : Natural; Case_El : Case_Element_Array_Acc; Nbr_Wires : Natural; Wires : Wire_Id_Array_Acc; Sel : Value_Acc; Sel_Net : Net; begin -- Strategies to synthesize a case statement. Assume the selector is -- a net of W bits -- - a large mux, with 2**W inputs -- - if the number of choices is dense -- - if W is small -- - a onehot mux. Each choice is converted to an single bit condition -- by adding a comparison operator (equal for single choice, -- inequalities for ranges, or for multiple choices). Only one of -- these conditions is true (plus 'others'). -- - if the number of choices is sparse -- - large range choices -- - a tree of mux/mux2 -- - large number of choices, densily grouped but sparsed compared -- to 2**W (eg: a partially filled memory) -- - divide and conquier -- Create a net for the expression. Sel := Synth_Expression (Syn_Inst, Expr); -- Count choices and alternatives. Count_Choices (Case_Info, Choices); Fill_Choices_Array (Case_Info, Choices); -- Allocate structures. -- Because there is no 1-1 link between choices and alternatives, -- create an array for the choices and an array for the alternatives. Alts := new Alternative_Data_Array (1 .. Alternative_Index (Case_Info.Nbr_Alternatives)); Choice_Data := new Choice_Data_Array (1 .. Case_Info.Nbr_Choices); Annex_Arr := new Annex_Array (1 .. Case_Info.Nbr_Choices); Case_Info.Annex_Arr := Annex_Arr; -- Synth statements, extract choice value. Alt_Idx := 0; Others_Alt_Idx := 0; Choice_Idx := 0; Choice := Choices; while Is_Valid (Choice) loop if not Get_Same_Alternative_Flag (Choice) then Alt_Idx := Alt_Idx + 1; declare Phi : Phi_Type; begin Push_Phi; Synth_Sequential_Statements (Syn_Inst, Get_Associated_Chain (Choice)); Pop_Phi (Phi); Alts (Alt_Idx).Asgns := Sort_Phi (Phi); end; end if; case Get_Kind (Choice) is when Iir_Kind_Choice_By_Expression => Choice_Idx := Choice_Idx + 1; Annex_Arr (Choice_Idx) := Int32 (Choice_Idx); declare Choice_Expr : constant Node := Get_Choice_Expression (Choice); Val, Dc : Uns64; begin Convert_To_Uns64 (Choice_Expr, Val, Dc); if Dc = 0 then Choice_Data (Choice_Idx) := (Val => Val, Alt => Alt_Idx); else Error_Msg_Synth (+Choice_Expr, "meta-values never match"); Choice_Data (Choice_Idx) := (Val => 0, Alt => 0); end if; end; when Iir_Kind_Choice_By_Others => Others_Alt_Idx := Alt_Idx; when others => raise Internal_Error; end case; Choice := Get_Chain (Choice); end loop; pragma Assert (Choice_Idx = Choice_Data'Last); -- Sort by order. if Get_Kind (Get_Type (Expr)) in Iir_Kinds_Discrete_Type_Definition then Sort_Discrete_Choices (Case_Info); else Sort_String_Choices (Case_Info); end if; -- Create list of wire_id, sort it. Nbr_Wires := Count_Wires_In_Alternatives (Alts.all); Wires := new Wire_Id_Array (1 .. Nbr_Wires); Fill_Wire_Id_Array (Wires.all, Alts.all); Sort_Wire_Id_Array (Wires.all); -- Associate each choice with the assign node -- For each wire_id: -- Build mux2/mux4 tree (group by 4) Case_El := new Case_Element_Array (1 .. Case_Info.Nbr_Choices); Sel_Net := Get_Net (Sel, Get_Type (Expr)); -- For each wire, compute the result. for I in Wires'Range loop declare Wi : constant Wire_Id := Wires (I); Last_Val : constant Net := Get_Last_Assigned_Value (Wi); Res : Net; Default : Net; C : Natural; begin -- Extract the value for each alternative. for Alt of Alts.all loop -- If there is an assignment to Wi in Alt, it will define the -- value. Otherwise, use Last_Val, ie the last assignment -- before the case. if Get_Wire_Id (Alt.Asgns) = Wi then Alt.Val := Get_Assign_Value (Alt.Asgns); Alt.Asgns := Get_Assign_Chain (Alt.Asgns); else Alt.Val := Last_Val; end if; end loop; -- Build the map between choices and values. for J in Annex_Arr'Range loop C := Natural (Annex_Arr (J)); Case_El (J) := (Sel => Choice_Data (C).Val, Val => Alts (Choice_Data (C).Alt).Val); end loop; -- Extract default value (for missing alternative). if Others_Alt_Idx /= 0 then Default := Alts (Others_Alt_Idx).Val; else Default := No_Net; end if; -- Generate the muxes tree. Synth_Case (Sel_Net, Case_El.all, Default, Res); Phi_Assign (Wi, Res); end; end loop; -- free. Free_Case_Element_Array (Case_El); Free_Wire_Id_Array (Wires); Free_Choice_Data_Array (Choice_Data); Free_Annex_Array (Annex_Arr); Free_Alternative_Data_Array (Alts); end Synth_Case_Statement; procedure Synth_Selected_Signal_Assignment (Syn_Inst : Synth_Instance_Acc; Stmt : Node) is use Vhdl.Sem_Expr; Targ : constant Node := Get_Target (Stmt); Targ_Type : constant Node := Get_Type (Targ); Expr : constant Node := Get_Expression (Stmt); Choices : constant Node := Get_Selected_Waveform_Chain (Stmt); Choice : Node; Case_Info : Choice_Info_Type; Annex_Arr : Annex_Array_Acc; -- Array of alternatives Alts : Alternative_Data_Acc; Alt_Idx : Alternative_Index; Others_Alt_Idx : Alternative_Index; -- Array of choices. Contains tuple of (Value, Alternative). Choice_Data : Choice_Data_Array_Acc; Choice_Idx : Natural; Case_El : Case_Element_Array_Acc; Sel : Value_Acc; Sel_Net : Net; begin -- Create a net for the expression. Sel := Synth_Expression (Syn_Inst, Expr); -- Count choices and alternatives. Count_Choices (Case_Info, Choices); Fill_Choices_Array (Case_Info, Choices); -- Allocate structures. -- Because there is no 1-1 link between choices and alternatives, -- create an array for the choices and an array for the alternatives. Alts := new Alternative_Data_Array (1 .. Alternative_Index (Case_Info.Nbr_Alternatives)); Choice_Data := new Choice_Data_Array (1 .. Case_Info.Nbr_Choices); Annex_Arr := new Annex_Array (1 .. Case_Info.Nbr_Choices); Case_Info.Annex_Arr := Annex_Arr; -- Synth statements, extract choice value. Alt_Idx := 0; Others_Alt_Idx := 0; Choice_Idx := 0; Choice := Choices; while Is_Valid (Choice) loop if not Get_Same_Alternative_Flag (Choice) then Alt_Idx := Alt_Idx + 1; Alts (Alt_Idx).Val := Get_Net (Synth_Waveform (Syn_Inst, Get_Associated_Chain (Choice), Targ_Type), Targ_Type); end if; case Get_Kind (Choice) is when Iir_Kind_Choice_By_Expression => Choice_Idx := Choice_Idx + 1; Annex_Arr (Choice_Idx) := Int32 (Choice_Idx); declare Choice_Expr : constant Node := Get_Choice_Expression (Choice); Val, Dc : Uns64; begin Convert_To_Uns64 (Choice_Expr, Val, Dc); if Dc = 0 then Choice_Data (Choice_Idx) := (Val => Val, Alt => Alt_Idx); else Error_Msg_Synth (+Choice_Expr, "meta-values never match"); Choice_Data (Choice_Idx) := (Val => 0, Alt => 0); end if; end; when Iir_Kind_Choice_By_Others => Others_Alt_Idx := Alt_Idx; when others => raise Internal_Error; end case; Choice := Get_Chain (Choice); end loop; pragma Assert (Choice_Idx = Choice_Data'Last); -- Sort by order. if Get_Kind (Get_Type (Expr)) in Iir_Kinds_Discrete_Type_Definition then Sort_Discrete_Choices (Case_Info); else Sort_String_Choices (Case_Info); end if; -- Associate each choice with the assign node -- For each wire_id: -- Build mux2/mux4 tree (group by 4) Case_El := new Case_Element_Array (1 .. Case_Info.Nbr_Choices); Sel_Net := Get_Net (Sel, Get_Type (Expr)); declare Res : Net; Default : Net; C : Natural; begin -- Build the map between choices and values. for J in Annex_Arr'Range loop C := Natural (Annex_Arr (J)); Case_El (J) := (Sel => Choice_Data (C).Val, Val => Alts (Choice_Data (C).Alt).Val); end loop; -- Extract default value (for missing alternative). if Others_Alt_Idx /= 0 then Default := Alts (Others_Alt_Idx).Val; else Default := No_Net; end if; -- Generate the muxes tree. Synth_Case (Sel_Net, Case_El.all, Default, Res); Synth_Assignment (Syn_Inst, Get_Target (Stmt), Create_Value_Net (Res, null)); end; -- free. Free_Case_Element_Array (Case_El); Free_Choice_Data_Array (Choice_Data); Free_Annex_Array (Annex_Arr); Free_Alternative_Data_Array (Alts); end Synth_Selected_Signal_Assignment; procedure Synth_Subprogram_Association (Subprg_Inst : Synth_Instance_Acc; Caller_Inst : Synth_Instance_Acc; Inter_Chain : Node; Assoc_Chain : Node) is Inter : Node; Assoc : Node; Assoc_Inter : Node; Actual : Node; Val : Value_Acc; begin Assoc := Assoc_Chain; Assoc_Inter := Inter_Chain; while Is_Valid (Assoc) loop Inter := Get_Association_Interface (Assoc, Assoc_Inter); Synth_Declaration_Type (Subprg_Inst, Inter); case Iir_Parameter_Modes (Get_Mode (Inter)) is when Iir_In_Mode => case Get_Kind (Assoc) is when Iir_Kind_Association_Element_Open => Actual := Get_Default_Value (Inter); Val := Synth_Expression_With_Type (Subprg_Inst, Actual, Get_Type (Inter)); when Iir_Kind_Association_Element_By_Expression => Actual := Get_Actual (Assoc); Val := Synth_Expression_With_Type (Caller_Inst, Actual, Get_Type (Inter)); when others => raise Internal_Error; end case; when Iir_Out_Mode | Iir_Inout_Mode => -- FIXME: todo raise Internal_Error; end case; case Iir_Kinds_Interface_Object_Declaration (Get_Kind (Inter)) is when Iir_Kind_Interface_Constant_Declaration | Iir_Kind_Interface_Variable_Declaration => -- FIXME: Arguments are passed by copy. Create_Object (Subprg_Inst, Inter, Val); when Iir_Kind_Interface_Signal_Declaration => Create_Object (Subprg_Inst, Inter, Val); when Iir_Kind_Interface_File_Declaration => raise Internal_Error; end case; Next_Association_Interface (Assoc, Assoc_Inter); end loop; end Synth_Subprogram_Association; procedure Synth_Subprogram_Back_Association (Subprg_Inst : Synth_Instance_Acc; Caller_Inst : Synth_Instance_Acc; Inter_Chain : Node; Assoc_Chain : Node) is Inter : Node; Assoc : Node; Assoc_Inter : Node; Val : Value_Acc; begin Assoc := Assoc_Chain; Assoc_Inter := Inter_Chain; while Is_Valid (Assoc) loop Inter := Get_Association_Interface (Assoc, Assoc_Inter); if Get_Mode (Inter) = Iir_Out_Mode then Val := Synth_Expression_With_Type (Subprg_Inst, Inter, Get_Type (Inter)); Synth_Assignment (Caller_Inst, Get_Actual (Assoc), Val); end if; Next_Association_Interface (Assoc, Assoc_Inter); end loop; end Synth_Subprogram_Back_Association; procedure Synth_Procedure_Call (Syn_Inst : Synth_Instance_Acc; Stmt : Node) is Call : constant Node := Get_Procedure_Call (Stmt); Imp : constant Node := Get_Implementation (Call); Assoc_Chain : constant Node := Get_Parameter_Association_Chain (Call); Inter_Chain : constant Node := Get_Interface_Declaration_Chain (Imp); Subprg_Body : constant Node := Get_Subprogram_Body (Imp); Decls_Chain : constant Node := Get_Declaration_Chain (Subprg_Body); Sub_Syn_Inst : Synth_Instance_Acc; M : Areapools.Mark_Type; begin if Get_Implicit_Definition (Imp) in Iir_Predefined_Implicit then Error_Msg_Synth (+Stmt, "call to implicit %n is not supported", +Imp); return; elsif Get_Foreign_Flag (Imp) then Error_Msg_Synth (+Stmt, "call to foreign %n is not supported", +Imp); return; end if; Areapools.Mark (M, Instance_Pool.all); Sub_Syn_Inst := Make_Instance (Syn_Inst, Get_Info (Imp)); Synth_Subprogram_Association (Sub_Syn_Inst, Syn_Inst, Inter_Chain, Assoc_Chain); Synth_Declarations (Sub_Syn_Inst, Decls_Chain); if Is_Valid (Decls_Chain) then Sub_Syn_Inst.Name := New_Sname (Syn_Inst.Name, Get_Identifier (Imp)); Synth_Declarations (Sub_Syn_Inst, Decls_Chain); end if; Synth_Sequential_Statements (Sub_Syn_Inst, Get_Sequential_Statement_Chain (Subprg_Body)); Synth_Subprogram_Back_Association (Sub_Syn_Inst, Syn_Inst, Inter_Chain, Assoc_Chain); Free_Instance (Sub_Syn_Inst); Areapools.Release (M, Instance_Pool.all); end Synth_Procedure_Call; function In_Range (Rng : Value_Acc; V : Int64) return Boolean is begin case Rng.Rng.Dir is when Iir_To => return V >= Rng.Rng.Left and then V <= Rng.Rng.Right; when Iir_Downto => return V <= Rng.Rng.Left and then V >= Rng.Rng.Right; end case; end In_Range; procedure Update_Index (Rng : Value_Acc; Idx : in out Int64) is begin case Rng.Rng.Dir is when Iir_To => Idx := Idx + 1; when Iir_Downto => Idx := Idx - 1; end case; end Update_Index; procedure Synth_For_Loop_Statement (Syn_Inst : Synth_Instance_Acc; Stmt : Node) is Iterator : constant Node := Get_Parameter_Specification (Stmt); Stmts : constant Node := Get_Sequential_Statement_Chain (Stmt); It_Rng : Value_Acc; It_Type : Node; Val : Value_Acc; begin It_Type := Get_Declaration_Type (Iterator); if It_Type /= Null_Node then Synth_Subtype_Indication (Syn_Inst, It_Type); end if; -- Initial value. It_Rng := Get_Value (Syn_Inst, Get_Type (Iterator)); Val := Create_Value_Discrete (It_Rng.Rng.Left); Create_Object (Syn_Inst, Iterator, Val); while In_Range (It_Rng, Val.Scal) loop Synth_Sequential_Statements (Syn_Inst, Stmts); Update_Index (It_Rng, Val.Scal); end loop; Destroy_Object (Syn_Inst, Iterator); if It_Type /= Null_Node then Destroy_Object (Syn_Inst, It_Type); end if; end Synth_For_Loop_Statement; procedure Synth_Return_Statement (Syn_Inst : Synth_Instance_Acc; Stmt : Node) is Val : Value_Acc; Expr : constant Node := Get_Expression (Stmt); begin if Expr = Null_Node then -- TODO: return in procedure. raise Internal_Error; end if; Val := Synth_Expression (Syn_Inst, Expr); if Syn_Inst.Return_Value /= null then -- TODO: multiple return raise Internal_Error; end if; Syn_Inst.Return_Value := Val; end Synth_Return_Statement; procedure Synth_Sequential_Statements (Syn_Inst : Synth_Instance_Acc; Stmts : Node) is Stmt : Node; begin Stmt := Stmts; while Is_Valid (Stmt) loop case Get_Kind (Stmt) is when Iir_Kind_If_Statement => Synth_If_Statement (Syn_Inst, Stmt); when Iir_Kind_Simple_Signal_Assignment_Statement => Synth_Simple_Signal_Assignment (Syn_Inst, Stmt); when Iir_Kind_Variable_Assignment_Statement => Synth_Variable_Assignment (Syn_Inst, Stmt); when Iir_Kind_Case_Statement => Synth_Case_Statement (Syn_Inst, Stmt); when Iir_Kind_For_Loop_Statement => Synth_For_Loop_Statement (Syn_Inst, Stmt); when Iir_Kind_Null_Statement => -- Easy null; when Iir_Kind_Return_Statement => Synth_Return_Statement (Syn_Inst, Stmt); exit; when Iir_Kind_Procedure_Call_Statement => Synth_Procedure_Call (Syn_Inst, Stmt); when others => Error_Kind ("synth_sequential_statements", Stmt); end case; Stmt := Get_Chain (Stmt); end loop; end Synth_Sequential_Statements; Proc_Pool : aliased Areapools.Areapool; -- Synthesis of statements of a non-sensitized process. procedure Synth_Process_Sequential_Statements (Syn_Inst : Synth_Instance_Acc; Proc : Node) is Stmt : Node; Cond : Node; Cond_Val : Value_Acc; Phi_True : Phi_Type; Phi_False : Phi_Type; begin Stmt := Get_Sequential_Statement_Chain (Proc); -- The first statement must be a wait statement. if Get_Kind (Stmt) /= Iir_Kind_Wait_Statement then Error_Msg_Synth (+Stmt, "expect wait as the first statement"); return; end if; -- Handle the condition as an if. Cond := Get_Condition_Clause (Stmt); Cond_Val := Synth_Expression (Syn_Inst, Cond); Push_Phi; Synth_Sequential_Statements (Syn_Inst, Get_Chain (Stmt)); Pop_Phi (Phi_True); Push_Phi; Pop_Phi (Phi_False); Merge_Phis (Build_Context, Get_Net (Cond_Val, Get_Type (Cond)), Phi_True, Phi_False); end Synth_Process_Sequential_Statements; procedure Synth_Process_Statement (Syn_Inst : Synth_Instance_Acc; Proc : Node) is use Areapools; Label : constant Name_Id := Get_Identifier (Proc); Info : constant Sim_Info_Acc := Get_Info (Proc); Decls_Chain : constant Node := Get_Declaration_Chain (Proc); Prev_Instance_Pool : constant Areapool_Acc := Instance_Pool; Proc_Inst : Synth_Instance_Acc; M : Areapools.Mark_Type; begin Proc_Inst := Make_Instance (Syn_Inst, Info); Mark (M, Proc_Pool); Instance_Pool := Proc_Pool'Access; if Is_Valid (Decls_Chain) then if Label = Null_Identifier then Proc_Inst.Name := New_Internal_Name (Build_Context, Syn_Inst.Name); else Proc_Inst.Name := New_Sname (Syn_Inst.Name, Label); end if; Synth_Declarations (Proc_Inst, Decls_Chain); end if; case Iir_Kinds_Process_Statement (Get_Kind (Proc)) is when Iir_Kind_Sensitized_Process_Statement => Synth_Sequential_Statements (Proc_Inst, Get_Sequential_Statement_Chain (Proc)); -- FIXME: check sensitivity list. when Iir_Kind_Process_Statement => Synth_Process_Sequential_Statements (Proc_Inst, Proc); end case; Free_Instance (Proc_Inst); Release (M, Proc_Pool); Instance_Pool := Prev_Instance_Pool; end Synth_Process_Statement; procedure Synth_Concurrent_Assertion_Statement (Syn_Inst : Synth_Instance_Acc; Stmt : Node) is Cond : constant Node := Get_Assertion_Condition (Stmt); Val : Value_Acc; begin Val := Synth_Expression (Syn_Inst, Cond); if Is_Const (Val) then if Val.Scal /= 1 then raise Internal_Error; end if; return; end if; Build_Assert (Build_Context, Get_Net (Val, Get_Type (Cond))); end Synth_Concurrent_Assertion_Statement; function Synth_PSL_Expression (Syn_Inst : Synth_Instance_Acc; Expr : PSL.Types.PSL_Node) return Net is use PSL.Nodes; begin case Get_Kind (Expr) is when N_HDL_Expr => declare E : constant Vhdl.Types.Vhdl_Node := Get_HDL_Node (Expr); begin return Get_Net (Synth_Expression (Syn_Inst, E), Get_Type (E)); end; when N_Not_Bool => return Build_Monadic (Build_Context, Netlists.Gates.Id_Not, Synth_PSL_Expression (Syn_Inst, Get_Boolean (Expr))); when others => PSL.Errors.Error_Kind ("translate_psl_expr", Expr); end case; end Synth_PSL_Expression; function Synth_Psl_NFA (Syn_Inst : Synth_Instance_Acc; NFA : PSL.Types.PSL_NFA; Nbr_States : Int32; States : Net) return Net is use PSL.NFAs; S : NFA_State; S_Num : Int32; D_Num : Int32; I : Net; Cond : Net; E : NFA_Edge; D_Arr : Net_Array_Acc; Res : Net; begin D_Arr := new Net_Array'(0 .. Nbr_States - 1 => No_Net); S := Get_First_State (NFA); while S /= No_State loop S_Num := Get_State_Label (S); I := Build_Extract_Bit (Build_Context, States, Uns32 (S_Num)); E := Get_First_Src_Edge (S); while E /= No_Edge loop Cond := Build_Dyadic (Build_Context, Netlists.Gates.Id_And, I, Synth_PSL_Expression (Syn_Inst, Get_Edge_Expr (E))); D_Num := Nbr_States - 1 - Get_State_Label (Get_Edge_Dest (E)); if D_Arr (D_Num) = No_Net then D_Arr (D_Num) := Cond; else D_Arr (D_Num) := Build_Dyadic (Build_Context, Netlists.Gates.Id_Or, D_Arr (D_Num), Cond); end if; E := Get_Next_Src_Edge (E); end loop; S := Get_Next_State (S); end loop; if D_Arr (Nbr_States - 1) = No_Net then D_Arr (Nbr_States - 1) := Build_Const_UB32 (Build_Context, 0, 1); end if; Res := Concat_Array (D_Arr); Free_Net_Array (D_Arr); return Res; end Synth_Psl_NFA; procedure Synth_Psl_Restrict_Directive (Syn_Inst : Synth_Instance_Acc; Stmt : Node) is Nbr_States : constant Int32 := Get_PSL_Nbr_States (Stmt); Init : Net; Clk : Net; States : Net; Next_States : Net; begin -- create init net, clock net pragma Assert (Nbr_States <= 32); Init := Build_Const_UB32 (Build_Context, 1, Uns32 (Nbr_States)); Clk := Synth_PSL_Expression (Syn_Inst, Get_PSL_Clock (Stmt)); -- build idff States := Build_Idff (Build_Context, Clk, No_Net, Init); -- create update nets -- For each state: if set, evaluate all outgoing edges. Next_States := Synth_Psl_NFA (Syn_Inst, Get_PSL_NFA (Stmt), Nbr_States, States); Connect (Get_Input (Get_Parent (States), 1), Next_States); -- Build assume gate. -- Note: for synthesis, we assume the next state will be correct. -- (If we assume on States, then the first cycle is ignored). Build_Assume (Build_Context, Build_Reduce (Build_Context, Netlists.Gates.Id_Red_Or, Next_States)); end Synth_Psl_Restrict_Directive; procedure Synth_Generate_Statement_Body (Syn_Inst : Synth_Instance_Acc; Bod : Node; Iterator : Node := Null_Node; Iterator_Val : Value_Acc := null) is use Areapools; Info : constant Sim_Info_Acc := Get_Info (Bod); Decls_Chain : constant Node := Get_Declaration_Chain (Bod); Prev_Instance_Pool : constant Areapool_Acc := Instance_Pool; Bod_Inst : Synth_Instance_Acc; M : Areapools.Mark_Type; begin Bod_Inst := Make_Instance (Syn_Inst, Info); -- Same module. Bod_Inst.M := Syn_Inst.M; Mark (M, Proc_Pool); Instance_Pool := Proc_Pool'Access; Bod_Inst.Name := New_Sname (Syn_Inst.Name, Get_Identifier (Bod)); if Iterator /= Null_Node then -- Add the iterator (for for-generate). Create_Object (Bod_Inst, Iterator, Iterator_Val); end if; Synth_Declarations (Bod_Inst, Decls_Chain); Synth_Concurrent_Statements (Bod_Inst, Get_Concurrent_Statement_Chain (Bod)); Free_Instance (Bod_Inst); Release (M, Proc_Pool); Instance_Pool := Prev_Instance_Pool; end Synth_Generate_Statement_Body; procedure Synth_For_Generate_Statement (Syn_Inst : Synth_Instance_Acc; Stmt : Node) is Iterator : constant Node := Get_Parameter_Specification (Stmt); Bod : constant Node := Get_Generate_Statement_Body (Stmt); Configs : constant Node := Get_Generate_Block_Configuration (Bod); Config : Node; It_Rng : Value_Acc; It_Type : Node; Val : Value_Acc; begin It_Type := Get_Declaration_Type (Iterator); if It_Type /= Null_Node then Synth_Subtype_Indication (Syn_Inst, It_Type); end if; -- Initial value. It_Rng := Get_Value (Syn_Inst, Get_Type (Iterator)); Val := Create_Value_Discrete (It_Rng.Rng.Left); while In_Range (It_Rng, Val.Scal) loop -- Find and apply the config block. declare Spec : Node; begin Config := Configs; while Config /= Null_Node loop Spec := Get_Block_Specification (Config); case Get_Kind (Spec) is when Iir_Kind_Simple_Name => exit; when others => Error_Kind ("synth_for_generate_statement", Spec); end case; Config := Get_Prev_Block_Configuration (Config); end loop; if Config = Null_Node then raise Internal_Error; end if; Apply_Block_Configuration (Config, Bod); end; Synth_Generate_Statement_Body (Syn_Inst, Bod, Iterator, Val); Update_Index (It_Rng, Val.Scal); end loop; end Synth_For_Generate_Statement; procedure Synth_Concurrent_Statements (Syn_Inst : Synth_Instance_Acc; Stmts : Node) is Stmt : Node; begin Stmt := Stmts; while Is_Valid (Stmt) loop case Get_Kind (Stmt) is when Iir_Kind_Concurrent_Simple_Signal_Assignment => Push_Phi; Synth_Simple_Signal_Assignment (Syn_Inst, Stmt); Pop_And_Merge_Phi (Build_Context, Stmt); when Iir_Kind_Concurrent_Conditional_Signal_Assignment => Push_Phi; Synth_Conditional_Signal_Assignment (Syn_Inst, Stmt); Pop_And_Merge_Phi (Build_Context, Stmt); when Iir_Kind_Concurrent_Selected_Signal_Assignment => Push_Phi; Synth_Selected_Signal_Assignment (Syn_Inst, Stmt); Pop_And_Merge_Phi (Build_Context, Stmt); when Iir_Kinds_Process_Statement => Push_Phi; Synth_Process_Statement (Syn_Inst, Stmt); Pop_And_Merge_Phi (Build_Context, Stmt); when Iir_Kind_If_Generate_Statement => declare Gen : Node; Bod : Node; Cond : Value_Acc; begin Gen := Stmt; loop Cond := Synth_Expression (Syn_Inst, Get_Condition (Gen)); pragma Assert (Cond.Kind = Value_Discrete); if Cond.Scal = 1 then Bod := Get_Generate_Statement_Body (Gen); Synth_Generate_Statement_Body (Syn_Inst, Bod); exit; end if; Gen := Get_Generate_Else_Clause (Gen); exit when Gen = Null_Node; end loop; end; when Iir_Kind_For_Generate_Statement => Synth_For_Generate_Statement (Syn_Inst, Stmt); when Iir_Kind_Component_Instantiation_Statement => Push_Phi; if Is_Component_Instantiation (Stmt) then declare Comp_Config : constant Node := Get_Component_Configuration (Stmt); begin if Get_Binding_Indication (Comp_Config) = Null_Node then -- Not bound. Synth_Blackbox_Instantiation_Statement (Syn_Inst, Stmt); else Synth_Component_Instantiation_Statement (Syn_Inst, Stmt); end if; end; else Synth_Design_Instantiation_Statement (Syn_Inst, Stmt); end if; Pop_And_Merge_Phi (Build_Context, Stmt); when Iir_Kind_Psl_Default_Clock => null; when Iir_Kind_Psl_Restrict_Directive => -- Passive statement. Synth_Psl_Restrict_Directive (Syn_Inst, Stmt); when Iir_Kind_Concurrent_Assertion_Statement => -- Passive statement. Synth_Concurrent_Assertion_Statement (Syn_Inst, Stmt); when others => Error_Kind ("synth_statements", Stmt); end case; Stmt := Get_Chain (Stmt); end loop; end Synth_Concurrent_Statements; end Synth.Stmts;