diff options
author | Tristan Gingold <tgingold@free.fr> | 2019-11-28 06:26:08 +0100 |
---|---|---|
committer | Tristan Gingold <tgingold@free.fr> | 2019-11-28 06:26:08 +0100 |
commit | 45fd84fcfce9e949223f9e8c537ebb7bb6f2699c (patch) | |
tree | b6fc8613956a952b6223ffecb7cfcfd45c97d732 | |
parent | 51844caf9dbb8efd6a86a12ed21ec3dc17a3b537 (diff) | |
download | ghdl-45fd84fcfce9e949223f9e8c537ebb7bb6f2699c.tar.gz ghdl-45fd84fcfce9e949223f9e8c537ebb7bb6f2699c.tar.bz2 ghdl-45fd84fcfce9e949223f9e8c537ebb7bb6f2699c.zip |
synth: factorize code, move value2logvec to synth-expr.
Fix #1036
-rw-r--r-- | src/synth/synth-context.adb | 83 | ||||
-rw-r--r-- | src/synth/synth-expr.adb | 70 | ||||
-rw-r--r-- | src/synth/synth-expr.ads | 21 | ||||
-rw-r--r-- | src/synth/synth-stmts.adb | 138 |
4 files changed, 116 insertions, 196 deletions
diff --git a/src/synth/synth-context.adb b/src/synth/synth-context.adb index 91f73b484..ef9569c0c 100644 --- a/src/synth/synth-context.adb +++ b/src/synth/synth-context.adb @@ -379,87 +379,6 @@ package body Synth.Context is pragma Unreferenced (Vec2net); - type Logic_32 is record - Val : Uns32; -- AKA aval - Zx : Uns32; -- AKA bval - end record; - - type Digit_Index is new Natural; - type Logvec_Array is array (Digit_Index range <>) of Logic_32; - type Logvec_Array_Acc is access Logvec_Array; - - procedure Free_Logvec_Array is new Ada.Unchecked_Deallocation - (Logvec_Array, Logvec_Array_Acc); - - procedure Value2net (Val : Value_Acc; - Vec : in out Logvec_Array; - Off : in out Uns32; - Has_Zx : in out Boolean) is - begin - if Val.Kind = Value_Const then - Value2net (Val.C_Val, Vec, Off, Has_Zx); - return; - end if; - - case Val.Typ.Kind is - when Type_Bit => - declare - Idx : constant Digit_Index := Digit_Index (Off / 32); - Pos : constant Natural := Natural (Off mod 32); - Va : Uns32; - begin - Va := Uns32 (Val.Scal); - Va := Shift_Left (Va, Pos); - Vec (Idx).Val := Vec (Idx).Val or Va; - Vec (Idx).Zx := 0; - Off := Off + 1; - end; - when Type_Logic => - declare - Idx : constant Digit_Index := Digit_Index (Off / 32); - Pos : constant Natural := Natural (Off mod 32); - Va : Uns32; - Zx : Uns32; - begin - From_Std_Logic (Val.Scal, Va, Zx); - Has_Zx := Has_Zx or Zx /= 0; - Va := Shift_Left (Va, Pos); - Zx := Shift_Left (Zx, Pos); - Vec (Idx).Val := Vec (Idx).Val or Va; - Vec (Idx).Zx := Vec (Idx).Zx or Zx; - Off := Off + 1; - end; - when Type_Discrete => - for I in 0 .. Val.Typ.W - 1 loop - declare - B : constant Uns32 := - Uns32 (Shift_Right (To_Uns64 (Val.Scal), Natural (I))) - and 1; - Idx : constant Digit_Index := Digit_Index (Off / 32); - Pos : constant Natural := Natural (Off mod 32); - begin - Vec (Idx).Val := Vec (Idx).Val or Shift_Left (B, Pos); - end; - Off := Off + 1; - end loop; - when Type_Vector => - -- TODO: optimize off mod 32 = 0. - for I in reverse Val.Arr.V'Range loop - Value2net (Val.Arr.V (I), Vec, Off, Has_Zx); - end loop; - when Type_Array => - for I in reverse Val.Arr.V'Range loop - Value2net (Val.Arr.V (I), Vec, Off, Has_Zx); - end loop; - when Type_Record => - for I in Val.Rec.V'Range loop - Value2net (Val.Rec.V (I), Vec, Off, Has_Zx); - end loop; - when others => - raise Internal_Error; - end case; - end Value2net; - procedure Value2net (Val : Value_Acc; W : Width; Vec : in out Logvec_Array; Res : out Net) is @@ -469,7 +388,7 @@ package body Synth.Context is begin Has_Zx := False; Off := 0; - Value2net (Val, Vec, Off, Has_Zx); + Value2logvec (Val, Vec, Off, Has_Zx); if W = 0 then -- For null range (like the null string literal "") Res := Build_Const_UB32 (Build_Context, 0, 0); diff --git a/src/synth/synth-expr.adb b/src/synth/synth-expr.adb index 627005a88..8724afdc0 100644 --- a/src/synth/synth-expr.adb +++ b/src/synth/synth-expr.adb @@ -121,6 +121,76 @@ package body Synth.Expr is end if; end To_Logic; + + procedure Value2logvec (Val : Value_Acc; + Vec : in out Logvec_Array; + Off : in out Uns32; + Has_Zx : in out Boolean) is + begin + if Val.Kind = Value_Const then + Value2logvec (Val.C_Val, Vec, Off, Has_Zx); + return; + end if; + + case Val.Typ.Kind is + when Type_Bit => + declare + Idx : constant Digit_Index := Digit_Index (Off / 32); + Pos : constant Natural := Natural (Off mod 32); + Va : Uns32; + begin + Va := Uns32 (Val.Scal); + Va := Shift_Left (Va, Pos); + Vec (Idx).Val := Vec (Idx).Val or Va; + Vec (Idx).Zx := 0; + Off := Off + 1; + end; + when Type_Logic => + declare + Idx : constant Digit_Index := Digit_Index (Off / 32); + Pos : constant Natural := Natural (Off mod 32); + Va : Uns32; + Zx : Uns32; + begin + From_Std_Logic (Val.Scal, Va, Zx); + Has_Zx := Has_Zx or Zx /= 0; + Va := Shift_Left (Va, Pos); + Zx := Shift_Left (Zx, Pos); + Vec (Idx).Val := Vec (Idx).Val or Va; + Vec (Idx).Zx := Vec (Idx).Zx or Zx; + Off := Off + 1; + end; + when Type_Discrete => + for I in 0 .. Val.Typ.W - 1 loop + declare + B : constant Uns32 := + Uns32 (Shift_Right (To_Uns64 (Val.Scal), Natural (I))) + and 1; + Idx : constant Digit_Index := Digit_Index (Off / 32); + Pos : constant Natural := Natural (Off mod 32); + begin + Vec (Idx).Val := Vec (Idx).Val or Shift_Left (B, Pos); + end; + Off := Off + 1; + end loop; + when Type_Vector => + -- TODO: optimize off mod 32 = 0. + for I in reverse Val.Arr.V'Range loop + Value2logvec (Val.Arr.V (I), Vec, Off, Has_Zx); + end loop; + when Type_Array => + for I in reverse Val.Arr.V'Range loop + Value2logvec (Val.Arr.V (I), Vec, Off, Has_Zx); + end loop; + when Type_Record => + for I in Val.Rec.V'Range loop + Value2logvec (Val.Rec.V (I), Vec, Off, Has_Zx); + end loop; + when others => + raise Internal_Error; + end case; + end Value2logvec; + function Bit_Extract (Val : Value_Acc; Off : Uns32; Loc : Node) return Value_Acc is diff --git a/src/synth/synth-expr.ads b/src/synth/synth-expr.ads index 5d8d7f7d5..8fdf5a89c 100644 --- a/src/synth/synth-expr.ads +++ b/src/synth/synth-expr.ads @@ -18,6 +18,8 @@ -- Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston, -- MA 02110-1301, USA. +with Ada.Unchecked_Deallocation; + with Types; use Types; with Netlists; use Netlists; @@ -110,4 +112,23 @@ package Synth.Expr is Voff : out Net; Off : out Uns32; W : out Width); + + -- Conversion to logic vector. + + type Logic_32 is record + Val : Uns32; -- AKA aval + Zx : Uns32; -- AKA bval + end record; + + type Digit_Index is new Natural; + type Logvec_Array is array (Digit_Index range <>) of Logic_32; + type Logvec_Array_Acc is access Logvec_Array; + + procedure Free_Logvec_Array is new Ada.Unchecked_Deallocation + (Logvec_Array, Logvec_Array_Acc); + + procedure Value2logvec (Val : Value_Acc; + Vec : in out Logvec_Array; + Off : in out Uns32; + Has_Zx : in out Boolean); end Synth.Expr; diff --git a/src/synth/synth-stmts.adb b/src/synth/synth-stmts.adb index 6e3a5d0c8..02732f58a 100644 --- a/src/synth/synth-stmts.adb +++ b/src/synth/synth-stmts.adb @@ -33,7 +33,6 @@ with Vhdl.Types; with Vhdl.Sem_Expr; with Vhdl.Utils; use Vhdl.Utils; with Vhdl.Std_Package; -with Vhdl.Ieee.Std_Logic_1164; with Vhdl.Evaluation; with PSL.Types; @@ -690,91 +689,24 @@ package body Synth.Stmts is end if; end Synth_If_Statement; - procedure Convert_Bv_To_Uns64 (Expr : Node; Val : out Uns64; Dc : out Uns64) - is - El_Type : constant Node := - Get_Base_Type (Get_Element_Subtype (Get_Type (Expr))); - begin - if El_Type = Vhdl.Ieee.Std_Logic_1164.Std_Ulogic_Type then - declare - use Vhdl.Evaluation.String_Utils; - - Info : constant Str_Info := Get_Str_Info (Expr); - begin - if Info.Len > 64 then - raise Internal_Error; - end if; - Val := 0; - Dc := 0; - for I in 0 .. Info.Len - 1 loop - Val := Shift_Left (Val, 1); - Dc := Shift_Left (Dc, 1); - case Get_Pos (Info, I) is - when Vhdl.Ieee.Std_Logic_1164.Std_Logic_0_Pos => - Val := Val or 0; - when Vhdl.Ieee.Std_Logic_1164.Std_Logic_1_Pos => - Val := Val or 1; - when Vhdl.Ieee.Std_Logic_1164.Std_Logic_U_Pos - | Vhdl.Ieee.Std_Logic_1164.Std_Logic_X_Pos - | Vhdl.Ieee.Std_Logic_1164.Std_Logic_Z_Pos - | Vhdl.Ieee.Std_Logic_1164.Std_Logic_W_Pos - | Vhdl.Ieee.Std_Logic_1164.Std_Logic_D_Pos - | Vhdl.Ieee.Std_Logic_1164.Std_Logic_L_Pos - | Vhdl.Ieee.Std_Logic_1164.Std_Logic_H_Pos => - Dc := Dc or 1; - when others => - raise Internal_Error; - end case; - end loop; - end; - elsif El_Type = Vhdl.Std_Package.Bit_Type_Definition then - declare - use Vhdl.Evaluation.String_Utils; - - Info : constant Str_Info := Get_Str_Info (Expr); - begin - if Info.Len > 64 then - raise Internal_Error; - end if; - Val := 0; - Dc := 0; - for I in 0 .. Info.Len - 1 loop - Val := Shift_Left (Val, 1); - case Get_Pos (Info, I) is - when 0 => - Val := Val or 0; - when 1 => - Val := Val or 1; - when others => - raise Internal_Error; - end case; - end loop; - end; - else - raise Internal_Error; - end if; - end Convert_Bv_To_Uns64; - -- EXPR is a choice, so a locally static literal. - procedure Convert_To_Uns64 (Expr : Node; Val : out Uns64; Dc : out Uns64) + function Convert_To_Uns64 (Syn_Inst : Synth_Instance_Acc; Expr : Node) + return Uns64 is - Expr_Type : constant Node := Get_Type (Expr); - begin - case Get_Kind (Expr_Type) is - when Iir_Kind_Array_Type_Definition - | Iir_Kind_Array_Subtype_Definition => - Convert_Bv_To_Uns64 (Expr, Val, Dc); - when Iir_Kind_Enumeration_Type_Definition => - Dc := 0; - Val := Uns64 (Get_Enum_Pos (Strip_Denoting_Name (Expr))); - when Iir_Kind_Integer_Type_Definition - | Iir_Kind_Integer_Subtype_Definition => - -- TODO: signed values. - Dc := 0; - Val := Uns64 (Get_Value (Expr)); - when others => - Error_Kind ("convert_to_uns64", Expr_Type); - end case; + 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; @@ -960,21 +892,10 @@ package body Synth.Stmts is when Iir_Kind_Choice_By_Expression => Choice_Idx := Choice_Idx + 1; Annex_Arr (Choice_Idx) := Int32 (Choice_Idx); - declare - Choice_Expr : constant Node := - Get_Choice_Expression (Choice); - Val, Dc : Uns64; - begin - Convert_To_Uns64 (Choice_Expr, Val, Dc); - if Dc = 0 then - Choice_Data (Choice_Idx) := (Val => Val, - Alt => Alt_Idx); - else - Error_Msg_Synth (+Choice_Expr, "meta-values never match"); - Choice_Data (Choice_Idx) := (Val => 0, - Alt => 0); - end if; - end; + 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 => @@ -1268,21 +1189,10 @@ package body Synth.Stmts is when Iir_Kind_Choice_By_Expression => Choice_Idx := Choice_Idx + 1; Annex_Arr (Choice_Idx) := Int32 (Choice_Idx); - declare - Choice_Expr : constant Node := - Get_Choice_Expression (Choice); - Val, Dc : Uns64; - begin - Convert_To_Uns64 (Choice_Expr, Val, Dc); - if Dc = 0 then - Choice_Data (Choice_Idx) := (Val => Val, - Alt => Alt_Idx); - else - Error_Msg_Synth (+Choice_Expr, "meta-values never match"); - Choice_Data (Choice_Idx) := (Val => 0, - Alt => 0); - end if; - end; + 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 => |