diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/synth/synth-aggr.adb | 433 | ||||
| -rw-r--r-- | src/synth/synth-aggr.ads | 30 | ||||
| -rw-r--r-- | src/synth/synth-context.adb | 102 | ||||
| -rw-r--r-- | src/synth/synth-decls.adb | 41 | ||||
| -rw-r--r-- | src/synth/synth-disp_vhdl.adb | 4 | ||||
| -rw-r--r-- | src/synth/synth-expr.adb | 829 | ||||
| -rw-r--r-- | src/synth/synth-expr.ads | 12 | ||||
| -rw-r--r-- | src/synth/synth-files_operations.adb | 19 | ||||
| -rw-r--r-- | src/synth/synth-heap.adb | 72 | ||||
| -rw-r--r-- | src/synth/synth-insts.adb | 67 | ||||
| -rw-r--r-- | src/synth/synth-oper.adb | 31 | ||||
| -rw-r--r-- | src/synth/synth-static_oper.adb | 295 | ||||
| -rw-r--r-- | src/synth/synth-static_proc.adb | 4 | ||||
| -rw-r--r-- | src/synth/synth-stmts.adb | 259 | ||||
| -rw-r--r-- | src/synth/synth-stmts.ads | 7 | ||||
| -rw-r--r-- | src/synth/synth-values.adb | 792 | ||||
| -rw-r--r-- | src/synth/synth-values.ads | 185 |
17 files changed, 1654 insertions, 1528 deletions
diff --git a/src/synth/synth-aggr.adb b/src/synth/synth-aggr.adb new file mode 100644 index 000000000..25f32cacd --- /dev/null +++ b/src/synth/synth-aggr.adb @@ -0,0 +1,433 @@ +-- Aggregates synthesis. +-- Copyright (C) 2020 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 Types; use Types; + +with Netlists; use Netlists; +with Netlists.Utils; use Netlists.Utils; + +with Vhdl.Errors; use Vhdl.Errors; + +with Synth.Errors; use Synth.Errors; +with Synth.Expr; use Synth.Expr; +with Synth.Stmts; use Synth.Stmts; +with Synth.Decls; use Synth.Decls; + +package body Synth.Aggr is + type Stride_Array is array (Dim_Type range <>) of Nat32; + + function Get_Index_Offset + (Index : Int64; Bounds : Bound_Type; Expr : Iir) return Uns32 + is + Left : constant Int64 := Int64 (Bounds.Left); + Right : constant Int64 := Int64 (Bounds.Right); + begin + case Bounds.Dir is + when Iir_To => + if Index >= Left and then Index <= Right then + -- to + return Uns32 (Index - Left); + end if; + when Iir_Downto => + if Index <= Left and then Index >= Right then + -- downto + return Uns32 (Left - Index); + end if; + end case; + Error_Msg_Synth (+Expr, "index out of bounds"); + return 0; + end Get_Index_Offset; + + function Get_Index_Offset + (Index : Valtyp; Bounds : Bound_Type; Expr : Iir) return Uns32 is + begin + return Get_Index_Offset (Read_Discrete (Index), Bounds, Expr); + end Get_Index_Offset; + + function Fill_Stride (Typ : Type_Acc) return Stride_Array is + begin + case Typ.Kind is + when Type_Vector => + return (1 => 1); + when Type_Array => + declare + Bnds : constant Bound_Array_Acc := Typ.Abounds; + Res : Stride_Array (1 .. Bnds.Ndim); + Stride : Nat32; + begin + Stride := 1; + for I in reverse 2 .. Bnds.Ndim loop + Res (Dim_Type (I)) := Stride; + Stride := Stride * Nat32 (Bnds.D (I).Len); + end loop; + Res (1) := Stride; + return Res; + end; + when others => + raise Internal_Error; + end case; + end Fill_Stride; + + procedure Fill_Array_Aggregate (Syn_Inst : Synth_Instance_Acc; + Aggr : Node; + Res : Valtyp_Array_Acc; + Typ : Type_Acc; + First_Pos : Nat32; + Strides : Stride_Array; + Dim : Dim_Type; + Const_P : out Boolean) + is + Bound : constant Bound_Type := Get_Array_Bound (Typ, Dim); + El_Typ : constant Type_Acc := Get_Array_Element (Typ); + Stride : constant Nat32 := Strides (Dim); + Value : Node; + Assoc : Node; + + procedure Set_Elem (Pos : Nat32) + is + Sub_Const : Boolean; + Val : Valtyp; + begin + if Dim = Strides'Last then + Val := Synth_Expression_With_Type (Syn_Inst, Value, El_Typ); + Val := Synth_Subtype_Conversion (Val, El_Typ, False, Value); + pragma Assert (Res (Pos) = No_Valtyp); + Res (Pos) := Val; + if Const_P and then not Is_Static (Val.Val) then + Const_P := False; + end if; + else + Fill_Array_Aggregate + (Syn_Inst, Value, Res, Typ, Pos, Strides, Dim + 1, Sub_Const); + if not Sub_Const then + Const_P := False; + end if; + end if; + end Set_Elem; + + procedure Set_Vector (Pos : Nat32; Len : Nat32; Val : Valtyp) is + begin + pragma Assert (Dim = Strides'Last); + if Len = 0 then + return; + end if; + pragma Assert (Res (Pos) = No_Valtyp); + Res (Pos) := Val; + + -- Mark following slots as busy so that 'others => x' won't fill + -- them. + for I in 2 .. Len loop + Res (Pos + I - 1).Typ := Val.Typ; + end loop; + + if Const_P and then not Is_Static (Val.Val) then + Const_P := False; + end if; + end Set_Vector; + + Pos : Nat32; + begin + Assoc := Get_Association_Choices_Chain (Aggr); + Pos := First_Pos; + Const_P := True; + while Is_Valid (Assoc) loop + Value := Get_Associated_Expr (Assoc); + loop + case Get_Kind (Assoc) is + when Iir_Kind_Choice_By_None => + if Get_Element_Type_Flag (Assoc) then + if Pos >= First_Pos + Stride * Nat32 (Bound.Len) then + Error_Msg_Synth (+Assoc, "element out of array bound"); + else + Set_Elem (Pos); + Pos := Pos + Stride; + end if; + else + declare + Val : Valtyp; + Val_Len : Uns32; + begin + Val := Synth_Expression_With_Basetype + (Syn_Inst, Value); + Val_Len := Get_Bound_Length (Val.Typ, 1); + pragma Assert (Stride = 1); + if Pos - First_Pos > Nat32 (Bound.Len - Val_Len) then + Error_Msg_Synth + (+Assoc, "element out of array bound"); + else + Set_Vector (Pos, Nat32 (Val_Len), Val); + Pos := Pos + Nat32 (Val_Len); + end if; + end; + end if; + when Iir_Kind_Choice_By_Others => + pragma Assert (Get_Element_Type_Flag (Assoc)); + declare + Last_Pos : constant Nat32 := + First_Pos + Nat32 (Bound.Len) * Stride; + begin + while Pos < Last_Pos loop + if Res (Pos) = No_Valtyp then + -- FIXME: the check is not correct if there is + -- an array. + Set_Elem (Pos); + end if; + Pos := Pos + Stride; + end loop; + end; + when Iir_Kind_Choice_By_Expression => + pragma Assert (Get_Element_Type_Flag (Assoc)); + declare + Ch : constant Node := Get_Choice_Expression (Assoc); + Idx : Valtyp; + Off : Nat32; + begin + Idx := Synth_Expression (Syn_Inst, Ch); + if not Is_Static (Idx.Val) then + Error_Msg_Synth (+Ch, "choice is not static"); + else + Off := Nat32 (Get_Index_Offset (Idx, Bound, Ch)); + Set_Elem (First_Pos + Off * Stride); + end if; + end; + when Iir_Kind_Choice_By_Range => + declare + Ch : constant Node := Get_Choice_Range (Assoc); + Rng : Discrete_Range_Type; + Val : Valtyp; + Rng_Len : Width; + Off : Nat32; + begin + Synth_Discrete_Range (Syn_Inst, Ch, Rng); + if Get_Element_Type_Flag (Assoc) then + Val := Create_Value_Discrete + (Rng.Left, + Get_Subtype_Object (Syn_Inst, + Get_Base_Type (Get_Type (Ch)))); + while In_Range (Rng, Read_Discrete (Val)) loop + Off := Nat32 (Get_Index_Offset (Val, Bound, Ch)); + Set_Elem (First_Pos + Off * Stride); + Update_Index (Rng, Val); + end loop; + else + -- The direction must be the same. + if Rng.Dir /= Bound.Dir then + Error_Msg_Synth + (+Assoc, "direction of range does not match " + & "direction of array"); + end if; + -- FIXME: can the expression be unbounded ? + Val := Synth_Expression_With_Basetype + (Syn_Inst, Value); + -- The length must match the range. + Rng_Len := Get_Range_Length (Rng); + if Get_Bound_Length (Val.Typ, 1) /= Rng_Len then + Error_Msg_Synth + (+Value, "length doesn't match range"); + end if; + pragma Assert (Stride = 1); + Off := Nat32 (Get_Index_Offset (Rng.Left, Bound, Ch)); + Set_Vector (First_Pos + Off, Nat32 (Rng_Len), Val); + end if; + end; + when others => + Error_Msg_Synth + (+Assoc, "unhandled association form"); + end case; + Assoc := Get_Chain (Assoc); + exit when Is_Null (Assoc); + exit when not Get_Same_Alternative_Flag (Assoc); + end loop; + end loop; + end Fill_Array_Aggregate; + + procedure Fill_Record_Aggregate (Syn_Inst : Synth_Instance_Acc; + Aggr : Node; + Rec : Valtyp_Array_Acc; + Const_P : out Boolean) + is + El_List : constant Node_Flist := + Get_Elements_Declaration_List (Get_Type (Aggr)); + Value : Node; + Assoc : Node; + Pos : Nat32; + + procedure Set_Elem (Pos : Nat32) + is + Val : Valtyp; + El_Type : Type_Acc; + begin + El_Type := Get_Subtype_Object + (Syn_Inst, Get_Type (Get_Nth_Element (El_List, Natural (Pos)))); + Val := Synth_Expression_With_Type (Syn_Inst, Value, El_Type); + if Const_P and not Is_Static (Val.Val) then + Const_P := False; + end if; + Val := Synth_Subtype_Conversion (Val, El_Type, False, Value); + Rec (Nat32 (Pos + 1)) := Val; + end Set_Elem; + begin + Assoc := Get_Association_Choices_Chain (Aggr); + Pos := 0; + Const_P := True; + while Is_Valid (Assoc) loop + Value := Get_Associated_Expr (Assoc); + loop + case Get_Kind (Assoc) is + when Iir_Kind_Choice_By_None => + Set_Elem (Pos); + Pos := Pos + 1; + when Iir_Kind_Choice_By_Others => + for I in Rec'Range loop + if Rec (I) = No_Valtyp then + Set_Elem (I - 1); + end if; + end loop; + when Iir_Kind_Choice_By_Name => + Pos := Nat32 (Get_Element_Position + (Get_Named_Entity + (Get_Choice_Name (Assoc)))); + Set_Elem (Pos); + when others => + Error_Msg_Synth + (+Assoc, "unhandled association form"); + end case; + Assoc := Get_Chain (Assoc); + exit when Is_Null (Assoc); + exit when not Get_Same_Alternative_Flag (Assoc); + end loop; + end loop; + end Fill_Record_Aggregate; + + function Valtyp_Array_To_Net (Tab : Valtyp_Array) return Net + is + Res : Net; + Arr : Net_Array_Acc; + Idx : Nat32; + begin + Arr := new Net_Array (Tab'Range); + Idx := 0; + for I in Arr'Range loop + if Tab (I).Val /= null then + Idx := Idx + 1; + Arr (Idx) := Get_Net (Tab (I)); + end if; + end loop; + Concat_Array (Arr (1 .. Idx), Res); + Free_Net_Array (Arr); + return Res; + end Valtyp_Array_To_Net; + + function Synth_Aggregate_Array (Syn_Inst : Synth_Instance_Acc; + Aggr : Node; + Aggr_Type : Type_Acc) return Valtyp + is + Strides : constant Stride_Array := Fill_Stride (Aggr_Type); + Flen : constant Iir_Index32 := Get_Array_Flat_Length (Aggr_Type); + Tab_Res : Valtyp_Array_Acc; + Const_P : Boolean; + Res : Valtyp; + begin + Tab_Res := new Valtyp_Array'(1 .. Nat32 (Flen) => No_Valtyp); + + Fill_Array_Aggregate + (Syn_Inst, Aggr, Tab_Res, Aggr_Type, 1, Strides, 1, Const_P); + + -- TODO: check all element types have the same bounds ? + + if Const_P then + declare + Off : Size_Type; + begin + Res := Create_Value_Memory (Aggr_Type); + Off := 0; + for I in Tab_Res'Range loop + if Tab_Res (I).Val /= null then + -- There can be holes due to sub-arrays. + Write_Value (Res.Val.Mem + Off, Tab_Res (I)); + Off := Off + Tab_Res (I).Typ.Sz; + end if; + end loop; + pragma Assert (Off = Aggr_Type.Sz); + end; + else + Res := Create_Value_Net + (Valtyp_Array_To_Net (Tab_Res.all), Aggr_Type); + end if; + + Free_Valtyp_Array (Tab_Res); + + return Res; + end Synth_Aggregate_Array; + + function Synth_Aggregate_Record (Syn_Inst : Synth_Instance_Acc; + Aggr : Node; + Aggr_Type : Type_Acc) return Valtyp + is + Tab_Res : Valtyp_Array_Acc; + Res : Valtyp; + Const_P : Boolean; + begin + -- Allocate the result. + Tab_Res := + new Valtyp_Array'(1 .. Nat32 (Aggr_Type.Rec.Len) => No_Valtyp); + + Fill_Record_Aggregate (Syn_Inst, Aggr, Tab_Res, Const_P); + + if Const_P then + Res := Create_Value_Memory (Aggr_Type); + for I in Aggr_Type.Rec.E'Range loop + Write_Value (Res.Val.Mem + Aggr_Type.Rec.E (I).Moff, + Tab_Res (Nat32 (I))); + end loop; + else + Res := Create_Value_Net + (Valtyp_Array_To_Net (Tab_Res.all), Aggr_Type); + end if; + + Free_Valtyp_Array (Tab_Res); + + return Res; + end Synth_Aggregate_Record; + + -- Aggr_Type is the type from the context. + function Synth_Aggregate (Syn_Inst : Synth_Instance_Acc; + Aggr : Node; + Aggr_Type : Type_Acc) return Valtyp is + begin + case Aggr_Type.Kind is + when Type_Unbounded_Array | Type_Unbounded_Vector => + declare + Res_Type : Type_Acc; + begin + Res_Type := Decls.Synth_Array_Subtype_Indication + (Syn_Inst, Get_Type (Aggr)); + return Synth_Aggregate_Array (Syn_Inst, Aggr, Res_Type); + end; + when Type_Vector | Type_Array => + return Synth_Aggregate_Array (Syn_Inst, Aggr, Aggr_Type); + when Type_Record => + return Synth_Aggregate_Record (Syn_Inst, Aggr, Aggr_Type); + when others => + raise Internal_Error; + end case; + end Synth_Aggregate; + +end Synth.Aggr; diff --git a/src/synth/synth-aggr.ads b/src/synth/synth-aggr.ads new file mode 100644 index 000000000..5dd7e4bd7 --- /dev/null +++ b/src/synth/synth-aggr.ads @@ -0,0 +1,30 @@ +-- Aggregates synthesis. +-- Copyright (C) 2020 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 Synth.Values; use Synth.Values; +with Synth.Context; use Synth.Context; +with Vhdl.Nodes; use Vhdl.Nodes; + +package Synth.Aggr is + -- Aggr_Type is the type from the context. + function Synth_Aggregate (Syn_Inst : Synth_Instance_Acc; + Aggr : Node; + Aggr_Type : Type_Acc) return Valtyp; +end Synth.Aggr; diff --git a/src/synth/synth-context.adb b/src/synth/synth-context.adb index 9654ec02f..576be4987 100644 --- a/src/synth/synth-context.adb +++ b/src/synth/synth-context.adb @@ -21,7 +21,6 @@ with Ada.Unchecked_Deallocation; with Types; use Types; -with Types_Utils; use Types_Utils; with Name_Table; use Name_Table; with Vhdl.Errors; use Vhdl.Errors; @@ -29,7 +28,6 @@ with Vhdl.Utils; with Netlists.Builders; use Netlists.Builders; with Netlists.Folds; use Netlists.Folds; -with Netlists.Concats; with Synth.Expr; use Synth.Expr; with Netlists.Locations; @@ -490,39 +488,29 @@ package body Synth.Context is return Get_Current_Value (Build_Context, Val.Val.W); when Value_Net => return Val.Val.N; - when Value_Discrete => - case Val.Typ.Kind is - when Type_Bit - | Type_Logic => - declare - V : Logvec_Array (0 .. 0) := (0 => (0, 0)); - Res : Net; - begin - Value2net (Val, 1, V, Res); - return Res; - end; - when Type_Discrete => - if Val.Typ.W <= 64 then - declare - Sh : constant Natural := 64 - Natural (Val.Typ.W); - V : Uns64; - begin - V := To_Uns64 (Val.Val.Scal); - -- Keep only Val.Typ.W bits of the value. - V := Shift_Right (Shift_Left (V, Sh), Sh); - return Build2_Const_Uns - (Build_Context, V, Val.Typ.W); - end; - else - raise Internal_Error; - end if; - when others => - raise Internal_Error; - end case; - when Value_Const_Array - | Value_Const_Record => + when Value_Alias => declare - W : constant Width := Get_Type_Width (Val.Typ); + Res : Net; + begin + if Val.Val.A_Obj.Kind = Value_Wire then + Res := Get_Current_Value (Build_Context, Val.Val.A_Obj.W); + return Build2_Extract + (Build_Context, Res, Val.Val.A_Off.Net_Off, Val.Typ.W); + else + pragma Assert (Val.Val.A_Off.Net_Off = 0); + return Get_Net ((Val.Typ, Val.Val.A_Obj)); + end if; + end; + when Value_Const => + if Val.Val.C_Net = No_Net then + Val.Val.C_Net := Get_Net ((Val.Typ, Val.Val.C_Val)); + Locations.Set_Location (Get_Net_Parent (Val.Val.C_Net), + Get_Location (Val.Val.C_Loc)); + end if; + return Val.Val.C_Net; + when Value_Memory => + declare + W : constant Width := Val.Typ.W; Nd : constant Digit_Index := Digit_Index ((W + 31) / 32); Res : Net; begin @@ -544,52 +532,6 @@ package body Synth.Context is end; end if; end; - when Value_Array => - declare - use Netlists.Concats; - El_Typ : constant Type_Acc := Get_Array_Element (Val.Typ); - C : Concat_Type; - Res : Net; - begin - for I in reverse Val.Val.Arr.V'Range loop - Append (C, Get_Net ((El_Typ, Val.Val.Arr.V (I)))); - end loop; - Build (Build_Context, C, Res); - return Res; - end; - when Value_Record => - declare - use Netlists.Concats; - C : Concat_Type; - Res : Net; - begin - for I in Val.Typ.Rec.E'Range loop - Append (C, Get_Net ((Val.Typ.Rec.E (I).Typ, - Val.Val.Rec.V (I)))); - end loop; - Build (Build_Context, C, Res); - return Res; - end; - when Value_Alias => - declare - Res : Net; - begin - if Val.Val.A_Obj.Kind = Value_Wire then - Res := Get_Current_Value (Build_Context, Val.Val.A_Obj.W); - return Build2_Extract (Build_Context, Res, Val.Val.A_Off, - Val.Typ.W); - else - pragma Assert (Val.Val.A_Off = 0); - return Get_Net ((Val.Typ, Val.Val.A_Obj)); - end if; - end; - when Value_Const => - if Val.Val.C_Net = No_Net then - Val.Val.C_Net := Get_Net ((Val.Typ, Val.Val.C_Val)); - Locations.Set_Location (Get_Net_Parent (Val.Val.C_Net), - Get_Location (Val.Val.C_Loc)); - end if; - return Val.Val.C_Net; when others => raise Internal_Error; end case; diff --git a/src/synth/synth-decls.adb b/src/synth/synth-decls.adb index 2c32a7381..9c3ead57a 100644 --- a/src/synth/synth-decls.adb +++ b/src/synth/synth-decls.adb @@ -119,7 +119,6 @@ package body Synth.Decls is Rec_Els : Rec_El_Array_Acc; El : Node; El_Typ : Type_Acc; - Off : Uns32; begin if not Is_Fully_Constrained_Type (Def) then return null; @@ -127,16 +126,13 @@ package body Synth.Decls is Rec_Els := Create_Rec_El_Array (Iir_Index32 (Get_Nbr_Elements (El_List))); - Off := 0; for I in Flist_First .. Flist_Last (El_List) loop El := Get_Nth_Element (El_List, I); El_Typ := Get_Subtype_Object (Syn_Inst, Get_Type (El)); - Rec_Els.E (Iir_Index32 (I + 1)) := (Off => Off, - Typ => El_Typ); - Off := Off + Get_Type_Width (El_Typ); + Rec_Els.E (Iir_Index32 (I + 1)).Typ := El_Typ; end loop; - return Create_Record_Type (Rec_Els, Off); + return Create_Record_Type (Rec_Els); end Synth_Record_Type_Definition; function Synth_Access_Type_Definition @@ -166,6 +162,20 @@ package body Synth.Decls is return Typ; end Synth_File_Type_Definition; + function Scalar_Size_To_Size (Def : Node) return Size_Type is + begin + case Get_Scalar_Size (Def) is + when Scalar_8 => + return 1; + when Scalar_16 => + return 2; + when Scalar_32 => + return 4; + when Scalar_64 => + return 8; + end case; + end Scalar_Size_To_Size; + procedure Synth_Type_Definition (Syn_Inst : Synth_Instance_Acc; Def : Node) is Typ : Type_Acc; @@ -192,7 +202,8 @@ package body Synth.Decls is Is_Signed => False, Left => Int64 (Nbr_El - 1), Right => 0); - Typ := Create_Discrete_Type (Rng, W); + Typ := Create_Discrete_Type + (Rng, Scalar_Size_To_Size (Def), W); end; end if; when Iir_Kind_Array_Type_Definition => @@ -231,7 +242,8 @@ package body Synth.Decls is Rng := Synth_Discrete_Range_Expression (L, R, Get_Direction (Cst)); W := Discrete_Range_Width (Rng); - Typ := Create_Discrete_Type (Rng, W); + Typ := Create_Discrete_Type + (Rng, Scalar_Size_To_Size (Def), W); end; when Iir_Kind_Floating_Type_Definition => declare @@ -366,7 +378,8 @@ package body Synth.Decls is Rng := Synth_Discrete_Range_Constraint (Syn_Inst, Get_Range_Constraint (Atype)); W := Discrete_Range_Width (Rng); - return Create_Discrete_Type (Rng, W); + return + Create_Discrete_Type (Rng, Btype.Sz, W); end if; end; when Iir_Kind_Floating_Subtype_Definition => @@ -719,8 +732,7 @@ package body Synth.Decls is Error_Msg_Synth (+Decl, "variable with access type is not synthesizable"); -- FIXME: use a poison value ? - Create_Object (Syn_Inst, Decl, - (Obj_Typ, Create_Value_Default (Obj_Typ))); + Create_Object (Syn_Inst, Decl, Create_Value_Default (Obj_Typ)); else if Is_Valid (Def) then Init := Synth_Expression_With_Type (Syn_Inst, Def, Obj_Typ); @@ -729,7 +741,7 @@ package body Synth.Decls is Init := Create_Value_Default (Obj_Typ); end if; if Get_Instance_Const (Syn_Inst) then - Init.Val := Unshare (Init.Val, Current_Pool); + Init := Unshare (Init, Current_Pool); Create_Object (Syn_Inst, Decl, Init); else Create_Wire_Object (Syn_Inst, Wire_Variable, Decl); @@ -747,7 +759,7 @@ package body Synth.Decls is (Syn_Inst : Synth_Instance_Acc; Decl : Node) is Atype : constant Node := Get_Declaration_Type (Decl); - Off : Uns32; + Off : Value_Offsets; Voff : Net; Rdwd : Width; Res : Valtyp; @@ -770,7 +782,8 @@ package body Synth.Decls is -- Object is a net if it is not writable. Extract the -- bits for the alias. Res := Create_Value_Net - (Build2_Extract (Get_Build (Syn_Inst), Base.Val.N, Off, Typ.W), + (Build2_Extract (Get_Build (Syn_Inst), + Base.Val.N, Off.Net_Off, Typ.W), Typ); else Res := Create_Value_Alias (Base.Val, Off, Typ); diff --git a/src/synth/synth-disp_vhdl.adb b/src/synth/synth-disp_vhdl.adb index 436ba938a..375f72e85 100644 --- a/src/synth/synth-disp_vhdl.adb +++ b/src/synth/synth-disp_vhdl.adb @@ -214,7 +214,7 @@ package body Synth.Disp_Vhdl is Disp_In_Converter (Mname, Pfx & '.' & Name_Table.Image (Get_Identifier (El)), - Off + Et.Off, Get_Type (El), Et.Typ, Rec_Full); + Off + Et.Boff, Get_Type (El), Et.Typ, Rec_Full); end; end loop; end; @@ -370,7 +370,7 @@ package body Synth.Disp_Vhdl is Disp_Out_Converter (Mname, Pfx & '.' & Name_Table.Image (Get_Identifier (El)), - Off + Et.Off, Get_Type (El), Et.Typ, Rec_Full); + Off + Et.Boff, Get_Type (El), Et.Typ, Rec_Full); end; end loop; end; diff --git a/src/synth/synth-expr.adb b/src/synth/synth-expr.adb index cf4ef01ea..d5a32c327 100644 --- a/src/synth/synth-expr.adb +++ b/src/synth/synth-expr.adb @@ -34,6 +34,7 @@ with Vhdl.Annotations; use Vhdl.Annotations; with Netlists.Gates; use Netlists.Gates; with Netlists.Builders; use Netlists.Builders; with Netlists.Folds; use Netlists.Folds; +with Netlists.Utils; use Netlists.Utils; with Synth.Errors; use Synth.Errors; with Synth.Environment; @@ -42,6 +43,7 @@ with Synth.Stmts; use Synth.Stmts; with Synth.Oper; use Synth.Oper; with Synth.Heap; use Synth.Heap; with Synth.Debugger; +with Synth.Aggr; with Grt.Types; with Grt.To_Strings; @@ -53,30 +55,25 @@ package body Synth.Expr is procedure Set_Location (N : Net; Loc : Node) renames Synth.Source.Set_Location; - function Get_Static_Discrete (V : Value_Acc) return Int64 + function Get_Static_Discrete (V : Valtyp) return Int64 is N : Net; begin - case V.Kind is - when Value_Discrete => - return V.Scal; + case V.Val.Kind is + when Value_Memory => + return Read_Discrete (V); when Value_Const => - return V.C_Val.Scal; + return Read_Discrete ((V.Typ, V.Val.C_Val)); when Value_Net => - N := V.N; + N := V.Val.N; when Value_Wire => - N := Synth.Environment.Get_Const_Wire (V.W); + N := Synth.Environment.Get_Const_Wire (V.Val.W); when others => raise Internal_Error; end case; return Get_Net_Int64 (N); end Get_Static_Discrete; - function Get_Static_Discrete (V : Valtyp) return Int64 is - begin - return Get_Static_Discrete (V.Val); - end Get_Static_Discrete; - function Is_Positive (V : Valtyp) return Boolean is N : Net; @@ -84,14 +81,14 @@ package body Synth.Expr is begin pragma Assert (V.Typ.Kind = Type_Discrete); case V.Val.Kind is - when Value_Discrete => - return V.Val.Scal >= 0; when Value_Const => - return V.Val.C_Val.Scal >= 0; + return Read_Discrete ((V.Typ, V.Val.C_Val)) >= 0; when Value_Net => N := V.Val.N; when Value_Wire => N := Get_Net (V); + when Value_Memory => + return Read_Discrete (V) >= 0; when others => raise Internal_Error; end case; @@ -179,91 +176,132 @@ package body Synth.Expr is end loop; end Uns2logvec; - procedure Value2logvec (Val : Valtyp; + procedure Bit2logvec (Val : Uns32; + Vec : in out Logvec_Array; + Off : in out Uns32) + is + pragma Assert (Val <= 1); + Idx : constant Digit_Index := Digit_Index (Off / 32); + Pos : constant Natural := Natural (Off mod 32); + Va : Uns32; + begin + Va := Shift_Left (Val, Pos); + Vec (Idx).Val := Vec (Idx).Val or Va; + Vec (Idx).Zx := 0; + Off := Off + 1; + end Bit2logvec; + + procedure Logic2logvec (Val : Int64; + Vec : in out Logvec_Array; + Off : in out Uns32; + Has_Zx : in out Boolean) + is + pragma Assert (Val <= 8); + Idx : constant Digit_Index := Digit_Index (Off / 32); + Pos : constant Natural := Natural (Off mod 32); + Va : Uns32; + Zx : Uns32; + begin + From_Std_Logic (Val, 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 Logic2logvec; + + procedure Value2logvec (Mem : Memory_Ptr; + Typ : Type_Acc; Vec : in out Logvec_Array; Off : in out Uns32; Has_Zx : in out Boolean) is begin - if Val.Val.Kind = Value_Const then - Value2logvec ((Val.Typ, Val.Val.C_Val), Vec, Off, Has_Zx); - return; - end if; - - case Val.Typ.Kind is + case Typ.Kind is when Type_Bit => + Bit2logvec (Uns32 (Read_U8 (Mem)), Vec, Off); + when Type_Logic => + Logic2logvec (Int64 (Read_U8 (Mem)), Vec, Off, Has_Zx); + when Type_Discrete => + Uns2logvec (To_Uns64 (Read_Discrete (Mem, Typ)), Typ.W, Vec, Off); + when Type_Vector => declare - Idx : constant Digit_Index := Digit_Index (Off / 32); - Pos : constant Natural := Natural (Off mod 32); - Va : Uns32; + Vlen : constant Iir_Index32 := Vec_Length (Typ); begin - Va := Uns32 (Val.Val.Scal); - Va := Shift_Left (Va, Pos); - Vec (Idx).Val := Vec (Idx).Val or Va; - Vec (Idx).Zx := 0; - Off := Off + 1; + case Typ.Vec_El.Kind is + when Type_Bit => + -- TODO: optimize off mod 32 = 0. + for I in reverse 1 .. Vlen loop + Bit2logvec (Uns32 (Read_U8 (Mem + Size_Type (I - 1))), + Vec, Off); + end loop; + when Type_Logic => + for I in reverse 1 .. Vlen loop + Logic2logvec + (Int64 (Read_U8 (Mem + Size_Type (I - 1))), + Vec, Off, Has_Zx); + end loop; + when others => + raise Internal_Error; + end case; end; - when Type_Logic => + when Type_Array => declare - Idx : constant Digit_Index := Digit_Index (Off / 32); - Pos : constant Natural := Natural (Off mod 32); - Va : Uns32; - Zx : Uns32; + Alen : constant Iir_Index32 := Get_Array_Flat_Length (Typ); + El_Typ : constant Type_Acc := Typ.Arr_El; begin - From_Std_Logic (Val.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; + for I in reverse 1 .. Alen loop + Value2logvec (Mem + Size_Type (I - 1) * El_Typ.Sz, + El_Typ, Vec, Off, Has_Zx); + end loop; end; - when Type_Discrete => - Uns2logvec (To_Uns64 (Val.Val.Scal), Val.Typ.W, Vec, Off); - when Type_Vector => - -- TODO: optimize off mod 32 = 0. - for I in reverse Val.Val.Arr.V'Range loop - Value2logvec ((Val.Typ.Vec_El, Val.Val.Arr.V (I)), - Vec, Off, Has_Zx); - end loop; - when Type_Array => - for I in reverse Val.Val.Arr.V'Range loop - Value2logvec ((Val.Typ.Arr_El, Val.Val.Arr.V (I)), - Vec, Off, Has_Zx); - end loop; when Type_Record => - for I in Val.Val.Rec.V'Range loop - Value2logvec ((Val.Typ.Rec.E (I).Typ, Val.Val.Rec.V (I)), + for I in Typ.Rec.E'Range loop + Value2logvec (Mem + Typ.Rec.E (I).Moff, Typ.Rec.E (I).Typ, Vec, Off, Has_Zx); end loop; when Type_Float => -- Fp64 is for sure 64 bits. Assume the endianness of floats is -- the same as integers endianness. - Uns2logvec (To_Uns64 (Val.Val.Fp), 64, Vec, Off); + Uns2logvec (To_Uns64 (Read_Fp64 (Mem)), 64, Vec, Off); when others => raise Internal_Error; end case; end Value2logvec; + procedure Value2logvec (Val : Valtyp; + Vec : in out Logvec_Array; + Off : in out Uns32; + Has_Zx : in out Boolean) is + begin + if Val.Val.Kind = Value_Const then + Value2logvec (Val.Val.C_Val.Mem, Val.Typ, Vec, Off, Has_Zx); + return; + end if; + + Value2logvec (Val.Val.Mem, Val.Typ, Vec, Off, Has_Zx); + end Value2logvec; + -- Resize for a discrete value. function Synth_Resize (Val : Valtyp; W : Width; Loc : Node) return Net is Wn : constant Width := Val.Typ.W; N : Net; Res : Net; + V : Int64; begin - if Is_Static (Val.Val) then - if Wn /= W then - pragma Assert (Val.Val.Kind = Value_Discrete); - if Val.Typ.Drange.Is_Signed then - Res := Build2_Const_Int - (Build_Context, Val.Val.Scal, W); - else - Res := Build2_Const_Uns - (Build_Context, To_Uns64 (Val.Val.Scal), W); - end if; - Set_Location (Res, Loc); - return Res; + if Is_Static (Val.Val) + and then Wn /= W + then + -- Optimization: resize directly. + V := Read_Discrete (Val); + if Val.Typ.Drange.Is_Signed then + Res := Build2_Const_Int (Build_Context, V, W); + else + Res := Build2_Const_Uns (Build_Context, To_Uns64 (V), W); end if; + Set_Location (Res, Loc); + return Res; end if; N := Get_Net (Val); @@ -283,349 +321,6 @@ package body Synth.Expr is end if; end Synth_Resize; - function Get_Index_Offset - (Index : Int64; Bounds : Bound_Type; Expr : Iir) return Uns32 - is - Left : constant Int64 := Int64 (Bounds.Left); - Right : constant Int64 := Int64 (Bounds.Right); - begin - case Bounds.Dir is - when Iir_To => - if Index >= Left and then Index <= Right then - -- to - return Uns32 (Index - Left); - end if; - when Iir_Downto => - if Index <= Left and then Index >= Right then - -- downto - return Uns32 (Left - Index); - end if; - end case; - Error_Msg_Synth (+Expr, "index out of bounds"); - return 0; - end Get_Index_Offset; - - function Get_Index_Offset - (Index : Value_Acc; Bounds : Bound_Type; Expr : Iir) return Uns32 is - begin - if Index.Kind = Value_Discrete then - return Get_Index_Offset (Index.Scal, Bounds, Expr); - else - raise Internal_Error; - end if; - end Get_Index_Offset; - - function Get_Array_Bound (Typ : Type_Acc; Dim : Dim_Type) - return Bound_Type is - begin - case Typ.Kind is - when Type_Vector => - pragma Assert (Dim = 1); - return Typ.Vbound; - when Type_Array => - return Typ.Abounds.D (Dim); - when others => - raise Internal_Error; - end case; - end Get_Array_Bound; - - function Get_Range_Length (Rng : Discrete_Range_Type) return Uns32 - is - Len : Int64; - begin - case Rng.Dir is - when Iir_To => - Len := Rng.Right - Rng.Left + 1; - when Iir_Downto => - Len := Rng.Left - Rng.Right + 1; - end case; - if Len < 0 then - return 0; - else - return Uns32 (Len); - end if; - end Get_Range_Length; - - type Stride_Array is array (Dim_Type range <>) of Iir_Index32; - - function Fill_Stride (Typ : Type_Acc) return Stride_Array is - begin - case Typ.Kind is - when Type_Vector => - return (1 => 1); - when Type_Array => - declare - Bnds : constant Bound_Array_Acc := Typ.Abounds; - Res : Stride_Array (1 .. Bnds.Len); - Stride : Iir_Index32; - begin - Stride := 1; - for I in reverse 2 .. Bnds.Len loop - Res (Dim_Type (I)) := Stride; - Stride := Stride * Iir_Index32 (Bnds.D (I).Len); - end loop; - Res (1) := Stride; - return Res; - end; - when others => - raise Internal_Error; - end case; - end Fill_Stride; - - procedure Fill_Array_Aggregate (Syn_Inst : Synth_Instance_Acc; - Aggr : Node; - Res : Value_Array_Acc; - Typ : Type_Acc; - First_Pos : Iir_Index32; - Strides : Stride_Array; - Dim : Dim_Type; - Const_P : out Boolean) - is - Bound : constant Bound_Type := Get_Array_Bound (Typ, Dim); - El_Typ : constant Type_Acc := Get_Array_Element (Typ); - Stride : constant Iir_Index32 := Strides (Dim); - Value : Node; - Assoc : Node; - - procedure Set_Elem (Pos : Iir_Index32) - is - Sub_Const : Boolean; - Val : Valtyp; - begin - if Dim = Strides'Last then - Val := Synth_Expression_With_Type (Syn_Inst, Value, El_Typ); - pragma Assert (Res.V (Pos) = null); - Res.V (Pos) := Val.Val; - if Const_P and then not Is_Static (Val.Val) then - Const_P := False; - end if; - else - Fill_Array_Aggregate - (Syn_Inst, Value, Res, Typ, Pos, Strides, Dim + 1, Sub_Const); - if not Sub_Const then - Const_P := False; - end if; - end if; - end Set_Elem; - - procedure Set_Vector - (Pos : Iir_Index32; Len : Iir_Index32; Val : Valtyp) is - begin - pragma Assert (Dim = Strides'Last); - if Len = 0 then - return; - end if; - -- FIXME: factorize with bit_extract ? - case Val.Val.Kind is - when Value_Array - | Value_Const_Array => - declare - E : Value_Acc; - begin - for I in 1 .. Len loop - E := Val.Val.Arr.V (I); - Res.V (Pos + I - 1) := E; - end loop; - Const_P := Const_P and then Val.Val.Kind = Value_Const_Array; - end; - when Value_Net - | Value_Wire => - declare - N : Net; - E : Net; - begin - N := Get_Net (Val); - for I in 1 .. Len loop - E := Build_Extract (Build_Context, N, - Uns32 (Len - I) * El_Typ.W, El_Typ.W); - Res.V (Pos + I - 1) := Create_Value_Net (E, El_Typ).Val; - end loop; - Const_P := False; - end; - when others => - raise Internal_Error; - end case; - end Set_Vector; - - Pos : Iir_Index32; - begin - Assoc := Get_Association_Choices_Chain (Aggr); - Pos := First_Pos; - Const_P := True; - while Is_Valid (Assoc) loop - Value := Get_Associated_Expr (Assoc); - loop - case Get_Kind (Assoc) is - when Iir_Kind_Choice_By_None => - if Get_Element_Type_Flag (Assoc) then - if Pos >= First_Pos + Stride * Iir_Index32 (Bound.Len) - then - Error_Msg_Synth (+Assoc, "element out of array bound"); - else - Set_Elem (Pos); - Pos := Pos + Stride; - end if; - else - declare - Val : Valtyp; - Val_Len : Uns32; - begin - Val := Synth_Expression_With_Basetype - (Syn_Inst, Value); - Val_Len := Get_Bound_Length (Val.Typ, 1); - pragma Assert (Stride = 1); - if Pos - First_Pos > Iir_Index32 (Bound.Len - Val_Len) - then - Error_Msg_Synth - (+Assoc, "element out of array bound"); - else - Set_Vector (Pos, Iir_Index32 (Val_Len), Val); - Pos := Pos + Iir_Index32 (Val_Len); - end if; - end; - end if; - when Iir_Kind_Choice_By_Others => - pragma Assert (Get_Element_Type_Flag (Assoc)); - declare - Last_Pos : constant Iir_Index32 := - First_Pos + Iir_Index32 (Bound.Len) * Stride; - begin - while Pos < Last_Pos loop - if Res.V (Pos) = null then - Set_Elem (Pos); - end if; - Pos := Pos + Stride; - end loop; - end; - when Iir_Kind_Choice_By_Expression => - pragma Assert (Get_Element_Type_Flag (Assoc)); - declare - Ch : constant Node := Get_Choice_Expression (Assoc); - Idx : Valtyp; - Off : Iir_Index32; - begin - Idx := Synth_Expression (Syn_Inst, Ch); - if not Is_Static (Idx.Val) then - Error_Msg_Synth (+Ch, "choice is not static"); - else - Off := Iir_Index32 - (Get_Index_Offset (Idx.Val, Bound, Ch)); - Set_Elem (First_Pos + Off * Stride); - end if; - end; - when Iir_Kind_Choice_By_Range => - declare - Ch : constant Node := Get_Choice_Range (Assoc); - Rng : Discrete_Range_Type; - Val : Valtyp; - Rng_Len : Width; - Off : Iir_Index32; - begin - Synth_Discrete_Range (Syn_Inst, Ch, Rng); - if Get_Element_Type_Flag (Assoc) then - Val := Create_Value_Discrete - (Rng.Left, - Get_Subtype_Object (Syn_Inst, - Get_Base_Type (Get_Type (Ch)))); - while In_Range (Rng, Val.Val.Scal) loop - Off := Iir_Index32 - (Get_Index_Offset (Val.Val, Bound, Ch)); - Set_Elem (First_Pos + Off * Stride); - Update_Index (Rng, Val.Val.Scal); - end loop; - else - -- The direction must be the same. - if Rng.Dir /= Bound.Dir then - Error_Msg_Synth - (+Assoc, "direction of range does not match " - & "direction of array"); - end if; - -- FIXME: can the expression be unbounded ? - Val := Synth_Expression_With_Basetype - (Syn_Inst, Value); - -- The length must match the range. - Rng_Len := Get_Range_Length (Rng); - if Get_Bound_Length (Val.Typ, 1) /= Rng_Len then - Error_Msg_Synth - (+Value, "length doesn't match range"); - end if; - pragma Assert (Stride = 1); - Off := Iir_Index32 - (Get_Index_Offset (Rng.Left, Bound, Ch)); - Set_Vector (First_Pos + Off, - Iir_Index32 (Rng_Len), Val); - end if; - end; - when others => - Error_Msg_Synth - (+Assoc, "unhandled association form"); - end case; - Assoc := Get_Chain (Assoc); - exit when Is_Null (Assoc); - exit when not Get_Same_Alternative_Flag (Assoc); - end loop; - end loop; - end Fill_Array_Aggregate; - - procedure Fill_Record_Aggregate (Syn_Inst : Synth_Instance_Acc; - Aggr : Node; - Rec : Value_Array_Acc; - Const_P : out Boolean) - is - El_List : constant Node_Flist := - Get_Elements_Declaration_List (Get_Type (Aggr)); - Value : Node; - Assoc : Node; - Pos : Natural; - - procedure Set_Elem (Pos : Natural) - is - Val : Valtyp; - El_Type : Type_Acc; - begin - El_Type := Get_Subtype_Object - (Syn_Inst, Get_Type (Get_Nth_Element (El_List, Pos))); - Val := Synth_Expression_With_Type (Syn_Inst, Value, El_Type); - if Const_P and not Is_Static (Val.Val) then - Const_P := False; - end if; - Val := Synth_Subtype_Conversion (Val, El_Type, False, Value); - Rec.V (Iir_Index32 (Pos + 1)) := Val.Val; - end Set_Elem; - begin - Assoc := Get_Association_Choices_Chain (Aggr); - Pos := 0; - Const_P := True; - Rec.V := (others => null); - while Is_Valid (Assoc) loop - Value := Get_Associated_Expr (Assoc); - loop - case Get_Kind (Assoc) is - when Iir_Kind_Choice_By_None => - Set_Elem (Pos); - Pos := Pos + 1; - when Iir_Kind_Choice_By_Others => - for I in Rec.V'Range loop - if Rec.V (I) = null then - Set_Elem (Natural (I - 1)); - end if; - end loop; - when Iir_Kind_Choice_By_Name => - Pos := Natural (Get_Element_Position - (Get_Named_Entity - (Get_Choice_Name (Assoc)))); - Set_Elem (Pos); - when others => - Error_Msg_Synth - (+Assoc, "unhandled association form"); - end case; - Assoc := Get_Chain (Assoc); - exit when Is_Null (Assoc); - exit when not Get_Same_Alternative_Flag (Assoc); - end loop; - end loop; - end Fill_Record_Aggregate; - procedure Concat_Array (Arr : in out Net_Array) is Last : Int32; @@ -661,10 +356,10 @@ package body Synth.Expr is end loop; end Concat_Array; - function Concat_Array (Arr : Net_Array_Acc) return Net is + procedure Concat_Array (Arr : in out Net_Array; N : out Net) is begin - Concat_Array (Arr.all); - return Arr (Arr'First); + Concat_Array (Arr); + N := Arr (Arr'First); end Concat_Array; function Synth_Discrete_Range_Expression @@ -680,6 +375,7 @@ package body Synth.Expr is (Syn_Inst : Synth_Instance_Acc; Rng : Node) return Discrete_Range_Type is L, R : Valtyp; + Lval, Rval : Int64; begin L := Synth_Expression_With_Basetype (Syn_Inst, Get_Left_Limit (Rng)); R := Synth_Expression_With_Basetype (Syn_Inst, Get_Right_Limit (Rng)); @@ -691,10 +387,12 @@ package body Synth.Expr is raise Internal_Error; end if; + Lval := Read_Discrete (L); + Rval := Read_Discrete (R); return (Dir => Get_Direction (Rng), - Left => L.Val.Scal, - Right => R.Val.Scal, - Is_Signed => L.Val.Scal < 0 or R.Val.Scal < 0); + Left => Lval, + Right => Rval, + Is_Signed => Lval < 0 or Rval < 0); end Synth_Discrete_Range_Expression; function Synth_Float_Range_Expression @@ -704,7 +402,7 @@ package body Synth.Expr is begin L := Synth_Expression (Syn_Inst, Get_Left_Limit (Rng)); R := Synth_Expression (Syn_Inst, Get_Right_Limit (Rng)); - return ((Get_Direction (Rng), L.Val.Fp, R.Val.Fp)); + return (Get_Direction (Rng), Read_Fp64 (L), Read_Fp64 (R)); end Synth_Float_Range_Expression; -- Return the type of EXPR without evaluating it. @@ -727,13 +425,12 @@ package body Synth.Expr is El_Typ : Type_Acc; Res_Bnd : Bound_Type; Sl_Voff : Net; - Sl_Off : Uns32; - Wd : Uns32; + Sl_Off : Value_Offsets; begin Pfx_Typ := Synth_Type_Of_Object (Syn_Inst, Get_Prefix (Expr)); Get_Onedimensional_Array_Bounds (Pfx_Typ, Pfx_Bnd, El_Typ); - Synth_Slice_Suffix (Syn_Inst, Expr, Pfx_Bnd, El_Typ.W, - Res_Bnd, Sl_Voff, Sl_Off, Wd); + Synth_Slice_Suffix (Syn_Inst, Expr, Pfx_Bnd, El_Typ, + Res_Bnd, Sl_Voff, Sl_Off); if Sl_Voff /= No_Net then raise Internal_Error; @@ -765,7 +462,7 @@ package body Synth.Expr is begin -- Maybe do not dereference it if its type is known ? Val := Synth_Expression (Syn_Inst, Get_Prefix (Expr)); - Res := Heap.Synth_Dereference (Val.Val.Acc); + Res := Heap.Synth_Dereference (Read_Access (Val)); return Res.Typ; end; @@ -894,75 +591,6 @@ package body Synth.Expr is Len => Get_Range_Length (Rng)); end Synth_Bounds_From_Range; - function Synth_Aggregate_Array (Syn_Inst : Synth_Instance_Acc; - Aggr : Node; - Aggr_Type : Type_Acc) return Valtyp - is - Strides : constant Stride_Array := Fill_Stride (Aggr_Type); - Arr : Value_Array_Acc; - Res : Valtyp; - Const_P : Boolean; - begin - Arr := Create_Value_Array - (Iir_Index32 (Get_Array_Flat_Length (Aggr_Type))); - - Fill_Array_Aggregate - (Syn_Inst, Aggr, Arr, Aggr_Type, 1, Strides, 1, Const_P); - - if Const_P then - Res := Create_Value_Const_Array (Aggr_Type, Arr); - else - Res := Create_Value_Array (Aggr_Type, Arr); - end if; - - return Res; - end Synth_Aggregate_Array; - - function Synth_Aggregate_Record (Syn_Inst : Synth_Instance_Acc; - Aggr : Node; - Aggr_Type : Type_Acc) return Valtyp - is - Arr : Value_Array_Acc; - Res : Valtyp; - Const_P : Boolean; - begin - -- Allocate the result. - Arr := Create_Value_Array (Aggr_Type.Rec.Len); - - Fill_Record_Aggregate (Syn_Inst, Aggr, Arr, Const_P); - - if Const_P then - Res := Create_Value_Const_Record (Aggr_Type, Arr); - else - Res := Create_Value_Record (Aggr_Type, Arr); - end if; - - return Res; - end Synth_Aggregate_Record; - - -- Aggr_Type is the type from the context. - function Synth_Aggregate (Syn_Inst : Synth_Instance_Acc; - Aggr : Node; - Aggr_Type : Type_Acc) return Valtyp is - begin - case Aggr_Type.Kind is - when Type_Unbounded_Array | Type_Unbounded_Vector => - declare - Res_Type : Type_Acc; - begin - Res_Type := Decls.Synth_Array_Subtype_Indication - (Syn_Inst, Get_Type (Aggr)); - return Synth_Aggregate_Array (Syn_Inst, Aggr, Res_Type); - end; - when Type_Vector | Type_Array => - return Synth_Aggregate_Array (Syn_Inst, Aggr, Aggr_Type); - when Type_Record => - return Synth_Aggregate_Record (Syn_Inst, Aggr, Aggr_Type); - when others => - raise Internal_Error; - end case; - end Synth_Aggregate; - function Synth_Simple_Aggregate (Syn_Inst : Synth_Instance_Acc; Aggr : Node) return Valtyp is @@ -975,8 +603,8 @@ package body Synth.Expr is Bnd : Bound_Type; Bnds : Bound_Array_Acc; Res_Type : Type_Acc; - Arr : Value_Array_Acc; Val : Valtyp; + Res : Valtyp; begin -- Allocate the result. Bnd := Synth_Array_Bounds (Syn_Inst, Aggr_Type, 1); @@ -990,26 +618,22 @@ package body Synth.Expr is Res_Type := Create_Array_Type (Bnds, El_Typ); end if; - Arr := Create_Value_Array (Iir_Index32 (Last + 1)); + Res := Create_Value_Memory (Res_Type); for I in Flist_First .. Last loop Val := Synth_Expression_With_Type (Syn_Inst, Get_Nth_Element (Els, I), El_Typ); pragma Assert (Is_Static (Val.Val)); - Arr.V (Iir_Index32 (I + 1)) := Val.Val; + Write_Value (Res.Val.Mem + Size_Type (I) * El_Typ.Sz, Val); end loop; - return Create_Value_Const_Array (Res_Type, Arr); + return Res; end Synth_Simple_Aggregate; -- Change the bounds of VAL. function Reshape_Value (Val : Valtyp; Ntype : Type_Acc) return Valtyp is begin case Val.Val.Kind is - when Value_Array => - return Create_Value_Array (Ntype, Val.Val.Arr); - when Value_Const_Array => - return Create_Value_Const_Array (Ntype, Val.Val.Arr); when Value_Wire => return Create_Value_Wire (Val.Val.W, Ntype); when Value_Net => @@ -1018,6 +642,8 @@ package body Synth.Expr is return Create_Value_Alias (Val.Val.A_Obj, Val.Val.A_Off, Ntype); when Value_Const => return Reshape_Value ((Val.Typ, Val.Val.C_Val), Ntype); + when Value_Memory => + return (Ntype, Val.Val); when others => raise Internal_Error; end case; @@ -1059,11 +685,12 @@ package body Synth.Expr is (Build_Context, N, Dtype.W, Get_Location (Loc)); end if; return Create_Value_Net (N, Dtype); - when Value_Discrete => - return Create_Value_Discrete (Vt.Val.Scal, Dtype); when Value_Const => return Synth_Subtype_Conversion ((Vt.Typ, Vt.Val.C_Val), Dtype, Bounds, Loc); + when Value_Memory => + return Create_Value_Discrete + (Read_Discrete (Vt), Dtype); when others => raise Internal_Error; end case; @@ -1138,7 +765,7 @@ package body Synth.Expr is end if; declare - Str : constant String := Value_To_String (V.Val); + Str : constant String := Value_To_String (V); Res_N : Node; Val : Int64; begin @@ -1169,7 +796,8 @@ package body Synth.Expr is Str : String (1 .. 24); Last : Natural; begin - Grt.To_Strings.To_String (Str, Last, Ghdl_F64 (Val.Val.Fp)); + Grt.To_Strings.To_String + (Str, Last, Ghdl_F64 (Read_Fp64 (Val))); return Str (Str'First .. Last); end; when Iir_Kind_Integer_Type_Definition @@ -1178,7 +806,8 @@ package body Synth.Expr is Str : String (1 .. 21); First : Natural; begin - Grt.To_Strings.To_String (Str, First, Ghdl_I64 (Val.Val.Scal)); + Grt.To_Strings.To_String + (Str, First, Ghdl_I64 (Read_Discrete (Val))); return Str (First .. Str'Last); end; when Iir_Kind_Enumeration_Type_Definition @@ -1189,7 +818,7 @@ package body Synth.Expr is begin return Name_Table.Image (Get_Identifier - (Get_Nth_Element (Lits, Natural (Val.Val.Scal)))); + (Get_Nth_Element (Lits, Natural (Read_Discrete (Val))))); end; when Iir_Kind_Physical_Type_Definition | Iir_Kind_Physical_Subtype_Definition => @@ -1199,7 +828,8 @@ package body Synth.Expr is Id : constant Name_Id := Get_Identifier (Get_Primary_Unit (Get_Base_Type (Expr_Type))); begin - Grt.To_Strings.To_String (Str, First, Ghdl_I64 (Val.Val.Scal)); + Grt.To_Strings.To_String + (Str, First, Ghdl_I64 (Read_Discrete (Val))); return Str (First .. Str'Last) & ' ' & Name_Table.Image (Id); end; when others => @@ -1210,25 +840,21 @@ package body Synth.Expr is function String_To_Valtyp (Str : String; Styp : Type_Acc) return Valtyp is Len : constant Natural := Str'Length; - Etyp : constant Type_Acc := Styp.Uarr_El; Bnd : Bound_Array_Acc; Typ : Type_Acc; - Dat : Value_Array_Acc; - P : Iir_Index32; + Res : Valtyp; begin Bnd := Create_Bound_Array (1); Bnd.D (1) := (Dir => Iir_To, Left => 1, Right => Int32 (Len), Len => Width (Len)); Typ := Create_Array_Type (Bnd, Styp.Uarr_El); - Dat := Create_Value_Array (Iir_Index32 (Len)); - P := Dat.V'First; + Res := Create_Value_Memory (Typ); for I in Str'Range loop - Dat.V (P) := Create_Value_Discrete (Int64 (Character'Pos (Str (I))), - Etyp).Val; - P := P + 1; + Write_U8 (Res.Val.Mem + Size_Type (I - Str'First), + Character'Pos (Str (I))); end loop; - return Create_Value_Const_Array (Typ, Dat); + return Res; end String_To_Valtyp; function Synth_Image_Attribute (Syn_Inst : Synth_Instance_Acc; Attr : Node) @@ -1276,8 +902,11 @@ package body Synth.Expr is declare Typ : constant Type_Acc := Get_Subtype_Object (Syn_Inst, Get_Type (Name)); + Res : Valtyp; begin - return Create_Value_Discrete (Int64 (Get_Enum_Pos (Name)), Typ); + Res := Create_Value_Memory (Typ); + Write_Discrete (Res, Int64 (Get_Enum_Pos (Name))); + return Res; end; when Iir_Kind_Unit_Declaration => declare @@ -1293,7 +922,7 @@ package body Synth.Expr is Val : Valtyp; begin Val := Synth_Expression (Syn_Inst, Get_Prefix (Name)); - return Heap.Synth_Dereference (Val.Val.Acc); + return Heap.Synth_Dereference (Read_Access (Val)); end; when others => Error_Kind ("synth_name", Name); @@ -1314,21 +943,27 @@ package body Synth.Expr is -- SYN_INST and LOC are used in case of error. function Index_To_Offset (Syn_Inst : Synth_Instance_Acc; Bnd : Bound_Type; Idx : Int64; Loc : Node) - return Uns32 is + return Value_Offsets + is + Res : Value_Offsets; begin if not In_Bounds (Bnd, Int32 (Idx)) then Error_Msg_Synth (+Loc, "index not within bounds"); Synth.Debugger.Debug_Error (Syn_Inst, Loc); - return 0; + return (0, 0); end if; -- The offset is from the LSB (bit 0). Bit 0 is the rightmost one. case Bnd.Dir is when Iir_To => - return Uns32 (Bnd.Right - Int32 (Idx)); + Res.Net_Off := Uns32 (Bnd.Right - Int32 (Idx)); + Res.Mem_Off := Size_Type (Int32 (Idx) - Bnd.Left); when Iir_Downto => - return Uns32 (Int32 (Idx) - Bnd.Right); + Res.Net_Off := Uns32 (Int32 (Idx) - Bnd.Right); + Res.Mem_Off := Size_Type (Bnd.Left - Int32 (Idx)); end case; + + return Res; end Index_To_Offset; function Dyn_Index_To_Offset @@ -1392,7 +1027,7 @@ package body Synth.Expr is when Type_Unbounded_Vector => Res := Create_Vector_Type (Bnd, Btyp.Uvec_El); when Type_Array => - pragma Assert (Btyp.Abounds.Len = 1); + pragma Assert (Btyp.Abounds.Ndim = 1); Bnds := Create_Bound_Array (1); Bnds.D (1) := Bnd; Res := Create_Array_Type (Bnds, Btyp.Arr_El); @@ -1411,8 +1046,7 @@ package body Synth.Expr is Name : Node; Pfx_Type : Type_Acc; Voff : out Net; - Off : out Uns32; - W : out Width) + Off : out Value_Offsets) is Indexes : constant Iir_Flist := Get_Index_List (Name); El_Typ : constant Type_Acc := Get_Array_Element (Pfx_Type); @@ -1421,16 +1055,16 @@ package body Synth.Expr is Bnd : Bound_Type; Stride : Uns32; Ivoff : Net; + Idx_Off : Value_Offsets; begin - W := El_Typ.W; Voff := No_Net; - Off := 0; + Off := (0, 0); for I in Flist_First .. Flist_Last (Indexes) loop Idx_Expr := Get_Nth_Element (Indexes, I); -- Compute stride. This is O(n**2), but for small n. - Stride := W; + Stride := 1; for J in I + 1 .. Flist_Last (Indexes) loop Bnd := Get_Array_Bound (Pfx_Type, Dim_Type (J + 1)); Stride := Stride * Bnd.Len; @@ -1442,13 +1076,16 @@ package body Synth.Expr is Bnd := Get_Array_Bound (Pfx_Type, Dim_Type (I + 1)); - if Idx_Val.Val.Kind = Value_Discrete then - Off := Off - + (Index_To_Offset (Syn_Inst, Bnd, Idx_Val.Val.Scal, Name) - * Stride); + if Is_Static (Idx_Val.Val) then + Idx_Off := Index_To_Offset (Syn_Inst, Bnd, + Read_Discrete (Idx_Val), Name); + Off.Net_Off := Off.Net_Off + Idx_Off.Net_Off * Stride * El_Typ.W; + Off.Mem_Off := Off.Mem_Off + + Idx_Off.Mem_Off * Size_Type (Stride) * El_Typ.Sz; else Ivoff := Dyn_Index_To_Offset (Bnd, Idx_Val, Name); - Ivoff := Build_Memidx (Get_Build (Syn_Inst), Ivoff, W, Bnd.Len - 1, + Ivoff := Build_Memidx (Get_Build (Syn_Inst), Ivoff, El_Typ.W, + Bnd.Len - 1, Width (Clog2 (Uns64 (Stride * Bnd.Len)))); Set_Location (Ivoff, Idx_Expr); @@ -1619,18 +1256,16 @@ package body Synth.Expr is Pfx_Bnd : Bound_Type; L, R : Int64; Dir : Iir_Direction; - El_Wd : Width; + El_Typ : Type_Acc; Res_Bnd : out Bound_Type; - Off : out Uns32; - Wd : out Width) + Off : out Value_Offsets) is Is_Null : Boolean; Len : Uns32; begin if Pfx_Bnd.Dir /= Dir then Error_Msg_Synth (+Name, "direction mismatch in slice"); - Off := 0; - Wd := 0; + Off := (0, 0); if Dir = Iir_To then Res_Bnd := (Dir => Iir_To, Left => 1, Right => 0, Len => 0); else @@ -1648,42 +1283,41 @@ package body Synth.Expr is end case; if Is_Null then Len := 0; - Off := 0; + Off := (0, 0); else if not In_Bounds (Pfx_Bnd, Int32 (L)) or else not In_Bounds (Pfx_Bnd, Int32 (R)) then Error_Msg_Synth (+Name, "index not within bounds"); Synth.Debugger.Debug_Error (Syn_Inst, Expr); - Wd := 0; - Off := 0; + Off := (0, 0); return; end if; case Pfx_Bnd.Dir is when Iir_To => Len := Uns32 (R - L + 1); - Off := Uns32 (Pfx_Bnd.Right - Int32 (R)) * El_Wd; + Off.Net_Off := Uns32 (Pfx_Bnd.Right - Int32 (R)) * El_Typ.W; + Off.Mem_Off := Size_Type (Int32 (L) - Pfx_Bnd.Left) * El_Typ.Sz; when Iir_Downto => Len := Uns32 (L - R + 1); - Off := Uns32 (Int32 (R) - Pfx_Bnd.Right) * El_Wd; + Off.Net_Off := Uns32 (Int32 (R) - Pfx_Bnd.Right) * El_Typ.W; + Off.Mem_Off := Size_Type (Pfx_Bnd.Left - Int32 (L)) * El_Typ.Sz; end case; end if; Res_Bnd := (Dir => Pfx_Bnd.Dir, Len => Len, Left => Int32 (L), Right => Int32 (R)); - Wd := Len * El_Wd; end Synth_Slice_Const_Suffix; procedure Synth_Slice_Suffix (Syn_Inst : Synth_Instance_Acc; Name : Node; Pfx_Bnd : Bound_Type; - El_Wd : Width; + El_Typ : Type_Acc; Res_Bnd : out Bound_Type; Inp : out Net; - Off : out Uns32; - Wd : out Width) + Off : out Value_Offsets) is Expr : constant Node := Get_Suffix (Name); Left, Right : Valtyp; @@ -1692,7 +1326,7 @@ package body Synth.Expr is Max : Uns32; Inp_W : Width; begin - Off := 0; + Off := (0, 0); case Get_Kind (Expr) is when Iir_Kind_Range_Expression => @@ -1710,7 +1344,7 @@ package body Synth.Expr is Synth_Slice_Const_Suffix (Syn_Inst, Expr, Name, Pfx_Bnd, Rng.Left, Rng.Right, Rng.Dir, - El_Wd, Res_Bnd, Off, Wd); + El_Typ, Res_Bnd, Off); return; end; when others => @@ -1722,16 +1356,15 @@ package body Synth.Expr is Inp := No_Net; Synth_Slice_Const_Suffix (Syn_Inst, Expr, Name, Pfx_Bnd, - Get_Static_Discrete (Left.Val), - Get_Static_Discrete (Right.Val), + Get_Static_Discrete (Left), + Get_Static_Discrete (Right), Dir, - El_Wd, Res_Bnd, Off, Wd); + El_Typ, Res_Bnd, Off); else if Pfx_Bnd.Dir /= Dir then Error_Msg_Synth (+Name, "direction mismatch in slice"); Inp := No_Net; - Off := 0; - Wd := 0; + Off := (0, 0); if Dir = Iir_To then Res_Bnd := (Dir => Iir_To, Left => 1, Right => 0, Len => 0); else @@ -1748,7 +1381,8 @@ package body Synth.Expr is end if; Synth_Extract_Dyn_Suffix (Get_Build (Syn_Inst), Name, - Pfx_Bnd, Get_Net (Left), Get_Net (Right), Inp, Step, Off, Wd); + Pfx_Bnd, Get_Net (Left), Get_Net (Right), Inp, Step, Off.Net_Off, + Res_Bnd.Len); Inp_W := Get_Width (Inp); -- FIXME: convert range to offset. -- Extract max from the range. @@ -1756,16 +1390,15 @@ package body Synth.Expr is -- len=8 wd=4 step=1 => max=4 -- max so that max*step+wd <= len - off -- max <= (len - off - wd) / step - Max := (Pfx_Bnd.Len - Off - Wd) / Step; + Max := (Pfx_Bnd.Len - Off.Net_Off - Res_Bnd.Len) / Step; if Clog2 (Uns64 (Max)) > Natural (Inp_W) then -- The width of Inp limits the max. Max := 2**Natural (Inp_W) - 1; end if; Inp := Build_Memidx (Get_Build (Syn_Inst), - Inp, Step * El_Wd, Max, - Inp_W + Width (Clog2 (Uns64 (Step * El_Wd)))); - Wd := Wd * El_Wd; + Inp, Step * El_Typ.W, Max, + Inp_W + Width (Clog2 (Uns64 (Step * El_Typ.W)))); end if; end Synth_Slice_Suffix; @@ -1886,14 +1519,16 @@ package body Synth.Expr is -- Int to int. return Val; elsif Val.Typ.Kind = Type_Float then - return Create_Value_Discrete (Int64 (Val.Val.Fp), Conv_Typ); + return Create_Value_Discrete + (Int64 (Read_Fp64 (Val)), Conv_Typ); else Error_Msg_Synth (+Conv, "unhandled type conversion (to int)"); return No_Valtyp; end if; when Iir_Kind_Floating_Subtype_Definition => if Is_Static (Val.Val) then - return Create_Value_Float (Fp64 (Val.Val.Scal), Conv_Typ); + return Create_Value_Float + (Fp64 (Read_Discrete (Val)), Conv_Typ); else Error_Msg_Synth (+Conv, "unhandled type conversion (to float)"); return No_Valtyp; @@ -1946,7 +1581,6 @@ package body Synth.Expr is Bnds : Bound_Array_Acc; Res_Type : Type_Acc; Res : Valtyp; - Arr : Value_Array_Acc; Pos : Nat8; begin case Str_Typ.Kind is @@ -1969,15 +1603,18 @@ package body Synth.Expr is Bnds.D (1) := Bounds; Res_Type := Create_Array_Type (Bnds, El_Type); end if; - Arr := Create_Value_Array (Iir_Index32 (Bounds.Len)); + Res := Create_Value_Memory (Res_Type); - for I in Arr.V'Range loop + -- Only U8 are handled. + pragma Assert (El_Type.Sz = 1); + + -- From left to right. + for I in 1 .. Bounds.Len loop -- FIXME: use literal from type ?? Pos := Str_Table.Element_String8 (Id, Pos32 (I)); - Arr.V (I) := Create_Value_Discrete (Int64 (Pos), El_Type).Val; + Write_U8 (Res.Val.Mem + Size_Type (I - 1), Nat8'Pos (Pos)); end loop; - Res := Create_Value_Const_Array (Res_Type, Arr); return Res; end Synth_String_Literal; @@ -2026,7 +1663,7 @@ package body Synth.Expr is return No_Valtyp; end if; if Is_Static_Val (Left.Val) - and then Get_Static_Discrete (Left.Val) = Val + and then Get_Static_Discrete (Left) = Val then return Create_Value_Discrete (Val, Boolean_Type); end if; @@ -2041,7 +1678,7 @@ package body Synth.Expr is -- Return a static value if both operands are static. -- Note: we know the value of left if it is not constant. if Is_Static_Val (Left.Val) and then Is_Static_Val (Right.Val) then - Val := Get_Static_Discrete (Right.Val); + Val := Get_Static_Discrete (Right); return Create_Value_Discrete (Val, Boolean_Type); end if; @@ -2052,9 +1689,7 @@ package body Synth.Expr is function Synth_Expression_With_Type (Syn_Inst : Synth_Instance_Acc; Expr : Node; Expr_Type : Type_Acc) - return Valtyp - is - Res : Valtyp; + return Valtyp is begin case Get_Kind (Expr) is when Iir_Kinds_Dyadic_Operator => @@ -2135,7 +1770,8 @@ package body Synth.Expr is declare Base : Valtyp; Typ : Type_Acc; - Off : Uns32; + Off : Value_Offsets; + Res : Valtyp; Voff : Net; Rdwd : Width; @@ -2143,10 +1779,13 @@ package body Synth.Expr is Synth_Assignment_Prefix (Syn_Inst, Expr, Base, Typ, Off, Voff, Rdwd); if Voff = No_Net and then Is_Static (Base.Val) then - pragma Assert (Off = 0); - return Base; + Res := Create_Value_Memory (Typ); + Copy_Memory + (Res.Val.Mem, Base.Val.Mem + Off.Mem_Off, Typ.Sz); + return Res; end if; - return Synth_Read_Memory (Syn_Inst, Base, Typ, Off, Voff, Expr); + return Synth_Read_Memory + (Syn_Inst, Base, Typ, Off.Net_Off, Voff, Expr); end; when Iir_Kind_Selected_Element => declare @@ -2155,16 +1794,22 @@ package body Synth.Expr is Pfx : constant Node := Get_Prefix (Expr); Res_Typ : Type_Acc; N : Net; + Val : Valtyp; + Res : Valtyp; begin - Res := Synth_Expression (Syn_Inst, Pfx); - Strip_Const (Res); - Res_Typ := Res.Typ.Rec.E (Idx + 1).Typ; - if Res.Val.Kind = Value_Const_Record then - return (Res_Typ, Res.Val.Rec.V (Idx + 1)); + Val := Synth_Expression (Syn_Inst, Pfx); + Strip_Const (Val); + Res_Typ := Val.Typ.Rec.E (Idx + 1).Typ; + if Is_Static (Val.Val) then + Res := Create_Value_Memory (Res_Typ); + Copy_Memory + (Res.Val.Mem, Val.Val.Mem + Val.Typ.Rec.E (Idx + 1).Moff, + Res_Typ.Sz); + return Res; else N := Build_Extract - (Build_Context, Get_Net (Res), - Res.Typ.Rec.E (Idx + 1).Off, Get_Type_Width (Res_Typ)); + (Build_Context, Get_Net (Val), + Val.Typ.Rec.E (Idx + 1).Boff, Get_Type_Width (Res_Typ)); Set_Location (N, Expr); return Create_Value_Net (N, Res_Typ); end if; @@ -2173,7 +1818,13 @@ package body Synth.Expr is return Synth_Expression_With_Type (Syn_Inst, Get_Named_Entity (Expr), Expr_Type); when Iir_Kind_Integer_Literal => - return Create_Value_Discrete (Get_Value (Expr), Expr_Type); + declare + Res : Valtyp; + begin + Res := Create_Value_Memory (Expr_Type); + Write_Discrete (Res, Get_Value (Expr)); + return Res; + end; when Iir_Kind_Floating_Point_Literal => return Create_Value_Float (Get_Fp_Value (Expr), Expr_Type); when Iir_Kind_Physical_Int_Literal @@ -2204,7 +1855,7 @@ package body Synth.Expr is end case; end; when Iir_Kind_Aggregate => - return Synth_Aggregate (Syn_Inst, Expr, Expr_Type); + return Synth.Aggr.Synth_Aggregate (Syn_Inst, Expr, Expr_Type); when Iir_Kind_Simple_Aggregate => return Synth_Simple_Aggregate (Syn_Inst, Expr); when Iir_Kind_Left_Array_Attribute => @@ -2278,7 +1929,7 @@ package body Synth.Expr is when Iir_Kind_Image_Attribute => return Synth_Image_Attribute (Syn_Inst, Expr); when Iir_Kind_Null_Literal => - return Create_Value_Access (Expr_Type, Null_Heap_Index); + return Create_Value_Access (Null_Heap_Index, Expr_Type); when Iir_Kind_Allocator_By_Subtype => declare T : Type_Acc; @@ -2287,7 +1938,7 @@ package body Synth.Expr is T := Synth.Decls.Synth_Subtype_Indication (Syn_Inst, Get_Subtype_Indication (Expr)); Acc := Allocate_By_Type (T); - return Create_Value_Access (Expr_Type, Acc); + return Create_Value_Access (Acc, Expr_Type); end; when Iir_Kind_Allocator_By_Expression => declare @@ -2297,7 +1948,7 @@ package body Synth.Expr is V := Synth_Expression_With_Type (Syn_Inst, Get_Expression (Expr), Expr_Type.Acc_Acc); Acc := Allocate_By_Value (V); - return Create_Value_Access (Expr_Type, Acc); + return Create_Value_Access (Acc, Expr_Type); end; when Iir_Kind_Overflow_Literal => declare diff --git a/src/synth/synth-expr.ads b/src/synth/synth-expr.ads index 84544eadf..3c47bebfa 100644 --- a/src/synth/synth-expr.ads +++ b/src/synth/synth-expr.ads @@ -23,7 +23,6 @@ with Ada.Unchecked_Deallocation; with Types; use Types; with Netlists; use Netlists; -with Netlists.Utils; use Netlists.Utils; with Synth.Source; with Synth.Values; use Synth.Values; @@ -39,7 +38,6 @@ package Synth.Expr is return Valtyp; -- For a static value V, return the value. - function Get_Static_Discrete (V : Value_Acc) return Int64; function Get_Static_Discrete (V : Valtyp) return Int64; -- Return True only if discrete value V is known to be positive or 0. @@ -66,7 +64,7 @@ package Synth.Expr is function Synth_Clock_Edge (Syn_Inst : Synth_Instance_Acc; Left, Right : Node) return Net; - function Concat_Array (Arr : Net_Array_Acc) return Net; + procedure Concat_Array (Arr : in out Net_Array; N : out Net); function Synth_Expression_With_Type (Syn_Inst : Synth_Instance_Acc; Expr : Node; Expr_Type : Type_Acc) @@ -101,11 +99,10 @@ package Synth.Expr is procedure Synth_Slice_Suffix (Syn_Inst : Synth_Instance_Acc; Name : Node; Pfx_Bnd : Bound_Type; - El_Wd : Width; + El_Typ : Type_Acc; Res_Bnd : out Bound_Type; Inp : out Net; - Off : out Uns32; - Wd : out Width); + Off : out Value_Offsets); -- If VOFF is No_Net then OFF is valid, if VOFF is not No_Net then -- OFF is 0. @@ -113,8 +110,7 @@ package Synth.Expr is Name : Node; Pfx_Type : Type_Acc; Voff : out Net; - Off : out Uns32; - W : out Width); + Off : out Value_Offsets); -- Return the type of EXPR (an object) without evaluating it (except when -- needed, like bounds of a slice). diff --git a/src/synth/synth-files_operations.adb b/src/synth/synth-files_operations.adb index d840035be..525adec54 100644 --- a/src/synth/synth-files_operations.adb +++ b/src/synth/synth-files_operations.adb @@ -47,16 +47,17 @@ package body Synth.Files_Operations is procedure Convert_String (Val : Valtyp; Res : out String) is Vtyp : constant Type_Acc := Val.Typ; + Vlen : constant Uns32 := Vtyp.Abounds.D (1).Len; begin pragma Assert (Vtyp.Kind = Type_Array); pragma Assert (Vtyp.Arr_El.Kind = Type_Discrete); pragma Assert (Vtyp.Arr_El.W in 7 .. 8); -- Could be 7 in vhdl87 - pragma Assert (Vtyp.Abounds.Len = 1); + pragma Assert (Vtyp.Abounds.Ndim = 1); pragma Assert (Vtyp.Abounds.D (1).Len = Res'Length); - for I in Val.Val.Arr.V'Range loop + for I in 1 .. Vlen loop Res (Res'First + Natural (I - 1)) := - Character'Val (Val.Val.Arr.V (I).Scal); + Character'Val (Read_U8 (Val.Val.Mem + Size_Type (I - 1))); end loop; end Convert_String; @@ -69,7 +70,7 @@ package body Synth.Files_Operations is Name : constant Valtyp := Strip_Alias_Const (Val); pragma Unreferenced (Val); begin - Len := Natural (Name.Val.Arr.Len); + Len := Natural (Name.Typ.Abounds.D (1).Len); if Len >= Res'Length - 1 then Status := Op_Filename_Error; @@ -125,7 +126,7 @@ package body Synth.Files_Operations is if Open_Kind /= Null_Node then Mode := Synth_Expression (Syn_Inst, Open_Kind); - File_Mode := Ghdl_I32 (Mode.Val.Scal); + File_Mode := Ghdl_I32 (Read_Discrete (Mode)); else case Get_Mode (Decl) is when Iir_In_Mode => @@ -196,7 +197,7 @@ package body Synth.Files_Operations is begin Convert_File_Name (File_Name, C_Name, C_Name_Len, Status); if Status = Op_Ok then - File_Mode := Ghdl_I32 (Open_Kind.Val.Scal); + File_Mode := Ghdl_I32 (Read_Discrete (Open_Kind)); if Get_Text_File_Flag (Get_Type (Inters)) then Ghdl_Text_File_Open (F, File_Mode, To_Ghdl_C_String (C_Name'Address), Status); @@ -250,7 +251,7 @@ package body Synth.Files_Operations is Str : constant Valtyp := Get_Value (Syn_Inst, Param2); Param3 : constant Node := Get_Chain (Param2); Param_Len : constant Valtyp := Get_Value (Syn_Inst, Param3); - Buf : String (1 .. Natural (Str.Val.Arr.Len)); + Buf : String (1 .. Natural (Str.Typ.Abounds.D (1).Len)); Len : Std_Integer; Status : Op_Status; begin @@ -262,10 +263,10 @@ package body Synth.Files_Operations is end if; for I in 1 .. Natural (Len) loop - Str.Val.Arr.V (Iir_Index32 (I)).Scal := Character'Pos (Buf (I)); + Write_U8 (Str.Val.Mem + Size_Type (I - 1), Character'Pos (Buf (I))); end loop; - Param_Len.Val.Scal := Int64 (Len); + Write_Discrete (Param_Len, Int64 (Len)); end Synth_Untruncated_Text_Read; end Synth.Files_Operations; diff --git a/src/synth/synth-heap.adb b/src/synth/synth-heap.adb index 76935a93c..75d0f7c82 100644 --- a/src/synth/synth-heap.adb +++ b/src/synth/synth-heap.adb @@ -21,7 +21,6 @@ with Types; use Types; with Tables; -with Vhdl.Nodes; use Vhdl.Nodes; package body Synth.Heap is @@ -31,32 +30,24 @@ package body Synth.Heap is Table_Low_Bound => 1, Table_Initial => 16); - function Allocate_By_Type (T : Type_Acc) return Value_Acc is + function Alloc_Mem (Sz : Size_Type) return Memory_Ptr; + pragma Import (C, Alloc_Mem, "malloc"); + + function Allocate_Memory (T : Type_Acc) return Value_Acc + is + M : Memory_Ptr; + begin + M := Alloc_Mem (T.Sz); + return new Value_Type'(Kind => Value_Memory, Mem => M); + end Allocate_Memory; + + function Allocate_By_Type (T : Type_Acc) return Value_Acc + is + Res : Value_Acc; begin - case T.Kind is - when Type_Bit - | Type_Logic => - return new Value_Type' - (Kind => Value_Discrete, Scal => 0); - when Type_Discrete => - return new Value_Type' - (Kind => Value_Discrete, Scal => T.Drange.Left); - when Type_Array => - declare - Len : constant Uns32 := Get_Array_Flat_Length (T); - El_Typ : constant Type_Acc := Get_Array_Element (T); - Arr : Value_Array_Acc; - begin - Arr := new Value_Array_Type (Iir_Index32 (Len)); - for I in Arr.V'Range loop - Arr.V (I) := Allocate_By_Type (El_Typ); - end loop; - return new Value_Type' - (Kind => Value_Const_Array, Arr => Arr); - end; - when others => - raise Internal_Error; - end case; + Res := Allocate_Memory (T); + Write_Value_Default (Res.Mem, T); + return Res; end Allocate_By_Type; function Allocate_By_Type (T : Type_Acc) return Heap_Index is @@ -66,30 +57,13 @@ package body Synth.Heap is return Heap_Table.Last; end Allocate_By_Type; - function Allocate_By_Value (V : Valtyp) return Value_Acc is + function Allocate_By_Value (V : Valtyp) return Value_Acc + is + Res : Value_Acc; begin - case V.Val.Kind is - when Value_Net - | Value_Wire => - raise Internal_Error; - when Value_Discrete => - return new Value_Type'(Kind => Value_Discrete, Scal => V.Val.Scal); - when Value_Array - | Value_Const_Array => - declare - El_Typ : constant Type_Acc := Get_Array_Element (V.Typ); - Arr : Value_Array_Acc; - begin - Arr := new Value_Array_Type (V.Val.Arr.Len); - for I in Arr.V'Range loop - Arr.V (I) := Allocate_By_Value - ((El_Typ, V.Val.Arr.V (I))); - end loop; - return new Value_Type'(Kind => Value_Const_Array, Arr => Arr); - end; - when others => - raise Internal_Error; - end case; + Res := Allocate_Memory (V.Typ); + Write_Value (Res.Mem, V); + return Res; end Allocate_By_Value; function Allocate_By_Value (V : Valtyp) return Heap_Index is diff --git a/src/synth/synth-insts.adb b/src/synth/synth-insts.adb index 93d601a5f..85693b11f 100644 --- a/src/synth/synth-insts.adb +++ b/src/synth/synth-insts.adb @@ -118,8 +118,8 @@ package body Synth.Insts is end if; Inter := Get_Generic_Chain (Params.Decl); while Inter /= Null_Node loop - if not Is_Equal (Get_Value (Obj.Syn_Inst, Inter).Val, - Get_Value (Params.Syn_Inst, Inter).Val) + if not Is_Equal (Get_Value (Obj.Syn_Inst, Inter), + Get_Value (Params.Syn_Inst, Inter)) then return False; end if; @@ -156,6 +156,17 @@ package body Synth.Insts is GNAT.SHA1.Update (C, S); end Hash_Uns64; + procedure Hash_Memory (C : in out GNAT.SHA1.Context; + M : Memory_Ptr; + Typ : Type_Acc) + is + S : String (1 .. Natural (Typ.Sz)); + for S'Address use M (0)'Address; + pragma Import (Ada, S); + begin + GNAT.SHA1.Update (C, S); + end Hash_Memory; + procedure Hash_Bound (C : in out GNAT.SHA1.Context; B : Bound_Type) is begin Hash_Uns64 (C, Iir_Direction'Pos (B.Dir)); @@ -182,37 +193,17 @@ package body Synth.Insts is Typ : Type_Acc) is begin case Val.Kind is - when Value_Discrete => - Hash_Uns64 (C, To_Uns64 (Val.Scal)); - when Value_Float => - Hash_Uns64 (C, To_Uns64 (Val.Fp)); - when Value_Const_Array => - declare - El_Typ : constant Type_Acc := Get_Array_Element (Typ); - begin - -- Bounds. - Hash_Bounds (C, Typ); - -- Values. - for I in Val.Arr.V'Range loop - Hash_Const (C, Val.Arr.V (I), El_Typ); - end loop; - end; - when Value_Const_Record => - for I in Val.Rec.V'Range loop - Hash_Const (C, Val.Rec.V (I), Typ.Rec.E (I).Typ); - end loop; + when Value_Memory => + Hash_Memory (C, Val.Mem, Typ); when Value_Const => Hash_Const (C, Val.C_Val, Typ); when Value_Alias => - if Val.A_Off /= 0 then + if Val.A_Off /= (0, 0) then raise Internal_Error; end if; Hash_Const (C, Val.A_Obj, Typ); when Value_Net | Value_Wire - | Value_Array - | Value_Record - | Value_Access | Value_File => raise Internal_Error; end case; @@ -274,11 +265,12 @@ package body Synth.Insts is Gen_Decl := Generics; while Gen_Decl /= Null_Node loop Gen := Get_Value (Params.Syn_Inst, Gen_Decl); - case Gen.Val.Kind is - when Value_Discrete => + Strip_Const (Gen); + case Gen.Typ.Kind is + when Type_Discrete => declare S : constant String := - Uns64'Image (To_Uns64 (Gen.Val.Scal)); + Uns64'Image (To_Uns64 (Read_Discrete (Gen))); begin if Len + S'Length > Str_Len then Has_Hash := True; @@ -555,23 +547,21 @@ package body Synth.Insts is begin Synth_Individual_Prefix (Syn_Inst, Inter_Inst, Get_Prefix (Formal), Off, Typ); - Off := Off + Typ.Rec.E (Idx + 1).Off; + Off := Off + Typ.Rec.E (Idx + 1).Boff; Typ := Typ.Rec.E (Idx + 1).Typ; end; when Iir_Kind_Indexed_Name => declare Voff : Net; - Arr_Off : Uns32; - W : Width; + Arr_Off : Value_Offsets; begin Synth_Individual_Prefix (Syn_Inst, Inter_Inst, Get_Prefix (Formal), Off, Typ); - Synth_Indexed_Name - (Syn_Inst, Formal, Typ, Voff, Arr_Off, W); + Synth_Indexed_Name (Syn_Inst, Formal, Typ, Voff, Arr_Off); if Voff /= No_Net then raise Internal_Error; end if; - Off := Off + Arr_Off; + Off := Off + Arr_Off.Net_Off; Typ := Get_Array_Element (Typ); end; when Iir_Kind_Slice_Name => @@ -580,19 +570,18 @@ package body Synth.Insts is El_Typ : Type_Acc; Res_Bnd : Bound_Type; Sl_Voff : Net; - Sl_Off : Uns32; - Wd : Uns32; + Sl_Off : Value_Offsets; begin Synth_Individual_Prefix (Syn_Inst, Inter_Inst, Get_Prefix (Formal), Off, Typ); Get_Onedimensional_Array_Bounds (Typ, Pfx_Bnd, El_Typ); - Synth_Slice_Suffix (Syn_Inst, Formal, Pfx_Bnd, El_Typ.W, - Res_Bnd, Sl_Voff, Sl_Off, Wd); + Synth_Slice_Suffix (Syn_Inst, Formal, Pfx_Bnd, El_Typ, + Res_Bnd, Sl_Voff, Sl_Off); if Sl_Voff /= No_Net then raise Internal_Error; end if; - Off := Off + Sl_Off; + Off := Off + Sl_Off.Net_Off; Typ := Create_Onedimensional_Array_Subtype (Typ, Res_Bnd); end; when others => diff --git a/src/synth/synth-oper.adb b/src/synth/synth-oper.adb index e9f93fb0e..2f2dc6dcc 100644 --- a/src/synth/synth-oper.adb +++ b/src/synth/synth-oper.adb @@ -54,12 +54,12 @@ package body Synth.Oper is Res : Net; begin if Is_Static (Val.Val) and then Val.Typ.Kind = Type_Discrete then - if Val.Typ.Drange.Is_Signed and then Val.Val.Scal < 0 then + if Val.Typ.Drange.Is_Signed and then Read_Discrete (Val) < 0 then -- TODO. raise Internal_Error; else Res := Build2_Const_Uns - (Build_Context, To_Uns64 (Val.Val.Scal), W); + (Build_Context, To_Uns64 (Read_Discrete (Val)), W); end if; Set_Location (Res, Loc); return Res; @@ -73,7 +73,7 @@ package body Synth.Oper is begin if Is_Static (Val.Val) and then Val.Typ.Kind = Type_Discrete then if Val.Typ.Drange.Is_Signed then - Res := Build2_Const_Int (Build_Context, Val.Val.Scal, W); + Res := Build2_Const_Int (Build_Context, Read_Discrete (Val), W); else -- TODO. raise Internal_Error; @@ -94,10 +94,11 @@ package body Synth.Oper is begin if Is_Static (Expr.Val) then return Create_Value_Discrete - (Boolean'Pos (Cst.Val.Scal = Expr.Val.Scal), Boolean_Type); + (Boolean'Pos (Read_Discrete (Cst) = Read_Discrete (Expr)), + Boolean_Type); end if; - To_Logic (Cst.Val.Scal, Cst.Typ, Val, Zx); + To_Logic (Read_Discrete (Cst), Cst.Typ, Val, Zx); if Zx /= 0 then -- Equal unknown -> return X N := Build_Const_UL32 (Build_Context, 0, 1, 1); @@ -197,8 +198,8 @@ package body Synth.Oper is Boff := 0; Woff := 0; - for I in reverse Cst.Val.Arr.V'Range loop - case Cst.Val.Arr.V (I).Scal is + for I in reverse 1 .. Vec_Length (Cst.Typ) loop + case Read_U8 (Cst.Val.Mem + Size_Type (I - 1)) is when Std_Logic_0_Pos | Std_Logic_L_Pos => B := 0; @@ -604,7 +605,7 @@ package body Synth.Oper is N : Net; begin if Is_Static_Val (Right.Val) then - Amt := Get_Static_Discrete (Right.Val); + Amt := Get_Static_Discrete (Right); if Amt < 0 then raise Internal_Error; end if; @@ -1057,7 +1058,7 @@ package body Synth.Oper is when Iir_Predefined_Ieee_Numeric_Std_Lt_Uns_Nat | Iir_Predefined_Ieee_Numeric_Std_Match_Lt_Uns_Nat => -- "<" (Unsigned, Natural) - if Is_Static (Right.Val) and then Right.Val.Scal = 0 then + if Is_Static (Right.Val) and then Read_Discrete (Right) = 0 then -- Always false. return Create_Value_Discrete (0, Expr_Typ); end if; @@ -1241,7 +1242,7 @@ package body Synth.Oper is use Mutils; Etype : constant Type_Acc := Get_Subtype_Object (Syn_Inst, Expr_Type); - R : constant Int64 := Get_Static_Discrete (Right.Val); + R : constant Int64 := Get_Static_Discrete (Right); Log_R : Natural; N : Net; begin @@ -1427,15 +1428,17 @@ package body Synth.Oper is function Synth_Conv_Vector (Is_Signed : Boolean) return Valtyp is Arg : constant Valtyp := Get_Value (Subprg_Inst, Param1); - Size_Vt : constant Valtyp := Get_Value (Subprg_Inst, Param2); + Size_Vt : Valtyp; Size : Width; Arg_Net : Net; begin + Size_Vt := Get_Value (Subprg_Inst, Param2); + Strip_Const (Size_Vt); if not Is_Static (Size_Vt.Val) then Error_Msg_Synth (+Expr, "size parameter must be constant"); return No_Valtyp; end if; - Size := Uns32 (Strip_Const (Size_Vt.Val).Scal); + Size := Uns32 (Read_Discrete (Size_Vt)); Arg_Net := Get_Net (Arg); Arg_Net := Build2_Resize (Ctxt, Arg_Net, Size, Is_Signed, Get_Location (Expr)); @@ -1518,7 +1521,7 @@ package body Synth.Oper is Error_Msg_Synth (+Expr, "size must be constant"); return No_Valtyp; end if; - W := Uns32 (R.Val.Scal); + W := Uns32 (Read_Discrete (R)); return Create_Value_Net (Synth_Uresize (Get_Net (L), W, Expr), Create_Vec_Type_By_Length (W, Logic_Type)); @@ -1531,7 +1534,7 @@ package body Synth.Oper is Error_Msg_Synth (+Expr, "size must be constant"); return No_Valtyp; end if; - W := Uns32 (R.Val.Scal); + W := Uns32 (Read_Discrete (R)); return Create_Value_Net (Build2_Sresize (Ctxt, Get_Net (L), W, Get_Location (Expr)), Create_Vec_Type_By_Length (W, Logic_Type)); diff --git a/src/synth/synth-static_oper.adb b/src/synth/synth-static_oper.adb index 641289492..2cf4c1b98 100644 --- a/src/synth/synth-static_oper.adb +++ b/src/synth/synth-static_oper.adb @@ -21,6 +21,8 @@ with Types; use Types; with Types_Utils; use Types_Utils; +with Grt.Types; + with Vhdl.Utils; use Vhdl.Utils; with Vhdl.Ieee.Std_Logic_1164; use Vhdl.Ieee.Std_Logic_1164; @@ -48,7 +50,7 @@ package body Synth.Static_Oper is type Static_Arr_Type (Kind : Static_Arr_Kind) is record case Kind is when Sarr_Value => - Arr : Value_Array_Acc; + Arr : Memory_Ptr; when Sarr_Net => N : Net; end case; @@ -60,9 +62,9 @@ package body Synth.Static_Oper is begin case V.Val.Kind is when Value_Const => - return (Kind => Sarr_Value, Arr => V.Val.C_Val.Arr); - when Value_Const_Array => - return (Kind => Sarr_Value, Arr => V.Val.Arr); + return (Kind => Sarr_Value, Arr => V.Val.C_Val.Mem); + when Value_Memory => + return (Kind => Sarr_Value, Arr => V.Val.Mem); when Value_Net => N := V.Val.N; when Value_Wire => @@ -94,7 +96,7 @@ package body Synth.Static_Oper is begin case Sarr.Kind is when Sarr_Value => - return Std_Ulogic'Val (Sarr.Arr.V (Iir_Index32 (Off + 1)).Scal); + return Std_Ulogic'Val (Read_U8 (Sarr.Arr + Size_Type (Off))); when Sarr_Net => declare Va : Uns32; @@ -303,15 +305,15 @@ package body Synth.Static_Oper is is Larr : constant Static_Arr_Type := Get_Static_Array (Left); Rarr : constant Static_Arr_Type := Get_Static_Array (Right); - Arr : Value_Array_Acc; + Res : Valtyp; begin if Left.Typ.W /= Right.Typ.W then Error_Msg_Synth (+Loc, "length of operands mismatch"); return No_Valtyp; end if; - Arr := Create_Value_Array (Iir_Index32 (Left.Typ.W)); - for I in Arr.V'Range loop + Res := Create_Value_Memory (Create_Res_Bound (Left.Typ)); + for I in 1 .. Vec_Length (Res.Typ) loop declare Ls : constant Std_Ulogic := Get_Static_Std_Logic (Larr, Uns32 (I - 1)); @@ -319,11 +321,11 @@ package body Synth.Static_Oper is Get_Static_Std_Logic (Rarr, Uns32 (I - 1)); V : constant Std_Ulogic := Op (Ls, Rs); begin - Arr.V (I) := Create_Value_Discrete (Std_Ulogic'Pos (V)); + Write_U8 (Res.Val.Mem + Size_Type (I - 1), Std_Ulogic'Pos (V)); end; end loop; - return Create_Value_Const_Array (Create_Res_Bound (Left.Typ), Arr); + return Res; end Synth_Vector_Dyadic; procedure To_Std_Logic_Vector @@ -333,8 +335,9 @@ package body Synth.Static_Oper is begin case Sarr.Kind is when Sarr_Value => - for I in Val.Val.Arr.V'Range loop - Arr (Natural (I)) := Std_Ulogic'Val (Val.Val.Arr.V (I).Scal); + for I in 1 .. Vec_Length (Val.Typ) loop + Arr (Natural (I)) := + Std_Ulogic'Val (Read_U8 (Val.Val.Mem + Size_Type (I - 1))); end loop; when Sarr_Net => for I in Arr'Range loop @@ -348,22 +351,21 @@ package body Synth.Static_Oper is is pragma Assert (Vec'First = 1); Res_Typ : Type_Acc; - Arr : Value_Array_Acc; + Res : Valtyp; begin Res_Typ := Create_Vec_Type_By_Length (Uns32 (Vec'Last), El_Typ); - Arr := Create_Value_Array (Iir_Index32 (Vec'Last)); - for I in Vec'Range loop - Arr.V (Iir_Index32 (I)) := - Create_Value_Discrete (Std_Ulogic'Pos (Vec (I))); + Res := Create_Value_Memory (Res_Typ); + for I in 1 .. Vec'Last loop + Write_U8 (Res.Val.Mem + Size_Type (I - 1), Std_Ulogic'Pos (Vec (I))); end loop; - return Create_Value_Const_Array (Res_Typ, Arr); + return Res; end To_Valtyp; function Synth_Add_Uns_Uns (L, R : Valtyp; Loc : Syn_Src) return Valtyp is pragma Unreferenced (Loc); - L_Arr : Std_Logic_Vector (1 .. Natural (L.Val.Arr.Len)); - R_Arr : Std_Logic_Vector (1 .. Natural (R.Val.Arr.Len)); + L_Arr : Std_Logic_Vector (1 .. Natural (Vec_Length (L.Typ))); + R_Arr : Std_Logic_Vector (1 .. Natural (Vec_Length (R.Typ))); begin To_Std_Logic_Vector (L, L_Arr); To_Std_Logic_Vector (R, R_Arr); @@ -377,8 +379,8 @@ package body Synth.Static_Oper is function Synth_Add_Sgn_Int (L, R : Valtyp; Loc : Syn_Src) return Valtyp is pragma Unreferenced (Loc); - L_Arr : Std_Logic_Vector (1 .. Natural (L.Val.Arr.Len)); - R_Val : constant Int64 := R.Val.Scal; + L_Arr : Std_Logic_Vector (1 .. Natural (Vec_Length (L.Typ))); + R_Val : constant Int64 := Read_Discrete (R); begin To_Std_Logic_Vector (L, L_Arr); declare @@ -392,7 +394,7 @@ package body Synth.Static_Oper is is pragma Unreferenced (Loc); L_Arr : Std_Logic_Vector (1 .. Natural (L.Typ.W)); - R_Val : constant Uns64 := Uns64 (R.Val.Scal); + R_Val : constant Uns64 := Uns64 (Read_Discrete (R)); begin To_Std_Logic_Vector (L, L_Arr); declare @@ -405,8 +407,8 @@ package body Synth.Static_Oper is function Synth_Sub_Uns_Uns (L, R : Valtyp; Loc : Syn_Src) return Valtyp is pragma Unreferenced (Loc); - L_Arr : Std_Logic_Vector (1 .. Natural (L.Val.Arr.Len)); - R_Arr : Std_Logic_Vector (1 .. Natural (R.Val.Arr.Len)); + L_Arr : Std_Logic_Vector (1 .. Natural (Vec_Length (L.Typ))); + R_Arr : Std_Logic_Vector (1 .. Natural (Vec_Length (R.Typ))); begin To_Std_Logic_Vector (L, L_Arr); To_Std_Logic_Vector (R, R_Arr); @@ -420,8 +422,8 @@ package body Synth.Static_Oper is function Synth_Sub_Uns_Nat (L, R : Valtyp; Loc : Syn_Src) return Valtyp is pragma Unreferenced (Loc); - L_Arr : Std_Logic_Vector (1 .. Natural (L.Val.Arr.Len)); - R_Val : constant Uns64 := Uns64 (R.Val.Scal); + L_Arr : Std_Logic_Vector (1 .. Natural (Vec_Length (L.Typ))); + R_Val : constant Uns64 := Uns64 (Read_Discrete (R)); begin To_Std_Logic_Vector (L, L_Arr); declare @@ -434,8 +436,8 @@ package body Synth.Static_Oper is function Synth_Mul_Uns_Uns (L, R : Valtyp; Loc : Syn_Src) return Valtyp is pragma Unreferenced (Loc); - L_Arr : Std_Logic_Vector (1 .. Natural (L.Val.Arr.Len)); - R_Arr : Std_Logic_Vector (1 .. Natural (R.Val.Arr.Len)); + L_Arr : Std_Logic_Vector (1 .. Natural (Vec_Length (L.Typ))); + R_Arr : Std_Logic_Vector (1 .. Natural (Vec_Length (R.Typ))); begin To_Std_Logic_Vector (L, L_Arr); To_Std_Logic_Vector (R, R_Arr); @@ -449,8 +451,8 @@ package body Synth.Static_Oper is function Synth_Mul_Nat_Uns (L, R : Valtyp; Loc : Syn_Src) return Valtyp is pragma Unreferenced (Loc); - R_Arr : Std_Logic_Vector (1 .. Natural (R.Val.Arr.Len)); - L_Val : constant Uns64 := Uns64 (L.Val.Scal); + R_Arr : Std_Logic_Vector (1 .. Natural (Vec_Length (R.Typ))); + L_Val : constant Uns64 := Uns64 (Read_Discrete (L)); begin To_Std_Logic_Vector (R, R_Arr); declare @@ -463,8 +465,8 @@ package body Synth.Static_Oper is function Synth_Mul_Sgn_Sgn (L, R : Valtyp; Loc : Syn_Src) return Valtyp is pragma Unreferenced (Loc); - L_Arr : Std_Logic_Vector (1 .. Natural (L.Val.Arr.Len)); - R_Arr : Std_Logic_Vector (1 .. Natural (R.Val.Arr.Len)); + L_Arr : Std_Logic_Vector (1 .. Natural (Vec_Length (L.Typ))); + R_Arr : Std_Logic_Vector (1 .. Natural (Vec_Length (R.Typ))); begin To_Std_Logic_Vector (L, L_Arr); To_Std_Logic_Vector (R, R_Arr); @@ -480,7 +482,7 @@ package body Synth.Static_Oper is Right : Boolean; Arith : Boolean) return Valtyp is - Len : constant Uns32 := Uns32 (Val.Val.Arr.Len); + Len : constant Uns32 := Uns32 (Vec_Length (Val.Typ)); Arr : Std_Logic_Vector (1 .. Natural (Len)); Pad : Std_Ulogic; begin @@ -577,10 +579,11 @@ package body Synth.Static_Oper is Res_Typ); when Iir_Predefined_Integer_Rem => return Create_Value_Discrete - (Left.Val.Scal rem Right.Val.Scal, Res_Typ); + (Read_Discrete (Left) rem Read_Discrete (Right), Res_Typ); when Iir_Predefined_Integer_Exp => return Create_Value_Discrete - (Left.Val.Scal ** Natural (Right.Val.Scal), Res_Typ); + (Read_Discrete (Left) ** Natural (Read_Discrete (Right)), + Res_Typ); when Iir_Predefined_Physical_Minimum | Iir_Predefined_Integer_Minimum => return Create_Value_Discrete @@ -596,19 +599,23 @@ package body Synth.Static_Oper is when Iir_Predefined_Integer_Less_Equal | Iir_Predefined_Physical_Less_Equal => return Create_Value_Discrete - (Boolean'Pos (Left.Val.Scal <= Right.Val.Scal), Boolean_Type); + (Boolean'Pos (Read_Discrete (Left) <= Read_Discrete (Right)), + Boolean_Type); when Iir_Predefined_Integer_Less | Iir_Predefined_Physical_Less => return Create_Value_Discrete - (Boolean'Pos (Left.Val.Scal < Right.Val.Scal), Boolean_Type); + (Boolean'Pos (Read_Discrete (Left) < Read_Discrete (Right)), + Boolean_Type); when Iir_Predefined_Integer_Greater_Equal | Iir_Predefined_Physical_Greater_Equal => return Create_Value_Discrete - (Boolean'Pos (Left.Val.Scal >= Right.Val.Scal), Boolean_Type); + (Boolean'Pos (Read_Discrete (Left) >= Read_Discrete (Right)), + Boolean_Type); when Iir_Predefined_Integer_Greater | Iir_Predefined_Physical_Greater => return Create_Value_Discrete - (Boolean'Pos (Left.Val.Scal > Right.Val.Scal), Boolean_Type); + (Boolean'Pos (Read_Discrete (Left) > Read_Discrete (Right)), + Boolean_Type); when Iir_Predefined_Integer_Equality | Iir_Predefined_Physical_Equality => return Create_Value_Discrete @@ -623,44 +630,57 @@ package body Synth.Static_Oper is when Iir_Predefined_Physical_Real_Mul => return Create_Value_Discrete - (Int64 (Fp64 (Left.Val.Scal) * Right.Val.Fp), Res_Typ); + (Int64 (Fp64 (Read_Discrete (Left)) * Read_Fp64 (Right)), + Res_Typ); when Iir_Predefined_Real_Physical_Mul => return Create_Value_Discrete - (Int64 (Left.Val.Fp * Fp64 (Right.Val.Scal)), Res_Typ); + (Int64 (Read_Fp64 (Left) * Fp64 (Read_Discrete (Right))), + Res_Typ); when Iir_Predefined_Physical_Real_Div => return Create_Value_Discrete - (Int64 (Fp64 (Left.Val.Scal) / Right.Val.Fp), Res_Typ); + (Int64 (Fp64 (Read_Discrete (Left)) / Read_Fp64 (Right)), + Res_Typ); when Iir_Predefined_Floating_Less => return Create_Value_Discrete - (Boolean'Pos (Left.Val.Fp < Right.Val.Fp), Boolean_Type); + (Boolean'Pos (Read_Fp64 (Left) < Read_Fp64 (Right)), + Boolean_Type); when Iir_Predefined_Floating_Less_Equal => return Create_Value_Discrete - (Boolean'Pos (Left.Val.Fp <= Right.Val.Fp), Boolean_Type); + (Boolean'Pos (Read_Fp64 (Left) <= Read_Fp64 (Right)), + Boolean_Type); when Iir_Predefined_Floating_Equality => return Create_Value_Discrete - (Boolean'Pos (Left.Val.Fp = Right.Val.Fp), Boolean_Type); + (Boolean'Pos (Read_Fp64 (Left) = Read_Fp64 (Right)), + Boolean_Type); when Iir_Predefined_Floating_Inequality => return Create_Value_Discrete - (Boolean'Pos (Left.Val.Fp /= Right.Val.Fp), Boolean_Type); + (Boolean'Pos (Read_Fp64 (Left) /= Read_Fp64 (Right)), + Boolean_Type); when Iir_Predefined_Floating_Greater => return Create_Value_Discrete - (Boolean'Pos (Left.Val.Fp > Right.Val.Fp), Boolean_Type); + (Boolean'Pos (Read_Fp64 (Left) > Read_Fp64 (Right)), + Boolean_Type); when Iir_Predefined_Floating_Greater_Equal => return Create_Value_Discrete - (Boolean'Pos (Left.Val.Fp >= Right.Val.Fp), Boolean_Type); + (Boolean'Pos (Read_Fp64 (Left) >= Read_Fp64 (Right)), + Boolean_Type); when Iir_Predefined_Floating_Plus => - return Create_Value_Float (Left.Val.Fp + Right.Val.Fp, Res_Typ); + return Create_Value_Float (Read_Fp64 (Left) + Read_Fp64 (Right), + Res_Typ); when Iir_Predefined_Floating_Minus => - return Create_Value_Float (Left.Val.Fp - Right.Val.Fp, Res_Typ); + return Create_Value_Float (Read_Fp64 (Left) - Read_Fp64 (Right), + Res_Typ); when Iir_Predefined_Floating_Mul => - return Create_Value_Float (Left.Val.Fp * Right.Val.Fp, Res_Typ); + return Create_Value_Float (Read_Fp64 (Left) * Read_Fp64 (Right), + Res_Typ); when Iir_Predefined_Floating_Div => - return Create_Value_Float (Left.Val.Fp / Right.Val.Fp, Res_Typ); + return Create_Value_Float (Read_Fp64 (Left) / Read_Fp64 (Right), + Res_Typ); when Iir_Predefined_Floating_Exp => return Create_Value_Float - (Left.Val.Fp ** Natural (Right.Val.Scal), Res_Typ); + (Read_Fp64 (Left) ** Natural (Read_Discrete (Right)), Res_Typ); when Iir_Predefined_Array_Array_Concat => declare @@ -674,78 +694,79 @@ package body Synth.Static_Oper is R : constant Valtyp := Strip_Alias_Const (Right); Bnd : Bound_Type; Res_Typ : Type_Acc; - Arr : Value_Array_Acc; + Res : Valtyp; begin Bnd := Oper.Create_Bounds_From_Length (Syn_Inst, Get_Index_Type (Get_Type (Expr), 0), L_Len + R_Len); Res_Typ := Create_Onedimensional_Array_Subtype (Ret_Typ, Bnd); - Arr := Create_Value_Array (L_Len + R_Len); - for I in 1 .. L_Len loop - Arr.V (I) := L.Val.Arr.V (I); - end loop; - for I in 1 .. R_Len loop - Arr.V (L_Len + I) := R.Val.Arr.V (I); - end loop; - return Create_Value_Const_Array (Res_Typ, Arr); + Res := Create_Value_Memory (Res_Typ); + if L.Typ.Sz > 0 then + Copy_Memory (Res.Val.Mem, L.Val.Mem, L.Typ.Sz); + end if; + if R.Typ.Sz > 0 then + Copy_Memory (Res.Val.Mem + L.Typ.Sz, R.Val.Mem, R.Typ.Sz); + end if; + return Res; end; when Iir_Predefined_Element_Array_Concat => declare Ret_Typ : constant Type_Acc := Get_Subtype_Object (Syn_Inst, Get_Return_Type (Imp)); + Rlen : constant Iir_Index32 := + Get_Array_Flat_Length (Right.Typ); Bnd : Bound_Type; Res_Typ : Type_Acc; - Arr : Value_Array_Acc; + Res : Valtyp; begin Bnd := Oper.Create_Bounds_From_Length - (Syn_Inst, Get_Index_Type (Get_Type (Expr), 0), - 1 + Right.Val.Arr.Len); + (Syn_Inst, Get_Index_Type (Get_Type (Expr), 0), 1 + Rlen); Res_Typ := Create_Onedimensional_Array_Subtype (Ret_Typ, Bnd); - Arr := Create_Value_Array (1 + Right.Val.Arr.Len); - Arr.V (1) := Left.Val; - for I in Right.Val.Arr.V'Range loop - Arr.V (1 + I) := Right.Val.Arr.V (I); - end loop; - return Create_Value_Const_Array (Res_Typ, Arr); + Res := Create_Value_Memory (Res_Typ); + Copy_Memory (Res.Val.Mem, Left.Val.Mem, Left.Typ.Sz); + Copy_Memory (Res.Val.Mem + Left.Typ.Sz, + Right.Val.Mem, Right.Typ.Sz); + return Res; end; when Iir_Predefined_Array_Element_Concat => declare Ret_Typ : constant Type_Acc := Get_Subtype_Object (Syn_Inst, Get_Return_Type (Imp)); + Llen : constant Iir_Index32 := Get_Array_Flat_Length (Left.Typ); Bnd : Bound_Type; Res_Typ : Type_Acc; - Arr : Value_Array_Acc; + Res : Valtyp; begin Bnd := Oper.Create_Bounds_From_Length - (Syn_Inst, Get_Index_Type (Get_Type (Expr), 0), - Left.Val.Arr.Len + 1); + (Syn_Inst, Get_Index_Type (Get_Type (Expr), 0), Llen + 1); Res_Typ := Create_Onedimensional_Array_Subtype (Ret_Typ, Bnd); - Arr := Create_Value_Array (Left.Val.Arr.Len + 1); - for I in Left.Val.Arr.V'Range loop - Arr.V (I) := Left.Val.Arr.V (I); - end loop; - Arr.V (Left.Val.Arr.Len + 1) := Right.Val; - return Create_Value_Const_Array (Res_Typ, Arr); + Res := Create_Value_Memory (Res_Typ); + Copy_Memory (Res.Val.Mem, Left.Val.Mem, Left.Typ.Sz); + Copy_Memory (Res.Val.Mem + Left.Typ.Sz, + Right.Val.Mem, Right.Typ.Sz); + return Res; end; when Iir_Predefined_Array_Equality | Iir_Predefined_Record_Equality => return Create_Value_Discrete - (Boolean'Pos (Is_Equal (Left.Val, Right.Val)), Boolean_Type); + (Boolean'Pos (Is_Equal (Left, Right)), Boolean_Type); when Iir_Predefined_Array_Inequality | Iir_Predefined_Record_Inequality => return Create_Value_Discrete - (Boolean'Pos (not Is_Equal (Left.Val, Right.Val)), Boolean_Type); + (Boolean'Pos (not Is_Equal (Left, Right)), Boolean_Type); when Iir_Predefined_Access_Equality => return Create_Value_Discrete - (Boolean'Pos (Left.Val.Acc = Right.Val.Acc), Boolean_Type); + (Boolean'Pos (Read_Access (Left) = Read_Access (Right)), + Boolean_Type); when Iir_Predefined_Access_Inequality => return Create_Value_Discrete - (Boolean'Pos (Left.Val.Acc /= Right.Val.Acc), Boolean_Type); + (Boolean'Pos (Read_Access (Left) /= Read_Access (Right)), + Boolean_Type); when Iir_Predefined_Ieee_1164_Vector_And | Iir_Predefined_Ieee_Numeric_Std_And_Uns_Uns @@ -909,18 +930,20 @@ package body Synth.Static_Oper is function Synth_Vector_Monadic (Vec : Valtyp; Op : Table_1d) return Valtyp is - Arr : Value_Array_Acc; + Len : constant Iir_Index32 := Vec_Length (Vec.Typ); + Res : Valtyp; begin - Arr := Create_Value_Array (Vec.Val.Arr.Len); - for I in Arr.V'Range loop + Res := Create_Value_Memory (Create_Res_Bound (Vec.Typ)); + for I in 1 .. Len loop declare - V : constant Std_Ulogic := Std_Ulogic'Val (Vec.Val.Arr.V (I).Scal); + V : constant Std_Ulogic := Std_Ulogic'Val + (Read_U8 (Vec.Val.Mem + Size_Type (I - 1))); begin - Arr.V (I) := Create_Value_Discrete (Std_Ulogic'Pos (Op (V))); + Write_U8 (Res.Val.Mem + Size_Type (I - 1), + Std_Ulogic'Pos (Op (V))); end; end loop; - - return Create_Value_Const_Array (Create_Res_Bound (Vec.Typ), Arr); + return Res; end Synth_Vector_Monadic; function Synth_Vector_Reduce @@ -930,10 +953,10 @@ package body Synth.Static_Oper is Res : Std_Ulogic; begin Res := Init; - for I in Vec.Val.Arr.V'Range loop + for I in 1 .. Vec_Length (Vec.Typ) loop declare V : constant Std_Ulogic := - Std_Ulogic'Val (Vec.Val.Arr.V (I).Scal); + Std_Ulogic'Val (Read_U8 (Vec.Val.Mem + Size_Type (I - 1))); begin Res := Op (Res, V); end; @@ -953,30 +976,30 @@ package body Synth.Static_Oper is Get_Interface_Declaration_Chain (Imp); Oper_Type : constant Node := Get_Type (Inter_Chain); Oper_Typ : constant Type_Acc := Get_Subtype_Object (Syn_Inst, Oper_Type); - -- Res_Typ : constant Type_Acc := - -- Get_Subtype_Object (Syn_Inst, Get_Type (Expr)); begin case Def is when Iir_Predefined_Boolean_Not | Iir_Predefined_Bit_Not => - return Create_Value_Discrete (1 - Operand.Val.Scal, Oper_Typ); + return Create_Value_Discrete + (1 - Read_Discrete (Operand), Oper_Typ); when Iir_Predefined_Integer_Negation | Iir_Predefined_Physical_Negation => - return Create_Value_Discrete (-Operand.Val.Scal, Oper_Typ); + return Create_Value_Discrete (-Read_Discrete (Operand), Oper_Typ); when Iir_Predefined_Integer_Absolute | Iir_Predefined_Physical_Absolute => - return Create_Value_Discrete (abs Operand.Val.Scal, Oper_Typ); + return Create_Value_Discrete + (abs Read_Discrete(Operand), Oper_Typ); when Iir_Predefined_Integer_Identity | Iir_Predefined_Physical_Identity => return Operand; when Iir_Predefined_Floating_Negation => - return Create_Value_Float (-Operand.Val.Fp, Oper_Typ); + return Create_Value_Float (-Read_Fp64 (Operand), Oper_Typ); when Iir_Predefined_Floating_Identity => return Operand; when Iir_Predefined_Floating_Absolute => - return Create_Value_Float (abs Operand.Val.Fp, Oper_Typ); + return Create_Value_Float (abs Read_Fp64 (Operand), Oper_Typ); when Iir_Predefined_Ieee_1164_Condition_Operator => -- Constant std_logic: need to convert. @@ -984,14 +1007,15 @@ package body Synth.Static_Oper is Val : Uns32; Zx : Uns32; begin - From_Std_Logic (Operand.Val.Scal, Val, Zx); + From_Std_Logic (Read_Discrete (Operand), Val, Zx); return Create_Value_Discrete (Boolean'Pos (Val = 1 and Zx = 0), Boolean_Type); end; when Iir_Predefined_Ieee_Numeric_Std_Neg_Sgn => declare - Op_Arr : Std_Logic_Vector (1 .. Natural (Operand.Val.Arr.Len)); + Op_Arr : Std_Logic_Vector + (1 .. Natural (Vec_Length (Operand.Typ))); begin To_Std_Logic_Vector (Operand, Op_Arr); declare @@ -1028,27 +1052,29 @@ package body Synth.Static_Oper is is Len : constant Iir_Index32 := Iir_Index32 (Sz); El_Type : constant Type_Acc := Get_Array_Element (Res_Type); - Arr : Value_Array_Acc; + Res : Valtyp; Bnd : Type_Acc; B : Uns64; begin - Arr := Create_Value_Array (Len); + Bnd := Create_Vec_Type_By_Length (Width (Len), El_Type); + Res := Create_Value_Memory (Bnd); for I in 1 .. Len loop B := Shift_Right_Arithmetic (Arg, Natural (I - 1)) and 1; - Arr.V (Len - I + 1) := Create_Value_Discrete - (Std_Logic_0_Pos + Int64 (B)); + Write_U8 (Res.Val.Mem + Size_Type (Len - I), + Uns64'Pos (Std_Logic_0_Pos + B)); end loop; - Bnd := Create_Vec_Type_By_Length (Width (Len), El_Type); - return Create_Value_Const_Array (Bnd, Arr); + return Res; end Eval_To_Vector; function Eval_Unsigned_To_Integer (Arg : Valtyp; Loc : Node) return Int64 is Res : Uns64; + V : Std_Ulogic; begin Res := 0; - for I in Arg.Val.Arr.V'Range loop - case To_X01 (Std_Ulogic'Val (Arg.Val.Arr.V (I).Scal)) is + for I in 1 .. Vec_Length (Arg.Typ) loop + V := Std_Ulogic'Val (Read_U8 (Arg.Val.Mem + Size_Type (I - 1))); + case To_X01 (V) is when '0' => Res := Res * 2; when '1' => @@ -1065,15 +1091,18 @@ package body Synth.Static_Oper is function Eval_Signed_To_Integer (Arg : Valtyp; Loc : Node) return Int64 is + Len : constant Iir_Index32 := Vec_Length (Arg.Typ); Res : Uns64; + E : Std_Ulogic; begin - if Arg.Val.Arr.Len = 0 then + if Len = 0 then Warning_Msg_Synth (+Loc, "numeric_std.to_integer: null detected, returning 0"); return 0; end if; - case To_X01 (Std_Ulogic'Val (Arg.Val.Arr.V (1).Scal)) is + E := Std_Ulogic'Val (Read_U8 (Arg.Val.Mem)); + case To_X01 (E) is when '0' => Res := 0; when '1' => @@ -1082,8 +1111,9 @@ package body Synth.Static_Oper is Warning_Msg_Synth (+Loc, "metavalue detected, returning 0"); return 0; end case; - for I in 2 .. Arg.Val.Arr.Len loop - case To_X01 (Std_Ulogic'Val (Arg.Val.Arr.V (I).Scal)) is + for I in 2 .. Len loop + E := Std_Ulogic'Val (Read_U8 (Arg.Val.Mem + Size_Type (I - 1))); + case To_X01 (E) is when '0' => Res := Res * 2; when '1' => @@ -1138,11 +1168,13 @@ package body Synth.Static_Oper is when Iir_Predefined_Ieee_Numeric_Std_Touns_Nat_Nat_Uns | Iir_Predefined_Ieee_Std_Logic_Arith_Conv_Unsigned_Int => return Eval_To_Vector - (Uns64 (Param1.Val.Scal), Param2.Val.Scal, Res_Typ); + (Uns64 (Read_Discrete (Param1)), Read_Discrete (Param2), + Res_Typ); when Iir_Predefined_Ieee_Numeric_Std_Tosgn_Int_Nat_Sgn | Iir_Predefined_Ieee_Std_Logic_Arith_Conv_Vector_Int => return Eval_To_Vector - (To_Uns64 (Param1.Val.Scal), Param2.Val.Scal, Res_Typ); + (To_Uns64 (Read_Discrete (Param1)), Read_Discrete (Param2), + Res_Typ); when Iir_Predefined_Ieee_Numeric_Std_Toint_Uns_Nat | Iir_Predefined_Ieee_Std_Logic_Arith_Conv_Integer_Uns | Iir_Predefined_Ieee_Std_Logic_Unsigned_Conv_Integer => @@ -1156,58 +1188,59 @@ package body Synth.Static_Oper is when Iir_Predefined_Ieee_1164_To_Stdlogicvector_Bv => declare + use Grt.Types; El_Type : constant Type_Acc := Get_Array_Element (Res_Typ); - Arr : Value_Array_Acc; + Res : Valtyp; Bnd : Type_Acc; - B : Int64; + B : Ghdl_U8; begin - Arr := Create_Value_Array (Param1.Val.Arr.Len); - for I in Param1.Val.Arr.V'Range loop - if Param1.Val.Arr.V (I).Scal = 0 then + Bnd := Create_Vec_Type_By_Length + (Uns32 (Vec_Length (Param1.Typ)), El_Type); + Res := Create_Value_Memory (Bnd); + for I in 1 .. Vec_Length (Param1.Typ) loop + if Read_U8 (Param1.Val.Mem + Size_Type (I - 1)) = 0 then B := Std_Logic_0_Pos; else B := Std_Logic_1_Pos; end if; - Arr.V (I) := Create_Value_Discrete (B); + Write_U8 (Res.Val.Mem + Size_Type (I - 1), B); end loop; - Bnd := Create_Vec_Type_By_Length - (Width (Param1.Val.Arr.Len), El_Type); - return Create_Value_Const_Array (Bnd, Arr); + return Res; end; when Iir_Predefined_Ieee_Math_Real_Log2 => declare function Log2 (Arg : Fp64) return Fp64; pragma Import (C, Log2); begin - return Create_Value_Float (Log2 (Param1.Val.Fp), Res_Typ); + return Create_Value_Float (Log2 (Read_Fp64 (Param1)), Res_Typ); end; when Iir_Predefined_Ieee_Math_Real_Ceil => declare function Ceil (Arg : Fp64) return Fp64; pragma Import (C, Ceil); begin - return Create_Value_Float (Ceil (Param1.Val.Fp), Res_Typ); + return Create_Value_Float (Ceil (Read_Fp64 (Param1)), Res_Typ); end; when Iir_Predefined_Ieee_Math_Real_Round => declare function Round (Arg : Fp64) return Fp64; pragma Import (C, Round); begin - return Create_Value_Float (Round (Param1.Val.Fp), Res_Typ); + return Create_Value_Float (Round (Read_Fp64 (Param1)), Res_Typ); end; when Iir_Predefined_Ieee_Math_Real_Sin => declare function Sin (Arg : Fp64) return Fp64; pragma Import (C, Sin); begin - return Create_Value_Float (Sin (Param1.Val.Fp), Res_Typ); + return Create_Value_Float (Sin (Read_Fp64 (Param1)), Res_Typ); end; when Iir_Predefined_Ieee_Math_Real_Cos => declare function Cos (Arg : Fp64) return Fp64; pragma Import (C, Cos); begin - return Create_Value_Float (Cos (Param1.Val.Fp), Res_Typ); + return Create_Value_Float (Cos (Read_Fp64 (Param1)), Res_Typ); end; when others => Error_Msg_Synth diff --git a/src/synth/synth-static_proc.adb b/src/synth/synth-static_proc.adb index be0475b4a..60388607b 100644 --- a/src/synth/synth-static_proc.adb +++ b/src/synth/synth-static_proc.adb @@ -32,8 +32,8 @@ package body Synth.Static_Proc is Inter : constant Node := Get_Interface_Declaration_Chain (Imp); Param : constant Valtyp := Get_Value (Syn_Inst, Inter); begin - Synth.Heap.Synth_Deallocate (Param.Val.Acc); - Param.Val.Acc := Null_Heap_Index; + Synth.Heap.Synth_Deallocate (Read_Access (Param)); + Write_Access (Param.Val.Mem, Null_Heap_Index); end Synth_Deallocate; procedure Synth_Static_Procedure (Syn_Inst : Synth_Instance_Acc; diff --git a/src/synth/synth-stmts.adb b/src/synth/synth-stmts.adb index e2da5d317..952b19289 100644 --- a/src/synth/synth-stmts.adb +++ b/src/synth/synth-stmts.adb @@ -111,15 +111,15 @@ package body Synth.Stmts is Pfx : Node; Dest_Base : out Valtyp; Dest_Typ : out Type_Acc; - Dest_Off : out Uns32; + Dest_Off : out Value_Offsets; Dest_Voff : out Net; Dest_Rdwd : out Width) is begin case Get_Kind (Pfx) is when Iir_Kind_Simple_Name => Synth_Assignment_Prefix (Syn_Inst, Get_Named_Entity (Pfx), - Dest_Base, Dest_Typ, Dest_Off, - Dest_Voff, Dest_Rdwd); + Dest_Base, Dest_Typ, + Dest_Off, Dest_Voff, Dest_Rdwd); when Iir_Kind_Interface_Signal_Declaration | Iir_Kind_Variable_Declaration | Iir_Kind_Interface_Variable_Declaration @@ -143,20 +143,19 @@ package body Synth.Stmts is Dest_Off := Targ.Val.A_Off; else Dest_Base := Targ; - Dest_Off := 0; + Dest_Off := (0, 0); end if; end; when Iir_Kind_Function_Call => Dest_Base := Synth_Expression (Syn_Inst, Pfx); Dest_Typ := Dest_Base.Typ; - Dest_Off := 0; + Dest_Off := (0, 0); Dest_Voff := No_Net; Dest_Rdwd := 0; when Iir_Kind_Indexed_Name => declare Voff : Net; - Off : Uns32; - W : Width; + Off : Value_Offsets; Dest_W : Width; begin Synth_Assignment_Prefix @@ -164,12 +163,14 @@ package body Synth.Stmts is Dest_Base, Dest_Typ, Dest_Off, Dest_Voff, Dest_Rdwd); Strip_Const (Dest_Base); Dest_W := Dest_Base.Typ.W; - Synth_Indexed_Name (Syn_Inst, Pfx, Dest_Typ, Voff, Off, W); + Synth_Indexed_Name (Syn_Inst, Pfx, Dest_Typ, Voff, Off); Dest_Typ := Get_Array_Element (Dest_Typ); + Dest_Off.Net_Off := Dest_Off.Net_Off + Off.Net_Off; + Dest_Off.Mem_Off := Dest_Off.Mem_Off + Off.Mem_Off; + if Voff /= No_Net then - Dest_Off := Dest_Off + Off; if Dest_Voff = No_Net then Dest_Voff := Voff; Dest_Rdwd := Dest_W; @@ -177,23 +178,6 @@ package body Synth.Stmts is Dest_Voff := Build_Addidx (Get_Build (Syn_Inst), Dest_Voff, Voff); end if; - else - Dest_Off := Dest_Off + Off; - - if Dest_Voff = No_Net then - -- For constant objects, directly return the indexed - -- object. - if Dest_Base.Val.Kind - in Value_Array .. Value_Const_Array - then - pragma Assert (Dest_Off = Off); - Dest_Base.Val := Dest_Base.Val.Arr.V - (Iir_Index32 ((Dest_W - Dest_Off) / W)); - Dest_Base.Typ := Dest_Typ; - Dest_Off := 0; - Dest_W := W; - end if; - end if; end if; end; @@ -201,26 +185,16 @@ package body Synth.Stmts is declare Idx : constant Iir_Index32 := Get_Element_Position (Get_Named_Entity (Pfx)); - El_Typ : Type_Acc; begin Synth_Assignment_Prefix (Syn_Inst, Get_Prefix (Pfx), Dest_Base, Dest_Typ, Dest_Off, Dest_Voff, Dest_Rdwd); - if Dest_Off /= 0 and then Dest_Voff /= No_Net then - -- TODO. - raise Internal_Error; - end if; - El_Typ := Dest_Typ.Rec.E (Idx + 1).Typ; - Strip_Const (Dest_Base); - if Dest_Base.Val.Kind = Value_Const_Record then - -- Return the selected element. - pragma Assert (Dest_Off = 0); - Dest_Base.Val := Dest_Base.Val.Rec.V (Idx + 1); - Dest_Base.Typ := El_Typ; - else - Dest_Off := Dest_Off + Dest_Typ.Rec.E (Idx + 1).Off; - end if; - Dest_Typ := El_Typ; + Dest_Off.Net_Off := + Dest_Off.Net_Off + Dest_Typ.Rec.E (Idx + 1).Boff; + Dest_Off.Mem_Off := + Dest_Off.Mem_Off + Dest_Typ.Rec.E (Idx + 1).Moff; + + Dest_Typ := Dest_Typ.Rec.E (Idx + 1).Typ; end; when Iir_Kind_Slice_Name => @@ -229,8 +203,7 @@ package body Synth.Stmts is El_Typ : Type_Acc; Res_Bnd : Bound_Type; Sl_Voff : Net; - Sl_Off : Uns32; - Wd : Uns32; + Sl_Off : Value_Offsets; begin Synth_Assignment_Prefix (Syn_Inst, Get_Prefix (Pfx), @@ -238,12 +211,14 @@ package body Synth.Stmts is Strip_Const (Dest_Base); Get_Onedimensional_Array_Bounds (Dest_Typ, Pfx_Bnd, El_Typ); - Synth_Slice_Suffix (Syn_Inst, Pfx, Pfx_Bnd, El_Typ.W, - Res_Bnd, Sl_Voff, Sl_Off, Wd); + Synth_Slice_Suffix (Syn_Inst, Pfx, Pfx_Bnd, El_Typ, + Res_Bnd, Sl_Voff, Sl_Off); + + Dest_Off.Net_Off := Dest_Off.Net_Off + Sl_Off.Net_Off; + Dest_Off.Mem_Off := Dest_Off.Mem_Off + Sl_Off.Mem_Off; 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); @@ -251,46 +226,11 @@ package body Synth.Stmts is Dest_Rdwd := Dest_Base.Typ.W; Dest_Voff := Sl_Voff; end if; - Dest_Typ := Create_Slice_Type (Wd, El_Typ); + Dest_Typ := Create_Slice_Type (Res_Bnd.Len, El_Typ); else -- Fixed slice. Dest_Typ := Create_Onedimensional_Array_Subtype (Dest_Typ, Res_Bnd); - if Dest_Voff /= No_Net then - -- Slice of a memory. - Dest_Off := Dest_Off + Sl_Off; - else - if Dest_Base.Val.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_Base.Val.Arr.V - (Off + 1 .. Off + Iir_Index32 (Res_Bnd.Len)); - if Dest_Base.Val.Kind = Value_Array then - Dest_Base.Val := Create_Value_Array (Arr); - else - Dest_Base.Val := Create_Value_Const_Array (Arr); - end if; - Dest_Base.Typ := Dest_Typ; - end; - else - -- Slice of a vector. - Dest_Off := Dest_Off + Sl_Off; - end if; - end if; end if; end; @@ -299,10 +239,10 @@ package body Synth.Stmts is Synth_Assignment_Prefix (Syn_Inst, Get_Prefix (Pfx), Dest_Base, Dest_Typ, Dest_Off, Dest_Voff, Dest_Rdwd); - if Dest_Off /= 0 and then Dest_Voff /= No_Net then + if Dest_Off /= (0, 0) and then Dest_Voff /= No_Net then raise Internal_Error; end if; - Dest_Base := Heap.Synth_Dereference (Dest_Base.Val.Acc); + Dest_Base := Heap.Synth_Dereference (Read_Access (Dest_Base)); Dest_Typ := Dest_Base.Typ; when others => @@ -320,8 +260,8 @@ package body Synth.Stmts is case Kind is when Target_Simple => -- For a simple target, the destination is known. - Obj : Value_Acc; - Off : Uns32; + Obj : Valtyp; + Off : Value_Offsets; when Target_Aggregate => -- For an aggregate: the type is computed and the details will -- be handled at the assignment. @@ -377,7 +317,7 @@ package body Synth.Stmts is declare Base : Valtyp; Typ : Type_Acc; - Off : Uns32; + Off : Value_Offsets; Voff : Net; Rdwd : Width; @@ -388,16 +328,16 @@ package body Synth.Stmts is -- FIXME: check index. return Target_Info'(Kind => Target_Simple, Targ_Type => Typ, - Obj => Base.Val, + Obj => Base, Off => Off); else return Target_Info'(Kind => Target_Memory, Targ_Type => Typ, Mem_Obj => Base, Mem_Mwidth => Rdwd, - Mem_Moff => 0, + Mem_Moff => 0, -- Uns32 (Off.Mem_Off), Mem_Voff => Voff, - Mem_Doff => Off); + Mem_Doff => Off.Net_Off); end if; end; when others => @@ -405,33 +345,6 @@ package body Synth.Stmts is 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 : Valtyp; @@ -446,15 +359,6 @@ package body Synth.Stmts is El_Typ : constant Type_Acc := Get_Array_Element (Val.Typ); begin case Val.Val.Kind is - when Value_Array - | Value_Const_Array => - if Typ /= El_Typ then - -- Sub-array (vhdl 2008) not yet supported. - raise Internal_Error; - end if; - pragma Assert (Val.Typ.Vbound.Len >= Off); - return (El_Typ, - Val.Val.Arr.V (Iir_Index32 (Val.Typ.Vbound.Len - Off))); when Value_Net | Value_Wire => declare @@ -515,17 +419,23 @@ package body Synth.Stmts is 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); + if Target.Obj.Val.Kind = Value_Wire then + Synth_Assign (Target.Obj.Val.W, Target.Targ_Type, + Val, Target.Off.Net_Off, Loc); else if not Is_Static (Val.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.Val), Loc); + declare + V : Valtyp; + begin + V := Val; + Strip_Const (V); + Copy_Memory (Target.Obj.Val.Mem + Target.Off.Mem_Off, + V.Val.Mem, V.Typ.Sz); + end; end if; end if; when Target_Memory => @@ -588,9 +498,8 @@ package body Synth.Stmts is begin case Targ.Kind is when Target_Simple => - N := Build2_Extract (Get_Build (Syn_Inst), - Get_Net ((Targ.Targ_Type, Targ.Obj)), - Targ.Off, Targ.Targ_Type.W); + N := Build2_Extract (Get_Build (Syn_Inst), Get_Net (Targ.Obj), + Targ.Off.Net_Off, Targ.Targ_Type.W); return Create_Value_Net (N, Targ.Targ_Type); when Target_Aggregate => raise Internal_Error; @@ -736,12 +645,12 @@ package body Synth.Stmts is end if; if Is_Static (Cond_Val.Val) then Strip_Const (Cond_Val); - if Cond_Val.Val.Scal = 1 then + if Read_Discrete (Cond_Val) = 1 then -- True. Synth_Sequential_Statements (C, Get_Sequential_Statement_Chain (Stmt)); else - pragma Assert (Cond_Val.Val.Scal = 0); + pragma Assert (Read_Discrete (Cond_Val) = 0); if Is_Valid (Els) then -- Else part if Is_Null (Get_Condition (Els)) then @@ -1101,7 +1010,7 @@ package body Synth.Stmts is end Synth_Case_Statement_Dynamic; procedure Synth_Case_Statement_Static_Array - (C : in out Seq_Context; Stmt : Node; Sel : Value_Acc) + (C : in out Seq_Context; Stmt : Node; Sel : Valtyp) is Choices : constant Node := Get_Case_Statement_Alternative_Chain (Stmt); Choice : Node; @@ -1122,7 +1031,7 @@ package body Synth.Stmts 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.Val, Sel) then + if Is_Equal (Sel_Val, Sel) then Synth_Sequential_Statements (C, Stmts); exit; end if; @@ -1200,10 +1109,11 @@ package body Synth.Stmts is when Type_Bit | Type_Logic | Type_Discrete => - Synth_Case_Statement_Static_Scalar (C, Stmt, Sel.Val.Scal); + Synth_Case_Statement_Static_Scalar (C, Stmt, + Read_Discrete (Sel)); when Type_Vector | Type_Array => - Synth_Case_Statement_Static_Array (C, Stmt, Sel.Val); + Synth_Case_Statement_Static_Array (C, Stmt, Sel); when others => raise Internal_Error; end case; @@ -1581,12 +1491,12 @@ package body Synth.Stmts is Nbr_Inout := Nbr_Inout + 1; Infos (Nbr_Inout) := Info; if Info.Kind = Target_Simple - and then Is_Static (Info.Obj) + and then Is_Static (Info.Obj.Val) then - if Info.Off /= 0 then - raise Internal_Error; - end if; - Val := (Info.Targ_Type, Info.Obj); + Val := Create_Value_Memory (Info.Targ_Type); + Copy_Memory (Val.Val.Mem, + Info.Obj.Val.Mem + Info.Off.Mem_Off, + Info.Targ_Type.Sz); else Val := Synth_Read (Caller_Inst, Info, Assoc); end if; @@ -1596,9 +1506,9 @@ package body Synth.Stmts is raise Internal_Error; end if; Val := Create_Value_Alias - (Info.Obj, Info.Off, Info.Targ_Type); + (Info.Obj.Val, Info.Off, Info.Targ_Type); when Iir_Kind_Interface_File_Declaration => - Val := (Info.Targ_Type, Info.Obj); + Val := Info.Obj; when Iir_Kind_Interface_Quantity_Declaration => raise Internal_Error; end case; @@ -1625,7 +1535,7 @@ package body Synth.Stmts is -- Arguments are passed by copy. if Is_Static (Val.Val) or else Get_Mode (Inter) = Iir_In_Mode then - Val.Val := Unshare (Val.Val, Current_Pool); + Val := Unshare (Val, Current_Pool); else -- Will be changed to a wire. null; @@ -2020,14 +1930,18 @@ package body Synth.Stmts is end case; end In_Range; - procedure Update_Index (Rng : Discrete_Range_Type; Idx : in out Int64) is + procedure Update_Index (Rng : Discrete_Range_Type; V : in out Valtyp) + is + T : Int64; begin + T := Read_Discrete (V); case Rng.Dir is when Iir_To => - Idx := Idx + 1; + T := T + 1; when Iir_Downto => - Idx := Idx - 1; + T := T - 1; end case; + Write_Discrete (V, T); end Update_Index; procedure Loop_Control_Init (C : Seq_Context; Stmt : Node) @@ -2159,7 +2073,7 @@ package body Synth.Stmts is Cond_Val := Synth_Expression (C.Inst, Cond); Static_Cond := Is_Static_Val (Cond_Val.Val); if Static_Cond then - if Get_Static_Discrete (Cond_Val.Val) = 0 then + if Get_Static_Discrete (Cond_Val) = 0 then -- Not executed. return; end if; @@ -2215,7 +2129,7 @@ package body Synth.Stmts is if Cond /= Null_Node then Cond_Val := Synth_Expression (C.Inst, Cond); pragma Assert (Is_Static_Val (Cond_Val.Val)); - if Get_Static_Discrete (Cond_Val.Val) = 0 then + if Get_Static_Discrete (Cond_Val) = 0 then -- Not executed. return; end if; @@ -2297,10 +2211,10 @@ package body Synth.Stmts is Init_For_Loop_Statement (C, Stmt, Val); - while In_Range (Val.Typ.Drange, Val.Val.Scal) loop + while In_Range (Val.Typ.Drange, Read_Discrete (Val)) loop Synth_Sequential_Statements (C, Stmts); - Update_Index (Val.Typ.Drange, Val.Val.Scal); + Update_Index (Val.Typ.Drange, Val); Loop_Control_Update (C); -- Constant exit. @@ -2331,11 +2245,11 @@ package body Synth.Stmts is Init_For_Loop_Statement (C, Stmt, Val); - while In_Range (Val.Typ.Drange, Val.Val.Scal) loop + while In_Range (Val.Typ.Drange, Read_Discrete (Val)) loop Synth_Sequential_Statements (C, Stmts); C.S_En := True; - Update_Index (Val.Typ.Drange, Val.Val.Scal); + Update_Index (Val.Typ.Drange, Val); exit when Lc.S_Exit or Lc.S_Quit or C.Nbr_Ret > 0; end loop; @@ -2373,7 +2287,7 @@ package body Synth.Stmts is Error_Msg_Synth (+Cond, "loop condition must be static"); exit; end if; - exit when Val.Val.Scal = 0; + exit when Read_Discrete (Val) = 0; end if; Synth_Sequential_Statements (C, Stmts); @@ -2421,7 +2335,7 @@ package body Synth.Stmts is if Cond /= Null_Node then Val := Synth_Expression_With_Type (C.Inst, Cond, Boolean_Type); pragma Assert (Is_Static (Val.Val)); - exit when Val.Val.Scal = 0; + exit when Read_Discrete (Val) = 0; end if; Synth_Sequential_Statements (C, Stmts); @@ -2527,7 +2441,7 @@ package body Synth.Stmts is Sev_V := 2; end if; else - Sev_V := Natural (Sev.Val.Scal); + Sev_V := Natural (Read_Discrete (Sev)); end if; case Sev_V is when 0 => @@ -2543,7 +2457,7 @@ package body Synth.Stmts is end case; Put_Err ("): "); - Put_Line_Err (Value_To_String (Rep.Val)); + Put_Line_Err (Value_To_String (Rep)); end Synth_Static_Report; procedure Synth_Static_Report_Statement @@ -2564,7 +2478,7 @@ package body Synth.Stmts is end if; pragma Assert (Is_Static (Cond.Val)); Strip_Const (Cond); - if Cond.Val.Scal = 1 then + if Read_Discrete (Cond) = 1 then return; end if; Synth_Static_Report (C, Stmt); @@ -2814,7 +2728,7 @@ package body Synth.Stmts is return; end if; if Is_Static (Val.Val) then - if Val.Val.Scal /= 1 then + if Read_Discrete (Val) /= 1 then Error_Msg_Synth (+Stmt, "assertion failure"); end if; return; @@ -2962,7 +2876,7 @@ package body Synth.Stmts is D_Arr (Nbr_States - 1) := Build_Const_UB32 (Build_Context, 0, 1); end if; - Res := Concat_Array (D_Arr); + Concat_Array (D_Arr.all, Res); Free_Net_Array (D_Arr); return Res; @@ -3166,12 +3080,11 @@ package body Synth.Stmts is if Icond /= Null_Node then Cond := Synth_Expression (Syn_Inst, Icond); Strip_Const (Cond); - pragma Assert (Cond.Val.Kind = Value_Discrete); else -- It is the else generate. Cond := No_Valtyp; end if; - if Cond = No_Valtyp or else Cond.Val.Scal = 1 then + if Cond = No_Valtyp or else Read_Discrete (Cond) = 1 then Bod := Get_Generate_Statement_Body (Gen); Apply_Block_Configuration (Get_Generate_Block_Configuration (Bod), Bod); @@ -3206,7 +3119,7 @@ package body Synth.Stmts is Name := New_Sname_User (Get_Identifier (Stmt), Get_Sname (Syn_Inst)); - while In_Range (It_Rng.Drange, Val.Val.Scal) loop + while In_Range (It_Rng.Drange, Read_Discrete (Val)) loop -- Find and apply the config block. declare Spec : Node; @@ -3229,10 +3142,10 @@ package body Synth.Stmts is end; -- FIXME: get position ? - Lname := New_Sname_Version (Uns32 (Val.Val.Scal), Name); + Lname := New_Sname_Version (Uns32 (Read_Discrete (Val)), Name); Synth_Generate_Statement_Body (Syn_Inst, Bod, Lname, Iterator, Val); - Update_Index (It_Rng.Drange, Val.Val.Scal); + Update_Index (It_Rng.Drange, Val); end loop; end Synth_For_Generate_Statement; @@ -3343,12 +3256,12 @@ package body Synth.Stmts is -- The value must be true V := Synth_Expression_With_Type (Syn_Inst, Get_Expression (Spec), Boolean_Type); - if V.Val.Scal /= 1 then + if Read_Discrete (V) /= 1 then return; end if; declare - Off : Uns32; + Off : Value_Offsets; Voff : Net; Wd : Width; N : Net; @@ -3356,7 +3269,7 @@ package body Synth.Stmts is Typ : Type_Acc; begin Synth_Assignment_Prefix (Syn_Inst, Sig, Base, Typ, Off, Voff, Wd); - pragma Assert (Off = 0); + pragma Assert (Off = (0, 0)); pragma Assert (Voff = No_Net); pragma Assert (Base.Val.Kind = Value_Wire); pragma Assert (Base.Typ = Typ); diff --git a/src/synth/synth-stmts.ads b/src/synth/synth-stmts.ads index 6bd796c70..dbe0d03b1 100644 --- a/src/synth/synth-stmts.ads +++ b/src/synth/synth-stmts.ads @@ -37,14 +37,15 @@ package Synth.Stmts is -- DEST_BASE is the base object. Can be the result, a net or an array -- larger than the result. -- DEST_TYP is the type of the result. - -- DEST_OFF/DEST_VOFF is the offset in the base. DEST_OFF is used when + -- DEST_NET_OFF/DEST_MEM_OFF/DEST_VOFF are the offsets in the base. + -- DEST_NET_OFF is used when -- the base is a net, while DEST_VOFF is set when the offset is dynamic. -- DEST_RDWD is the width of what is extracted from the base. procedure Synth_Assignment_Prefix (Syn_Inst : Synth_Instance_Acc; Pfx : Node; Dest_Base : out Valtyp; Dest_Typ : out Type_Acc; - Dest_Off : out Uns32; + Dest_Off : out Value_Offsets; Dest_Voff : out Net; Dest_Rdwd : out Width); @@ -78,7 +79,7 @@ package Synth.Stmts is -- For iterators. function In_Range (Rng : Discrete_Range_Type; V : Int64) return Boolean; - procedure Update_Index (Rng : Discrete_Range_Type; Idx : in out Int64); + procedure Update_Index (Rng : Discrete_Range_Type; V : in out Valtyp); private -- There are 2 execution mode: diff --git a/src/synth/synth-values.adb b/src/synth/synth-values.adb index 079d5638d..e0d56174b 100644 --- a/src/synth/synth-values.adb +++ b/src/synth/synth-values.adb @@ -20,6 +20,8 @@ with Ada.Unchecked_Conversion; with System; +with System.Storage_Elements; + with Mutils; use Mutils; with Netlists.Utils; @@ -36,26 +38,21 @@ package body Synth.Values is function To_Value_Acc is new Ada.Unchecked_Conversion (System.Address, Value_Acc); - function To_Value_Array_Acc is new Ada.Unchecked_Conversion - (System.Address, Values.Value_Array_Acc); + + function "+" (L, R : Value_Offsets) return Value_Offsets is + begin + return (L.Net_Off + R.Net_Off, L.Mem_Off + R.Mem_Off); + end "+"; function Is_Static (Val : Value_Acc) return Boolean is begin case Val.Kind is - when Value_Discrete - | Value_Float => + when Value_Memory => return True; when Value_Net | Value_Wire => return False; - when Value_Const_Array - | Value_Const_Record => - return True; - when Value_Array - | Value_Record => - return False; - when Value_Access - | Value_File => + when Value_File => return True; when Value_Alias => return Is_Static (Val.A_Obj); @@ -67,21 +64,13 @@ package body Synth.Values is function Is_Static_Val (Val : Value_Acc) return Boolean is begin case Val.Kind is - when Value_Discrete - | Value_Float => + when Value_Memory => return True; when Value_Net => return Netlists.Utils.Is_Const_Net (Val.N); when Value_Wire => return Is_Const_Wire (Val.W); - when Value_Const_Array - | Value_Const_Record => - return True; - when Value_Array - | Value_Record => - return False; - when Value_Access - | Value_File => + when Value_File => return True; when Value_Const => return True; @@ -120,7 +109,7 @@ package body Synth.Values is when Value_Const => Res := Res.C_Val; when Value_Alias => - if Res.A_Off /= 0 then + if Res.A_Off /= (0, 0) then raise Internal_Error; end if; Res := Res.A_Obj; @@ -135,12 +124,11 @@ package body Synth.Values is return (V.Typ, Strip_Alias_Const (V.Val)); end Strip_Alias_Const; - function Is_Equal (L, R : Value_Acc) return Boolean + function Is_Equal (L, R : Valtyp) return Boolean is - L1 : constant Value_Acc := Strip_Alias_Const (L); - R1 : constant Value_Acc := Strip_Alias_Const (R); + L1 : constant Value_Acc := Strip_Alias_Const (L.Val); + R1 : constant Value_Acc := Strip_Alias_Const (R.Val); begin - pragma Unreferenced (L, R); if L1.Kind /= R1.Kind then return False; end if; @@ -149,22 +137,20 @@ package body Synth.Values is end if; case L1.Kind is - when Value_Discrete => - return L1.Scal = R1.Scal; - when Value_Float => - return L1.Fp = R1.Fp; - when Value_Const_Array => - if L1.Arr.Len /= R1.Arr.Len then + when Value_Const => + raise Internal_Error; + when Value_Memory => + pragma Assert (R1.Kind = Value_Memory); + if L.Typ.Sz /= R.Typ.Sz then return False; end if; - for I in L1.Arr.V'Range loop - if not Is_Equal (L1.Arr.V (I), R1.Arr.V (I)) then + -- FIXME: not correct for records, not correct for floats! + for I in 1 .. L.Typ.Sz loop + if L1.Mem (I - 1) /= R1.Mem (I - 1) then return False; end if; end loop; return True; - when Value_Const => - raise Internal_Error; when others => -- TODO. raise Internal_Error; @@ -198,7 +184,7 @@ package body Synth.Values is when Type_Slice => return Are_Types_Equal (L.Slice_El, R.Slice_El); when Type_Array => - if L.Abounds.Len /= R.Abounds.Len then + if L.Abounds.Ndim /= R.Abounds.Ndim then return False; end if; for I in L.Abounds.D'Range loop @@ -270,6 +256,8 @@ package body Synth.Values is begin return To_Type_Acc (Alloc (Current_Pool, (Kind => Type_Bit, Is_Synth => True, + Al => 0, + Sz => 1, W => 1))); end Create_Bit_Type; @@ -280,17 +268,32 @@ package body Synth.Values is begin return To_Type_Acc (Alloc (Current_Pool, (Kind => Type_Logic, Is_Synth => True, + Al => 0, + Sz => 1, W => 1))); end Create_Logic_Type; - function Create_Discrete_Type (Rng : Discrete_Range_Type; W : Width) + function Create_Discrete_Type (Rng : Discrete_Range_Type; + Sz : Size_Type; + W : Width) return Type_Acc is subtype Discrete_Type_Type is Type_Type (Type_Discrete); function Alloc is new Areapools.Alloc_On_Pool_Addr (Discrete_Type_Type); + Al : Palign_Type; begin + if Sz <= 1 then + Al := 0; + elsif Sz <= 4 then + Al := 2; + else + pragma Assert (Sz <= 8); + Al := 3; + end if; return To_Type_Acc (Alloc (Current_Pool, (Kind => Type_Discrete, Is_Synth => True, + Al => Al, + Sz => Sz, W => W, Drange => Rng))); end Create_Discrete_Type; @@ -302,6 +305,8 @@ package body Synth.Values is begin return To_Type_Acc (Alloc (Current_Pool, (Kind => Type_Float, Is_Synth => True, + Al => 3, + Sz => 8, W => 64, Frange => Rng))); end Create_Float_Type; @@ -312,22 +317,29 @@ package body Synth.Values is subtype Vector_Type_Type is Type_Type (Type_Vector); function Alloc is new Areapools.Alloc_On_Pool_Addr (Vector_Type_Type); begin - return To_Type_Acc (Alloc (Current_Pool, (Kind => Type_Vector, - Is_Synth => True, - W => Bnd.Len, - Vbound => Bnd, - Vec_El => El_Type))); + return To_Type_Acc + (Alloc (Current_Pool, (Kind => Type_Vector, + Is_Synth => True, + Al => El_Type.Al, + Sz => El_Type.Sz * Size_Type (Bnd.Len), + W => Bnd.Len, + Vbound => Bnd, + Vec_El => El_Type))); end Create_Vector_Type; - function Create_Slice_Type (W : Width; El_Type : Type_Acc) return Type_Acc + function Create_Slice_Type (Len : Uns32; El_Type : Type_Acc) + return Type_Acc is subtype Slice_Type_Type is Type_Type (Type_Slice); function Alloc is new Areapools.Alloc_On_Pool_Addr (Slice_Type_Type); begin - return To_Type_Acc (Alloc (Current_Pool, (Kind => Type_Slice, - Is_Synth => El_Type.Is_Synth, - W => W, - Slice_El => El_Type))); + return To_Type_Acc (Alloc (Current_Pool, + (Kind => Type_Slice, + Is_Synth => El_Type.Is_Synth, + Al => El_Type.Al, + Sz => Size_Type (Len) * El_Type.Sz, + W => Len * El_Type.W, + Slice_El => El_Type))); end Create_Slice_Type; function Create_Vec_Type_By_Length (Len : Width; El : Type_Acc) @@ -372,17 +384,20 @@ package body Synth.Values is is subtype Array_Type_Type is Type_Type (Type_Array); function Alloc is new Areapools.Alloc_On_Pool_Addr (Array_Type_Type); - W : Width; + L : Uns32; begin - W := El_Type.W; + L := 1; for I in Bnd.D'Range loop - W := W * Bnd.D (I).Len; + L := L * Bnd.D (I).Len; end loop; - return To_Type_Acc (Alloc (Current_Pool, (Kind => Type_Array, - Is_Synth => El_Type.Is_Synth, - W => W, - Abounds => Bnd, - Arr_El => El_Type))); + return To_Type_Acc (Alloc (Current_Pool, + (Kind => Type_Array, + Is_Synth => El_Type.Is_Synth, + Al => El_Type.Al, + Sz => El_Type.Sz * Size_Type (L), + W => El_Type.W * L, + Abounds => Bnd, + Arr_El => El_Type))); end Create_Array_Type; function Create_Unbounded_Array (Ndim : Dim_Type; El_Type : Type_Acc) @@ -393,6 +408,8 @@ package body Synth.Values is begin return To_Type_Acc (Alloc (Current_Pool, (Kind => Type_Unbounded_Array, Is_Synth => El_Type.Is_Synth, + Al => El_Type.Al, + Sz => 0, W => 0, Uarr_Ndim => Ndim, Uarr_El => El_Type))); @@ -405,6 +422,8 @@ package body Synth.Values is begin return To_Type_Acc (Alloc (Current_Pool, (Kind => Type_Unbounded_Vector, Is_Synth => El_Type.Is_Synth, + Al => El_Type.Al, + Sz => 0, W => 0, Uvec_El => El_Type))); end Create_Unbounded_Vector; @@ -441,6 +460,23 @@ package body Synth.Values is end case; end Get_Array_Bound; + function Get_Range_Length (Rng : Discrete_Range_Type) return Uns32 + is + Len : Int64; + begin + case Rng.Dir is + when Iir_To => + Len := Rng.Right - Rng.Left + 1; + when Iir_Downto => + Len := Rng.Left - Rng.Right + 1; + end case; + if Len < 0 then + return 0; + else + return Uns32 (Len); + end if; + end Get_Range_Length; + function Create_Rec_El_Array (Nels : Iir_Index32) return Rec_El_Array_Acc is use System; @@ -468,22 +504,50 @@ package body Synth.Values is return To_Rec_El_Array_Acc (Res); end Create_Rec_El_Array; - function Create_Record_Type (Els : Rec_El_Array_Acc; W : Width) + function Align (Off : Size_Type; Al : Palign_Type) return Size_Type + is + Mask : constant Size_Type := 2 ** Natural (Al) - 1; + begin + return (Off + Mask) and not Mask; + end Align; + + function Create_Record_Type (Els : Rec_El_Array_Acc) return Type_Acc is subtype Record_Type_Type is Type_Type (Type_Record); function Alloc is new Areapools.Alloc_On_Pool_Addr (Record_Type_Type); Is_Synth : Boolean; + W : Width; + Al : Palign_Type; + Sz : Size_Type; begin + -- Layout the record. Is_Synth := True; + Al := 0; + Sz := 0; + W := 0; for I in Els.E'Range loop - if not Els.E (I).Typ.Is_Synth then - Is_Synth := False; - exit; - end if; + declare + E : Rec_El_Type renames Els.E (I); + begin + -- For nets. + E.Boff := W; + Is_Synth := Is_Synth and E.Typ.Is_Synth; + W := W + E.Typ.W; + + -- For memory. + Al := Palign_Type'Max (Al, E.Typ.Al); + Sz := Align (Sz, E.Typ.Al); + E.Moff := Sz; + Sz := Sz + E.Typ.Sz; + end; end loop; + Sz := Align (Sz, Al); + return To_Type_Acc (Alloc (Current_Pool, (Kind => Type_Record, Is_Synth => Is_Synth, + Al => Al, + Sz => Sz, W => W, Rec => Els))); end Create_Record_Type; @@ -495,6 +559,8 @@ package body Synth.Values is begin return To_Type_Acc (Alloc (Current_Pool, (Kind => Type_Access, Is_Synth => False, + Al => 2, + Sz => 4, W => 32, Acc_Acc => Acc_Type))); end Create_Access_Type; @@ -506,6 +572,8 @@ package body Synth.Values is begin return To_Type_Acc (Alloc (Current_Pool, (Kind => Type_File, Is_Synth => False, + Al => 2, + Sz => 4, W => 32, File_Typ => File_Type))); end Create_File_Type; @@ -543,54 +611,23 @@ package body Synth.Values is return (Ntype, Create_Value_Net (N)); end Create_Value_Net; - function Create_Value_Discrete (Val : Int64) return Value_Acc - is - subtype Value_Type_Discrete is Value_Type (Value_Discrete); - function Alloc is new Areapools.Alloc_On_Pool_Addr (Value_Type_Discrete); - begin - return To_Value_Acc (Alloc (Current_Pool, - (Kind => Value_Discrete, Scal => Val))); - end Create_Value_Discrete; - - function Create_Value_Discrete (Val : Int64; Vtype : Type_Acc) return Valtyp - is - pragma Assert (Vtype /= null); - begin - return (Vtype, Create_Value_Discrete (Val)); - end Create_Value_Discrete; - - function Create_Value_Float (Val : Fp64) return Value_Acc - is - subtype Value_Type_Float is Value_Type (Value_Float); - function Alloc is new Areapools.Alloc_On_Pool_Addr (Value_Type_Float); - begin - return To_Value_Acc (Alloc (Current_Pool, - (Kind => Value_Float, Fp => Val))); - end Create_Value_Float; - - function Create_Value_Float (Val : Fp64; Vtype : Type_Acc) return Valtyp + function Create_Value_Memory (Vtype : Type_Acc) return Valtyp is - pragma Assert (Vtype /= null); - begin - return (Vtype, Create_Value_Float (Val)); - end Create_Value_Float; - - function Create_Value_Access (Acc : Heap_Index) return Value_Acc - is - subtype Value_Type_Access is Value_Type (Value_Access); - function Alloc is new Areapools.Alloc_On_Pool_Addr (Value_Type_Access); - begin - return To_Value_Acc (Alloc (Current_Pool, - (Kind => Value_Access, Acc => Acc))); - end Create_Value_Access; - - function Create_Value_Access (Vtype : Type_Acc; Acc : Heap_Index) - return Valtyp - is - pragma Assert (Vtype /= null); - begin - return (Vtype, Create_Value_Access (Acc)); - end Create_Value_Access; + subtype Value_Type_Memory is Value_Type (Value_Memory); + function Alloc is new Areapools.Alloc_On_Pool_Addr (Value_Type_Memory); + function To_Memory_Ptr is new Ada.Unchecked_Conversion + (System.Address, Memory_Ptr); + V : Value_Acc; + M : System.Address; + begin + Areapools.Allocate (Current_Pool.all, M, + Vtype.Sz, Size_Type (2 ** Natural (Vtype.Al))); + V := To_Value_Acc + (Alloc (Current_Pool, Value_Type_Memory'(Kind => Value_Memory, + Mem => To_Memory_Ptr (M)))); + + return (Vtype, V); + end Create_Value_Memory; function Create_Value_File (File : File_Index) return Value_Acc is @@ -609,79 +646,16 @@ package body Synth.Values is return (Vtype, Create_Value_File (File)); end Create_Value_File; - function Create_Value_Array (Len : Iir_Index32) return Value_Array_Acc - is - use System; - subtype Data_Type is Values.Value_Array_Type (Len); - Res : Address; - begin - -- Manually allocate the array to handle large arrays without - -- creating a large temporary value. - Areapools.Allocate - (Current_Pool.all, Res, - Data_Type'Size / Storage_Unit, Data_Type'Alignment); - - declare - -- Discard the warnings for no pragma Import as we really want - -- to use the default initialization. - pragma Warnings (Off); - Addr1 : constant Address := Res; - Init : Data_Type; - for Init'Address use Addr1; - pragma Warnings (On); - begin - null; - end; - - return To_Value_Array_Acc (Res); - end Create_Value_Array; - - function Create_Value_Array (Arr : Value_Array_Acc) return Value_Acc - is - subtype Value_Type_Array is Value_Type (Value_Array); - function Alloc is new Areapools.Alloc_On_Pool_Addr (Value_Type_Array); - - Res : Value_Acc; + function Vec_Length (Typ : Type_Acc) return Iir_Index32 is begin - Res := To_Value_Acc (Alloc (Current_Pool, - (Kind => Value_Array, Arr => Arr))); - return Res; - end Create_Value_Array; + return Iir_Index32 (Typ.Vbound.Len); + end Vec_Length; - function Create_Value_Array (Bounds : Type_Acc; Arr : Value_Array_Acc) - return Valtyp - is - pragma Assert (Bounds /= null); - begin - return (Bounds, Create_Value_Array (Arr)); - end Create_Value_Array; - - function Create_Value_Const_Array (Arr : Value_Array_Acc) return Value_Acc - is - subtype Value_Type_Const_Array is Value_Type (Value_Const_Array); - function Alloc is - new Areapools.Alloc_On_Pool_Addr (Value_Type_Const_Array); - - Res : Value_Acc; - begin - Res := To_Value_Acc (Alloc (Current_Pool, - (Kind => Value_Const_Array, Arr => Arr))); - return Res; - end Create_Value_Const_Array; - - function Create_Value_Const_Array (Bounds : Type_Acc; Arr : Value_Array_Acc) - return Valtyp - is - pragma Assert (Bounds /= null); - begin - return (Bounds, Create_Value_Const_Array (Arr)); - end Create_Value_Const_Array; - - function Get_Array_Flat_Length (Typ : Type_Acc) return Width is + function Get_Array_Flat_Length (Typ : Type_Acc) return Iir_Index32 is begin case Typ.Kind is when Type_Vector => - return Typ.Vbound.Len; + return Iir_Index32 (Typ.Vbound.Len); when Type_Array => declare Len : Width; @@ -690,91 +664,26 @@ package body Synth.Values is for I in Typ.Abounds.D'Range loop Len := Len * Typ.Abounds.D (I).Len; end loop; - return Len; + return Iir_Index32 (Len); end; when others => raise Internal_Error; end case; end Get_Array_Flat_Length; - procedure Create_Array_Data (Arr : Valtyp) - is - Len : Width; - begin - case Arr.Typ.Kind is - when Type_Array => - Len := Get_Array_Flat_Length (Arr.Typ); - when Type_Vector => - Len := Arr.Typ.Vbound.Len; - when others => - raise Internal_Error; - end case; - - Arr.Val.Arr := Create_Value_Array (Iir_Index32 (Len)); - end Create_Array_Data; - - function Create_Value_Array (Bounds : Type_Acc) return Value_Acc - is - Res : Value_Acc; - begin - Res := Create_Value_Array (Value_Array_Acc'(null)); - Create_Array_Data ((Bounds, Res)); - return Res; - end Create_Value_Array; - - function Create_Value_Record (Els : Value_Array_Acc) return Value_Acc - is - subtype Value_Type_Record is Value_Type (Value_Record); - function Alloc is new Areapools.Alloc_On_Pool_Addr (Value_Type_Record); - begin - return To_Value_Acc (Alloc (Current_Pool, - (Kind => Value_Record, - Rec => Els))); - end Create_Value_Record; - - function Create_Value_Record (Typ : Type_Acc; Els : Value_Array_Acc) - return Valtyp - is - pragma Assert (Typ /= null); - begin - return (Typ, Create_Value_Record (Els)); - end Create_Value_Record; - - function Create_Value_Const_Record (Els : Value_Array_Acc) return Value_Acc - is - subtype Value_Type_Const_Record is Value_Type (Value_Const_Record); - function Alloc is - new Areapools.Alloc_On_Pool_Addr (Value_Type_Const_Record); - begin - return To_Value_Acc (Alloc (Current_Pool, - (Kind => Value_Const_Record, Rec => Els))); - end Create_Value_Const_Record; - - function Create_Value_Const_Record (Typ : Type_Acc; Els : Value_Array_Acc) - return Valtyp + function Create_Value_Alias + (Obj : Value_Acc; Off : Value_Offsets; Typ : Type_Acc) return Valtyp is pragma Assert (Typ /= null); - begin - return (Typ, Create_Value_Const_Record (Els)); - end Create_Value_Const_Record; - - function Create_Value_Alias (Obj : Value_Acc; Off : Uns32) return Value_Acc - is subtype Value_Type_Alias is Value_Type (Value_Alias); function Alloc is new Areapools.Alloc_On_Pool_Addr (Value_Type_Alias); + Val : Value_Acc; begin - return To_Value_Acc (Alloc (Current_Pool, + Val := To_Value_Acc (Alloc (Current_Pool, (Kind => Value_Alias, A_Obj => Obj, A_Off => Off))); - end Create_Value_Alias; - - function Create_Value_Alias (Obj : Value_Acc; Off : Uns32; Typ : Type_Acc) - return Valtyp - is - pragma Assert (Typ /= null); - begin - return (Typ, Create_Value_Alias (Obj, Off)); + return (Typ, Val); end Create_Value_Alias; function Create_Value_Const (Val : Value_Acc; Loc : Syn_Src) @@ -797,70 +706,45 @@ package body Synth.Values is return (Val.Typ, Create_Value_Const (Val.Val, Loc)); end Create_Value_Const; - procedure Strip_Const (Val : in out Value_Acc) is - begin - if Val.Kind = Value_Const then - Val := Val.C_Val; - end if; - end Strip_Const; - - function Strip_Const (Val : Value_Acc) return Value_Acc is + procedure Strip_Const (Vt : in out Valtyp) is begin - if Val.Kind = Value_Const then - return Val.C_Val; - else - return Val; + if Vt.Val.Kind = Value_Const then + Vt.Val := Vt.Val.C_Val; end if; end Strip_Const; - procedure Strip_Const (Vt : in out Valtyp) is + procedure Copy_Memory (Dest : Memory_Ptr; Src : Memory_Ptr; Sz : Size_Type) + is begin - Vt.Val := Strip_Const (Vt.Val); - end Strip_Const; - - function Copy (Src : Value_Acc) return Value_Acc; + for I in 1 .. Sz loop + Dest (I - 1) := Src (I - 1); + end loop; + end Copy_Memory; - function Copy_Array (Arr : Value_Array_Acc) return Value_Array_Acc + procedure Write_Value (Dest : Memory_Ptr; Vt : Valtyp) is - Res : Value_Array_Acc; + Mt : Memtyp; begin - Res := Create_Value_Array (Arr.Len); - for I in Res.V'Range loop - Res.V (I) := Copy (Arr.V (I)); - end loop; - return Res; - end Copy_Array; + Mt := Get_Memtyp (Vt); + Copy_Memory (Dest, Mt.Mem, Mt.Typ.Sz); + end Write_Value; - function Copy (Src : Value_Acc) return Value_Acc + function Copy (Src : Valtyp) return Valtyp is - Res : Value_Acc; - Arr : Value_Array_Acc; + Res : Valtyp; begin - case Src.Kind is + case Src.Val.Kind is + when Value_Memory => + Res := Create_Value_Memory (Src.Typ); + for I in 1 .. Src.Typ.Sz loop + Res.Val.Mem (I - 1) := Src.Val.Mem (I - 1); + end loop; when Value_Net => - Res := Create_Value_Net (Src.N); + Res := Create_Value_Net (Src.Val.N, Src.Typ); when Value_Wire => - Res := Create_Value_Wire (Src.W); - when Value_Discrete => - Res := Create_Value_Discrete (Src.Scal); - when Value_Float => - Res := Create_Value_Float (Src.Fp); - when Value_Array => - Arr := Copy_Array (Src.Arr); - Res := Create_Value_Array (Arr); - when Value_Const_Array => - Arr := Copy_Array (Src.Arr); - Res := Create_Value_Const_Array (Arr); - when Value_Record => - Arr := Copy_Array (Src.Rec); - Res := Create_Value_Record (Arr); - when Value_Const_Record => - Arr := Copy_Array (Src.Rec); - Res := Create_Value_Const_Record (Arr); - when Value_Access => - Res := Create_Value_Access (Src.Acc); + Res := Create_Value_Wire (Src.Val.W, Src.Typ); when Value_File => - Res := Create_Value_File (Src.File); + Res := Create_Value_File (Src.Typ, Src.Val.File); when Value_Const => raise Internal_Error; when Value_Alias => @@ -869,11 +753,10 @@ package body Synth.Values is return Res; end Copy; - function Unshare (Src : Value_Acc; Pool : Areapool_Acc) - return Value_Acc + function Unshare (Src : Valtyp; Pool : Areapool_Acc) return Valtyp is Prev_Pool : constant Areapool_Acc := Current_Pool; - Res : Value_Acc; + Res : Valtyp; begin Current_Pool := Pool; Res := Copy (Src); @@ -939,27 +822,240 @@ package body Synth.Values is end case; end Is_Matching_Bounds; - function Create_Value_Default (Typ : Type_Acc) return Value_Acc is + type Ghdl_U8_Ptr is access all Ghdl_U8; + function To_U8_Ptr is + new Ada.Unchecked_Conversion (Memory_Ptr, Ghdl_U8_Ptr); + + procedure Write_U8 (Mem : Memory_Ptr; Val : Ghdl_U8) is + begin + To_U8_Ptr (Mem).all := Val; + end Write_U8; + + function Read_U8 (Mem : Memory_Ptr) return Ghdl_U8 is + begin + return To_U8_Ptr (Mem).all; + end Read_U8; + + type Ghdl_I32_Ptr is access all Ghdl_I32; + function To_I32_Ptr is + new Ada.Unchecked_Conversion (Memory_Ptr, Ghdl_I32_Ptr); + + procedure Write_I32 (Mem : Memory_Ptr; Val : Ghdl_I32) is + begin + To_I32_Ptr (Mem).all := Val; + end Write_I32; + + function Read_I32 (Mem : Memory_Ptr) return Ghdl_I32 is + begin + return To_I32_Ptr (Mem).all; + end Read_I32; + + type Ghdl_U32_Ptr is access all Ghdl_U32; + function To_U32_Ptr is + new Ada.Unchecked_Conversion (Memory_Ptr, Ghdl_U32_Ptr); + + procedure Write_U32 (Mem : Memory_Ptr; Val : Ghdl_U32) is + begin + To_U32_Ptr (Mem).all := Val; + end Write_U32; + + function Read_U32 (Mem : Memory_Ptr) return Ghdl_U32 is + begin + return To_U32_Ptr (Mem).all; + end Read_U32; + + type Ghdl_I64_Ptr is access all Ghdl_I64; + function To_I64_Ptr is + new Ada.Unchecked_Conversion (Memory_Ptr, Ghdl_I64_Ptr); + + procedure Write_I64 (Mem : Memory_Ptr; Val : Ghdl_I64) is + begin + To_I64_Ptr (Mem).all := Val; + end Write_I64; + + function Read_I64 (Mem : Memory_Ptr) return Ghdl_I64 is + begin + return To_I64_Ptr (Mem).all; + end Read_I64; + + type Fp64_Ptr is access all Fp64; + function To_Fp64_Ptr is + new Ada.Unchecked_Conversion (Memory_Ptr, Fp64_Ptr); + + procedure Write_Fp64 (Mem : Memory_Ptr; Val : Fp64) is + begin + To_Fp64_Ptr (Mem).all := Val; + end Write_Fp64; + + function Read_Fp64 (Mem : Memory_Ptr) return Fp64 is + begin + return To_Fp64_Ptr (Mem).all; + end Read_Fp64; + + type Heap_Index_Ptr is access all Heap_Index; + function To_Heap_Index_Ptr is + new Ada.Unchecked_Conversion (Memory_Ptr, Heap_Index_Ptr); + + procedure Write_Access (Mem : Memory_Ptr; Val : Heap_Index) is + begin + To_Heap_Index_Ptr (Mem).all := Val; + end Write_Access; + + function Read_Access (Mem : Memory_Ptr) return Heap_Index is + begin + return To_Heap_Index_Ptr (Mem).all; + end Read_Access; + + function "+" (Base : Memory_Ptr; Off : Size_Type) return Memory_Ptr + is + use System.Storage_Elements; + + function To_Address is new Ada.Unchecked_Conversion + (Memory_Ptr, System.Address); + function To_Memory_Ptr is new Ada.Unchecked_Conversion + (System.Address, Memory_Ptr); + begin + return To_Memory_Ptr (To_Address (Base) + Storage_Offset (Off)); + end "+"; + + procedure Write_Discrete (Mem : Memory_Ptr; Typ : Type_Acc; Val : Int64) is + begin + case Typ.Sz is + when 1 => + Write_U8 (Mem, Ghdl_U8 (Val)); + when 4 => + Write_I32 (Mem, Ghdl_I32 (Val)); + when 8 => + Write_I64 (Mem, Ghdl_I64 (Val)); + when others => + raise Internal_Error; + end case; + end Write_Discrete; + + procedure Write_Discrete (Vt : Valtyp; Val : Int64) is + begin + Write_Discrete (Vt.Val.Mem, Vt.Typ, Val); + end Write_Discrete; + + function Read_Discrete (Mem : Memory_Ptr; Typ : Type_Acc) return Int64 is + begin + case Typ.Sz is + when 1 => + return Int64 (Read_U8 (Mem)); + when 4 => + return Int64 (Read_I32 (Mem)); + when 8 => + return Int64 (Read_I64 (Mem)); + when others => + raise Internal_Error; + end case; + end Read_Discrete; + + function Read_Discrete (Vt : Valtyp) return Int64 is + begin + return Read_Discrete (Vt.Val.Mem, Vt.Typ); + end Read_Discrete; + + function Create_Value_Float (Val : Fp64; Vtype : Type_Acc) return Valtyp + is + Res : Valtyp; + pragma Assert (Vtype /= null); + begin + Res := Create_Value_Memory (Vtype); + Write_Fp64 (Res.Val.Mem, Val); + return Res; + end Create_Value_Float; + + function Read_Fp64 (Vt : Valtyp) return Fp64 is + begin + pragma Assert (Vt.Typ.Kind = Type_Float); + pragma Assert (Vt.Typ.Sz = 8); + return Read_Fp64 (Vt.Val.Mem); + end Read_Fp64; + + function Read_Access (Vt : Valtyp) return Heap_Index is + begin + pragma Assert (Vt.Typ.Kind = Type_Access); + return Read_Access (Vt.Val.Mem); + end Read_Access; + + function Create_Value_Discrete (Val : Int64; Vtype : Type_Acc) return Valtyp + is + Res : Valtyp; + begin + Res := Create_Value_Memory (Vtype); + case Vtype.Sz is + when 1 => + Write_U8 (Res.Val.Mem, Ghdl_U8 (Val)); + when 4 => + Write_I32 (Res.Val.Mem, Ghdl_I32 (Val)); + when 8 => + Write_I64 (Res.Val.Mem, Ghdl_I64 (Val)); + when others => + raise Internal_Error; + end case; + return Res; + end Create_Value_Discrete; + + function Create_Value_Uns (Val : Uns64; Vtype : Type_Acc) return Valtyp + is + Res : Valtyp; + begin + Res := Create_Value_Memory (Vtype); + case Vtype.Sz is + when 1 => + Write_U8 (Res.Val.Mem, Ghdl_U8 (Val)); + when 4 => + Write_U32 (Res.Val.Mem, Ghdl_U32 (Val)); + when others => + raise Internal_Error; + end case; + return Res; + end Create_Value_Uns; + + pragma Unreferenced (Read_U32); + + function Create_Value_Int (Val : Int64; Vtype : Type_Acc) return Valtyp + is + Res : Valtyp; + begin + Res := Create_Value_Memory (Vtype); + case Vtype.Sz is + when 4 => + Write_I32 (Res.Val.Mem, Ghdl_I32 (Val)); + when 8 => + Write_I64 (Res.Val.Mem, Ghdl_I64 (Val)); + when others => + raise Internal_Error; + end case; + return Res; + end Create_Value_Int; + + function Arr_Index (M : Memory_Ptr; Idx : Iir_Index32; El_Typ : Type_Acc) + return Memory_Ptr is + begin + return M + Size_Type (Idx) * El_Typ.Sz; + end Arr_Index; + + procedure Write_Value_Default (M : Memory_Ptr; Typ : Type_Acc) is begin case Typ.Kind is when Type_Bit | Type_Logic => -- FIXME: what about subtype ? - return Create_Value_Discrete (0); + Write_U8 (M, 0); when Type_Discrete => - return Create_Value_Discrete (Typ.Drange.Left); + Write_Discrete (M, Typ, Typ.Drange.Left); when Type_Float => - return Create_Value_Float (Typ.Frange.Left); + Write_Fp64 (M, Typ.Frange.Left); when Type_Vector => declare + Len : constant Iir_Index32 := Vec_Length (Typ); El_Typ : constant Type_Acc := Typ.Vec_El; - Arr : Value_Array_Acc; begin - Arr := Create_Value_Array (Iir_Index32 (Typ.Vbound.Len)); - for I in Arr.V'Range loop - Arr.V (I) := Create_Value_Default (El_Typ); + for I in 1 .. Len loop + Write_Value_Default (Arr_Index (M, I - 1, El_Typ), El_Typ); end loop; - return Create_Value_Const_Array (Arr); end; when Type_Unbounded_Vector => raise Internal_Error; @@ -967,50 +1063,78 @@ package body Synth.Values is raise Internal_Error; when Type_Array => declare - El_Typ : constant Type_Acc := Get_Array_Element (Typ); - Arr : Value_Array_Acc; + Len : constant Iir_Index32 := Get_Array_Flat_Length (Typ); + El_Typ : constant Type_Acc := Typ.Arr_El; begin - Arr := Create_Value_Array - (Iir_Index32 (Get_Array_Flat_Length (Typ))); - for I in Arr.V'Range loop - Arr.V (I) := Create_Value_Default (El_Typ); + for I in 1 .. Len loop + Write_Value_Default (Arr_Index (M, I - 1, El_Typ), El_Typ); end loop; - return Create_Value_Const_Array (Arr); end; when Type_Unbounded_Array => raise Internal_Error; when Type_Record => - declare - Els : Value_Array_Acc; - begin - Els := Create_Value_Array (Typ.Rec.Len); - for I in Els.V'Range loop - Els.V (I) := Create_Value_Default (Typ.Rec.E (I).Typ); - end loop; - return Create_Value_Const_Record (Els); - end; + for I in Typ.Rec.E'Range loop + Write_Value_Default (M + Typ.Rec.E (I).Moff, Typ.Rec.E (I).Typ); + end loop; when Type_Access => - return Create_Value_Access (Null_Heap_Index); + Write_Access (M, Null_Heap_Index); when Type_File => raise Internal_Error; end case; - end Create_Value_Default; + end Write_Value_Default; - function Create_Value_Default (Typ : Type_Acc) return Valtyp is + function Create_Value_Default (Typ : Type_Acc) return Valtyp + is + Res : Valtyp; begin - return (Typ, Create_Value_Default (Typ)); + Res := Create_Value_Memory (Typ); + Write_Value_Default (Res.Val.Mem, Typ); + return Res; end Create_Value_Default; - function Value_To_String (Val : Value_Acc) return String + function Create_Value_Access (Val : Heap_Index; Acc_Typ : Type_Acc) + return Valtyp is - Str : String (1 .. Natural (Val.Arr.Len)); + Res : Valtyp; begin - for I in Val.Arr.V'Range loop - Str (Natural (I)) := Character'Val (Val.Arr.V (I).Scal); + Res := Create_Value_Memory (Acc_Typ); + Write_Access (Res.Val.Mem, Val); + return Res; + end Create_Value_Access; + + function Value_To_String (Val : Valtyp) return String + is + Str : String (1 .. Natural (Val.Typ.Abounds.D (1).Len)); + begin + for I in Str'Range loop + Str (Natural (I)) := Character'Val + (Read_U8 (Val.Val.Mem + Size_Type (I - 1))); end loop; return Str; end Value_To_String; + function Get_Memtyp (V : Valtyp) return Memtyp is + begin + case V.Val.Kind is + when Value_Net + | Value_Wire => + raise Internal_Error; + when Value_Memory => + return (V.Typ, V.Val.Mem); + when Value_Alias => + declare + T : Memtyp; + begin + T := Get_Memtyp ((V.Typ, V.Val.A_Obj)); + return (T.Typ, T.Mem + V.Val.A_Off.Mem_Off); + end; + when Value_Const => + return Get_Memtyp ((V.Typ, V.Val.C_Val)); + when Value_File => + raise Internal_Error; + end case; + end Get_Memtyp; + procedure Init is begin Instance_Pool := Global_Pool'Access; diff --git a/src/synth/synth-values.ads b/src/synth/synth-values.ads index 6e1b29e80..ffb554717 100644 --- a/src/synth/synth-values.ads +++ b/src/synth/synth-values.ads @@ -18,9 +18,12 @@ -- Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston, -- MA 02110-1301, USA. +with Ada.Unchecked_Deallocation; + with Types; use Types; with Areapools; use Areapools; +with Grt.Types; use Grt.Types; with Grt.Files_Operations; with Netlists; use Netlists; @@ -60,8 +63,8 @@ package Synth.Values is type Bound_Array_Type is array (Dim_Type range <>) of Bound_Type; - type Bound_Array (Len : Dim_Type) is record - D : Bound_Array_Type (1 .. Len); + type Bound_Array (Ndim : Dim_Type) is record + D : Bound_Array_Type (1 .. Ndim); end record; type Bound_Array_Acc is access Bound_Array; @@ -92,7 +95,13 @@ package Synth.Values is type Type_Acc is access Type_Type; type Rec_El_Type is record - Off : Uns32; + -- Bit offset: offset of the element in a net. + Boff : Uns32; + + -- Memory offset: offset of the element in memory. + Moff : Size_Type; + + -- Type of the element. Typ : Type_Acc; end record; @@ -103,11 +112,20 @@ package Synth.Values is type Rec_El_Array_Acc is access Rec_El_Array; + -- Power of 2 alignment. + type Palign_Type is range 0 .. 3; + type Type_Type (Kind : Type_Kind) is record -- False if the type is not synthesisable: is or contains access/file. Is_Synth : Boolean; - -- Number of bits for this type. + -- Alignment (in bytes) for this type. + Al : Palign_Type; + + -- Number of bytes (when in memory) for this type. + Sz : Size_Type; + + -- Number of bits (when in a net) for this type. W : Width; case Kind is @@ -153,20 +171,9 @@ package Synth.Values is -- into a net. Value_Wire, - -- A discrete value (integer or enumeration). - Value_Discrete, + -- Any kind of constant value, raw stored in memory. + Value_Memory, - Value_Float, - - -- An array (const if all elements are constants). - Value_Array, - Value_Const_Array, - - -- A record (const if all elements are constants). - Value_Record, - Value_Const_Record, - - Value_Access, Value_File, -- A constant. This is a named value. One purpose is to avoid to @@ -184,9 +191,9 @@ package Synth.Values is type Value_Type_Array is array (Iir_Index32 range <>) of Value_Acc; - type Value_Array_Type (Len : Iir_Index32) is record + type Value_Array_Type (Ln : Iir_Index32) is record -- Values are from left to right. So V(1) is at index 'Left. - V : Value_Type_Array (1 .. Len); + V : Value_Type_Array (1 .. Ln); end record; type Value_Array_Acc is access Value_Array_Type; @@ -196,24 +203,33 @@ package Synth.Values is subtype File_Index is Grt.Files_Operations.Ghdl_File_Index; + type Memory_Element is mod 2**8; + type Memory_Array is array (Size_Type range <>) of Memory_Element; + + -- Flat pointer for a generic pointer. + type Memory_Ptr is access all Memory_Array (Size_Type); + + type Memtyp is record + Typ : Type_Acc; + Mem : Memory_Ptr; + end record; + + -- Offsets for a value. + type Value_Offsets is record + Net_Off : Uns32; + Mem_Off : Size_Type; + end record; + + function "+" (L, R : Value_Offsets) return Value_Offsets; + type Value_Type (Kind : Value_Kind) is record case Kind is when Value_Net => N : Net; when Value_Wire => W : Wire_Id; - when Value_Discrete => - Scal : Int64; - when Value_Float => - Fp : Fp64; - when Value_Array - | Value_Const_Array => - Arr : Value_Array_Acc; - when Value_Record - | Value_Const_Record => - Rec : Value_Array_Acc; - when Value_Access => - Acc : Heap_Index; + when Value_Memory => + Mem : Memory_Ptr; when Value_File => File : File_Index; when Value_Const => @@ -222,7 +238,7 @@ package Synth.Values is C_Net : Net; when Value_Alias => A_Obj : Value_Acc; - A_Off : Uns32; + A_Off : Value_Offsets; end case; end record; @@ -234,6 +250,12 @@ package Synth.Values is No_Valtyp : constant Valtyp := (null, null); + type Valtyp_Array is array (Nat32 range <>) of Valtyp; + type Valtyp_Array_Acc is access Valtyp_Array; + + procedure Free_Valtyp_Array is new Ada.Unchecked_Deallocation + (Valtyp_Array, Valtyp_Array_Acc); + Global_Pool : aliased Areapool; Expr_Pool : aliased Areapool; @@ -244,15 +266,19 @@ package Synth.Values is Instance_Pool : Areapool_Acc; -- Types. - function Create_Discrete_Type (Rng : Discrete_Range_Type; W : Width) + function Create_Discrete_Type (Rng : Discrete_Range_Type; + Sz : Size_Type; + W : Width) return Type_Acc; + function Create_Float_Type (Rng : Float_Range_Type) return Type_Acc; function Create_Vec_Type_By_Length (Len : Width; El : Type_Acc) return Type_Acc; function Create_Vector_Type (Bnd : Bound_Type; El_Type : Type_Acc) return Type_Acc; function Create_Unbounded_Vector (El_Type : Type_Acc) return Type_Acc; - function Create_Slice_Type (W : Width; El_Type : Type_Acc) return Type_Acc; + function Create_Slice_Type (Len : Uns32; El_Type : Type_Acc) + return Type_Acc; function Create_Bound_Array (Ndims : Dim_Type) return Bound_Array_Acc; function Create_Array_Type (Bnd : Bound_Array_Acc; El_Type : Type_Acc) return Type_Acc; @@ -260,8 +286,7 @@ package Synth.Values is return Type_Acc; function Create_Rec_El_Array (Nels : Iir_Index32) return Rec_El_Array_Acc; - function Create_Record_Type (Els : Rec_El_Array_Acc; W : Width) - return Type_Acc; + function Create_Record_Type (Els : Rec_El_Array_Acc) return Type_Acc; function Create_Access_Type (Acc_Type : Type_Acc) return Type_Acc; @@ -272,6 +297,9 @@ package Synth.Values is function Get_Array_Bound (Typ : Type_Acc; Dim : Dim_Type) return Bound_Type; + -- Return the length of RNG. + function Get_Range_Length (Rng : Discrete_Range_Type) return Uns32; + -- Return the element of a vector/array/unbounded_array. function Get_Array_Element (Arr_Type : Type_Acc) return Type_Acc; @@ -283,80 +311,55 @@ package Synth.Values is -- Can also return true for nets and wires. function Is_Static_Val (Val : Value_Acc) return Boolean; - function Is_Equal (L, R : Value_Acc) return Boolean; + function Is_Equal (L, R : Valtyp) return Boolean; function Are_Types_Equal (L, R : Type_Acc) return Boolean; -- Create a Value_Net. - function Create_Value_Net (N : Net) return Value_Acc; function Create_Value_Net (N : Net; Ntype : Type_Acc) return Valtyp; -- Create a Value_Wire. For a bit wire, RNG must be null. - function Create_Value_Wire (W : Wire_Id) return Value_Acc; function Create_Value_Wire (W : Wire_Id; Wtype : Type_Acc) return Valtyp; - function Create_Value_Discrete (Val : Int64) return Value_Acc; + function Create_Value_Memory (Vtype : Type_Acc) return Valtyp; + + function Create_Value_Uns (Val : Uns64; Vtype : Type_Acc) return Valtyp; + function Create_Value_Int (Val : Int64; Vtype : Type_Acc) return Valtyp; function Create_Value_Discrete (Val : Int64; Vtype : Type_Acc) return Valtyp; - function Create_Value_Float (Val : Fp64) return Value_Acc; - function Create_Value_Float (Val : Fp64; Vtype : Type_Acc) return Valtyp; - - function Create_Value_Access (Acc : Heap_Index) return Value_Acc; - function Create_Value_Access (Vtype : Type_Acc; Acc : Heap_Index) + function Create_Value_Access (Val : Heap_Index; Acc_Typ : Type_Acc) return Valtyp; - function Create_Value_File (File : File_Index) return Value_Acc; + function Create_Value_Float (Val : Fp64; Vtype : Type_Acc) return Valtyp; + function Create_Value_File (Vtype : Type_Acc; File : File_Index) return Valtyp; - function Create_Value_Array (Len : Iir_Index32) return Value_Array_Acc; + function Create_Value_Alias + (Obj : Value_Acc; Off : Value_Offsets; Typ : Type_Acc) return Valtyp; - -- Create a Value_Array. - function Create_Value_Array (Arr : Value_Array_Acc) return Value_Acc; - function Create_Value_Array (Bounds : Type_Acc; Arr : Value_Array_Acc) - return Valtyp; - function Create_Value_Const_Array (Arr : Value_Array_Acc) return Value_Acc; - function Create_Value_Const_Array (Bounds : Type_Acc; Arr : Value_Array_Acc) - return Valtyp; - - -- Like the previous one but automatically build the array. - function Create_Value_Array (Bounds : Type_Acc) return Value_Acc; - - -- Allocate the ARR component of the Value_Type ARR, using BOUNDS. - -- procedure Create_Array_Data (Arr : Value_Acc); - - function Create_Value_Record (Els : Value_Array_Acc) return Value_Acc; - function Create_Value_Record (Typ : Type_Acc; Els : Value_Array_Acc) - return Valtyp; - function Create_Value_Const_Record (Els : Value_Array_Acc) return Value_Acc; - function Create_Value_Const_Record (Typ : Type_Acc; Els : Value_Array_Acc) - return Valtyp; - - function Create_Value_Alias (Obj : Value_Acc; Off : Uns32) return Value_Acc; - function Create_Value_Alias (Obj : Value_Acc; Off : Uns32; Typ : Type_Acc) - return Valtyp; - function Create_Value_Const (Val : Value_Acc; Loc : Syn_Src) - return Value_Acc; function Create_Value_Const (Val : Valtyp; Loc : Syn_Src) return Valtyp; -- If VAL is a const, replace it by its value. - procedure Strip_Const (Val : in out Value_Acc); procedure Strip_Const (Vt : in out Valtyp); - function Strip_Const (Val : Value_Acc) return Value_Acc; -- If VAL is a const or an alias, replace it by its value. -- Used to extract the real data of a static value. Note that the type -- is not correct anymore. - function Strip_Alias_Const (V : Value_Acc) return Value_Acc; function Strip_Alias_Const (V : Valtyp) return Valtyp; - function Unshare (Src : Value_Acc; Pool : Areapool_Acc) - return Value_Acc; + -- Return the memtyp of V; also strip const and aliases. + function Get_Memtyp (V : Valtyp) return Memtyp; + + function Unshare (Src : Valtyp; Pool : Areapool_Acc) return Valtyp; + + -- Return the length of a vector type. + function Vec_Length (Typ : Type_Acc) return Iir_Index32; -- Get the number of indexes in array type TYP without counting -- sub-elements. - function Get_Array_Flat_Length (Typ : Type_Acc) return Width; + function Get_Array_Flat_Length (Typ : Type_Acc) return Iir_Index32; -- Return length of dimension DIM of type T. function Get_Bound_Length (T : Type_Acc; Dim : Dim_Type) return Width; @@ -366,12 +369,32 @@ package Synth.Values is function Get_Type_Width (Atype : Type_Acc) return Width; -- Create a default initial value for TYP. - function Create_Value_Default (Typ : Type_Acc) return Value_Acc; function Create_Value_Default (Typ : Type_Acc) return Valtyp; + procedure Write_Value_Default (M : Memory_Ptr; Typ : Type_Acc); -- Convert a value to a string. The value must be a const_array of scalar, -- which represent characters. - function Value_To_String (Val : Value_Acc) return String; + function Value_To_String (Val : Valtyp) return String; + + -- Memory access. + procedure Write_Discrete (Vt : Valtyp; Val : Int64); + function Read_Discrete (Mem : Memory_Ptr; Typ : Type_Acc) return Int64; + function Read_Discrete (Vt : Valtyp) return Int64; + + procedure Write_Access (Mem : Memory_Ptr; Val : Heap_Index); + function Read_Access (Vt : Valtyp) return Heap_Index; + + function Read_Fp64 (Mem : Memory_Ptr) return Fp64; + function Read_Fp64 (Vt : Valtyp) return Fp64; + + -- Low level subprograms. + function Read_U8 (Mem : Memory_Ptr) return Ghdl_U8; + procedure Write_U8 (Mem : Memory_Ptr; Val : Ghdl_U8); + + function "+" (Base : Memory_Ptr; Off : Size_Type) return Memory_Ptr; + + procedure Copy_Memory (Dest : Memory_Ptr; Src : Memory_Ptr; Sz : Size_Type); + procedure Write_Value (Dest : Memory_Ptr; Vt : Valtyp); procedure Init; |