-- 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 Name_Table;
with Std_Names;
with Errorout; use Errorout;
with Files_Map;
with Simple_IO;
with Vhdl.Errors; use Vhdl.Errors;
with Vhdl.Types;
with Vhdl.Sem_Expr;
with Vhdl.Utils; use Vhdl.Utils;
with Vhdl.Std_Package;
with Vhdl.Evaluation;
with PSL.Types;
with PSL.Nodes;
with PSL.NFAs;
with PSL.Errors;
with Synth.Errors; use Synth.Errors;
with Synth.Decls; use Synth.Decls;
with Synth.Expr; use Synth.Expr;
with Synth.Insts; use Synth.Insts;
with Synth.Source;
with Synth.Static_Proc;
with Synth.Heap;
with Synth.Flags;
with Synth.Debugger;
with Netlists.Builders; use Netlists.Builders;
with Netlists.Folds; use Netlists.Folds;
with Netlists.Gates;
with Netlists.Utils; use Netlists.Utils;
with Netlists.Locations; use Netlists.Locations;
with Netlists.Butils; use Netlists.Butils;
package body Synth.Stmts is
procedure Synth_Sequential_Statements
(C : in out Seq_Context; Stmts : Node);
procedure Set_Location (N : Net; Loc : Node)
renames Synth.Source.Set_Location;
function Synth_Waveform (Syn_Inst : Synth_Instance_Acc;
Wf : Node;
Targ_Type : Type_Acc) 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;
if Targ_Type = null then
return Synth_Expression (Syn_Inst, Get_We_Value (Wf));
else
return Synth_Expression_With_Type
(Syn_Inst, Get_We_Value (Wf), Targ_Type);
end if;
end Synth_Waveform;
procedure Synth_Assign (Wid : Wire_Id;
Typ : Type_Acc;
Val : Value_Acc;
Offset : Uns32;
Loc : Source.Syn_Src) is
begin
Phi_Assign (Build_Context, Wid,
Get_Net (Synth_Subtype_Conversion (Val, Typ, False, Loc)),
Offset);
end Synth_Assign;
procedure Synth_Assignment_Aggregate (Syn_Inst : Synth_Instance_Acc;
Target : Node;
Target_Type : Type_Acc;
Val : Value_Acc;
Loc : Node)
is
Choice : Node;
Assoc : Node;
Pos : Uns32;
begin
if Target_Type.Kind = Type_Vector then
Choice := Get_Association_Choices_Chain (Target);
Pos := Target_Type.W;
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), Loc);
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_Prefix (Syn_Inst : Synth_Instance_Acc;
Pfx : Node;
Dest_Obj : out Value_Acc;
Dest_Off : out Uns32;
Dest_Voff : out Net;
Dest_Rdwd : out Width;
Dest_Type : out Type_Acc) is
begin
case Get_Kind (Pfx) is
when Iir_Kind_Simple_Name =>
Synth_Assignment_Prefix (Syn_Inst, Get_Named_Entity (Pfx),
Dest_Obj, Dest_Off,
Dest_Voff, Dest_Rdwd, Dest_Type);
when Iir_Kind_Interface_Signal_Declaration
| Iir_Kind_Variable_Declaration
| Iir_Kind_Interface_Variable_Declaration
| Iir_Kind_Signal_Declaration
| Iir_Kind_Anonymous_Signal_Declaration
| Iir_Kind_Interface_Constant_Declaration
| Iir_Kind_Constant_Declaration
| Iir_Kind_File_Declaration
| Iir_Kind_Interface_File_Declaration
| Iir_Kind_Object_Alias_Declaration =>
declare
Targ : constant Value_Acc := Get_Value (Syn_Inst, Pfx);
begin
Dest_Voff := No_Net;
Dest_Rdwd := 0;
Dest_Type := Targ.Typ;
if Targ.Kind = Value_Alias then
-- Replace alias by the aliased name.
Dest_Obj := Targ.A_Obj;
Dest_Off := Targ.A_Off;
else
Dest_Obj := Targ;
Dest_Off := 0;
end if;
end;
when Iir_Kind_Function_Call =>
Dest_Obj := Synth_Expression (Syn_Inst, Pfx);
Dest_Off := 0;
Dest_Voff := No_Net;
Dest_Rdwd := 0;
Dest_Type := Dest_Obj.Typ;
when Iir_Kind_Indexed_Name =>
declare
Voff : Net;
Off : Uns32;
W : Width;
Dest_W : Width;
begin
Synth_Assignment_Prefix
(Syn_Inst, Get_Prefix (Pfx),
Dest_Obj, Dest_Off, Dest_Voff, Dest_Rdwd, Dest_Type);
Strip_Const (Dest_Obj);
Dest_W := Dest_Type.W;
Synth_Indexed_Name (Syn_Inst, Pfx, Dest_Type, Voff, Off, W);
Dest_Type := Get_Array_Element (Dest_Type);
if Voff /= No_Net then
if Dest_Off /= 0 then
-- TODO: add addidx (addoff ?)
if Off /= 0 or else Dest_Type.W /= 1 then
raise Internal_Error;
end if;
else
Dest_Off := Off;
end if;
if Dest_Voff = No_Net then
Dest_Voff := Voff;
Dest_Rdwd := Dest_W;
else
Dest_Voff := Build_Addidx
(Get_Build (Syn_Inst), Dest_Voff, Voff);
end if;
else
if Dest_Voff = No_Net then
Dest_Off := Dest_Off + Off;
Strip_Const (Dest_Obj);
if Dest_Obj.Kind in Value_Array .. Value_Const_Array then
Dest_Obj := Dest_Obj.Arr.V
(Iir_Index32 ((Dest_W - Dest_Off) / W));
Dest_Off := 0;
Dest_W := W;
end if;
else
if Dest_Off /= 0 then
-- TODO.
raise Internal_Error;
end if;
Dest_Off := Dest_Off + Off;
end if;
end if;
end;
when Iir_Kind_Selected_Element =>
declare
Idx : constant Iir_Index32 :=
Get_Element_Position (Get_Named_Entity (Pfx));
begin
Synth_Assignment_Prefix
(Syn_Inst, Get_Prefix (Pfx),
Dest_Obj, Dest_Off, Dest_Voff, Dest_Rdwd, Dest_Type);
if Dest_Off /= 0 and then Dest_Voff /= No_Net then
-- TODO.
raise Internal_Error;
end if;
Strip_Const (Dest_Obj);
if Dest_Obj.Kind = Value_Const_Record then
pragma Assert (Dest_Off = 0);
Dest_Obj := Dest_Obj.Rec.V (Idx + 1);
else
Dest_Off := Dest_Off + Dest_Type.Rec.E (Idx + 1).Off;
end if;
Dest_Type := Dest_Type.Rec.E (Idx + 1).Typ;
end;
when Iir_Kind_Slice_Name =>
declare
Pfx_Bnd : Bound_Type;
El_Typ : Type_Acc;
Res_Bnd : Bound_Type;
Sl_Voff : Net;
Sl_Off : Uns32;
Wd : Uns32;
begin
Synth_Assignment_Prefix
(Syn_Inst, Get_Prefix (Pfx),
Dest_Obj, Dest_Off, Dest_Voff, Dest_Rdwd, Dest_Type);
Strip_Const (Dest_Obj);
Get_Onedimensional_Array_Bounds (Dest_Type, Pfx_Bnd, El_Typ);
Synth_Slice_Suffix (Syn_Inst, Pfx, Pfx_Bnd, El_Typ.W,
Res_Bnd, Sl_Voff, Sl_Off, Wd);
if Sl_Voff /= No_Net then
-- Variable slice.
Dest_Off := Dest_Off + Sl_Off;
if Dest_Voff /= No_Net then
Dest_Voff := Build_Addidx
(Get_Build (Syn_Inst), Dest_Voff, Sl_Voff);
else
Dest_Rdwd := Dest_Type.W;
Dest_Voff := Sl_Voff;
end if;
Dest_Type := Create_Slice_Type (Wd, El_Typ);
else
-- Fixed slice.
Dest_Type :=
Create_Onedimensional_Array_Subtype (Dest_Type, Res_Bnd);
if Dest_Voff /= No_Net then
-- Slice of a memory.
if Dest_Off /= 0 then
raise Internal_Error;
end if;
Dest_Off := Sl_Off;
else
if Dest_Obj.Kind in Value_Array .. Value_Const_Array then
declare
Arr : Value_Array_Acc;
Off : Iir_Index32;
begin
pragma Assert (Dest_Off = 0);
Arr := Create_Value_Array
(Iir_Index32 (Res_Bnd.Len));
case Pfx_Bnd.Dir is
when Iir_To =>
Off := Iir_Index32
(Res_Bnd.Left - Pfx_Bnd.Left);
when Iir_Downto =>
Off := Iir_Index32
(Pfx_Bnd.Left - Res_Bnd.Left);
end case;
Arr.V := Dest_Obj.Arr.V
(Off + 1 .. Off + Iir_Index32 (Res_Bnd.Len));
if Dest_Obj.Kind = Value_Array then
Dest_Obj := Create_Value_Array
(Dest_Type, Arr);
else
Dest_Obj := Create_Value_Const_Array
(Dest_Type, Arr);
end if;
end;
else
-- Slice of a vector.
Dest_Off := Dest_Off + Sl_Off;
end if;
end if;
end if;
end;
when Iir_Kind_Implicit_Dereference
| Iir_Kind_Dereference =>
Synth_Assignment_Prefix
(Syn_Inst, Get_Prefix (Pfx),
Dest_Obj, Dest_Off, Dest_Voff, Dest_Rdwd, Dest_Type);
if Dest_Off /= 0 and then Dest_Voff /= No_Net then
raise Internal_Error;
end if;
Dest_Obj := Heap.Synth_Dereference (Dest_Obj.Acc);
Dest_Type := Dest_Obj.Typ;
when others =>
Error_Kind ("synth_assignment_prefix", Pfx);
end case;
end Synth_Assignment_Prefix;
type Target_Kind is
(Target_Simple, Target_Aggregate, Target_Memory);
type Target_Info (Kind : Target_Kind := Target_Simple) is record
-- In all cases, the type of the target is known or computed.
Targ_Type : Type_Acc;
case Kind is
when Target_Simple =>
-- For a simple target, the destination is known.
Obj : Value_Acc;
Off : Uns32;
when Target_Aggregate =>
-- For an aggregate: the type is computed and the details will
-- be handled at the assignment.
Aggr : Node;
when Target_Memory =>
-- For a memory: the destination is known.
Mem_Obj : Value_Acc;
-- The dynamic offset.
Mem_Voff : Net;
-- Offset of the memory in the wire (usually 0).
Mem_Moff : Uns32;
-- Width of the whole memory
Mem_Mwidth : Width;
-- Offset of the data to be accessed from the memory.
Mem_Doff : Uns32;
end case;
end record;
type Target_Info_Array is array (Natural range <>) of Target_Info;
function Synth_Target (Syn_Inst : Synth_Instance_Acc;
Target : Node) return Target_Info is
begin
case Get_Kind (Target) is
when Iir_Kind_Aggregate =>
declare
Targ_Type : constant Node := Get_Type (Target);
Base_Typ : Type_Acc;
Bnd : Bound_Type;
begin
Base_Typ :=
Get_Value_Type (Syn_Inst, Get_Base_Type (Targ_Type));
case Base_Typ.Kind is
when Type_Unbounded_Vector =>
Bnd := Expr.Synth_Array_Bounds (Syn_Inst, Targ_Type, 0);
return Target_Info' (Kind => Target_Aggregate,
Targ_Type => Create_Vector_Type
(Bnd, Base_Typ.Uvec_El),
Aggr => Target);
when others =>
raise Internal_Error;
end case;
end;
when Iir_Kind_Simple_Name
| Iir_Kind_Selected_Element
| Iir_Kind_Interface_Signal_Declaration
| Iir_Kind_Variable_Declaration
| Iir_Kind_Signal_Declaration
| Iir_Kind_Anonymous_Signal_Declaration
| Iir_Kind_Indexed_Name
| Iir_Kind_Slice_Name
| Iir_Kind_Dereference =>
declare
Obj : Value_Acc;
Off : Uns32;
Typ : Type_Acc;
Voff : Net;
Rdwd : Width;
begin
Synth_Assignment_Prefix (Syn_Inst, Target,
Obj, Off, Voff, Rdwd, Typ);
if Voff = No_Net then
-- FIXME: check index.
return Target_Info'(Kind => Target_Simple,
Targ_Type => Typ,
Obj => Obj,
Off => Off);
else
return Target_Info'(Kind => Target_Memory,
Targ_Type => Typ,
Mem_Obj => Obj,
Mem_Mwidth => Rdwd,
Mem_Moff => 0,
Mem_Voff => Voff,
Mem_Doff => Off);
end if;
end;
when others =>
Error_Kind ("synth_target", Target);
end case;
end Synth_Target;
procedure Assign_Value (Targ : Value_Acc; Val : Value_Acc; Loc : Node) is
begin
case Targ.Kind is
when Value_Discrete =>
Targ.Scal := Val.Scal;
when Value_Access =>
Targ.Acc := Val.Acc;
when Value_Const_Array
| Value_Array =>
declare
Len : constant Iir_Index32 := Val.Arr.Len;
begin
for I in 1 .. Len loop
Assign_Value (Targ.Arr.V (Targ.Arr.Len - Len + I),
Val.Arr.V (I), Loc);
end loop;
end;
when Value_Const_Record
| Value_Record =>
for I in Targ.Rec.V'Range loop
Assign_Value (Targ.Rec.V (I), Val.Rec.V (I), Loc);
end loop;
when others =>
raise Internal_Error;
end case;
end Assign_Value;
procedure Synth_Assignment (Syn_Inst : Synth_Instance_Acc;
Target : Target_Info;
Val : Value_Acc;
Loc : Node) is
begin
case Target.Kind is
when Target_Aggregate =>
Synth_Assignment_Aggregate
(Syn_Inst, Target.Aggr, Target.Targ_Type, Val, Loc);
when Target_Simple =>
if Target.Obj.Kind = Value_Wire then
Synth_Assign (Target.Obj.W, Target.Targ_Type,
Val, Target.Off, Loc);
else
if not Is_Static (Val) then
-- Maybe the error message is too cryptic ?
Error_Msg_Synth
(+Loc, "cannot assign a net to a static value");
else
pragma Assert (Target.Off = 0);
Assign_Value (Target.Obj, Strip_Const (Val), Loc);
end if;
end if;
when Target_Memory =>
declare
V : Net;
begin
V := Get_Current_Assign_Value
(Get_Build (Syn_Inst), Target.Mem_Obj.W, Target.Mem_Moff,
Target.Mem_Mwidth);
V := Build_Dyn_Insert (Get_Build (Syn_Inst), V, Get_Net (Val),
Target.Mem_Voff, Target.Mem_Doff);
Set_Location (V, Loc);
Synth_Assign
(Target.Mem_Obj.W, Target.Targ_Type,
Create_Value_Net (V, Target.Targ_Type),
Target.Mem_Moff, Loc);
end;
end case;
end Synth_Assignment;
procedure Synth_Assignment (Syn_Inst : Synth_Instance_Acc;
Target : Node;
Val : Value_Acc;
Loc : Node)
is
Info : Target_Info;
begin
Info := Synth_Target (Syn_Inst, Target);
Synth_Assignment (Syn_Inst, Info, Val, Loc);
end Synth_Assignment;
function Synth_Read_Memory (Syn_Inst : Synth_Instance_Acc;
Obj : Value_Acc;
Off : Uns32;
Voff : Net;
Typ : Type_Acc;
Loc : Node) return Value_Acc
is
N : Net;
begin
if Voff /= No_Net then
N := Get_Net (Obj);
Synth.Source.Set_Location_Maybe (N, Loc);
N := Build_Dyn_Extract (Get_Build (Syn_Inst), N, Voff, Off, Typ.W);
else
pragma Assert (not Is_Static (Obj));
if Off = 0
and then Typ.W = Obj.Typ.W
and then Typ /= Get_Array_Element (Obj.Typ)
then
-- Nothing to do if extracting the whole object as a slice.
return Obj;
end if;
N := Build_Extract (Get_Build (Syn_Inst), Get_Net (Obj), Off, Typ.W);
end if;
Set_Location (N, Loc);
return Create_Value_Net (N, Typ);
end Synth_Read_Memory;
function Synth_Read (Syn_Inst : Synth_Instance_Acc;
Targ : Target_Info;
Loc : Node) return Value_Acc
is
N : Net;
begin
if Targ.Kind = Target_Simple then
N := Build2_Extract (Get_Build (Syn_Inst),
Get_Net (Targ.Obj), Targ.Off, Targ.Targ_Type.W);
return Create_Value_Net (N, Targ.Targ_Type);
else
return Synth_Read_Memory (Syn_Inst, Targ.Obj, Targ.Off, No_Net,
Targ.Targ_Type, Loc);
end if;
end Synth_Read;
-- Concurrent or sequential simple signal assignment
procedure Synth_Simple_Signal_Assignment
(Syn_Inst : Synth_Instance_Acc; Stmt : Node)
is
Targ : Target_Info;
Val : Value_Acc;
begin
Targ := Synth_Target (Syn_Inst, Get_Target (Stmt));
Val := Synth_Waveform
(Syn_Inst, Get_Waveform_Chain (Stmt), Targ.Targ_Type);
Synth_Assignment (Syn_Inst, Targ, Val, Stmt);
end Synth_Simple_Signal_Assignment;
procedure Synth_Conditional_Signal_Assignment
(Syn_Inst : Synth_Instance_Acc; Stmt : Node)
is
Targ : Target_Info;
Cond : Node;
Cwf : Node;
Val, Cond_Val : Value_Acc;
First, Last : Net;
V : Net;
begin
Targ := Synth_Target (Syn_Inst, Get_Target (Stmt));
Last := No_Net;
Cwf := Get_Conditional_Waveform_Chain (Stmt);
while Cwf /= Null_Node loop
Val := Synth_Waveform
(Syn_Inst, Get_Waveform_Chain (Cwf), Targ.Targ_Type);
V := Get_Net (Val);
Cond := Get_Condition (Cwf);
if Cond /= Null_Node then
Cond_Val := Synth_Expression (Syn_Inst, Cond);
V := Build_Mux2 (Build_Context,
Get_Net (Cond_Val),
No_Net, V);
Set_Location (V, Cwf);
end if;
if Last /= No_Net then
Connect (Get_Input (Get_Net_Parent (Last), 1), V);
else
First := V;
end if;
Last := V;
Cwf := Get_Chain (Cwf);
end loop;
Val := Create_Value_Net (First, Targ.Targ_Type);
Synth_Assignment (Syn_Inst, Targ, Val, Stmt);
end Synth_Conditional_Signal_Assignment;
procedure Synth_Variable_Assignment
(Syn_Inst : Synth_Instance_Acc; Stmt : Node)
is
Targ : Target_Info;
Val : Value_Acc;
begin
Targ := Synth_Target (Syn_Inst, Get_Target (Stmt));
Val := Synth_Expression_With_Type
(Syn_Inst, Get_Expression (Stmt), Targ.Targ_Type);
Synth_Assignment (Syn_Inst, Targ, Val, Stmt);
end Synth_Variable_Assignment;
procedure Synth_Conditional_Variable_Assignment
(Syn_Inst : Synth_Instance_Acc; Stmt : Node)
is
Target : constant Node := Get_Target (Stmt);
Targ_Type : Type_Acc;
Cond : Node;
Ce : Node;
Val, Cond_Val : Value_Acc;
V : Net;
First, Last : Net;
begin
Targ_Type := Get_Value_Type (Syn_Inst, Get_Type (Target));
Last := No_Net;
Ce := Get_Conditional_Expression_Chain (Stmt);
while Ce /= Null_Node loop
Val := Synth_Expression_With_Type
(Syn_Inst, Get_Expression (Ce), Targ_Type);
V := Get_Net (Val);
Cond := Get_Condition (Ce);
if Cond /= Null_Node then
Cond_Val := Synth_Expression (Syn_Inst, Cond);
V := Build_Mux2 (Build_Context, Get_Net (Cond_Val), No_Net, V);
Set_Location (V, Ce);
end if;
if Last /= No_Net then
Connect (Get_Input (Get_Net_Parent (Last), 1), V);
else
First := V;
end if;
Last := V;
Ce := Get_Chain (Ce);
end loop;
Val := Create_Value_Net (First, Targ_Type);
Synth_Assignment (Syn_Inst, Target, Val, Stmt);
end Synth_Conditional_Variable_Assignment;
procedure Synth_If_Statement (C : in out Seq_Context; 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 (C.Inst, Cond);
if Is_Static (Cond_Val) then
if Cond_Val.Scal = 1 then
-- True.
Synth_Sequential_Statements
(C, 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
(C, Get_Sequential_Statement_Chain (Els));
else
-- Elsif. Handled as a nested if.
Synth_If_Statement (C, Els);
end if;
end if;
end if;
else
Push_Phi;
Synth_Sequential_Statements
(C, 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
(C, Get_Sequential_Statement_Chain (Els));
else
-- Elsif. Handled as a nested if.
Synth_If_Statement (C, Els);
end if;
end if;
Pop_Phi (Phi_False);
Merge_Phis (Get_Build (C.Inst),
Get_Net (Cond_Val), Phi_True, Phi_False, Stmt);
end if;
end Synth_If_Statement;
-- EXPR is a choice, so a locally static literal.
function Convert_To_Uns64 (Syn_Inst : Synth_Instance_Acc; Expr : Node)
return Uns64
is
Expr_Val : Value_Acc;
Vec : Logvec_Array (0 .. 1);
Off : Uns32;
Has_Zx : Boolean;
begin
Expr_Val := Synth_Expression_With_Basetype (Syn_Inst, Expr);
Off := 0;
Has_Zx := False;
Vec := (others => (0, 0));
Value2logvec (Expr_Val, Vec, Off, Has_Zx);
if Has_Zx then
Error_Msg_Synth (+Expr, "meta-values never match");
end if;
return Uns64 (Vec (0).Val) or Shift_Left (Uns64 (Vec (1).Val), 32);
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 Partial_Assign_Array_Acc is access Partial_Assign_Array;
procedure Free_Partial_Assign_Array is new Ada.Unchecked_Deallocation
(Partial_Assign_Array, Partial_Assign_Array_Acc);
procedure Synth_Case_Statement_Dynamic
(C : in out Seq_Context; Stmt : Node; Sel : Value_Acc)
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;
Pasgns : Partial_Assign_Array_Acc;
Nets : Net_Array_Acc;
Nbr_Wires : Natural;
Wires : Wire_Id_Array_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
-- 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 (C, 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);
Choice_Data (Choice_Idx) :=
(Val => Convert_To_Uns64 (C.Inst,
Get_Choice_Expression (Choice)),
Alt => Alt_Idx);
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);
Pasgns := new Partial_Assign_Array (1 .. Int32 (Alts'Last));
Nets := new Net_Array (1 .. Int32 (Alts'Last));
Sel_Net := Get_Net (Sel);
-- For each wire, compute the result.
for I in Wires'Range loop
declare
Wi : constant Wire_Id := Wires (I);
Last_Val : Net;
Res : Net;
Default : Net;
Ch : Natural;
Min_Off, Off : Uns32;
Wd : Width;
List : Partial_Assign_List;
begin
-- Extract the value for each branch.
for I in Alts'Range loop
-- If there is an assignment to Wi in Alt, it will define the
-- value.
if Get_Wire_Id (Alts (I).Asgns) = Wi then
Pasgns (Int32 (I)) := Get_Assign_Partial (Alts (I).Asgns);
Alts (I).Asgns := Get_Assign_Chain (Alts (I).Asgns);
else
Pasgns (Int32 (I)) := No_Partial_Assign;
end if;
end loop;
Partial_Assign_Init (List);
Min_Off := 0;
loop
Off := Min_Off;
-- Extract value of partial assignments to NETS.
Extract_Merge_Partial_Assigns
(Build_Context, Pasgns.all, Nets.all, Off, Wd);
exit when Off = Uns32'Last and Wd = Width'Last;
-- If a branch has no value, use the value before the case.
Last_Val := No_Net;
for I in Nets'Range loop
if Nets (I) = No_Net then
if Last_Val = No_Net then
Last_Val := Get_Current_Assign_Value
(Build_Context, Wi, Off, Wd);
end if;
Nets (I) := Last_Val;
end if;
end loop;
-- Build the map between choices and values.
for J in Annex_Arr'Range loop
Ch := Natural (Annex_Arr (J));
Case_El (J) := (Sel => Choice_Data (Ch).Val,
Val => Nets (Int32 (Choice_Data (Ch).Alt)));
end loop;
-- Extract default value (for missing alternative).
if Others_Alt_Idx /= 0 then
Default := Nets (Int32 (Others_Alt_Idx));
else
Default := No_Net;
end if;
-- Generate the muxes tree.
Synth_Case (Get_Build (C.Inst),
Sel_Net, Case_El.all, Default, Res,
Get_Location (Expr));
Partial_Assign_Append (List, New_Partial_Assign (Res, Off));
Min_Off := Off + Wd;
end loop;
Merge_Partial_Assigns (Build_Context, Wi, List);
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);
Free_Partial_Assign_Array (Pasgns);
Free_Net_Array (Nets);
end Synth_Case_Statement_Dynamic;
procedure Synth_Case_Statement_Static_Array
(C : in out Seq_Context; Stmt : Node; Sel : Value_Acc)
is
Choices : constant Node := Get_Case_Statement_Alternative_Chain (Stmt);
Choice : Node;
Stmts : Node;
Sel_Expr : Node;
Sel_Val : Value_Acc;
begin
-- Synth statements, extract choice value.
Stmts := Null_Node;
Choice := Choices;
loop
pragma Assert (Is_Valid (Choice));
if not Get_Same_Alternative_Flag (Choice) then
Stmts := Get_Associated_Chain (Choice);
end if;
case Get_Kind (Choice) is
when Iir_Kind_Choice_By_Expression =>
Sel_Expr := Get_Choice_Expression (Choice);
Sel_Val := Synth_Expression_With_Basetype (C.Inst, Sel_Expr);
if Is_Equal (Sel_Val, Sel) then
Synth_Sequential_Statements (C, Stmts);
exit;
end if;
when Iir_Kind_Choice_By_Others =>
Synth_Sequential_Statements (C, Stmts);
exit;
when others =>
raise Internal_Error;
end case;
Choice := Get_Chain (Choice);
end loop;
end Synth_Case_Statement_Static_Array;
procedure Synth_Case_Statement_Static_Scalar
(C : in out Seq_Context; Stmt : Node; Sel : Int64)
is
Choices : constant Node := Get_Case_Statement_Alternative_Chain (Stmt);
Choice : Node;
Stmts : Node;
Sel_Expr : Node;
begin
-- Synth statements, extract choice value.
Stmts := Null_Node;
Choice := Choices;
loop
pragma Assert (Is_Valid (Choice));
if not Get_Same_Alternative_Flag (Choice) then
Stmts := Get_Associated_Chain (Choice);
end if;
case Get_Kind (Choice) is
when Iir_Kind_Choice_By_Expression =>
Sel_Expr := Get_Choice_Expression (Choice);
if Vhdl.Evaluation.Eval_Pos (Sel_Expr) = Sel then
Synth_Sequential_Statements (C, Stmts);
exit;
end if;
when Iir_Kind_Choice_By_Others =>
Synth_Sequential_Statements (C, Stmts);
exit;
when Iir_Kind_Choice_By_Range =>
declare
Bnd : Discrete_Range_Type;
Is_In : Boolean;
begin
Synth_Discrete_Range
(C.Inst, Get_Choice_Range (Choice), Bnd);
case Bnd.Dir is
when Iir_To =>
Is_In := Sel >= Bnd.Left and Sel <= Bnd.Right;
when Iir_Downto =>
Is_In := Sel <= Bnd.Left and Sel >= Bnd.Right;
end case;
if Is_In then
Synth_Sequential_Statements (C, Stmts);
exit;
end if;
end;
when others =>
raise Internal_Error;
end case;
Choice := Get_Chain (Choice);
end loop;
end Synth_Case_Statement_Static_Scalar;
procedure Synth_Case_Statement (C : in out Seq_Context; Stmt : Node)
is
Expr : constant Node := Get_Expression (Stmt);
Sel : Value_Acc;
begin
Sel := Synth_Expression_With_Basetype (C.Inst, Expr);
if Is_Static (Sel) then
case Sel.Typ.Kind is
when Type_Bit
| Type_Logic
| Type_Discrete =>
Synth_Case_Statement_Static_Scalar (C, Stmt, Sel.Scal);
when Type_Vector
| Type_Array =>
Synth_Case_Statement_Static_Array (C, Stmt, Sel);
when others =>
raise Internal_Error;
end case;
else
Synth_Case_Statement_Dynamic (C, Stmt, Sel);
end if;
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);
Expr : constant Node := Get_Expression (Stmt);
Choices : constant Node := Get_Selected_Waveform_Chain (Stmt);
Choice : Node;
Targ_Type : Type_Acc;
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
Targ_Type := Get_Value_Type (Syn_Inst, Get_Type (Targ));
-- Create a net for the expression.
Sel := Synth_Expression_With_Basetype (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));
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);
Choice_Data (Choice_Idx) :=
(Val => Convert_To_Uns64 (Syn_Inst,
Get_Choice_Expression (Choice)),
Alt => Alt_Idx);
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);
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 (Get_Build (Syn_Inst),
Sel_Net, Case_El.all, Default, Res,
Get_Location (Expr));
Synth_Assignment (Syn_Inst, Get_Target (Stmt),
Create_Value_Net (Res, Targ_Type),
Stmt);
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;
function Synth_Label (Stmt : Node) return Sname
is
Label : constant Name_Id := Get_Label (Stmt);
begin
if Label = Null_Identifier then
return No_Sname;
else
return New_Sname_User (Label, No_Sname);
end if;
end Synth_Label;
function Is_Copyback_Interface (Inter : Node) return Boolean is
begin
case Iir_Parameter_Modes (Get_Mode (Inter)) is
when Iir_In_Mode =>
return False;
when Iir_Out_Mode | Iir_Inout_Mode =>
return Get_Kind (Inter) = Iir_Kind_Interface_Variable_Declaration;
end case;
end Is_Copyback_Interface;
function Count_Associations (Inter_Chain : Node; Assoc_Chain : Node)
return Natural
is
Assoc : Node;
Assoc_Inter : Node;
Inter : Node;
Nbr_Inout : Natural;
begin
Nbr_Inout := 0;
Assoc := Assoc_Chain;
Assoc_Inter := Inter_Chain;
while Is_Valid (Assoc) loop
Inter := Get_Association_Interface (Assoc, Assoc_Inter);
if Is_Copyback_Interface (Inter) then
Nbr_Inout := Nbr_Inout + 1;
end if;
Next_Association_Interface (Assoc, Assoc_Inter);
end loop;
return Nbr_Inout;
end Count_Associations;
type Association_Iterator is record
Inter : Node;
First_Named_Assoc : Node;
Next_Assoc : Node;
end record;
procedure Association_Iterate_Init (Iterator : out Association_Iterator;
Inter_Chain : Node;
Assoc_Chain : Node) is
begin
Iterator := (Inter => Inter_Chain,
First_Named_Assoc => Null_Node,
Next_Assoc => Assoc_Chain);
end Association_Iterate_Init;
procedure Association_Iterate_Next (Iterator : in out Association_Iterator;
Inter : out Node;
Assoc : out Node)
is
Formal : Node;
begin
Inter := Iterator.Inter;
if Inter = Null_Node then
-- End of iterator.
Assoc := Null_Node;
return;
else
-- Advance to the next interface for the next call.
Iterator.Inter := Get_Chain (Iterator.Inter);
end if;
if Iterator.First_Named_Assoc = Null_Node then
Assoc := Iterator.Next_Assoc;
if Assoc = Null_Node then
-- No more association: open association.
return;
end if;
Formal := Get_Formal (Assoc);
if Formal = Null_Node then
-- Association by position.
-- Update for the next call.
Iterator.Next_Assoc := Get_Chain (Assoc);
return;
end if;
Iterator.First_Named_Assoc := Assoc;
end if;
-- Search by name.
Assoc := Iterator.First_Named_Assoc;
while Assoc /= Null_Node loop
Formal := Get_Formal (Assoc);
pragma Assert (Formal /= Null_Node);
Formal := Get_Interface_Of_Formal (Formal);
if Formal = Inter then
-- Found.
-- Optimize in case assocs are in order.
if Assoc = Iterator.First_Named_Assoc then
Iterator.First_Named_Assoc := Get_Chain (Assoc);
end if;
return;
end if;
Assoc := Get_Chain (Assoc);
end loop;
-- Not found: open association.
return;
end Association_Iterate_Next;
procedure Synth_Subprogram_Association (Subprg_Inst : Synth_Instance_Acc;
Caller_Inst : Synth_Instance_Acc;
Inter_Chain : Node;
Assoc_Chain : Node;
Infos : out Target_Info_Array)
is
pragma Assert (Infos'First = 1);
Inter : Node;
Inter_Type : Type_Acc;
Assoc : Node;
Actual : Node;
Val : Value_Acc;
Nbr_Inout : Natural;
Iterator : Association_Iterator;
Info : Target_Info;
begin
Set_Instance_Const (Subprg_Inst, True);
Nbr_Inout := 0;
-- Process in INTER order.
Association_Iterate_Init (Iterator, Inter_Chain, Assoc_Chain);
loop
Association_Iterate_Next (Iterator, Inter, Assoc);
exit when Inter = Null_Node;
Inter_Type := Get_Value_Type (Caller_Inst, Get_Type (Inter));
case Iir_Parameter_Modes (Get_Mode (Inter)) is
when Iir_In_Mode =>
if Assoc = Null_Node
or else Get_Kind (Assoc) = Iir_Kind_Association_Element_Open
then
Actual := Get_Default_Value (Inter);
Val := Synth_Expression_With_Type
(Subprg_Inst, Actual, Inter_Type);
else
case Get_Kind (Assoc) is
when Iir_Kind_Association_Element_By_Expression =>
Actual := Get_Actual (Assoc);
Val := Synth_Expression_With_Type
(Caller_Inst, Actual, Inter_Type);
when others =>
raise Internal_Error;
end case;
end if;
when Iir_Out_Mode | Iir_Inout_Mode =>
Actual := Get_Actual (Assoc);
Info := Synth_Target (Caller_Inst, Actual);
if Info.Kind /= Target_Simple then
raise Internal_Error;
end if;
case Iir_Kinds_Interface_Object_Declaration (Get_Kind (Inter))
is
when Iir_Kind_Interface_Constant_Declaration =>
raise Internal_Error;
when Iir_Kind_Interface_Variable_Declaration =>
-- Always pass by value.
Nbr_Inout := Nbr_Inout + 1;
Infos (Nbr_Inout) := Info;
if Is_Static (Info.Obj) then
if Info.Off /= 0 then
raise Internal_Error;
end if;
Val := Info.Obj;
else
Val := Synth_Read (Caller_Inst, Info, Assoc);
end if;
when Iir_Kind_Interface_Signal_Declaration =>
-- Always pass by reference (use an alias).
Val := Create_Value_Alias
(Info.Obj, Info.Off, Info.Targ_Type);
when Iir_Kind_Interface_File_Declaration =>
Val := Info.Obj;
when Iir_Kind_Interface_Quantity_Declaration =>
raise Internal_Error;
end case;
end case;
-- FIXME: conversion only for constants, reshape for all.
Val := Synth_Subtype_Conversion (Val, Inter_Type, True, Assoc);
if Get_Instance_Const (Subprg_Inst) and then not Is_Static (Val) then
Set_Instance_Const (Subprg_Inst, False);
end if;
case Iir_Kinds_Interface_Object_Declaration (Get_Kind (Inter)) is
when Iir_Kind_Interface_Constant_Declaration =>
-- Pass by reference.
Create_Object (Subprg_Inst, Inter, Val);
when Iir_Kind_Interface_Variable_Declaration =>
-- Arguments are passed by copy.
if Is_Static (Val) or else Get_Mode (Inter) = Iir_In_Mode then
Val := Unshare (Val, Current_Pool);
else
-- Will be changed to a wire.
null;
end if;
Create_Object (Subprg_Inst, Inter, Val);
when Iir_Kind_Interface_Signal_Declaration =>
Create_Object (Subprg_Inst, Inter, Val);
when Iir_Kind_Interface_File_Declaration =>
Create_Object (Subprg_Inst, Inter, Val);
when Iir_Kind_Interface_Quantity_Declaration =>
raise Internal_Error;
end case;
end loop;
end Synth_Subprogram_Association;
procedure Synth_Subprogram_Association (Subprg_Inst : Synth_Instance_Acc;
Caller_Inst : Synth_Instance_Acc;
Inter_Chain : Node;
Assoc_Chain : Node)
is
Infos : Target_Info_Array (1 .. 0);
pragma Unreferenced (Infos);
begin
Synth_Subprogram_Association (Subprg_Inst, Caller_Inst,
Inter_Chain, Assoc_Chain, Infos);
end Synth_Subprogram_Association;
-- Create wires for out and inout interface variables.
procedure Synth_Subprogram_Association_Wires
(Subprg_Inst : Synth_Instance_Acc; Inter_Chain : Node; Assoc_Chain : Node)
is
Inter : Node;
Assoc : Node;
Val : Value_Acc;
Iterator : Association_Iterator;
Wire : Wire_Id;
begin
-- Process in INTER order.
Association_Iterate_Init (Iterator, Inter_Chain, Assoc_Chain);
loop
Association_Iterate_Next (Iterator, Inter, Assoc);
exit when Inter = Null_Node;
if Get_Mode (Inter) in Iir_Out_Modes
and then Get_Kind (Inter) = Iir_Kind_Interface_Variable_Declaration
then
Val := Get_Value (Subprg_Inst, Inter);
-- Arguments are passed by copy.
Wire := Alloc_Wire (Wire_Variable, Inter);
Set_Wire_Gate (Wire, Get_Net (Val));
Val := Create_Value_Wire (Wire, Val.Typ);
Create_Object_Force (Subprg_Inst, Inter, null);
Create_Object_Force (Subprg_Inst, Inter, Val);
end if;
end loop;
end Synth_Subprogram_Association_Wires;
procedure Synth_Subprogram_Back_Association
(Subprg_Inst : Synth_Instance_Acc;
Caller_Inst : Synth_Instance_Acc;
Inter_Chain : Node;
Assoc_Chain : Node;
Infos : Target_Info_Array)
is
pragma Assert (Infos'First = 1);
Inter : Node;
Assoc : Node;
Assoc_Inter : Node;
Val : Value_Acc;
Nbr_Inout : Natural;
begin
Nbr_Inout := 0;
Assoc := Assoc_Chain;
Assoc_Inter := Inter_Chain;
while Is_Valid (Assoc) loop
Inter := Get_Association_Interface (Assoc, Assoc_Inter);
if Is_Copyback_Interface (Inter) then
if not Get_Whole_Association_Flag (Assoc) then
raise Internal_Error;
end if;
Nbr_Inout := Nbr_Inout + 1;
Val := Get_Value (Subprg_Inst, Inter);
Synth_Assignment (Caller_Inst, Infos (Nbr_Inout), Val, Assoc);
-- Free wire used for out/inout interface variables.
if Val.Kind = Value_Wire then
Phi_Discard_Wires (Val.W, No_Wire_Id);
Free_Wire (Val.W);
end if;
end if;
Next_Association_Interface (Assoc, Assoc_Inter);
end loop;
pragma Assert (Nbr_Inout = Infos'Last);
end Synth_Subprogram_Back_Association;
function Synth_Dynamic_Subprogram_Call (Syn_Inst : Synth_Instance_Acc;
Sub_Inst : Synth_Instance_Acc;
Call : Node;
Infos : Target_Info_Array)
return Value_Acc
is
Imp : constant Node := Get_Implementation (Call);
Is_Func : constant Boolean := Is_Function_Declaration (Imp);
Assoc_Chain : constant Node := Get_Parameter_Association_Chain (Call);
Inter_Chain : constant Node := Get_Interface_Declaration_Chain (Imp);
Bod : constant Node := Get_Subprogram_Body (Imp);
Res : Value_Acc;
C : Seq_Context (Mode_Dynamic);
Wire_Mark : Wire_Id;
Subprg_Phi : Phi_Type;
begin
Mark (Wire_Mark);
C := (Mode => Mode_Dynamic,
Inst => Sub_Inst,
Cur_Loop => null,
W_En => No_Wire_Id,
W_Ret => No_Wire_Id,
W_Val => No_Wire_Id,
Ret_Init => No_Net,
Ret_Value => null,
Ret_Typ => null,
Nbr_Ret => 0);
C.W_En := Alloc_Wire (Wire_Variable, Imp);
C.W_Ret := Alloc_Wire (Wire_Variable, Imp);
if Is_Func then
C.W_Val := Alloc_Wire (Wire_Variable, Imp);
end if;
Push_Phi;
Synth_Subprogram_Association_Wires (Sub_Inst, Inter_Chain, Assoc_Chain);
if Is_Func then
-- Set a default value for the return.
C.Ret_Typ := Get_Value_Type (Syn_Inst, Get_Return_Type (Imp));
Set_Wire_Gate (C.W_Val,
Build_Signal (Build_Context,
New_Internal_Name (Build_Context),
C.Ret_Typ.W));
C.Ret_Init := Build_Const_X (Build_Context, C.Ret_Typ.W);
Phi_Assign (Build_Context, C.W_Val, C.Ret_Init, 0);
end if;
Set_Wire_Gate
(C.W_En, Build_Signal (Build_Context,
New_Internal_Name (Build_Context), 1));
Phi_Assign (Build_Context, C.W_En, Get_Inst_Bit1 (Syn_Inst), 0);
Set_Wire_Gate
(C.W_Ret, Build_Signal (Build_Context,
New_Internal_Name (Build_Context), 1));
Phi_Assign (Build_Context, C.W_Ret, Get_Inst_Bit1 (Syn_Inst), 0);
Decls.Synth_Declarations (C.Inst, Get_Declaration_Chain (Bod), True);
Synth_Sequential_Statements (C, Get_Sequential_Statement_Chain (Bod));
if Is_Func then
if C.Nbr_Ret = 0 then
raise Internal_Error;
elsif C.Nbr_Ret = 1 and then Is_Static (C.Ret_Value) then
Res := C.Ret_Value;
else
Res := Create_Value_Net
(Get_Current_Value (Build_Context, C.W_Val), C.Ret_Value.Typ);
end if;
else
Res := null;
Synth_Subprogram_Back_Association
(C.Inst, Syn_Inst, Inter_Chain, Assoc_Chain, Infos);
end if;
Pop_Phi (Subprg_Phi);
Decls.Finalize_Declarations (C.Inst, Get_Declaration_Chain (Bod), True);
pragma Unreferenced (Infos);
-- Propagate assignments.
Propagate_Phi_Until_Mark (Get_Build (C.Inst), Subprg_Phi, Wire_Mark);
-- Free wires.
Free_Wire (C.W_En);
Free_Wire (C.W_Ret);
if Is_Func then
Free_Wire (C.W_Val);
end if;
Release (Wire_Mark);
return Res;
end Synth_Dynamic_Subprogram_Call;
function Synth_Static_Subprogram_Call (Syn_Inst : Synth_Instance_Acc;
Sub_Inst : Synth_Instance_Acc;
Call : Node;
Infos : Target_Info_Array)
return Value_Acc
is
Imp : constant Node := Get_Implementation (Call);
Is_Func : constant Boolean := Is_Function_Declaration (Imp);
Assoc_Chain : constant Node := Get_Parameter_Association_Chain (Call);
Inter_Chain : constant Node := Get_Interface_Declaration_Chain (Imp);
Bod : constant Node := Get_Subprogram_Body (Imp);
Res : Value_Acc;
C : Seq_Context (Mode_Static);
begin
C := (Mode_Static,
Inst => Sub_Inst,
Cur_Loop => null,
S_En => True,
Ret_Value => null,
Ret_Typ => null,
Nbr_Ret => 0);
if Is_Func then
-- Set a default value for the return.
C.Ret_Typ := Get_Value_Type (Syn_Inst, Get_Return_Type (Imp));
end if;
Decls.Synth_Declarations (C.Inst, Get_Declaration_Chain (Bod), True);
Synth_Sequential_Statements (C, Get_Sequential_Statement_Chain (Bod));
if Is_Func then
if C.Nbr_Ret = 0 then
raise Internal_Error;
elsif C.Nbr_Ret = 1 and then Is_Static (C.Ret_Value) then
Res := C.Ret_Value;
else
raise Internal_Error;
end if;
else
Res := null;
Synth_Subprogram_Back_Association
(C.Inst, Syn_Inst, Inter_Chain, Assoc_Chain, Infos);
end if;
Decls.Finalize_Declarations (C.Inst, Get_Declaration_Chain (Bod), True);
pragma Unreferenced (Infos);
return Res;
end Synth_Static_Subprogram_Call;
function Synth_Subprogram_Call
(Syn_Inst : Synth_Instance_Acc; Call : Node) return Value_Acc
is
Imp : constant Node := Get_Implementation (Call);
Is_Func : constant Boolean := Is_Function_Declaration (Imp);
Assoc_Chain : constant Node := Get_Parameter_Association_Chain (Call);
Inter_Chain : constant Node := Get_Interface_Declaration_Chain (Imp);
Bod : constant Node := Get_Subprogram_Body (Imp);
Nbr_Inout : constant Natural :=
Count_Associations (Inter_Chain, Assoc_Chain);
Infos : Target_Info_Array (1 .. Nbr_Inout);
Area_Mark : Areapools.Mark_Type;
Res : Value_Acc;
Sub_Inst : Synth_Instance_Acc;
begin
Areapools.Mark (Area_Mark, Instance_Pool.all);
Sub_Inst := Make_Instance (Syn_Inst, Bod,
New_Internal_Name (Build_Context));
Synth_Subprogram_Association
(Sub_Inst, Syn_Inst, Inter_Chain, Assoc_Chain, Infos);
if not Is_Func then
if Get_Purity_State (Imp) /= Pure then
Set_Instance_Const (Sub_Inst, False);
end if;
end if;
if Get_Instance_Const (Sub_Inst) then
Res := Synth_Static_Subprogram_Call
(Syn_Inst, Sub_Inst, Call, Infos);
else
Res := Synth_Dynamic_Subprogram_Call
(Syn_Inst, Sub_Inst, Call, Infos);
end if;
Free_Instance (Sub_Inst);
Areapools.Release (Area_Mark, Instance_Pool.all);
return Res;
end Synth_Subprogram_Call;
procedure Synth_Implicit_Procedure_Call
(Syn_Inst : Synth_Instance_Acc; Call : Node)
is
Imp : constant Node := Get_Implementation (Call);
Assoc_Chain : constant Node := Get_Parameter_Association_Chain (Call);
Inter_Chain : constant Node := Get_Interface_Declaration_Chain (Imp);
Nbr_Inout : constant Natural :=
Count_Associations (Inter_Chain, Assoc_Chain);
Infos : Target_Info_Array (1 .. Nbr_Inout);
Area_Mark : Areapools.Mark_Type;
Sub_Inst : Synth_Instance_Acc;
begin
Areapools.Mark (Area_Mark, Instance_Pool.all);
Sub_Inst := Make_Instance (Syn_Inst, Imp,
New_Internal_Name (Build_Context));
Synth_Subprogram_Association
(Sub_Inst, Syn_Inst, Inter_Chain, Assoc_Chain, Infos);
Synth.Static_Proc.Synth_Static_Procedure (Sub_Inst, Imp, Call);
Synth_Subprogram_Back_Association
(Sub_Inst, Syn_Inst, Inter_Chain, Assoc_Chain, Infos);
Free_Instance (Sub_Inst);
Areapools.Release (Area_Mark, Instance_Pool.all);
end Synth_Implicit_Procedure_Call;
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);
Res : Value_Acc;
begin
case Get_Implicit_Definition (Imp) is
when Iir_Predefined_None =>
if Get_Foreign_Flag (Imp) then
Error_Msg_Synth
(+Stmt, "call to foreign %n is not supported", +Imp);
else
Res := Synth_Subprogram_Call (Syn_Inst, Call);
pragma Assert (Res = null);
end if;
when others =>
Synth_Implicit_Procedure_Call (Syn_Inst, Call);
end case;
end Synth_Procedure_Call;
function In_Range (Rng : Discrete_Range_Type; V : Int64) return Boolean is
begin
case Rng.Dir is
when Iir_To =>
return V >= Rng.Left and then V <= Rng.Right;
when Iir_Downto =>
return V <= Rng.Left and then V >= Rng.Right;
end case;
end In_Range;
procedure Update_Index (Rng : Discrete_Range_Type; Idx : in out Int64) is
begin
case Rng.Dir is
when Iir_To =>
Idx := Idx + 1;
when Iir_Downto =>
Idx := Idx - 1;
end case;
end Update_Index;
procedure Loop_Control_Init (C : Seq_Context; Stmt : Node)
is
Lc : constant Loop_Context_Acc := C.Cur_Loop;
begin
Mark (C.Cur_Loop.Wire_Mark);
if (Lc.Prev_Loop /= null and then Lc.Prev_Loop.Need_Quit) then
Lc.W_Quit := Alloc_Wire (Wire_Variable, Lc.Loop_Stmt);
Set_Wire_Gate
(Lc.W_Quit, Build_Signal (Get_Build (C.Inst),
New_Internal_Name (Build_Context), 1));
Phi_Assign (Get_Build (C.Inst), Lc.W_Quit, Get_Inst_Bit1 (C.Inst), 0);
end if;
if Get_Exit_Flag (Stmt) or else Get_Next_Flag (Stmt) then
Lc.Saved_En := Get_Current_Value (null, C.W_En);
Lc.Need_Quit := True;
end if;
if Get_Exit_Flag (Stmt) then
-- Exit statement for this loop.
Lc.W_Exit := Alloc_Wire (Wire_Variable, Lc.Loop_Stmt);
Set_Wire_Gate
(Lc.W_Exit, Build_Signal (Get_Build (C.Inst),
New_Internal_Name (Build_Context), 1));
Phi_Assign (Get_Build (C.Inst), Lc.W_Exit, Get_Inst_Bit1 (C.Inst), 0);
end if;
end Loop_Control_Init;
function Loop_Control_And (C : Seq_Context; L, R : Net) return Net
is
B1 : constant Net := Get_Inst_Bit1 (C.Inst);
begin
-- Optimize common cases.
if L = B1 then
return R;
elsif R = B1 then
return L;
else
return Build_Dyadic (Get_Build (C.Inst), Netlists.Gates.Id_And, L, R);
end if;
end Loop_Control_And;
procedure Loop_Control_Update (C : Seq_Context)
is
Lc : constant Loop_Context_Acc := C.Cur_Loop;
Res : Net;
begin
-- Execution continue iff:
-- 1. Loop was enabled (Lc.Saved_En)
Res := Lc.Saved_En;
if Res = No_Net then
-- No loop control.
return;
end if;
-- 2. No return (C.W_Ret)
if C.W_Ret /= No_Wire_Id then
Res := Loop_Control_And (C, Res, Get_Current_Value (null, C.W_Ret));
end if;
-- 3. No exit.
if Lc.W_Exit /= No_Wire_Id then
Res := Loop_Control_And (C, Res, Get_Current_Value (null, Lc.W_Exit));
end if;
-- 4. No quit.
if Lc.W_Quit /= No_Wire_Id then
Res := Loop_Control_And (C, Res, Get_Current_Value (null, Lc.W_Quit));
end if;
Phi_Assign (Get_Build (C.Inst), C.W_En, Res, 0);
end Loop_Control_Update;
procedure Loop_Control_Finish (C : Seq_Context)
is
Lc : constant Loop_Context_Acc := C.Cur_Loop;
Res : Net;
begin
-- Execute continue iff:
-- 1. Loop was enabled (Lc.Saved_En)
Res := Lc.Saved_En;
if Res = No_Net then
-- No loop control.
return;
end if;
-- 2. No return (C.W_Ret)
if C.W_Ret /= No_Wire_Id then
Res := Loop_Control_And (C, Res, Get_Current_Value (null, C.W_Ret));
end if;
-- 3. No quit (C.W_Quit)
if Lc.W_Quit /= No_Wire_Id then
Res := Loop_Control_And (C, Res, Get_Current_Value (null, Lc.W_Quit));
end if;
Phi_Discard_Wires (Lc.W_Quit, Lc.W_Exit);
if Lc.W_Quit /= No_Wire_Id then
Free_Wire (Lc.W_Quit);
end if;
if Lc.W_Exit /= No_Wire_Id then
Free_Wire (Lc.W_Exit);
end if;
Release (C.Cur_Loop.Wire_Mark);
Phi_Assign (Get_Build (C.Inst), C.W_En, Res, 0);
end Loop_Control_Finish;
procedure Synth_Dynamic_Exit_Next_Statement
(C : in out Seq_Context; Stmt : Node)
is
Cond : constant Node := Get_Condition (Stmt);
Is_Exit : constant Boolean := Get_Kind (Stmt) = Iir_Kind_Exit_Statement;
Static_Cond : Boolean;
Loop_Label : Node;
Lc : Loop_Context_Acc;
Cond_Val : Value_Acc;
Phi_True : Phi_Type;
Phi_False : Phi_Type;
begin
if Cond /= Null_Node then
Cond_Val := Synth_Expression (C.Inst, Cond);
Static_Cond := Is_Static_Val (Cond_Val);
if Static_Cond then
if Get_Static_Discrete (Cond_Val) = 0 then
-- Not executed.
return;
end if;
else
Push_Phi;
end if;
end if;
-- Execution is suspended.
Phi_Assign (Get_Build (C.Inst), C.W_En, Get_Inst_Bit0 (C.Inst), 0);
Lc := C.Cur_Loop;
Loop_Label := Get_Loop_Label (Stmt);
if Loop_Label = Null_Node then
Loop_Label := Lc.Loop_Stmt;
else
Loop_Label := Get_Named_Entity (Loop_Label);
end if;
loop
if Lc.Loop_Stmt = Loop_Label then
if Is_Exit then
Phi_Assign (Get_Build (C.Inst), Lc.W_Exit,
Get_Inst_Bit0 (C.Inst), 0);
end if;
exit;
else
Phi_Assign (Get_Build (C.Inst), Lc.W_Quit,
Get_Inst_Bit0 (C.Inst), 0);
end if;
Lc := Lc.Prev_Loop;
end loop;
if Cond /= Null_Node and not Static_Cond then
Pop_Phi (Phi_True);
Push_Phi;
Pop_Phi (Phi_False);
Merge_Phis (Build_Context,
Get_Net (Cond_Val), Phi_True, Phi_False, Stmt);
end if;
end Synth_Dynamic_Exit_Next_Statement;
procedure Synth_Static_Exit_Next_Statement
(C : in out Seq_Context; Stmt : Node)
is
Cond : constant Node := Get_Condition (Stmt);
Is_Exit : constant Boolean := Get_Kind (Stmt) = Iir_Kind_Exit_Statement;
Loop_Label : Node;
Lc : Loop_Context_Acc;
Cond_Val : Value_Acc;
begin
if Cond /= Null_Node then
Cond_Val := Synth_Expression (C.Inst, Cond);
pragma Assert (Is_Static_Val (Cond_Val));
if Get_Static_Discrete (Cond_Val) = 0 then
-- Not executed.
return;
end if;
end if;
-- Execution is suspended.
C.S_En := False;
Lc := C.Cur_Loop;
Loop_Label := Get_Loop_Label (Stmt);
if Loop_Label = Null_Node then
Loop_Label := Lc.Loop_Stmt;
else
Loop_Label := Get_Named_Entity (Loop_Label);
end if;
loop
if Lc.Loop_Stmt = Loop_Label then
if Is_Exit then
Lc.S_Exit := True;
end if;
exit;
else
Lc.S_Quit := True;
end if;
Lc := Lc.Prev_Loop;
end loop;
end Synth_Static_Exit_Next_Statement;
procedure Init_For_Loop_Statement (C : in out Seq_Context;
Stmt : Node;
It_Rng : out Type_Acc;
Val : out Value_Acc)
is
Iterator : constant Node := Get_Parameter_Specification (Stmt);
It_Type : constant Node := Get_Declaration_Type (Iterator);
begin
if It_Type /= Null_Node then
Synth_Subtype_Indication (C.Inst, It_Type);
end if;
-- Initial value.
It_Rng := Get_Value_Type (C.Inst, Get_Type (Iterator));
Val := Create_Value_Discrete (It_Rng.Drange.Left, It_Rng);
Create_Object (C.Inst, Iterator, Val);
end Init_For_Loop_Statement;
procedure Finish_For_Loop_Statement (C : in out Seq_Context;
Stmt : Node)
is
Iterator : constant Node := Get_Parameter_Specification (Stmt);
It_Type : constant Node := Get_Declaration_Type (Iterator);
begin
Destroy_Object (C.Inst, Iterator);
if It_Type /= Null_Node then
Destroy_Object (C.Inst, It_Type);
end if;
end Finish_For_Loop_Statement;
procedure Synth_Dynamic_For_Loop_Statement
(C : in out Seq_Context; Stmt : Node)
is
Stmts : constant Node := Get_Sequential_Statement_Chain (Stmt);
It_Rng : Type_Acc;
Val : Value_Acc;
Lc : aliased Loop_Context (Mode_Dynamic);
begin
Lc := (Mode => Mode_Dynamic,
Prev_Loop => C.Cur_Loop,
Loop_Stmt => Stmt,
Need_Quit => False,
Saved_En => No_Net,
W_Exit => No_Wire_Id,
W_Quit => No_Wire_Id,
Wire_Mark => No_Wire_Id);
C.Cur_Loop := Lc'Unrestricted_Access;
Loop_Control_Init (C, Stmt);
Init_For_Loop_Statement (C, Stmt, It_Rng, Val);
while In_Range (It_Rng.Drange, Val.Scal) loop
Synth_Sequential_Statements (C, Stmts);
Update_Index (It_Rng.Drange, Val.Scal);
Loop_Control_Update (C);
-- Constant exit.
exit when (Get_Current_Value (null, C.W_En) = Get_Inst_Bit0 (C.Inst));
-- FIXME: dynamic exits.
end loop;
Loop_Control_Finish (C);
Finish_For_Loop_Statement (C, Stmt);
C.Cur_Loop := Lc.Prev_Loop;
end Synth_Dynamic_For_Loop_Statement;
procedure Synth_Static_For_Loop_Statement
(C : in out Seq_Context; Stmt : Node)
is
Stmts : constant Node := Get_Sequential_Statement_Chain (Stmt);
It_Rng : Type_Acc;
Val : Value_Acc;
Lc : aliased Loop_Context (Mode_Static);
begin
Lc := (Mode_Static,
Prev_Loop => C.Cur_Loop,
Loop_Stmt => Stmt,
S_Exit => False,
S_Quit => False);
C.Cur_Loop := Lc'Unrestricted_Access;
Init_For_Loop_Statement (C, Stmt, It_Rng, Val);
while In_Range (It_Rng.Drange, Val.Scal) loop
Synth_Sequential_Statements (C, Stmts);
C.S_En := True;
Update_Index (It_Rng.Drange, Val.Scal);
exit when Lc.S_Exit or Lc.S_Quit or C.Nbr_Ret > 0;
end loop;
Finish_For_Loop_Statement (C, Stmt);
C.Cur_Loop := Lc.Prev_Loop;
end Synth_Static_For_Loop_Statement;
procedure Synth_Dynamic_While_Loop_Statement
(C : in out Seq_Context; Stmt : Node)
is
Bit0 : constant Net := Get_Inst_Bit0 (C.Inst);
Stmts : constant Node := Get_Sequential_Statement_Chain (Stmt);
Cond : constant Node := Get_Condition (Stmt);
Val : Value_Acc;
Lc : aliased Loop_Context (Mode_Dynamic);
begin
Lc := (Mode => Mode_Dynamic,
Prev_Loop => C.Cur_Loop,
Loop_Stmt => Stmt,
Need_Quit => False,
Saved_En => No_Net,
W_Exit => No_Wire_Id,
W_Quit => No_Wire_Id,
Wire_Mark => No_Wire_Id);
C.Cur_Loop := Lc'Unrestricted_Access;
Loop_Control_Init (C, Stmt);
loop
if Cond /= Null_Node then
Val := Synth_Expression_With_Type (C.Inst, Cond, Boolean_Type);
if not Is_Static (Val) then
Error_Msg_Synth (+Cond, "loop condition must be static");
exit;
end if;
exit when Val.Scal = 0;
end if;
Synth_Sequential_Statements (C, Stmts);
Loop_Control_Update (C);
-- Exit from the loop if W_Exit/W_Ret/W_Quit = 0
if Lc.W_Exit /= No_Wire_Id
and then Get_Current_Value (null, Lc.W_Exit) = Bit0
then
exit;
end if;
if C.W_Ret /= No_Wire_Id
and then Get_Current_Value (null, C.W_Ret) = Bit0
then
exit;
end if;
if Lc.W_Quit /= No_Wire_Id
and then Get_Current_Value (null, Lc.W_Quit) = Bit0
then
exit;
end if;
end loop;
Loop_Control_Finish (C);
C.Cur_Loop := Lc.Prev_Loop;
end Synth_Dynamic_While_Loop_Statement;
procedure Synth_Static_While_Loop_Statement
(C : in out Seq_Context; Stmt : Node)
is
Stmts : constant Node := Get_Sequential_Statement_Chain (Stmt);
Cond : constant Node := Get_Condition (Stmt);
Val : Value_Acc;
Lc : aliased Loop_Context (Mode_Static);
begin
Lc := (Mode => Mode_Static,
Prev_Loop => C.Cur_Loop,
Loop_Stmt => Stmt,
S_Exit => False,
S_Quit => False);
C.Cur_Loop := Lc'Unrestricted_Access;
loop
if Cond /= Null_Node then
Val := Synth_Expression_With_Type (C.Inst, Cond, Boolean_Type);
pragma Assert (Is_Static (Val));
exit when Val.Scal = 0;
end if;
Synth_Sequential_Statements (C, Stmts);
C.S_En := True;
-- Exit from the loop if S_Exit/S_Quit
exit when Lc.S_Exit or Lc.S_Quit or C.Nbr_Ret > 0;
end loop;
C.Cur_Loop := Lc.Prev_Loop;
end Synth_Static_While_Loop_Statement;
procedure Synth_Return_Statement (C : in out Seq_Context; Stmt : Node)
is
Is_Dyn : constant Boolean := not Get_Instance_Const (C.Inst);
Val : Value_Acc;
Expr : constant Node := Get_Expression (Stmt);
begin
if Expr /= Null_Node then
-- Return in function.
Val := Synth_Expression_With_Type (C.Inst, Expr, C.Ret_Typ);
Val := Synth_Subtype_Conversion (Val, C.Ret_Typ, True, Stmt);
if C.Nbr_Ret = 0 then
C.Ret_Value := Val;
if not Is_Bounded_Type (C.Ret_Typ) then
-- The function was declared with an unconstrained return type.
-- Now that a value has been returned, we know the subtype of
-- the returned values. So adjust it.
-- All the returned values must have the same length.
C.Ret_Typ := Val.Typ;
if Is_Dyn then
Set_Width (Get_Wire_Gate (C.W_Val), C.Ret_Typ.W);
Set_Width (C.Ret_Init, C.Ret_Typ.W);
end if;
end if;
end if;
if Is_Dyn then
Phi_Assign (Get_Build (C.Inst), C.W_Val, Get_Net (Val), 0);
end if;
end if;
if Is_Dyn then
-- The subprogram has returned. Do not execute further statements.
Phi_Assign (Get_Build (C.Inst), C.W_En, Get_Inst_Bit0 (C.Inst), 0);
if C.W_Ret /= No_Wire_Id then
Phi_Assign (Get_Build (C.Inst), C.W_Ret,
Get_Inst_Bit0 (C.Inst), 0);
end if;
end if;
C.Nbr_Ret := C.Nbr_Ret + 1;
end Synth_Return_Statement;
procedure Synth_Sequential_Statements
(C : in out Seq_Context; Stmts : Node)
is
Is_Dyn : constant Boolean := not Get_Instance_Const (C.Inst);
Stmt : Node;
Phi_T, Phi_F : Phi_Type;
Has_Phi : Boolean;
En : Net;
begin
Stmt := Stmts;
while Is_Valid (Stmt) loop
if Is_Dyn then
En := Get_Current_Value (null, C.W_En);
pragma Assert (En /= Get_Inst_Bit0 (C.Inst));
Has_Phi := En /= Get_Inst_Bit1 (C.Inst);
if Has_Phi then
Push_Phi;
end if;
end if;
if Flags.Flag_Trace_Statements then
declare
Name : Name_Id;
Line : Natural;
Col : Natural;
begin
Files_Map.Location_To_Position
(Get_Location (Stmt), Name, Line, Col);
Simple_IO.Put_Line ("Execute statement at "
& Name_Table.Image (Name)
& Natural'Image (Line));
end;
end if;
if Synth.Debugger.Flag_Need_Debug then
Synth.Debugger.Debug_Break (C.Inst, Stmt);
end if;
case Get_Kind (Stmt) is
when Iir_Kind_If_Statement =>
Synth_If_Statement (C, Stmt);
when Iir_Kind_Simple_Signal_Assignment_Statement =>
Synth_Simple_Signal_Assignment (C.Inst, Stmt);
when Iir_Kind_Conditional_Signal_Assignment_Statement =>
Synth_Conditional_Signal_Assignment (C.Inst, Stmt);
when Iir_Kind_Variable_Assignment_Statement =>
Synth_Variable_Assignment (C.Inst, Stmt);
when Iir_Kind_Conditional_Variable_Assignment_Statement =>
Synth_Conditional_Variable_Assignment (C.Inst, Stmt);
when Iir_Kind_Case_Statement =>
Synth_Case_Statement (C, Stmt);
when Iir_Kind_For_Loop_Statement =>
if Is_Dyn then
Synth_Dynamic_For_Loop_Statement (C, Stmt);
else
Synth_Static_For_Loop_Statement (C, Stmt);
end if;
when Iir_Kind_While_Loop_Statement =>
if Is_Dyn then
Synth_Dynamic_While_Loop_Statement (C, Stmt);
else
Synth_Static_While_Loop_Statement (C, Stmt);
end if;
when Iir_Kind_Null_Statement =>
-- Easy
null;
when Iir_Kind_Return_Statement =>
Synth_Return_Statement (C, Stmt);
when Iir_Kind_Procedure_Call_Statement =>
Synth_Procedure_Call (C.Inst, Stmt);
when Iir_Kind_Report_Statement
| Iir_Kind_Assertion_Statement =>
-- TODO ?
null;
when Iir_Kind_Exit_Statement
| Iir_Kind_Next_Statement =>
if Is_Dyn then
Synth_Dynamic_Exit_Next_Statement (C, Stmt);
else
Synth_Static_Exit_Next_Statement (C, Stmt);
end if;
when others =>
Error_Kind ("synth_sequential_statements", Stmt);
end case;
if Is_Dyn then
if Has_Phi then
Pop_Phi (Phi_T);
Push_Phi;
Pop_Phi (Phi_F);
Merge_Phis (Build_Context,
Get_Current_Value (Build_Context, C.W_En),
Phi_T, Phi_F, Stmt);
end if;
if Get_Current_Value (null, C.W_En) = Get_Inst_Bit0 (C.Inst) then
return;
end if;
else
if not C.S_En or C.Nbr_Ret /= 0 then
return;
end if;
end if;
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
(C : in out Seq_Context; 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);
if Cond = Null_Node then
Error_Msg_Synth (+Stmt, "expect wait condition");
return;
end if;
Cond_Val := Synth_Expression (C.Inst, Cond);
Push_Phi;
Synth_Sequential_Statements (C, Get_Chain (Stmt));
Pop_Phi (Phi_True);
Push_Phi;
Pop_Phi (Phi_False);
Merge_Phis (Build_Context, Get_Net (Cond_Val),
Phi_True, Phi_False, Stmt);
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);
Decls_Chain : constant Node := Get_Declaration_Chain (Proc);
Prev_Instance_Pool : constant Areapool_Acc := Instance_Pool;
M : Areapools.Mark_Type;
C_Sname : Sname;
C : Seq_Context (Mode_Dynamic);
begin
if Label = Null_Identifier then
C_Sname := New_Internal_Name (Build_Context, Get_Sname (Syn_Inst));
else
C_Sname := New_Sname_User (Label, Get_Sname (Syn_Inst));
end if;
C := (Mode => Mode_Dynamic,
Inst => Make_Instance (Syn_Inst, Proc, C_Sname),
Cur_Loop => null,
W_En => Alloc_Wire (Wire_Variable, Proc),
W_Ret => No_Wire_Id,
W_Val => No_Wire_Id,
Ret_Init => No_Net,
Ret_Value => null,
Ret_Typ => null,
Nbr_Ret => 0);
Mark (M, Proc_Pool);
Instance_Pool := Proc_Pool'Access;
if Is_Valid (Decls_Chain) then
Synth_Declarations (C.Inst, Decls_Chain);
end if;
Set_Wire_Gate (C.W_En, Build_Signal (Build_Context,
New_Internal_Name (Build_Context),
1));
Phi_Assign (Build_Context, C.W_En, Get_Inst_Bit1 (Syn_Inst), 0);
case Iir_Kinds_Process_Statement (Get_Kind (Proc)) is
when Iir_Kind_Sensitized_Process_Statement =>
Synth_Sequential_Statements
(C, Get_Sequential_Statement_Chain (Proc));
-- FIXME: check sensitivity list.
when Iir_Kind_Process_Statement =>
Synth_Process_Sequential_Statements (C, Proc);
end case;
-- FIXME: free W_En ?
Free_Instance (C.Inst);
Release (M, Proc_Pool);
Instance_Pool := Prev_Instance_Pool;
end Synth_Process_Statement;
function Synth_User_Function_Call
(Syn_Inst : Synth_Instance_Acc; Expr : Node) return Value_Acc is
begin
-- Is it a call to an ieee function ?
declare
Imp : constant Node := Get_Implementation (Expr);
Pkg : constant Node := Get_Parent (Imp);
Unit : Node;
Lib : Node;
begin
if Get_Kind (Pkg) = Iir_Kind_Package_Declaration then
Unit := Get_Parent (Pkg);
if Get_Kind (Unit) = Iir_Kind_Design_Unit then
Lib := Get_Library (Get_Design_File (Unit));
if Get_Identifier (Lib) = Std_Names.Name_Ieee then
Error_Msg_Synth
(+Expr, "unhandled call to an ieee function");
raise Internal_Error;
end if;
end if;
end if;
end;
return Synth_Subprogram_Call (Syn_Inst, Expr);
end Synth_User_Function_Call;
procedure Synth_Concurrent_Assertion_Statement
(Syn_Inst : Synth_Instance_Acc; Stmt : Node)
is
Cond : constant Node := Get_Assertion_Condition (Stmt);
Val : Value_Acc;
Inst : Instance;
begin
Val := Synth_Expression (Syn_Inst, Cond);
if Is_Static (Val) then
if Val.Scal /= 1 then
Error_Msg_Synth (+Stmt, "assertion failure");
end if;
return;
end if;
Inst := Build_Assert (Build_Context, Synth_Label (Stmt), Get_Net (Val));
Set_Location (Inst, Get_Location (Stmt));
end Synth_Concurrent_Assertion_Statement;
procedure Synth_Block_Statement (Syn_Inst : Synth_Instance_Acc; Blk : Node)
is
use Areapools;
Prev_Instance_Pool : constant Areapool_Acc := Instance_Pool;
Blk_Inst : Synth_Instance_Acc;
Blk_Sname : Sname;
M : Areapools.Mark_Type;
begin
-- No support for guard or header.
if Get_Block_Header (Blk) /= Null_Node
or else Get_Guard_Decl (Blk) /= Null_Node
then
raise Internal_Error;
end if;
Blk_Sname := New_Sname_User (Get_Identifier (Blk), Get_Sname (Syn_Inst));
Blk_Inst := Make_Instance (Syn_Inst, Blk, Blk_Sname);
Mark (M, Proc_Pool);
Instance_Pool := Proc_Pool'Access;
Synth_Declarations (Blk_Inst, Get_Declaration_Chain (Blk));
Synth_Concurrent_Statements
(Blk_Inst, Get_Concurrent_Statement_Chain (Blk));
Free_Instance (Blk_Inst);
Release (M, Proc_Pool);
Instance_Pool := Prev_Instance_Pool;
end Synth_Block_Statement;
function Synth_PSL_Expression
(Syn_Inst : Synth_Instance_Acc; Expr : PSL.Types.PSL_Node) return Net
is
use PSL.Types;
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));
end;
when N_Not_Bool =>
return Build_Monadic
(Build_Context, Netlists.Gates.Id_Not,
Synth_PSL_Expression (Syn_Inst, Get_Boolean (Expr)));
when N_And_Bool =>
declare
L : constant PSL_Node := Get_Left (Expr);
R : constant PSL_Node := Get_Right (Expr);
Edge : Net;
begin
-- Handle edge (as it can be in default clock).
if Get_Kind (L) = N_HDL_Expr and then Get_Kind (R) = N_HDL_Expr
then
Edge := Synth_Clock_Edge
(Syn_Inst, Get_HDL_Node (L), Get_HDL_Node (R));
if Edge /= No_Net then
return Edge;
end if;
end if;
if Get_Kind (R) = N_EOS then
-- It is never EOS!
return Build_Const_UB32 (Build_Context, 0, 1);
end if;
return Build_Dyadic
(Build_Context, Netlists.Gates.Id_And,
Synth_PSL_Expression (Syn_Inst, L),
Synth_PSL_Expression (Syn_Inst, R));
end;
when N_Or_Bool =>
return Build_Dyadic
(Build_Context, Netlists.Gates.Id_Or,
Synth_PSL_Expression (Syn_Inst, Get_Left (Expr)),
Synth_PSL_Expression (Syn_Inst, Get_Right (Expr)));
when N_True =>
return Build_Const_UB32 (Build_Context, 1, 1);
when N_False
| N_EOS =>
return Build_Const_UB32 (Build_Context, 0, 1);
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);
-- For each state:
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));
-- For each edge:
E := Get_First_Src_Edge (S);
while E /= No_Edge loop
-- Edge condition.
Cond := Build_Dyadic
(Build_Context, Netlists.Gates.Id_And,
I, Synth_PSL_Expression (Syn_Inst, Get_Edge_Expr (E)));
-- TODO: if EOS is present, then this is a live state.
-- Reverse order for final concatenation.
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_Dff (Syn_Inst : Synth_Instance_Acc;
Stmt : Node;
Next_States : out Net)
is
use Netlists.Gates;
Nbr_States : constant Int32 := Get_PSL_Nbr_States (Stmt);
States : Net;
Init : Net;
Clk : Net;
Clk_Inst : Instance;
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));
-- Check the clock is an edge and extract it.
Clk_Inst := Get_Net_Parent (Clk);
if Get_Id (Clk_Inst) /= Id_Edge then
Error_Msg_Synth (+Stmt, "clock is not an edge");
Next_States := No_Net;
return;
end if;
Clk := Get_Input_Net (Clk_Inst, 0);
-- 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_Net_Parent (States), 1), Next_States);
end Synth_Psl_Dff;
function Synth_Psl_Final
(Syn_Inst : Synth_Instance_Acc; Stmt : Node; Next_States : Net) return Net
is
use PSL.Types;
use PSL.NFAs;
NFA : constant PSL_NFA := Get_PSL_NFA (Stmt);
begin
return Build_Extract_Bit
(Get_Build (Syn_Inst), Next_States,
Uns32 (Get_State_Label (Get_Final_State (NFA))));
end Synth_Psl_Final;
function Synth_Psl_Not_Final
(Syn_Inst : Synth_Instance_Acc; Stmt : Node; Next_States : Net)
return Net is
begin
return Build_Monadic
(Get_Build (Syn_Inst), Netlists.Gates.Id_Not,
Synth_Psl_Final (Syn_Inst, Stmt, Next_States));
end Synth_Psl_Not_Final;
procedure Synth_Psl_Restrict_Directive
(Syn_Inst : Synth_Instance_Acc; Stmt : Node)
is
Next_States : Net;
Res : Net;
Inst : Instance;
begin
-- 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).
Synth_Psl_Dff (Syn_Inst, Stmt, Next_States);
if Next_States /= No_Net then
-- The restriction holds as long as there is a 1 in the NFA state.
Res := Build_Reduce (Build_Context,
Netlists.Gates.Id_Red_Or, Next_States);
Inst := Build_Assume (Build_Context, Synth_Label (Stmt), Res);
Set_Location (Inst, Get_Location (Stmt));
end if;
end Synth_Psl_Restrict_Directive;
procedure Synth_Psl_Cover_Directive
(Syn_Inst : Synth_Instance_Acc; Stmt : Node)
is
Next_States : Net;
Res : Net;
Inst : Instance;
begin
-- Build cover gate.
-- Note: for synthesis, we assume the next state will be correct.
-- (If we assume on States, then the first cycle is ignored).
Synth_Psl_Dff (Syn_Inst, Stmt, Next_States);
if Next_States /= No_Net then
-- The sequence is covered as soon as the final state is reached.
Res := Synth_Psl_Final (Syn_Inst, Stmt, Next_States);
Inst := Build_Cover (Build_Context, Synth_Label (Stmt), Res);
Set_Location (Inst, Get_Location (Stmt));
end if;
end Synth_Psl_Cover_Directive;
procedure Synth_Psl_Assume_Directive
(Syn_Inst : Synth_Instance_Acc; Stmt : Node)
is
Next_States : Net;
Inst : Instance;
begin
-- 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).
Synth_Psl_Dff (Syn_Inst, Stmt, Next_States);
if Next_States /= No_Net then
Inst := Build_Assume
(Build_Context, Synth_Label (Stmt),
Synth_Psl_Not_Final (Syn_Inst, Stmt, Next_States));
Set_Location (Inst, Get_Location (Stmt));
end if;
end Synth_Psl_Assume_Directive;
procedure Synth_Psl_Assert_Directive
(Syn_Inst : Synth_Instance_Acc; Stmt : Node)
is
use PSL.Types;
use PSL.NFAs;
NFA : constant PSL_NFA := Get_PSL_NFA (Stmt);
Active : NFA_State;
Next_States : Net;
Inst : Instance;
Lab : Sname;
begin
-- Build assert gate.
-- Note: for synthesis, we assume the next state will be correct.
-- (If we assert on States, then the first cycle is ignored).
Synth_Psl_Dff (Syn_Inst, Stmt, Next_States);
if Next_States /= No_Net then
Lab := Synth_Label (Stmt);
Inst := Build_Assert
(Build_Context, Lab,
Synth_Psl_Not_Final (Syn_Inst, Stmt, Next_States));
Set_Location (Inst, Get_Location (Stmt));
Active := Get_Active_State (NFA);
if Active /= No_State then
if Lab /= No_Sname then
Lab := New_Sname_User (Std_Names.Name_Cover, Lab);
end if;
Inst := Build_Assert_Cover
(Get_Build (Syn_Inst), Lab,
Build_Extract_Bit (Get_Build (Syn_Inst), Next_States,
Uns32 (Get_State_Label (Active))));
Set_Location (Inst, Get_Location (Stmt));
end if;
end if;
end Synth_Psl_Assert_Directive;
procedure Synth_Generate_Statement_Body (Syn_Inst : Synth_Instance_Acc;
Bod : Node;
Name : Sname;
Iterator : Node := Null_Node;
Iterator_Val : Value_Acc := null)
is
use Areapools;
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, Bod, Name);
Mark (M, Proc_Pool);
Instance_Pool := Proc_Pool'Access;
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_If_Generate_Statement
(Syn_Inst : Synth_Instance_Acc; Stmt : Node)
is
Gen : Node;
Bod : Node;
Icond : Node;
Cond : Value_Acc;
Name : Sname;
begin
Gen := Stmt;
Name := New_Sname_User (Get_Identifier (Stmt), Get_Sname (Syn_Inst));
loop
Icond := Get_Condition (Gen);
if Icond /= Null_Node then
Cond := Synth_Expression (Syn_Inst, Icond);
Strip_Const (Cond);
pragma Assert (Cond.Kind = Value_Discrete);
else
-- It is the else generate.
Cond := null;
end if;
if Cond = null or else Cond.Scal = 1 then
Bod := Get_Generate_Statement_Body (Gen);
Apply_Block_Configuration
(Get_Generate_Block_Configuration (Bod), Bod);
Synth_Generate_Statement_Body (Syn_Inst, Bod, Name);
exit;
end if;
Gen := Get_Generate_Else_Clause (Gen);
exit when Gen = Null_Node;
end loop;
end Synth_If_Generate_Statement;
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);
It_Type : constant Node := Get_Declaration_Type (Iterator);
Config : Node;
It_Rng : Type_Acc;
Val : Value_Acc;
Name : Sname;
Lname : Sname;
begin
if It_Type /= Null_Node then
Synth_Subtype_Indication (Syn_Inst, It_Type);
end if;
-- Initial value.
It_Rng := Get_Value_Type (Syn_Inst, Get_Type (Iterator));
Val := Create_Value_Discrete (It_Rng.Drange.Left, It_Rng);
Name := New_Sname_User (Get_Identifier (Stmt), Get_Sname (Syn_Inst));
while In_Range (It_Rng.Drange, 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;
-- FIXME: get position ?
Lname := New_Sname_Version (Uns32 (Val.Scal), Name);
Synth_Generate_Statement_Body (Syn_Inst, Bod, Lname, Iterator, Val);
Update_Index (It_Rng.Drange, Val.Scal);
end loop;
end Synth_For_Generate_Statement;
procedure Synth_Concurrent_Statement
(Syn_Inst : Synth_Instance_Acc; Stmt : Node) is
begin
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_Kind_Concurrent_Procedure_Call_Statement =>
Push_Phi;
Synth_Procedure_Call (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 =>
Synth_If_Generate_Statement (Syn_Inst, Stmt);
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;
-- Un-apply configuration.
Set_Component_Configuration (Stmt, Null_Node);
else
Synth_Design_Instantiation_Statement (Syn_Inst, Stmt);
end if;
Pop_And_Merge_Phi (Build_Context, Stmt);
when Iir_Kind_Block_Statement =>
Synth_Block_Statement (Syn_Inst, Stmt);
when Iir_Kind_Psl_Default_Clock =>
null;
when Iir_Kind_Psl_Restrict_Directive =>
Synth_Psl_Restrict_Directive (Syn_Inst, Stmt);
when Iir_Kind_Psl_Assume_Directive =>
Synth_Psl_Assume_Directive (Syn_Inst, Stmt);
when Iir_Kind_Psl_Cover_Directive =>
Synth_Psl_Cover_Directive (Syn_Inst, Stmt);
when Iir_Kind_Psl_Assert_Directive =>
Synth_Psl_Assert_Directive (Syn_Inst, Stmt);
when Iir_Kind_Concurrent_Assertion_Statement =>
-- Passive statement.
Synth_Concurrent_Assertion_Statement (Syn_Inst, Stmt);
when others =>
Error_Kind ("synth_concurrent_statement", Stmt);
end case;
end Synth_Concurrent_Statement;
procedure Synth_Concurrent_Statements
(Syn_Inst : Synth_Instance_Acc; Stmts : Node)
is
Stmt : Node;
begin
Stmt := Stmts;
while Is_Valid (Stmt) loop
Synth_Concurrent_Statement (Syn_Inst, Stmt);
Stmt := Get_Chain (Stmt);
end loop;
end Synth_Concurrent_Statements;
procedure Synth_Attribute_Formal (Syn_Inst : Synth_Instance_Acc;
Val : Node;
Id : Netlists.Gates.Formal_Module_Id)
is
Spec : constant Node := Get_Attribute_Specification (Val);
Sig : constant Node := Get_Designated_Entity (Val);
V : Value_Acc;
Targ : Value_Acc;
begin
-- The type must be boolean
if (Get_Base_Type (Get_Type (Val)) /=
Vhdl.Std_Package.Boolean_Type_Definition)
then
Error_Msg_Synth (+Val, "type of attribute %i must be boolean",
(1 => +Get_Attribute_Designator (Spec)));
return;
end if;
-- The designated entity must be a signal.
if Get_Kind (Sig) /= Iir_Kind_Signal_Declaration then
Error_Msg_Synth (+Val, "attribute %i only applies to signals",
(1 => +Get_Attribute_Designator (Spec)));
return;
end if;
-- The value must be true
V := Synth_Expression_With_Type
(Syn_Inst, Get_Expression (Spec), Boolean_Type);
if V.Scal /= 1 then
return;
end if;
declare
Off : Uns32;
Voff : Net;
Wd : Width;
Typ : Type_Acc;
N : Net;
begin
Synth_Assignment_Prefix (Syn_Inst, Sig, Targ, Off, Voff, Wd, Typ);
pragma Assert (Off = 0);
pragma Assert (Voff = No_Net);
pragma Assert (Targ.Kind = Value_Wire);
N := Build_Formal_Input (Get_Build (Syn_Inst), Id, Typ.W);
Add_Conc_Assign (Targ.W, N, 0, Val);
end;
end Synth_Attribute_Formal;
procedure Synth_Attribute_Values
(Syn_Inst : Synth_Instance_Acc; Unit : Node)
is
use Std_Names;
use Netlists.Gates;
Val : Node;
Spec : Node;
Id : Name_Id;
begin
Val := Get_Attribute_Value_Chain (Unit);
while Val /= Null_Node loop
Spec := Get_Attribute_Specification (Val);
Id := Get_Identifier (Get_Attribute_Designator (Spec));
case Id is
when Name_Allconst =>
Synth_Attribute_Formal (Syn_Inst, Val, Id_Allconst);
when Name_Allseq =>
Synth_Attribute_Formal (Syn_Inst, Val, Id_Allseq);
when Name_Anyconst =>
Synth_Attribute_Formal (Syn_Inst, Val, Id_Anyconst);
when Name_Anyseq =>
Synth_Attribute_Formal (Syn_Inst, Val, Id_Anyseq);
when others =>
Warning_Msg_Synth (+Spec, "unhandled attribute %i", (1 => +Id));
end case;
Val := Get_Value_Chain (Val);
end loop;
end Synth_Attribute_Values;
procedure Synth_Verification_Unit
(Syn_Inst : Synth_Instance_Acc; Unit : Node)
is
use Areapools;
Prev_Instance_Pool : constant Areapool_Acc := Instance_Pool;
Unit_Inst : Synth_Instance_Acc;
Unit_Sname : Sname;
M : Areapools.Mark_Type;
Item : Node;
begin
Unit_Sname := New_Sname_User (Get_Identifier (Unit),
Get_Sname (Syn_Inst));
Unit_Inst := Make_Instance (Syn_Inst, Unit, Unit_Sname);
Mark (M, Proc_Pool);
Instance_Pool := Proc_Pool'Access;
Item := Get_Vunit_Item_Chain (Unit);
while Item /= Null_Node loop
case Get_Kind (Item) is
when Iir_Kind_Psl_Default_Clock =>
null;
when Iir_Kind_Psl_Assert_Directive =>
Synth_Psl_Assert_Directive (Unit_Inst, Item);
when Iir_Kind_Psl_Assume_Directive =>
Synth_Psl_Assume_Directive (Unit_Inst, Item);
when Iir_Kind_Psl_Restrict_Directive =>
Synth_Psl_Restrict_Directive (Unit_Inst, Item);
when Iir_Kind_Psl_Cover_Directive =>
Synth_Psl_Cover_Directive (Unit_Inst, Item);
when Iir_Kind_Signal_Declaration
| Iir_Kind_Function_Declaration
| Iir_Kind_Procedure_Declaration
| Iir_Kind_Function_Body
| Iir_Kind_Procedure_Body
| Iir_Kind_Attribute_Declaration
| Iir_Kind_Attribute_Specification =>
Synth_Declaration (Unit_Inst, Item, False);
when Iir_Kind_Concurrent_Simple_Signal_Assignment =>
Synth_Concurrent_Statement (Unit_Inst, Item);
when others =>
Error_Kind ("synth_verification_unit", Item);
end case;
Item := Get_Chain (Item);
end loop;
Synth_Attribute_Values (Unit_Inst, Unit);
Free_Instance (Unit_Inst);
Release (M, Proc_Pool);
Instance_Pool := Prev_Instance_Pool;
end Synth_Verification_Unit;
end Synth.Stmts;