diff options
| author | Tristan Gingold <tgingold@free.fr> | 2022-08-19 07:20:25 +0200 | 
|---|---|---|
| committer | Tristan Gingold <tgingold@free.fr> | 2022-08-19 07:46:47 +0200 | 
| commit | c28f780bc65b54989cccf83b0637113be3964b51 (patch) | |
| tree | 2952b30cef115df0aaf6efa4c4122324043e8c12 /src | |
| parent | 8445d2e9d7af348c86d6e28eff74407530719138 (diff) | |
| download | ghdl-c28f780bc65b54989cccf83b0637113be3964b51.tar.gz ghdl-c28f780bc65b54989cccf83b0637113be3964b51.tar.bz2 ghdl-c28f780bc65b54989cccf83b0637113be3964b51.zip | |
elab-vhdl_expr: factorize code
Diffstat (limited to 'src')
| -rw-r--r-- | src/synth/elab-vhdl_decls.adb | 15 | ||||
| -rw-r--r-- | src/synth/elab-vhdl_expr.adb | 965 | ||||
| -rw-r--r-- | src/synth/elab-vhdl_expr.ads | 26 | ||||
| -rw-r--r-- | src/synth/elab-vhdl_files.adb | 7 | ||||
| -rw-r--r-- | src/synth/elab-vhdl_insts.adb | 10 | ||||
| -rw-r--r-- | src/synth/elab-vhdl_stmts.adb | 5 | ||||
| -rw-r--r-- | src/synth/elab-vhdl_types.adb | 12 | ||||
| -rw-r--r-- | src/synth/netlists-builders.ads | 2 | ||||
| -rw-r--r-- | src/synth/synth-vhdl_expr.adb | 3 | ||||
| -rw-r--r-- | src/synth/synth-vhdl_expr.ads | 3 | 
10 files changed, 50 insertions, 998 deletions
| diff --git a/src/synth/elab-vhdl_decls.adb b/src/synth/elab-vhdl_decls.adb index 44faae846..0beb5997a 100644 --- a/src/synth/elab-vhdl_decls.adb +++ b/src/synth/elab-vhdl_decls.adb @@ -27,6 +27,9 @@ with Elab.Vhdl_Errors; use Elab.Vhdl_Errors;  with Elab.Vhdl_Expr; use Elab.Vhdl_Expr;  with Elab.Vhdl_Insts; +with Synth.Vhdl_Expr; use Synth.Vhdl_Expr; +with Synth.Vhdl_Stmts; use Synth.Vhdl_Stmts; +  package body Elab.Vhdl_Decls is     procedure Elab_Subprogram_Declaration       (Syn_Inst : Synth_Instance_Acc; Subprg : Node) @@ -91,7 +94,7 @@ package body Elab.Vhdl_Decls is           end if;           Last_Type := Decl_Type;        end if; -      Val := Exec_Expression_With_Type +      Val := Synth_Expression_With_Type          (Syn_Inst, Get_Default_Value (Decl), Obj_Type);        if Val = No_Valtyp then           Set_Error (Syn_Inst); @@ -111,7 +114,7 @@ package body Elab.Vhdl_Decls is        Obj_Typ := Elab_Declaration_Type (Syn_Inst, Decl);        if Is_Valid (Def) then -         Init := Exec_Expression_With_Type (Syn_Inst, Def, Obj_Typ); +         Init := Synth_Expression_With_Type (Syn_Inst, Def, Obj_Typ);           Init := Exec_Subtype_Conversion (Init, Obj_Typ, False, Decl);        else           Init := No_Valtyp; @@ -135,7 +138,7 @@ package body Elab.Vhdl_Decls is        end if;        if Is_Valid (Def) then -         Init := Exec_Expression_With_Type (Syn_Inst, Def, Obj_Typ); +         Init := Synth_Expression_With_Type (Syn_Inst, Def, Obj_Typ);           Init := Exec_Subtype_Conversion (Init, Obj_Typ, False, Decl);        else           if Force_Init then @@ -233,7 +236,7 @@ package body Elab.Vhdl_Decls is           --     subtype conversion is first performed on the value,           --     unless the attribute's subtype indication denotes an           --     unconstrained array type. -         Val := Exec_Expression_With_Type +         Val := Synth_Expression_With_Type             (Syn_Inst, Get_Expression (Spec), Val_Type);           --  Check_Constraints (Instance, Val, Attr_Type, Decl); @@ -258,6 +261,7 @@ package body Elab.Vhdl_Decls is        Obj_Typ : Type_Acc;        Base : Valtyp;        Typ : Type_Acc; +      Dyn : Dyn_Name;     begin        --  Subtype indication may not be present.        if Atype /= Null_Node then @@ -267,7 +271,8 @@ package body Elab.Vhdl_Decls is           Obj_Typ := null;        end if; -      Exec_Assignment_Prefix (Syn_Inst, Get_Name (Decl), Base, Typ, Off); +      Synth_Assignment_Prefix (Syn_Inst, Get_Name (Decl), Base, Typ, Off, Dyn); +      pragma Assert (Dyn = No_Dyn_Name);        Res := Create_Value_Alias (Base, Off, Typ);        if Obj_Typ /= null then           Res := Exec_Subtype_Conversion (Res, Obj_Typ, True, Decl); diff --git a/src/synth/elab-vhdl_expr.adb b/src/synth/elab-vhdl_expr.adb index f29ca1347..d1b44fe78 100644 --- a/src/synth/elab-vhdl_expr.adb +++ b/src/synth/elab-vhdl_expr.adb @@ -18,9 +18,9 @@  with Types; use Types;  with Name_Table; -with Std_Names;  with Str_Table; -with Errorout; use Errorout; + +with Netlists.Builders;  with Vhdl.Errors; use Vhdl.Errors;  with Vhdl.Utils; use Vhdl.Utils; @@ -30,11 +30,7 @@ with Elab.Memtype; use Elab.Memtype;  with Elab.Vhdl_Heap; use Elab.Vhdl_Heap;  with Elab.Vhdl_Types; use Elab.Vhdl_Types;  with Elab.Vhdl_Errors; use Elab.Vhdl_Errors; -with Elab.Debugger; -with Synth.Vhdl_Stmts; use Synth.Vhdl_Stmts; -with Synth.Vhdl_Oper; use Synth.Vhdl_Oper; -with Synth.Vhdl_Aggr;  with Synth.Vhdl_Expr; use Synth.Vhdl_Expr;  with Synth.Vhdl_Eval; use Synth.Vhdl_Eval; @@ -91,7 +87,7 @@ package body Elab.Vhdl_Expr is        for I in Flist_First .. Last loop           --  Elements are supposed to be static, so no need for enable. -         Val := Exec_Expression_With_Type +         Val := Synth_Expression_With_Type             (Syn_Inst, Get_Nth_Element (Els, I), El_Typ);           pragma Assert (Is_Static (Val.Val));           Write_Value (Res.Val.Mem + Size_Type (I) * El_Typ.Sz, Val); @@ -100,138 +96,13 @@ package body Elab.Vhdl_Expr is        return Res;     end Exec_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_Alias => -            return Create_Value_Alias -              ((Val.Val.A_Typ, 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; -   end Reshape_Value; -     function Exec_Subtype_Conversion (Vt : Valtyp;                                       Dtype : Type_Acc;                                       Bounds : Boolean; -                                     Loc : Node) -                                    return Valtyp -   is -      Vtype : constant Type_Acc := Vt.Typ; +                                     Loc : Node) return Valtyp is     begin -      if Vt = No_Valtyp then -         --  Propagate error. -         return No_Valtyp; -      end if; -      if Dtype = Vtype then -         return Vt; -      end if; - -      case Dtype.Kind is -         when Type_Bit => -            pragma Assert (Vtype.Kind = Type_Bit); -            return Vt; -         when Type_Logic => -            pragma Assert (Vtype.Kind = Type_Logic); -            return Vt; -         when Type_Discrete => -            pragma Assert (Vtype.Kind in Type_All_Discrete); -            case Vt.Val.Kind is -               when Value_Net -                  | Value_Wire -                  | Value_Alias => -                  raise Internal_Error; -               when Value_Const => -                  return Exec_Subtype_Conversion -                    ((Vt.Typ, Vt.Val.C_Val), Dtype, Bounds, Loc); -               when Value_Memory => -                  --  Check for overflow. -                  declare -                     Val : constant Int64 := Read_Discrete (Vt); -                  begin -                     if not In_Range (Dtype.Drange, Val) then -                        Error_Msg_Elab (+Loc, "value out of range"); -                        return No_Valtyp; -                     end if; -                     return Create_Value_Discrete (Val, Dtype); -                  end; -               when others => -                  raise Internal_Error; -            end case; -         when Type_Float => -            pragma Assert (Vtype.Kind = Type_Float); -            --  TODO: check range -            return Vt; -         when Type_Vector => -            pragma Assert (Vtype.Kind = Type_Vector -                             or Vtype.Kind = Type_Slice); -            if Dtype.W /= Vtype.W then -               Error_Msg_Elab -                 (+Loc, "mismatching vector length; got %v, expect %v", -                  (+Vtype.W, +Dtype.W)); -               return No_Valtyp; -            end if; -            if Bounds then -               return Reshape_Value (Vt, Dtype); -            else -               return Vt; -            end if; -         when Type_Slice => -            --  TODO: check width -            return Vt; -         when Type_Array => -            pragma Assert (Vtype.Kind = Type_Array); -            --  Check bounds. -            declare -               Src_Typ, Dst_Typ : Type_Acc; -            begin -               Src_Typ := Vtype; -               Dst_Typ := Dtype; -               loop -                  pragma Assert (Src_Typ.Alast = Dst_Typ.Alast); -                  if Src_Typ.Abound.Len /= Dst_Typ.Abound.Len then -                     Error_Msg_Elab (+Loc, "mismatching array bounds"); -                     return No_Valtyp; -                  end if; -                  exit when Src_Typ.Alast; -                  Src_Typ := Src_Typ.Arr_El; -                  Dst_Typ := Dst_Typ.Arr_El; -               end loop; -               --  TODO: check element. -               if Bounds then -                  return Reshape_Value (Vt, Dtype); -               else -                  return Vt; -               end if; -            end; -         when Type_Unbounded_Array => -            pragma Assert (Vtype.Kind = Type_Array); -            return Vt; -         when Type_Unbounded_Vector => -            pragma Assert (Vtype.Kind = Type_Vector -                             or else Vtype.Kind = Type_Slice); -            return Vt; -         when Type_Record => -            pragma Assert (Vtype.Kind = Type_Record); -            --  TODO: handle elements. -            return Vt; -         when Type_Unbounded_Record => -            pragma Assert (Vtype.Kind = Type_Record); -            return Vt; -         when Type_Access => -            return Vt; -         when Type_File -            | Type_Protected => -            --  No conversion expected. -            --  As the subtype is identical, it is already handled by the -            --  above check. -            raise Internal_Error; -      end case; +      return Synth_Subtype_Conversion +        (Netlists.Builders.No_Context, Vt, Dtype, Bounds, Loc);     end Exec_Subtype_Conversion;     function Exec_Value_Attribute (Syn_Inst : Synth_Instance_Acc; Attr : Node) @@ -244,7 +115,7 @@ package body Elab.Vhdl_Expr is        Dtype : Type_Acc;     begin        --  The value is supposed to be static. -      V := Exec_Expression (Syn_Inst, Param); +      V := Synth_Expression (Syn_Inst, Param);        if V = No_Valtyp then           return No_Valtyp;        end if; @@ -338,7 +209,7 @@ package body Elab.Vhdl_Expr is        Res : Memtyp;     begin        --  The parameter is expected to be static. -      V := Exec_Expression (Syn_Inst, Param); +      V := Synth_Expression (Syn_Inst, Param);        if V = No_Valtyp then           return No_Valtyp;        end if; @@ -368,33 +239,6 @@ package body Elab.Vhdl_Expr is        return Create_Value_Memtyp (Res);     end Exec_Instance_Name_Attribute; -   --  Convert index IDX in PFX to an offset. -   --  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 Value_Offsets -   is -      Res : Value_Offsets; -   begin -      if not In_Bounds (Bnd, Int32 (Idx)) then -         Error_Msg_Elab (+Loc, "index not within bounds"); -         Elab.Debugger.Debug_Error (Syn_Inst, Loc); -         return (0, 0); -      end if; - -      --  The offset is from the LSB (bit 0).  Bit 0 is the rightmost one. -      case Bnd.Dir is -         when Dir_To => -            Res.Net_Off := Uns32 (Bnd.Right - Int32 (Idx)); -            Res.Mem_Off := Size_Type (Int32 (Idx) - Bnd.Left); -         when Dir_Downto => -            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; -     procedure Check_Matching_Bounds (L, R : Type_Acc; Loc : Node) is     begin        if not Are_Types_Equal (L, R) then @@ -444,219 +288,6 @@ package body Elab.Vhdl_Expr is        return Res;     end Create_Onedimensional_Array_Subtype; -   procedure Exec_Indexed_Name (Syn_Inst : Synth_Instance_Acc; -                                Name : Node; -                                Pfx_Type : Type_Acc; -                                Off : out Value_Offsets) -   is -      Indexes : constant Iir_Flist := Get_Index_List (Name); -      Arr_Typ : Type_Acc; -      Idx_Expr : Node; -      Idx_Val : Valtyp; -      Bnd : Bound_Type; -      Stride : Uns32; -      Idx_Off : Value_Offsets; -   begin -      Off := (0, 0); - -      Arr_Typ := Pfx_Type; -      for I in Flist_First .. Flist_Last (Indexes) loop -         Idx_Expr := Get_Nth_Element (Indexes, I); - -         --  Use the base type as the subtype of the index is not synth-ed. -         Idx_Val := Exec_Expression_With_Basetype (Syn_Inst, Idx_Expr); -         if Idx_Val = No_Valtyp then -            --  Propagate errorc -            Off := (0, 0); -            return; -         end if; - -         Strip_Const (Idx_Val); -         pragma Assert (Is_Static (Idx_Val.Val)); - -         Bnd := Get_Array_Bound (Arr_Typ); - -         if I = Flist_First then -            Stride := 1; -         else -            Stride := Bnd.Len; -         end if; - -         Idx_Off := Index_To_Offset (Syn_Inst, Bnd, -                                     Get_Static_Discrete (Idx_Val), Name); -         Off.Net_Off := Off.Net_Off * Stride + Idx_Off.Net_Off; -         Off.Mem_Off := Off.Mem_Off * Size_Type (Stride) + Idx_Off.Mem_Off; - - -         Arr_Typ := Arr_Typ.Arr_El; -      end loop; - -      Off.Net_Off := Off.Net_Off * Arr_Typ.W; -      Off.Mem_Off := Off.Mem_Off * Arr_Typ.Sz; -   end Exec_Indexed_Name; - -   procedure Exec_Slice_Const_Suffix (Syn_Inst: Synth_Instance_Acc; -                                      Expr : Node; -                                      Name : Node; -                                      Pfx_Bnd : Bound_Type; -                                      L, R : Int64; -                                      Dir : Direction_Type; -                                      El_Typ : Type_Acc; -                                      Res_Bnd : out Bound_Type; -                                      Off : out Value_Offsets) -   is -      Is_Null : Boolean; -      Len : Uns32; -   begin -      if Pfx_Bnd.Dir /= Dir then -         Error_Msg_Elab (+Name, "direction mismatch in slice"); -         Off := (0, 0); -         if Dir = Dir_To then -            Res_Bnd := (Dir => Dir_To, Left => 1, Right => 0, Len => 0); -         else -            Res_Bnd := (Dir => Dir_Downto, Left => 0, Right => 1, Len => 0); -         end if; -         return; -      end if; - -      --  Might be a null slice. -      case Pfx_Bnd.Dir is -         when Dir_To => -            Is_Null := L > R; -         when Dir_Downto => -            Is_Null := L < R; -      end case; -      if Is_Null then -         Len := 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_Elab (+Name, "index not within bounds"); -            Elab.Debugger.Debug_Error (Syn_Inst, Expr); -            Off := (0, 0); -            return; -         end if; - -         case Pfx_Bnd.Dir is -            when Dir_To => -               Len := Uns32 (R - L + 1); -               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 Dir_Downto => -               Len := Uns32 (L - R + 1); -               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)); -   end Exec_Slice_Const_Suffix; - -   procedure Exec_Slice_Suffix (Syn_Inst : Synth_Instance_Acc; -                                Name : Node; -                                Pfx_Bnd : Bound_Type; -                                El_Typ : Type_Acc; -                                Res_Bnd : out Bound_Type; -                                Off : out Value_Offsets) -   is -      Expr : constant Node := Get_Suffix (Name); -      Left, Right : Valtyp; -      Dir : Direction_Type; -   begin -      Off := (0, 0); - -      case Get_Kind (Expr) is -         when Iir_Kind_Range_Expression => -            --  As the range may be dynamic, cannot use synth_discrete_range. -            Left := Exec_Expression_With_Basetype -              (Syn_Inst, Get_Left_Limit (Expr)); -            Right := Exec_Expression_With_Basetype -              (Syn_Inst, Get_Right_Limit (Expr)); -            Dir := Get_Direction (Expr); - -         when Iir_Kind_Range_Array_Attribute -           | Iir_Kind_Reverse_Range_Array_Attribute -           | Iir_Kinds_Denoting_Name => -            declare -               Rng : Discrete_Range_Type; -            begin -               Synth_Discrete_Range (Syn_Inst, Expr, Rng); -               Exec_Slice_Const_Suffix (Syn_Inst, Expr, -                                        Name, Pfx_Bnd, -                                        Rng.Left, Rng.Right, Rng.Dir, -                                        El_Typ, Res_Bnd, Off); -               return; -            end; -         when others => -            Error_Msg_Elab -              (+Expr, "only range expression supported for slices"); -            Res_Bnd := (Dir => Dir_To, Left => 1, Right => 0, Len => 0); -            return; -      end case; - -      pragma Assert (Is_Static (Left.Val)); -      pragma Assert (Is_Static (Right.Val)); -      Exec_Slice_Const_Suffix (Syn_Inst, Expr, -                               Name, Pfx_Bnd, -                               Get_Static_Discrete (Left), -                               Get_Static_Discrete (Right), -                               Dir, -                               El_Typ, Res_Bnd, Off); -   end Exec_Slice_Suffix; - -   function Exec_Name (Syn_Inst : Synth_Instance_Acc; Name : Node) -                       return Valtyp is -   begin -      case Get_Kind (Name) is -         when Iir_Kind_Simple_Name -           | Iir_Kind_Selected_Name => -            return Exec_Name (Syn_Inst, Get_Named_Entity (Name)); -         when Iir_Kind_Interface_Signal_Declaration -           | Iir_Kind_Variable_Declaration -           | Iir_Kind_Interface_Variable_Declaration -           | Iir_Kind_Signal_Declaration -           | Iir_Kind_Interface_Constant_Declaration -           | Iir_Kind_Constant_Declaration -           | Iir_Kind_Iterator_Declaration -           | Iir_Kind_Object_Alias_Declaration -           | Iir_Kind_File_Declaration -           | Iir_Kind_Interface_File_Declaration => -            return Get_Value (Syn_Inst, Name); -         when Iir_Kind_Enumeration_Literal => -            declare -               Typ : constant Type_Acc := -                 Get_Subtype_Object (Syn_Inst, Get_Type (Name)); -               Res : Valtyp; -            begin -               Res := Create_Value_Memory (Typ); -               Write_Discrete (Res, Int64 (Get_Enum_Pos (Name))); -               return Res; -            end; -         when Iir_Kind_Unit_Declaration => -            declare -               Typ : constant Type_Acc := -                 Get_Subtype_Object (Syn_Inst, Get_Type (Name)); -            begin -               return Create_Value_Discrete -                 (Vhdl.Evaluation.Get_Physical_Value (Name), Typ); -            end; -         when Iir_Kind_Implicit_Dereference -           | Iir_Kind_Dereference => -            declare -               Val : Valtyp; -            begin -               Val := Exec_Expression (Syn_Inst, Get_Prefix (Name)); -               return Elab.Vhdl_Heap.Synth_Dereference (Read_Access (Val)); -            end; -         when others => -            Error_Kind ("exec_name", Name); -      end case; -   end Exec_Name; -     function Exec_Name_Subtype (Syn_Inst : Synth_Instance_Acc; Name : Node)                                return Type_Acc is     begin @@ -702,7 +333,7 @@ package body Elab.Vhdl_Expr is              declare                 Val : Valtyp;              begin -               Val := Exec_Expression (Syn_Inst, Get_Prefix (Name)); +               Val := Synth_Expression (Syn_Inst, Get_Prefix (Name));                 Val := Elab.Vhdl_Heap.Synth_Dereference (Read_Access (Val));                 return Val.Typ;              end; @@ -718,101 +349,6 @@ package body Elab.Vhdl_Expr is        end case;     end Exec_Name_Subtype; -   procedure Exec_Assignment_Prefix (Syn_Inst : Synth_Instance_Acc; -                                     Pfx : Node; -                                     Dest_Base : out Valtyp; -                                     Dest_Typ : out Type_Acc; -                                     Dest_Off : out Value_Offsets) is -   begin -      case Get_Kind (Pfx) is -         when Iir_Kind_Simple_Name => -            Exec_Assignment_Prefix (Syn_Inst, Get_Named_Entity (Pfx), -                                    Dest_Base, Dest_Typ, Dest_Off); -         when Iir_Kind_Interface_Signal_Declaration -           | Iir_Kind_Variable_Declaration -           | Iir_Kind_Interface_Variable_Declaration -           | Iir_Kind_Signal_Declaration -           | Iir_Kind_Interface_Constant_Declaration -           | Iir_Kind_Constant_Declaration -           | Iir_Kind_File_Declaration -           | Iir_Kind_Interface_File_Declaration -           | Iir_Kind_Object_Alias_Declaration => -            declare -               Targ : constant Valtyp := Get_Value (Syn_Inst, Pfx); -            begin -               Dest_Typ := Targ.Typ; - -               if Targ.Val.Kind = Value_Alias then -                  --  Replace alias by the aliased name. -                  Dest_Base := (Targ.Val.A_Typ, Targ.Val.A_Obj); -                  Dest_Off := Targ.Val.A_Off; -               else -                  Dest_Base := Targ; -                  Dest_Off := (0, 0); -               end if; -            end; - -         when Iir_Kind_Indexed_Name => -            declare -               Off : Value_Offsets; -            begin -               Exec_Assignment_Prefix -                 (Syn_Inst, Get_Prefix (Pfx), Dest_Base, Dest_Typ, Dest_Off); -               Strip_Const (Dest_Base); -               Exec_Indexed_Name (Syn_Inst, Pfx, Dest_Typ, Off); - -               Dest_Off := Dest_Off + Off; - -               while not Dest_Typ.Alast loop -                  Dest_Typ := Get_Array_Element (Dest_Typ); -               end loop; -               Dest_Typ := Get_Array_Element (Dest_Typ); -            end; - -         when Iir_Kind_Selected_Element => -            declare -               Idx : constant Iir_Index32 := -                 Get_Element_Position (Get_Named_Entity (Pfx)); -            begin -               Exec_Assignment_Prefix -                 (Syn_Inst, Get_Prefix (Pfx), Dest_Base, Dest_Typ, Dest_Off); -               Dest_Off := Dest_Off + Dest_Typ.Rec.E (Idx + 1).Offs; - -               Dest_Typ := Dest_Typ.Rec.E (Idx + 1).Typ; -            end; - -         when Iir_Kind_Slice_Name => -            declare -               Pfx_Bnd : Bound_Type; -               El_Typ : Type_Acc; -               Res_Bnd : Bound_Type; -               Sl_Off : Value_Offsets; -            begin -               Exec_Assignment_Prefix -                 (Syn_Inst, Get_Prefix (Pfx), Dest_Base, Dest_Typ, Dest_Off); -               Strip_Const (Dest_Base); - -               Get_Onedimensional_Array_Bounds (Dest_Typ, Pfx_Bnd, El_Typ); -               Exec_Slice_Suffix (Syn_Inst, Pfx, Pfx_Bnd, El_Typ, -                                  Res_Bnd, Sl_Off); - -               --  Fixed slice. -               Dest_Typ := Create_Onedimensional_Array_Subtype -                 (Dest_Typ, Res_Bnd, El_Typ); -               Dest_Off.Net_Off := Dest_Off.Net_Off + Sl_Off.Net_Off; -               Dest_Off.Mem_Off := Dest_Off.Mem_Off + Sl_Off.Mem_Off; -            end; - -         when Iir_Kind_Function_Call => -            Dest_Base := Synth_Expression (Syn_Inst, Pfx); -            Dest_Typ := Dest_Base.Typ; -            Dest_Off := (0, 0); - -         when others => -            Error_Kind ("exec_assignment_prefix", Pfx); -      end case; -   end Exec_Assignment_Prefix; -     --  Return the type of EXPR without evaluating it.     function Exec_Type_Of_Object (Syn_Inst : Synth_Instance_Acc; Expr : Node)                                  return Type_Acc is @@ -828,16 +364,19 @@ package body Elab.Vhdl_Expr is              return Exec_Type_Of_Object (Syn_Inst, Get_Named_Entity (Expr));           when Iir_Kind_Slice_Name =>              declare +               use Netlists;                 Pfx_Typ : Type_Acc;                 Pfx_Bnd : Bound_Type;                 El_Typ : Type_Acc;                 Res_Bnd : Bound_Type;                 Sl_Off : Value_Offsets; +               Inp : Net;              begin                 Pfx_Typ := Exec_Type_Of_Object (Syn_Inst, Get_Prefix (Expr));                 Get_Onedimensional_Array_Bounds (Pfx_Typ, Pfx_Bnd, El_Typ); -               Exec_Slice_Suffix (Syn_Inst, Expr, Pfx_Bnd, El_Typ, -                                   Res_Bnd, Sl_Off); +               Synth_Slice_Suffix (Syn_Inst, Expr, Pfx_Bnd, El_Typ, +                                   Res_Bnd, Inp, Sl_Off); +               pragma Assert (Inp = No_Net);                 return Create_Onedimensional_Array_Subtype                   (Pfx_Typ, Res_Bnd, El_Typ);              end; @@ -865,7 +404,7 @@ package body Elab.Vhdl_Expr is                 Res : Valtyp;              begin                 --  Maybe do not dereference it if its type is known ? -               Val := Exec_Expression (Syn_Inst, Get_Prefix (Expr)); +               Val := Synth_Expression (Syn_Inst, Get_Prefix (Expr));                 Res := Elab.Vhdl_Heap.Synth_Dereference (Read_Access (Val));                 return Res.Typ;              end; @@ -881,96 +420,6 @@ package body Elab.Vhdl_Expr is        return null;     end Exec_Type_Of_Object; -   function Exec_Type_Conversion -     (Syn_Inst : Synth_Instance_Acc; Conv : Node) return Valtyp -   is -      Expr : constant Node := Get_Expression (Conv); -      Conv_Type : constant Node := Get_Type (Conv); -      Conv_Typ : constant Type_Acc := Get_Subtype_Object (Syn_Inst, Conv_Type); -      Val : Valtyp; -   begin -      Val := Exec_Expression_With_Basetype (Syn_Inst, Expr); -      if Val = No_Valtyp then -         return No_Valtyp; -      end if; -      Strip_Const (Val); -      case Get_Kind (Conv_Type) is -         when Iir_Kind_Integer_Subtype_Definition => -            if Val.Typ.Kind = Type_Discrete then -               --  Int to int. -               return Val; -            elsif Val.Typ.Kind = Type_Float then -               return Create_Value_Discrete -                 (Int64 (Read_Fp64 (Val)), Conv_Typ); -            else -               Error_Msg_Elab (+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 (Read_Discrete (Val)), Conv_Typ); -            else -               Error_Msg_Elab (+Conv, "unhandled type conversion (to float)"); -               return No_Valtyp; -            end if; -         when Iir_Kind_Array_Type_Definition -           | Iir_Kind_Array_Subtype_Definition => -            case Conv_Typ.Kind is -               when Type_Vector -                 | Type_Unbounded_Vector -                 | Type_Array -                 | Type_Unbounded_Array => -                  return Val; -               when others => -                  Error_Msg_Elab -                    (+Conv, "unhandled type conversion (to array)"); -                  return No_Valtyp; -            end case; -         when Iir_Kind_Enumeration_Type_Definition -           | Iir_Kind_Enumeration_Subtype_Definition => -            pragma Assert (Get_Base_Type (Get_Type (Expr)) -                             = Get_Base_Type (Conv_Type)); -            return Val; -         when others => -            Error_Msg_Elab (+Conv, "unhandled type conversion"); -            return No_Valtyp; -      end case; -   end Exec_Type_Conversion; - -   function Error_Ieee_Operator (Imp : Node; Loc : Node) return Boolean -   is -      use Std_Names; -      Parent : constant Iir := Get_Parent (Imp); -   begin -      if Get_Kind (Parent) = Iir_Kind_Package_Declaration -        and then (Get_Identifier -                    (Get_Library (Get_Design_File (Get_Design_Unit (Parent)))) -                    = Name_Ieee) -      then -         case Get_Identifier (Parent) is -            when Name_Std_Logic_1164 -               | Name_Std_Logic_Arith -               | Name_Std_Logic_Signed -               | Name_Std_Logic_Unsigned -               | Name_Std_Logic_Misc -               | Name_Numeric_Std -               | Name_Numeric_Bit -               | Name_Math_Real => -               Error_Msg_Elab -                 (+Loc, "unhandled predefined IEEE operator %i", +Imp); -               Error_Msg_Elab -                 (+Imp, " declared here"); -               return True; -            when others => -               --  ieee 2008 packages are handled like regular packages. -               null; -         end case; -      end if; - -      return False; -   end Error_Ieee_Operator; -     function Exec_String_Literal (Syn_Inst : Synth_Instance_Acc;                                   Str : Node;                                   Str_Typ : Type_Acc) return Valtyp @@ -1019,388 +468,4 @@ package body Elab.Vhdl_Expr is        return Res;     end Exec_String_Literal; -   --  Return the left bound if the direction of the range is LEFT_DIR. -   function Synth_Low_High_Type_Attribute -     (Syn_Inst : Synth_Instance_Acc; Expr : Node; Left_Dir : Direction_Type) -     return Valtyp -   is -      Typ : Type_Acc; -      R : Int64; -   begin -      Typ := Get_Subtype_Object (Syn_Inst, Get_Type (Get_Prefix (Expr))); -      pragma Assert (Typ.Kind = Type_Discrete); -      if Typ.Drange.Dir = Left_Dir then -         R := Typ.Drange.Left; -      else -         R := Typ.Drange.Right; -      end if; -      return Create_Value_Discrete (R, Typ); -   end Synth_Low_High_Type_Attribute; - -   function Exec_Short_Circuit (Syn_Inst : Synth_Instance_Acc; -                                 Val : Int64; -                                 Left_Expr : Node; -                                 Right_Expr : Node; -                                 Typ : Type_Acc) return Valtyp -   is -      Left : Valtyp; -      Right : Valtyp; -   begin -      Left := Exec_Expression_With_Type (Syn_Inst, Left_Expr, Typ); -      if Left = No_Valtyp then -         --  Propagate error. -         return No_Valtyp; -      end if; -      pragma Assert (Is_Static (Left.Val)); -      if Get_Static_Discrete (Left) = Val then -         --  Short-circuit when the left operand determines the result. -         return Create_Value_Discrete (Val, Typ); -      end if; - -      Strip_Const (Left); -      Right := Exec_Expression_With_Type (Syn_Inst, Right_Expr, Typ); -      if Right = No_Valtyp then -         --  Propagate error. -         return No_Valtyp; -      end if; -      Strip_Const (Right); - -      pragma Assert (Is_Static (Right.Val)); -      if Get_Static_Discrete (Right) = Val then -         --  If the right operand can determine the result, return it. -         return Create_Value_Discrete (Val, Typ); -      end if; - -      --  Return a static value if both operands are static. -      --  Note: we know the value of left if it is not constant. -      return Create_Value_Discrete (Get_Static_Discrete (Right), Typ); -   end Exec_Short_Circuit; - -   function Exec_Expression_With_Type (Syn_Inst : Synth_Instance_Acc; -                                       Expr : Node; -                                       Expr_Type : Type_Acc) return Valtyp is -   begin -      case Get_Kind (Expr) is -         when Iir_Kinds_Dyadic_Operator => -            declare -               Imp : constant Node := Get_Implementation (Expr); -               Def : constant Iir_Predefined_Functions := -                 Get_Implicit_Definition (Imp); -            begin -               --  Specially handle short-circuit operators. -               case Def is -                  when Iir_Predefined_Boolean_And => -                     return Exec_Short_Circuit -                       (Syn_Inst, 0, Get_Left (Expr), Get_Right (Expr), -                        Boolean_Type); -                  when Iir_Predefined_Boolean_Or => -                     return Exec_Short_Circuit -                       (Syn_Inst, 1, Get_Left (Expr), Get_Right (Expr), -                        Boolean_Type); -                  when Iir_Predefined_Bit_And => -                     return Exec_Short_Circuit -                       (Syn_Inst, 0, Get_Left (Expr), Get_Right (Expr), -                        Bit_Type); -                  when Iir_Predefined_Bit_Or => -                     return Exec_Short_Circuit -                       (Syn_Inst, 1, Get_Left (Expr), Get_Right (Expr), -                        Bit_Type); -                  when Iir_Predefined_None => -                     if Error_Ieee_Operator (Imp, Expr) then -                        return No_Valtyp; -                     else -                        return Synth_User_Operator -                          (Syn_Inst, Get_Left (Expr), Get_Right (Expr), Expr); -                     end if; -                  when others => -                     return Synth_Dyadic_Operation -                       (Syn_Inst, Imp, -                        Get_Left (Expr), Get_Right (Expr), Expr); -               end case; -            end; -         when Iir_Kinds_Monadic_Operator => -            declare -               Imp : constant Node := Get_Implementation (Expr); -               Def : constant Iir_Predefined_Functions := -                 Get_Implicit_Definition (Imp); -            begin -               if Def = Iir_Predefined_None then -                  if Error_Ieee_Operator (Imp, Expr) then -                     return No_Valtyp; -                  else -                     return Synth_User_Operator -                       (Syn_Inst, Get_Operand (Expr), Null_Node, Expr); -                  end if; -               else -                  return Synth_Monadic_Operation -                    (Syn_Inst, Imp, Get_Operand (Expr), Expr); -               end if; -            end; -         when Iir_Kind_Simple_Name -            | Iir_Kind_Selected_Name -            | Iir_Kind_Interface_Signal_Declaration --  For PSL. -            | Iir_Kind_Signal_Declaration   -- For PSL. -            | Iir_Kind_Implicit_Dereference -            | Iir_Kind_Dereference => -            declare -               Res : Valtyp; -            begin -               Res := Exec_Name (Syn_Inst, Expr); -               if Res.Val.Kind = Value_Signal then -                  Vhdl_Errors.Error_Msg_Elab -                    (+Expr, "cannot use signal value during elaboration"); -                  return No_Valtyp; -               end if; -               if Res.Typ /= null -                 and then Res.Typ.W = 0 and then Res.Val.Kind /= Value_Memory -               then -                  --  This is a null object.  As nothing can be done about it, -                  --  returns 0. -                  return Create_Value_Memtyp (Create_Memory_Zero (Res.Typ)); -               end if; -               return Res; -            end; -         when Iir_Kind_Reference_Name => -            --  Only used for anonymous signals in internal association. -            return Exec_Expression_With_Type -              (Syn_Inst, Get_Named_Entity (Expr), Expr_Type); -         when Iir_Kind_Indexed_Name -           | Iir_Kind_Slice_Name => -            declare -               Base : Valtyp; -               Typ : Type_Acc; -               Off : Value_Offsets; -               Res : Valtyp; -            begin -               Exec_Assignment_Prefix (Syn_Inst, Expr, Base, Typ, Off); -               Res := Create_Value_Memory (Typ); -               Copy_Memory (Res.Val.Mem, Base.Val.Mem + Off.Mem_Off, Typ.Sz); -               return Res; -            end; -         when Iir_Kind_Selected_Element => -            declare -               Idx : constant Iir_Index32 := -                 Get_Element_Position (Get_Named_Entity (Expr)); -               Pfx : constant Node := Get_Prefix (Expr); -               Res_Typ : Type_Acc; -               Val : Valtyp; -               Res : Valtyp; -            begin -               Val := Exec_Expression (Syn_Inst, Pfx); -               Strip_Const (Val); -               Res_Typ := Val.Typ.Rec.E (Idx + 1).Typ; -               if Res_Typ.W = 0 and then Val.Val.Kind /= Value_Memory then -                  --  This is a null object.  As nothing can be done about it, -                  --  returns 0. -                  return Create_Value_Memtyp (Create_Memory_Zero (Res_Typ)); -               end if; -               pragma Assert (Is_Static (Val.Val)); -               Res := Create_Value_Memory (Res_Typ); -               Copy_Memory -                 (Res.Val.Mem, -                  Val.Val.Mem + Val.Typ.Rec.E (Idx + 1).Offs.Mem_Off, -                  Res_Typ.Sz); -               return Res; -            end; -         when Iir_Kind_Character_Literal => -            return Exec_Expression_With_Type -              (Syn_Inst, Get_Named_Entity (Expr), Expr_Type); -         when Iir_Kind_Integer_Literal => -            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 -           | Iir_Kind_Physical_Fp_Literal => -            return Create_Value_Discrete -              (Get_Physical_Value (Expr), Expr_Type); -         when Iir_Kind_String_Literal8 => -            return Exec_String_Literal (Syn_Inst, Expr, Expr_Type); -         when Iir_Kind_Enumeration_Literal => -            return Exec_Name (Syn_Inst, Expr); -         when Iir_Kind_Type_Conversion => -            return Exec_Type_Conversion (Syn_Inst, Expr); -         when Iir_Kind_Qualified_Expression => -            return Exec_Expression_With_Type -              (Syn_Inst, Get_Expression (Expr), -               Get_Subtype_Object (Syn_Inst, Get_Type (Get_Type_Mark (Expr)))); -         when Iir_Kind_Function_Call => -            declare -               Imp : constant Node := Get_Implementation (Expr); -            begin -               case Get_Implicit_Definition (Imp) is -                  when Iir_Predefined_Operators -                     | Iir_Predefined_Ieee_Numeric_Std_Binary_Operators => -                     return Synth_Operator_Function_Call (Syn_Inst, Expr); -                  when Iir_Predefined_None => -                     return Synth_User_Function_Call (Syn_Inst, Expr); -                  when others => -                     return Synth_Predefined_Function_Call (Syn_Inst, Expr); -               end case; -            end; -         when Iir_Kind_Aggregate => -            return Synth.Vhdl_Aggr.Synth_Aggregate (Syn_Inst, Expr, Expr_Type); -         when Iir_Kind_Simple_Aggregate => -            return Exec_Simple_Aggregate (Syn_Inst, Expr); -         when Iir_Kind_Parenthesis_Expression => -            return Exec_Expression_With_Type -              (Syn_Inst, Get_Expression (Expr), Expr_Type); -         when Iir_Kind_Left_Array_Attribute => -            declare -               B : Bound_Type; -            begin -               B := Synth_Array_Attribute (Syn_Inst, Expr); -               return Create_Value_Discrete (Int64 (B.Left), Expr_Type); -            end; -         when Iir_Kind_Right_Array_Attribute => -            declare -               B : Bound_Type; -            begin -               B := Synth_Array_Attribute (Syn_Inst, Expr); -               return Create_Value_Discrete (Int64 (B.Right), Expr_Type); -            end; -         when Iir_Kind_High_Array_Attribute => -            declare -               B : Bound_Type; -               V : Int32; -            begin -               B := Synth_Array_Attribute (Syn_Inst, Expr); -               case B.Dir is -                  when Dir_To => -                     V := B.Right; -                  when Dir_Downto => -                     V := B.Left; -               end case; -               return Create_Value_Discrete (Int64 (V), Expr_Type); -            end; -         when Iir_Kind_Low_Array_Attribute => -            declare -               B : Bound_Type; -               V : Int32; -            begin -               B := Synth_Array_Attribute (Syn_Inst, Expr); -               case B.Dir is -                  when Dir_To => -                     V := B.Left; -                  when Dir_Downto => -                     V := B.Right; -               end case; -               return Create_Value_Discrete (Int64 (V), Expr_Type); -            end; -         when Iir_Kind_Length_Array_Attribute => -            declare -               B : Bound_Type; -            begin -               B := Synth_Array_Attribute (Syn_Inst, Expr); -               return Create_Value_Discrete (Int64 (B.Len), Expr_Type); -            end; -         when Iir_Kind_Ascending_Array_Attribute => -            declare -               B : Bound_Type; -               V : Int64; -            begin -               B := Synth_Array_Attribute (Syn_Inst, Expr); -               case B.Dir is -                  when Dir_To => -                     V := 1; -                  when Dir_Downto => -                     V := 0; -               end case; -               return Create_Value_Discrete (V, Expr_Type); -            end; - -         when Iir_Kind_Pos_Attribute -           | Iir_Kind_Val_Attribute => -            declare -               Param : constant Node := Get_Parameter (Expr); -               V : Valtyp; -               Dtype : Type_Acc; -            begin -               V := Exec_Expression (Syn_Inst, Param); -               Dtype := Get_Subtype_Object (Syn_Inst, Get_Type (Expr)); -               --  FIXME: to be generalized.  Not always as simple as a -               --  subtype conversion. -               return Exec_Subtype_Conversion (V, Dtype, False, Expr); -            end; -         when Iir_Kind_Low_Type_Attribute => -            return Synth_Low_High_Type_Attribute (Syn_Inst, Expr, Dir_To); -         when Iir_Kind_High_Type_Attribute => -            return Synth_Low_High_Type_Attribute (Syn_Inst, Expr, Dir_Downto); -         when Iir_Kind_Value_Attribute => -            return Exec_Value_Attribute (Syn_Inst, Expr); -         when Iir_Kind_Image_Attribute => -            return Exec_Image_Attribute (Syn_Inst, Expr); -         when Iir_Kind_Instance_Name_Attribute => -            return Exec_Instance_Name_Attribute (Syn_Inst, Expr); -         when Iir_Kind_Null_Literal => -            return Create_Value_Access (Null_Heap_Index, Expr_Type); -         when Iir_Kind_Allocator_By_Subtype => -            declare -               T : Type_Acc; -               Acc : Heap_Index; -            begin -               T := Synth_Subtype_Indication -                 (Syn_Inst, Get_Subtype_Indication (Expr)); -               Acc := Allocate_By_Type (T); -               return Create_Value_Access (Acc, Expr_Type); -            end; -         when Iir_Kind_Allocator_By_Expression => -            declare -               V : Valtyp; -               Acc : Heap_Index; -            begin -               V := Exec_Expression_With_Type -                 (Syn_Inst, Get_Expression (Expr), Expr_Type.Acc_Acc); -               Acc := Allocate_By_Value (V); -               return Create_Value_Access (Acc, Expr_Type); -            end; -         when Iir_Kind_Stable_Attribute => -            Error_Msg_Elab (+Expr, "signal attribute not supported"); -            return No_Valtyp; -         when Iir_Kind_Overflow_Literal => -            Error_Msg_Elab (+Expr, "out of bound expression"); -            return No_Valtyp; -         when others => -            Error_Kind ("exec_expression_with_type", Expr); -      end case; -   end Exec_Expression_With_Type; - -   function Exec_Expression (Syn_Inst : Synth_Instance_Acc; Expr : Node) -                             return Valtyp -   is -      Etype : Node; -   begin -      Etype := Get_Type (Expr); - -      case Get_Kind (Expr) is -         when Iir_Kind_High_Array_Attribute -           |  Iir_Kind_Low_Array_Attribute -           |  Iir_Kind_Integer_Literal => -            --  The type of this attribute is the type of the index, which is -            --  not synthesized as atype (only as an index). -            --  For integer_literal, the type is not really needed, and it -            --  may be created by static evaluation of an array attribute. -            Etype := Get_Base_Type (Etype); -         when others => -            null; -      end case; - -      return Exec_Expression_With_Type -        (Syn_Inst, Expr, Get_Subtype_Object (Syn_Inst, Etype)); -   end Exec_Expression; - -   function Exec_Expression_With_Basetype -     (Syn_Inst : Synth_Instance_Acc; Expr : Node) return Valtyp -   is -      Basetype : Type_Acc; -   begin -      Basetype := Get_Subtype_Object -        (Syn_Inst, Get_Base_Type (Get_Type (Expr))); -      return Exec_Expression_With_Type (Syn_Inst, Expr, Basetype); -   end Exec_Expression_With_Basetype;  end Elab.Vhdl_Expr; diff --git a/src/synth/elab-vhdl_expr.ads b/src/synth/elab-vhdl_expr.ads index 6427a5de7..8f78faa7a 100644 --- a/src/synth/elab-vhdl_expr.ads +++ b/src/synth/elab-vhdl_expr.ads @@ -38,36 +38,10 @@ package Elab.Vhdl_Expr is     function Exec_Type_Of_Object (Syn_Inst : Synth_Instance_Acc; Expr : Node)                                  return Type_Acc; -   procedure Exec_Assignment_Prefix (Syn_Inst : Synth_Instance_Acc; -                                     Pfx : Node; -                                     Dest_Base : out Valtyp; -                                     Dest_Typ : out Type_Acc; -                                     Dest_Off : out Value_Offsets); - -   function Exec_Name (Syn_Inst : Synth_Instance_Acc; Name : Node) -                      return Valtyp; -     --  Get the type of NAME.  No expressions are expected to be evaluated.     function Exec_Name_Subtype (Syn_Inst : Synth_Instance_Acc; Name : Node)                                return Type_Acc; -   --  Synthesize EXPR.  The expression must be self-constrained. -   --  If EN is not No_Net, the execution is controlled by EN.  This is used -   --  for assertions and checks. -   function Exec_Expression -     (Syn_Inst : Synth_Instance_Acc; Expr : Node) return Valtyp; - -   --  Same as Synth_Expression, but the expression may be constrained by -   --  EXPR_TYPE. -   function Exec_Expression_With_Type (Syn_Inst : Synth_Instance_Acc; -                                       Expr : Node; -                                       Expr_Type : Type_Acc) return Valtyp; - -   --  Use base type of EXPR to synthesize EXPR.  Useful when the type of -   --  EXPR is defined by itself or a range. -   function Exec_Expression_With_Basetype (Syn_Inst : Synth_Instance_Acc; -                                           Expr : Node) return Valtyp; -     --  Subtype conversion.     function Exec_Subtype_Conversion (Vt : Valtyp;                                       Dtype : Type_Acc; diff --git a/src/synth/elab-vhdl_files.adb b/src/synth/elab-vhdl_files.adb index c2a8dc35f..8c01c30bf 100644 --- a/src/synth/elab-vhdl_files.adb +++ b/src/synth/elab-vhdl_files.adb @@ -29,9 +29,10 @@ with Grt.Stdio;  with Elab.Memtype; use Elab.Memtype;  with Elab.Vhdl_Objtypes; use Elab.Vhdl_Objtypes; -with Elab.Vhdl_Expr; use Elab.Vhdl_Expr;  with Elab.Vhdl_Errors; use Elab.Vhdl_Errors; +with Synth.Vhdl_Expr; use Synth.Vhdl_Expr; +  package body Elab.Vhdl_Files is     --  Variables to store the search path. @@ -214,10 +215,10 @@ package body Elab.Vhdl_Files is           return F;        end if; -      File_Name := Exec_Expression_With_Basetype (Syn_Inst, External_Name); +      File_Name := Synth_Expression_With_Basetype (Syn_Inst, External_Name);        if Open_Kind /= Null_Node then -         Mode := Exec_Expression (Syn_Inst, Open_Kind); +         Mode := Synth_Expression (Syn_Inst, Open_Kind);           File_Mode := Ghdl_I32 (Read_Discrete (Mode));        else           case Get_Mode (Decl) is diff --git a/src/synth/elab-vhdl_insts.adb b/src/synth/elab-vhdl_insts.adb index b5c4a7bc9..2a7babf27 100644 --- a/src/synth/elab-vhdl_insts.adb +++ b/src/synth/elab-vhdl_insts.adb @@ -34,6 +34,8 @@ with Elab.Vhdl_Files;  with Elab.Vhdl_Errors; use Elab.Vhdl_Errors;  with Elab.Vhdl_Expr; use Elab.Vhdl_Expr; +with Synth.Vhdl_Expr; use Synth.Vhdl_Expr; +  package body Elab.Vhdl_Insts is     procedure Elab_Instance_Body (Syn_Inst : Synth_Instance_Acc);     procedure Elab_Recurse_Instantiations @@ -76,11 +78,11 @@ package body Elab.Vhdl_Insts is                 case Get_Kind (Assoc) is                    when Iir_Kind_Association_Element_Open =>                       Actual := Get_Default_Value (Inter); -                     Val := Exec_Expression_With_Type +                     Val := Synth_Expression_With_Type                         (Sub_Inst, Actual, Inter_Type);                    when Iir_Kind_Association_Element_By_Expression =>                       Actual := Get_Actual (Assoc); -                     Val := Exec_Expression_With_Type +                     Val := Synth_Expression_With_Type                         (Syn_Inst, Actual, Inter_Type);                    when others =>                       raise Internal_Error; @@ -344,7 +346,7 @@ package body Elab.Vhdl_Insts is           then              --  For expression: just compute the expression and associate.              Inter_Typ := Elab_Declaration_Type (Sub_Inst, Inter); -            Val := Exec_Expression_With_Type +            Val := Synth_Expression_With_Type                (Syn_Inst, Get_Actual (Assoc), Inter_Typ);              return Val.Typ;           end if; @@ -805,7 +807,7 @@ package body Elab.Vhdl_Insts is              Inter_Typ : Type_Acc;           begin              Inter_Typ := Elab_Declaration_Type (Top_Inst, Inter); -            Val := Exec_Expression_With_Type +            Val := Synth_Expression_With_Type                (Top_Inst, Get_Default_Value (Inter), Inter_Typ);              pragma Assert (Is_Static (Val.Val));              Create_Object (Top_Inst, Inter, Val); diff --git a/src/synth/elab-vhdl_stmts.adb b/src/synth/elab-vhdl_stmts.adb index ce2648db0..e6c93a327 100644 --- a/src/synth/elab-vhdl_stmts.adb +++ b/src/synth/elab-vhdl_stmts.adb @@ -26,7 +26,8 @@ with Elab.Vhdl_Values; use Elab.Vhdl_Values;  with Elab.Vhdl_Types; use Elab.Vhdl_Types;  with Elab.Vhdl_Decls; use Elab.Vhdl_Decls;  with Elab.Vhdl_Insts; use Elab.Vhdl_Insts; -with Elab.Vhdl_Expr; use Elab.Vhdl_Expr; + +with Synth.Vhdl_Expr; use Synth.Vhdl_Expr;  package body Elab.Vhdl_Stmts is     function Elab_Generate_Statement_Body (Syn_Inst : Synth_Instance_Acc; @@ -129,7 +130,7 @@ package body Elab.Vhdl_Stmts is        loop           Icond := Get_Condition (Gen);           if Icond /= Null_Node then -            Cond := Exec_Expression (Syn_Inst, Icond); +            Cond := Synth_Expression (Syn_Inst, Icond);              Strip_Const (Cond);           else              --  It is the else generate. diff --git a/src/synth/elab-vhdl_types.adb b/src/synth/elab-vhdl_types.adb index 3844704ee..992f9c9fa 100644 --- a/src/synth/elab-vhdl_types.adb +++ b/src/synth/elab-vhdl_types.adb @@ -30,6 +30,8 @@ with Elab.Vhdl_Expr; use Elab.Vhdl_Expr;  with Elab.Vhdl_Decls;  with Elab.Vhdl_Errors; use Elab.Vhdl_Errors; +with Synth.Vhdl_Expr; use Synth.Vhdl_Expr; +  package body Elab.Vhdl_Types is     function Synth_Discrete_Range_Expression       (Syn_Inst : Synth_Instance_Acc; Rng : Node) return Discrete_Range_Type @@ -38,8 +40,8 @@ package body Elab.Vhdl_Types is        Lval, Rval : Int64;     begin        --  Static values. -      L := Exec_Expression_With_Basetype (Syn_Inst, Get_Left_Limit (Rng)); -      R := Exec_Expression_With_Basetype (Syn_Inst, Get_Right_Limit (Rng)); +      L := Synth_Expression_With_Basetype (Syn_Inst, Get_Left_Limit (Rng)); +      R := Synth_Expression_With_Basetype (Syn_Inst, Get_Right_Limit (Rng));        Strip_Const (L);        Strip_Const (R); @@ -63,8 +65,8 @@ package body Elab.Vhdl_Types is        L, R : Valtyp;     begin        --  Static values (so no enable). -      L := Exec_Expression (Syn_Inst, Get_Left_Limit (Rng)); -      R := Exec_Expression (Syn_Inst, Get_Right_Limit (Rng)); +      L := Synth_Expression (Syn_Inst, Get_Left_Limit (Rng)); +      R := Synth_Expression (Syn_Inst, Get_Right_Limit (Rng));        return (Get_Direction (Rng), Read_Fp64 (L), Read_Fp64 (R));     end Synth_Float_Range_Expression; @@ -670,7 +672,7 @@ package body Elab.Vhdl_Types is                    Pfx : constant Node := Get_Prefix (Atype);                    Vt : Valtyp;                 begin -                  Vt := Exec_Name (Syn_Inst, Pfx); +                  Vt := Synth_Name (Syn_Inst, Pfx);                    return Vt.Typ;                 end;              when others => diff --git a/src/synth/netlists-builders.ads b/src/synth/netlists-builders.ads index 135b4544f..53174933c 100644 --- a/src/synth/netlists-builders.ads +++ b/src/synth/netlists-builders.ads @@ -23,6 +23,8 @@ package Netlists.Builders is     type Context is private;     type Context_Acc is access Context; +   No_Context : constant Context_Acc := null; +     type Uns32_Arr is array (Natural range <>) of Uns32;     type Uns32_Arr_Acc is access Uns32_Arr;     procedure Unchecked_Deallocate is new Ada.Unchecked_Deallocation diff --git a/src/synth/synth-vhdl_expr.adb b/src/synth/synth-vhdl_expr.adb index a16b8c066..655269111 100644 --- a/src/synth/synth-vhdl_expr.adb +++ b/src/synth/synth-vhdl_expr.adb @@ -51,9 +51,6 @@ with Synth.Vhdl_Aggr;  with Synth.Vhdl_Context; use Synth.Vhdl_Context;  package body Synth.Vhdl_Expr is -   function Synth_Name (Syn_Inst : Synth_Instance_Acc; Name : Node) -                       return Valtyp; -     procedure Set_Location (N : Net; Loc : Node)       renames Synth.Source.Set_Location; diff --git a/src/synth/synth-vhdl_expr.ads b/src/synth/synth-vhdl_expr.ads index 90c603280..f5d9fa7a0 100644 --- a/src/synth/synth-vhdl_expr.ads +++ b/src/synth/synth-vhdl_expr.ads @@ -130,6 +130,9 @@ package Synth.Vhdl_Expr is                                   Off : out Value_Offsets;                                   Error : out Boolean); +   function Synth_Name (Syn_Inst : Synth_Instance_Acc; Name : Node) +                       return Valtyp; +     --  Conversion to logic vector.     type Digit_Index is new Natural;     type Logvec_Array is array (Digit_Index range <>) of Logic_32; | 
