diff options
Diffstat (limited to 'src/synth/synth-vhdl_environment.adb')
| -rw-r--r-- | src/synth/synth-vhdl_environment.adb | 213 |
1 files changed, 213 insertions, 0 deletions
diff --git a/src/synth/synth-vhdl_environment.adb b/src/synth/synth-vhdl_environment.adb new file mode 100644 index 000000000..c7f7daccc --- /dev/null +++ b/src/synth/synth-vhdl_environment.adb @@ -0,0 +1,213 @@ +-- Environment definition for 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, see <gnu.org/licenses>. + +with Name_Table; +with Errorout; use Errorout; + +with Vhdl.Nodes; use Vhdl.Nodes; +with Vhdl.Errors; use Vhdl.Errors; +with Vhdl.Utils; + +with Synth.Errors; use Synth.Errors; +with Synth.Vhdl_Context; use Synth.Vhdl_Context; + +package body Synth.Vhdl_Environment is + function Get_Bitwidth (Val : Memtyp) return Uns32 is + begin + return Val.Typ.W; + end Get_Bitwidth; + + function Memtyp_To_Net (Ctxt : Builders.Context_Acc; Val : Memtyp) + return Net is + begin + return Get_Memtyp_Net (Ctxt, Val); + end Memtyp_To_Net; + + function Partial_Memtyp_To_Net + (Ctxt : Builders.Context_Acc; Val : Memtyp; Off : Uns32; Wd : Uns32) + return Net is + begin + return Get_Partial_Memtyp_Net (Ctxt, Val, Off, Wd); + end Partial_Memtyp_To_Net; + + procedure Warning_No_Assignment + (Decl : Decl_Type; First_Off : Uns32; Last_Off : Uns32) is + begin + if Last_Off < First_Off then + Warning_Msg_Synth + (+Decl.Obj, "no assignment for %n", +Decl.Obj); + elsif Last_Off = First_Off then + Warning_Msg_Synth (+Decl.Obj, "no assignment for offset %v of %n", + (1 => +First_Off, 2 => +Decl.Obj)); + else + Warning_Msg_Synth (+Decl.Obj, "no assignment for offsets %v:%v of %n", + (+First_Off, +Last_Off, +Decl.Obj)); + end if; + end Warning_No_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 + 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; + + procedure Error_Multiple_Assignments + (Decl : Decl_Type; First_Off : Uns32; Last_Off : Uns32) is + begin + Error_Msg_Synth (+Decl.Obj, "multiple assignments for %i offsets %v:%v", + (+Decl.Obj, +First_Off, +Last_Off)); + Info_Subnet (Decl.Obj, Decl.Typ, First_Off, Last_Off + 1 - First_Off); + end Error_Multiple_Assignments; + +end Synth.Vhdl_Environment; |