aboutsummaryrefslogtreecommitdiffstats
path: root/src/synth/synth-environment.adb
diff options
context:
space:
mode:
Diffstat (limited to 'src/synth/synth-environment.adb')
-rw-r--r--src/synth/synth-environment.adb308
1 files changed, 45 insertions, 263 deletions
diff --git a/src/synth/synth-environment.adb b/src/synth/synth-environment.adb
index c791c5a2d..001b417ca 100644
--- a/src/synth/synth-environment.adb
+++ b/src/synth/synth-environment.adb
@@ -25,16 +25,7 @@ with Netlists.Utils; use Netlists.Utils;
with Netlists.Folds; use Netlists.Folds;
with Netlists.Inference;
-with Errorout; use Errorout;
-with Name_Table;
-
with Synth.Flags;
-with Synth.Errors; use Synth.Errors;
-with Synth.Source; use Synth.Source;
-with Synth.Vhdl_Context;
-
-with Vhdl.Nodes;
-with Vhdl.Utils;
package body Synth.Environment is
procedure Phi_Assign
@@ -50,15 +41,13 @@ package body Synth.Environment is
return Wire_Id_Table.Table (Wid).Mark_Flag;
end Get_Wire_Mark;
- function Alloc_Wire (Kind : Wire_Kind; Typ : Type_Acc; Obj : Source.Syn_Src)
- return Wire_Id
+ function Alloc_Wire (Kind : Wire_Kind; Decl : Decl_Type) return Wire_Id
is
Res : Wire_Id;
begin
Wire_Id_Table.Append ((Kind => Kind,
Mark_Flag => False,
- Decl => Obj,
- Typ => Typ,
+ Decl => Decl,
Gate => No_Net,
Cur_Assign => No_Seq_Assign,
Final_Assign => No_Conc_Assign,
@@ -118,7 +107,7 @@ package body Synth.Environment is
return Assign_Table.Table (Asgn).Val.Is_Static = True;
end Get_Assign_Is_Static;
- function Get_Assign_Static_Val (Asgn : Seq_Assign) return Memtyp is
+ function Get_Assign_Static_Val (Asgn : Seq_Assign) return Static_Type is
begin
return Assign_Table.Table (Asgn).Val.Val;
end Get_Assign_Static_Val;
@@ -363,23 +352,21 @@ package body Synth.Environment is
Conc_Assign_Table.Table (Asgn).Next := Chain;
end Set_Conc_Chain;
- procedure Add_Conc_Assign
- (Wid : Wire_Id; Val : Net; Off : Uns32; Stmt : Source.Syn_Src)
+ procedure Add_Conc_Assign (Wid : Wire_Id; Val : Net; Off : Uns32)
is
Wire_Rec : Wire_Id_Record renames Wire_Id_Table.Table (Wid);
begin
pragma Assert (Wire_Rec.Kind /= Wire_None);
Conc_Assign_Table.Append ((Next => Wire_Rec.Final_Assign,
Value => Val,
- Offset => Off,
- Stmt => Stmt));
+ Offset => Off));
Wire_Rec.Final_Assign := Conc_Assign_Table.Last;
Wire_Rec.Nbr_Final_Assign := Wire_Rec.Nbr_Final_Assign + 1;
end Add_Conc_Assign;
procedure Pop_And_Merge_Phi_Wire (Ctxt : Builders.Context_Acc;
Asgn_Rec : Seq_Assign_Record;
- Stmt : Source.Syn_Src)
+ Loc : Location_Type)
is
Wid : constant Wire_Id := Asgn_Rec.Id;
Wire_Rec : Wire_Id_Record renames Wire_Id_Table.Table (Wid);
@@ -397,11 +384,11 @@ package body Synth.Environment is
raise Internal_Error;
when True =>
-- Create a net. No inference to do.
- Res := Synth.Vhdl_Context.Get_Memtyp_Net (Ctxt, Asgn_Rec.Val.Val);
+ Res := Static_To_Net (Ctxt, Asgn_Rec.Val.Val);
if Wire_Rec.Kind = Wire_Enable then
Connect (Get_Input (Get_Net_Parent (Outport), 0), Res);
else
- Add_Conc_Assign (Wid, Res, 0, Stmt);
+ Add_Conc_Assign (Wid, Res, 0);
end if;
when False =>
P := Asgn_Rec.Val.Asgns;
@@ -418,16 +405,16 @@ package body Synth.Environment is
pragma Assert (Pa.Offset = 0);
pragma Assert (Pa.Next = No_Partial_Assign);
Res := Inference.Infere_Assert
- (Ctxt, Pa.Value, Outport, Stmt);
+ (Ctxt, Pa.Value, Outport, Loc);
Connect (Get_Input (Get_Net_Parent (Outport), 0), Res);
else
-- Note: lifetime is currently based on the kind of the
-- wire (variable -> not reused beyond this process).
-- This is OK for vhdl but not general.
Res := Inference.Infere
- (Ctxt, Pa.Value, Pa.Offset, Outport, Stmt,
+ (Ctxt, Pa.Value, Pa.Offset, Outport, Loc,
Wire_Rec.Kind = Wire_Variable);
- Add_Conc_Assign (Wid, Res, Pa.Offset, Stmt);
+ Add_Conc_Assign (Wid, Res, Pa.Offset);
end if;
P := Pa.Next;
end;
@@ -438,12 +425,13 @@ package body Synth.Environment is
-- This procedure is called after each concurrent statement to assign
-- values to signals.
procedure Pop_And_Merge_Phi (Ctxt : Builders.Context_Acc;
- Stmt : Source.Syn_Src)
+ Loc : Location_Type)
is
Phi : Phi_Type;
Asgn : Seq_Assign;
begin
Pop_Phi (Phi);
+ -- Must be the last phi.
pragma Assert (Phis_Table.Last = No_Phi_Id);
-- It is possible that the same value is assigned to different targets.
@@ -523,7 +511,7 @@ package body Synth.Environment is
declare
Asgn_Rec : Seq_Assign_Record renames Assign_Table.Table (Asgn);
begin
- Pop_And_Merge_Phi_Wire (Ctxt, Asgn_Rec, Stmt);
+ Pop_And_Merge_Phi_Wire (Ctxt, Asgn_Rec, Loc);
Asgn := Asgn_Rec.Chain;
end;
end loop;
@@ -700,149 +688,6 @@ package body Synth.Environment is
and then Is_Tribuf_Net (N_Val);
end Is_Tribuf_Assignment;
- function Info_Subrange_Vhdl (Off : Width; Wd : Width; Bnd: Bound_Type)
- return String
- is
- function Image (V : Int32) return String
- is
- Res : constant String := Int32'Image (V);
- begin
- if V >= 0 then
- return Res (2 .. Res'Last);
- else
- return Res;
- end if;
- end Image;
- begin
- case Bnd.Dir is
- when Dir_To =>
- if Wd = 1 then
- return Image (Bnd.Right - Int32 (Off));
- else
- return Image (Bnd.Left + Int32 (Bnd.Len - (Off + Wd)))
- & " to "
- & Image (Bnd.Right - Int32 (Off));
- end if;
- when Dir_Downto =>
- if Wd = 1 then
- return Image (Bnd.Right + Int32 (Off));
- else
- return Image (Bnd.Left - Int32 (Bnd.Len - (Off + Wd)))
- & " downto "
- & Image (Bnd.Right + Int32 (Off));
- end if;
- end case;
- end Info_Subrange_Vhdl;
-
- procedure Info_Subnet_Vhdl (Loc : Location_Type;
- Prefix : String;
- Otype : Vhdl.Nodes.Node;
- Typ : Type_Acc;
- Off : Width;
- Wd : Width) is
- begin
- case Typ.Kind is
- when Type_Bit
- | Type_Logic
- | Type_Discrete
- | Type_Float =>
- pragma Assert (Wd = Typ.W);
- pragma Assert (Off = 0);
- Info_Msg_Synth (+Loc, " " & Prefix);
- when Type_File
- | Type_Protected
- | Type_Access
- | Type_Unbounded_Array
- | Type_Unbounded_Record
- | Type_Unbounded_Vector =>
- raise Internal_Error;
- when Type_Vector =>
- pragma Assert (Wd <= Typ.W);
- if Off = 0 and Wd = Typ.W then
- Info_Msg_Synth (+Loc, " " & Prefix);
- else
- Info_Msg_Synth
- (+Loc,
- " " & Prefix
- & "(" & Info_Subrange_Vhdl (Off, Wd, Typ.Vbound) & ")");
- end if;
- when Type_Slice
- | Type_Array =>
- Info_Msg_Synth (+Loc, " " & Prefix & "(??)");
- when Type_Record =>
- declare
- use Vhdl.Nodes;
- Els : constant Iir_Flist :=
- Get_Elements_Declaration_List (Otype);
- begin
- for I in Typ.Rec.E'Range loop
- declare
- El : Rec_El_Type renames Typ.Rec.E (I);
- Field : constant Vhdl.Nodes.Node :=
- Get_Nth_Element (Els, Natural (I - 1));
- Sub_Off : Uns32;
- Sub_Wd : Width;
- begin
- if Off + Wd <= El.Boff then
- -- Not covered anymore.
- exit;
- elsif Off >= El.Boff + El.Typ.W then
- -- Not yet covered.
- null;
- elsif Off <= El.Boff
- and then Off + Wd >= El.Boff + El.Typ.W
- then
- -- Fully covered.
- Info_Msg_Synth
- (+Loc,
- " " & Prefix & '.'
- & Vhdl.Utils.Image_Identifier (Field));
- else
- -- Partially covered.
- if Off < El.Boff then
- Sub_Off := 0;
- Sub_Wd := Wd - (El.Boff - Off);
- Sub_Wd := Width'Min (Sub_Wd, El.Typ.W);
- else
- Sub_Off := Off - El.Boff;
- Sub_Wd := El.Typ.W - (Off - El.Boff);
- Sub_Wd := Width'Min (Sub_Wd, Wd);
- end if;
- Info_Subnet_Vhdl
- (+Loc,
- Prefix & '.' & Vhdl.Utils.Image_Identifier (Field),
- Get_Type (Field), El.Typ, Sub_Off, Sub_Wd);
- end if;
- end;
- end loop;
- end;
- end case;
- end Info_Subnet_Vhdl;
-
- procedure Info_Subnet
- (Decl : Vhdl.Nodes.Node; Typ : Type_Acc; Off : Width; Wd : Width)
- is
- Loc : Location_Type;
- begin
- if Typ = null then
- -- Type is unknown, cannot display more infos.
- return;
- end if;
-
- if Off = 0 and Wd = Typ.W then
- -- Whole object, no need to give details.
- -- TODO: just say it ?
- return;
- end if;
-
- Loc := Vhdl.Nodes.Get_Location (Decl);
- Info_Msg_Synth (+Loc, " this concerns these parts of the signal:");
- Info_Subnet_Vhdl (Loc,
- Name_Table.Image (Vhdl.Nodes.Get_Identifier (Decl)),
- Vhdl.Nodes.Get_Type (Decl),
- Typ, Off, Wd);
- end Info_Subnet;
-
-- Compute the VALUE to be assigned to WIRE_REC. Handle partial
-- assignment, multiple assignments and error cases.
procedure Finalize_Complex_Assignment (Ctxt : Builders.Context_Acc;
@@ -885,23 +730,14 @@ package body Synth.Environment is
Asgn := Get_Conc_Chain (Asgn);
elsif Next_Off > Expected_Off then
-- There is an hole.
- if Next_Off = Expected_Off + 1 then
- Warning_Msg_Synth
- (+Wire_Rec.Decl, "no assignment for offset %v of %n",
- (1 => +Expected_Off, 2 => +Wire_Rec.Decl));
- else
- Warning_Msg_Synth
- (+Wire_Rec.Decl, "no assignment for offsets %v:%v of %n",
- (+Expected_Off, +(Next_Off - 1), +Wire_Rec.Decl));
- end if;
+ Warning_No_Assignment (Wire_Rec.Decl, Expected_Off, Next_Off - 1);
-- Insert conc_assign with initial value.
-- FIXME: handle initial values.
Conc_Assign_Table.Append
((Next => Asgn,
Value => Build_Const_Z (Ctxt, Next_Off - Expected_Off),
- Offset => Expected_Off,
- Stmt => Source.No_Syn_Src));
+ Offset => Expected_Off));
New_Asgn := Conc_Assign_Table.Last;
if Last_Asgn = No_Conc_Assign then
First_Assign := New_Asgn;
@@ -956,13 +792,8 @@ package body Synth.Environment is
Overlap_Wd := Expected_Off - Next_Off;
end if;
- Error_Msg_Synth
- (+Wire_Rec.Decl,
- "multiple assignments for %i offsets %v:%v",
- (+Wire_Rec.Decl,
- +Next_Off, +(Next_Off + Overlap_Wd - 1)));
- Info_Subnet (Wire_Rec.Decl, Wire_Rec.Typ,
- Next_Off, Overlap_Wd);
+ Error_Multiple_Assignments
+ (Wire_Rec.Decl, Next_Off, Next_Off + Overlap_Wd - 1);
if Next_Off + Asgn_Wd < Expected_Off then
-- Remove this assignment
@@ -1003,7 +834,6 @@ package body Synth.Environment is
procedure Finalize_Assignment
(Ctxt : Builders.Context_Acc; Wid : Wire_Id)
is
- use Vhdl.Nodes;
Wire_Rec : Wire_Id_Record renames Wire_Id_Table.Table (Wid);
Gate_Inst : constant Instance := Get_Net_Parent (Wire_Rec.Gate);
Inp : constant Input := Get_Input (Gate_Inst, 0);
@@ -1013,11 +843,8 @@ package body Synth.Environment is
when 0 =>
-- TODO: use initial value ?
-- TODO: fix that in synth-decls.finalize_object.
- if Wire_Rec.Decl /= Null_Node
- and then Wire_Rec.Kind = Wire_Output
- then
- Warning_Msg_Synth
- (+Wire_Rec.Decl, "no assignment for %n", +Wire_Rec.Decl);
+ if Wire_Rec.Kind = Wire_Output then
+ Warning_No_Assignment (Wire_Rec.Decl, 1, 0);
if Get_Id (Gate_Inst) = Gates.Id_Iinout then
Value := Get_Input_Net (Gate_Inst, 1);
else
@@ -1154,7 +981,7 @@ package body Synth.Environment is
end case;
if Asgn_Rec.Val.Is_Static = True then
- return Synth.Vhdl_Context.Get_Memtyp_Net (Ctxt, Asgn_Rec.Val.Val);
+ return Static_To_Net (Ctxt, Asgn_Rec.Val.Val);
end if;
-- Cannot be empty.
@@ -1217,7 +1044,7 @@ package body Synth.Environment is
-- If the current value is static, just return it.
if Get_Assign_Is_Static (First_Seq) then
- return Vhdl_Context.Get_Partial_Memtyp_Net
+ return Partial_Static_To_Net
(Ctxt, Get_Assign_Static_Val (First_Seq), Off, Wd);
end if;
@@ -1305,7 +1132,7 @@ package body Synth.Environment is
end if;
if Get_Assign_Is_Static (Seq) then
-- Extract from static value.
- Append (Vec, Vhdl_Context.Get_Partial_Memtyp_Net
+ Append (Vec, Partial_Static_To_Net
(Ctxt, Get_Assign_Static_Val (Seq),
Cur_Off, Cur_Wd));
exit;
@@ -1353,7 +1180,7 @@ package body Synth.Environment is
null;
when True =>
declare
- P_Wd : constant Width := P (I).Val.Typ.W;
+ P_Wd : constant Width := Get_Width (P (I).Val); --.Typ.W;
begin
if Min_Off >= P_Wd then
-- No net can be beyond the width.
@@ -1418,8 +1245,7 @@ package body Synth.Environment is
when Unknown =>
null;
when True =>
- N (I) := Vhdl_Context.Get_Partial_Memtyp_Net
- (Ctxt, P (I).Val, Off, Wd);
+ N (I) := Partial_Static_To_Net (Ctxt, P (I).Val, Off, Wd);
when False =>
if Get_Partial_Offset (P (I).Asgns) <= Off then
declare
@@ -1448,51 +1274,6 @@ package body Synth.Environment is
end loop;
end Extract_Merge_Partial_Assigns;
- function Is_Assign_Value_Array_Static
- (Wid : Wire_Id; Arr : Seq_Assign_Value_Array) return Memtyp
- is
- Res : Memtyp;
- Prev_Val : Memtyp;
- begin
- Prev_Val := Null_Memtyp;
- for I in Arr'Range loop
- case Arr (I).Is_Static is
- when False =>
- -- A value is not static.
- return Null_Memtyp;
- when Unknown =>
- if Prev_Val = Null_Memtyp then
- -- First use of previous value.
- if not Is_Static_Wire (Wid) then
- -- The previous value is not static.
- return Null_Memtyp;
- end if;
- Prev_Val := Get_Static_Wire (Wid);
- if Res /= Null_Memtyp then
- -- There is already a result.
- if not Is_Equal (Res, Prev_Val) then
- -- The previous value is different from the result.
- return Null_Memtyp;
- end if;
- else
- Res := Prev_Val;
- end if;
- end if;
- when True =>
- if Res = Null_Memtyp then
- -- First value. Keep it.
- Res := Arr (I).Val;
- else
- if not Is_Equal (Res, Arr (I).Val) then
- -- Value is different.
- return Null_Memtyp;
- end if;
- end if;
- end case;
- end loop;
- return Res;
- end Is_Assign_Value_Array_Static;
-
procedure Partial_Assign_Init (List : out Partial_Assign_List) is
begin
List := (First | Last => No_Partial_Assign);
@@ -1528,7 +1309,7 @@ package body Synth.Environment is
Sel : Net;
F_Asgns : Seq_Assign_Value;
T_Asgns : Seq_Assign_Value;
- Stmt : Source.Syn_Src)
+ Loc : Location_Type)
is
use Netlists.Gates;
use Netlists.Gates_Ports;
@@ -1588,11 +1369,11 @@ package body Synth.Environment is
Res := N1_Net;
Disconnect (N1_Sel);
N1_Sel_Net := Build_Dyadic (Ctxt, Id_And, Sel, N1_Sel_Net);
- Set_Location (N1_Sel_Net, Stmt);
+ Set_Location (N1_Sel_Net, Loc);
Connect (N1_Sel, N1_Sel_Net);
else
Res := Build_Dyadic (Ctxt, Id_And, Sel, N1_Sel_Net);
- Set_Location (Res, Stmt);
+ Set_Location (Res, Loc);
Res := Build_Mux2
(Ctxt, Res, N (0), Get_Driver (Get_Mux2_I1 (N1_Inst)));
end if;
@@ -1604,7 +1385,7 @@ package body Synth.Environment is
else
Res := Build_Mux2 (Ctxt, Sel, N (0), N (1));
end if;
- Set_Location (Res, Stmt);
+ Set_Location (Res, Loc);
-- Keep the result in a list.
Pasgn := New_Partial_Assign (Res, Off);
@@ -1622,7 +1403,7 @@ package body Synth.Environment is
function Merge_Static_Assigns (Wid : Wire_Id; Tv, Fv : Seq_Assign_Value)
return Boolean
is
- Prev : Memtyp;
+ Prev : Static_Type;
begin
-- First case: both TV and FV are static.
if Tv.Is_Static = True and then Fv.Is_Static = True then
@@ -1673,7 +1454,7 @@ package body Synth.Environment is
procedure Merge_Phis (Ctxt : Builders.Context_Acc;
Sel : Net;
T, F : Phi_Type;
- Stmt : Source.Syn_Src)
+ Loc : Location_Type)
is
T_Asgns : Seq_Assign;
F_Asgns : Seq_Assign;
@@ -1717,7 +1498,7 @@ package body Synth.Environment is
Merge_Partial_Assignments (Ctxt, Fv);
Merge_Partial_Assignments (Ctxt, Tv);
if not Merge_Static_Assigns (W, Tv, Fv) then
- Merge_Assigns (Ctxt, W, Sel, Fv, Tv, Stmt);
+ Merge_Assigns (Ctxt, W, Sel, Fv, Tv, Loc);
end if;
end loop;
@@ -1745,8 +1526,11 @@ package body Synth.Environment is
Phi_Append_Assign (Phis_Table.Table (Phis_Table.Last), Asgn);
end Phi_Append_Assign;
- function Phi_Enable (Ctxt : Builders.Context_Acc; Loc : Source.Syn_Src)
- return Net
+ function Phi_Enable (Ctxt : Builders.Context_Acc;
+ Decl : Decl_Type;
+ Val_0 : Static_Type;
+ Val_1 : Static_Type;
+ Loc : Location_Type) return Net
is
Last : constant Phi_Id := Phis_Table.Last;
Wid : Wire_Id;
@@ -1765,7 +1549,7 @@ package body Synth.Environment is
-- Cached value.
Wid := Phis_Table.Table (Last).En;
if Wid = No_Wire_Id then
- Wid := Alloc_Wire (Wire_Enable, Bit_Type, Loc);
+ Wid := Alloc_Wire (Wire_Enable, Decl);
Phis_Table.Table (Last).En := Wid;
-- Create the Enable gate.
@@ -1780,13 +1564,13 @@ package body Synth.Environment is
Id => Wid,
Prev => No_Seq_Assign,
Chain => No_Seq_Assign,
- Val => (Is_Static => True, Val => Bit0)));
+ Val => (Is_Static => True, Val => Val_0)));
Asgn := Assign_Table.Last;
Wire_Id_Table.Table (Wid).Cur_Assign := Asgn;
Phi_Append_Assign (Phis_Table.Table (No_Phi_Id + 1), Asgn);
-- Assign to '1'.
- Phi_Assign_Static (Wid, Bit1);
+ Phi_Assign_Static (Wid, Val_1);
return N;
else
return Get_Current_Value (Ctxt, Wid);
@@ -1995,7 +1779,7 @@ package body Synth.Environment is
N : Net;
Pa : Partial_Assign;
begin
- N := Synth.Vhdl_Context.Get_Memtyp_Net (Ctxt, Asgn_Rec.Val.Val);
+ N := Static_To_Net (Ctxt, Asgn_Rec.Val.Val);
Pa := New_Partial_Assign (N, 0);
Asgn_Rec.Val := (Is_Static => False, Asgns => Pa);
end;
@@ -2015,7 +1799,7 @@ package body Synth.Environment is
Phi_Assign (Ctxt, Dest, Pasgn);
end Phi_Assign_Net;
- procedure Phi_Assign_Static (Dest : Wire_Id; Val : Memtyp)
+ procedure Phi_Assign_Static (Dest : Wire_Id; Val : Static_Type)
is
Wire_Rec : Wire_Id_Record renames Wire_Id_Table.Table (Dest);
pragma Assert (Wire_Rec.Kind /= Wire_None);
@@ -2052,7 +1836,7 @@ package body Synth.Environment is
return Get_Assign_Is_Static (Wire_Rec.Cur_Assign);
end Is_Static_Wire;
- function Get_Static_Wire (Wid : Wire_Id) return Memtyp
+ function Get_Static_Wire (Wid : Wire_Id) return Static_Type
is
Wire_Rec : Wire_Id_Record renames Wire_Id_Table.Table (Wid);
begin
@@ -2061,8 +1845,7 @@ package body Synth.Environment is
begin
Wire_Id_Table.Append ((Kind => Wire_None,
Mark_Flag => False,
- Decl => Source.No_Syn_Src,
- Typ => null,
+ Decl => <>,
Gate => No_Net,
Cur_Assign => No_Seq_Assign,
Final_Assign => No_Conc_Assign,
@@ -2090,7 +1873,6 @@ begin
Conc_Assign_Table.Append ((Next => No_Conc_Assign,
Value => No_Net,
- Offset => 0,
- Stmt => Source.No_Syn_Src));
+ Offset => 0));
pragma Assert (Conc_Assign_Table.Last = No_Conc_Assign);
end Synth.Environment;