diff options
| -rw-r--r-- | src/synth/synth-vhdl_expr.adb | 182 |
1 files changed, 120 insertions, 62 deletions
diff --git a/src/synth/synth-vhdl_expr.adb b/src/synth/synth-vhdl_expr.adb index c73b2133e..65e0a9d27 100644 --- a/src/synth/synth-vhdl_expr.adb +++ b/src/synth/synth-vhdl_expr.adb @@ -831,71 +831,136 @@ package body Synth.Vhdl_Expr is end case; end Synth_Subtype_Conversion; + function Synth_Pathname_Object (Loc_Inst : Synth_Instance_Acc; + Name : Node; + Cur_Inst : Synth_Instance_Acc; + Path : Node) return Valtyp + is + Id : constant Name_Id := Get_Identifier (Path); + Scope : constant Node := Get_Source_Scope (Cur_Inst); + Obj : Node; + Res : Valtyp; + begin + -- Object simple name. + case Get_Kind (Scope) is + when Iir_Kind_Architecture_Body => + Obj := Find_Name_In_Chain (Get_Declaration_Chain (Scope), Id); + when others => + Error_Kind ("synth_pathname_object(1)", Scope); + end case; + + -- LRM08 8.7 External names + -- It is an error when evaluating an external name if the identified + -- declarative region does not contain a declaration of an object + -- whose simple name is the object simple name of the external + -- pathname. + if Obj = Null_Node then + Error_Msg_Synth + (Loc_Inst, Path, "cannot find object %i in %i", (+Id, +Scope)); + return No_Valtyp; + end if; + + -- LRM08 8.7 External names + -- It is also an error when evaluating an external name if the object + -- denoted by an external constant name is not a constant, or if the + -- object denoted by an external signal name is not a signal, or if + -- the object denoted by an external variable name is not a variable. + case Get_Kind (Obj) is + when Iir_Kind_Signal_Declaration => + case Iir_Kinds_External_Name (Get_Kind (Name)) is + when Iir_Kind_External_Signal_Name => + Res := Get_Value (Cur_Inst, Obj); + when Iir_Kind_External_Constant_Name + | Iir_Kind_External_Variable_Name => + Error_Msg_Synth + (Loc_Inst, Path, "object name %i is a signal", +Obj); + return No_Valtyp; + end case; + when others => + Error_Kind ("synth_pathname_object(2)", Obj); + end case; + + -- LRM08 8.7 External names + -- Moreover, it is an error if the base type of the object denoted by + -- an external name is not the same as the base type mark in the + -- subtype indication of the external name. + declare + Obj_Type : constant Node := Get_Type (Obj); + Name_Type : constant Node := Get_Type (Name); + begin + if Get_Base_Type (Obj_Type) /= Get_Base_Type (Name_Type) then + Error_Msg_Synth + (Loc_Inst, Path, "external name and object have different type"); + return No_Valtyp; + end if; + end; + + -- LRM08 8.7 External names + -- If the subtype indication denotes a composite subtype, then the + -- object denoted by the external name is viewed as if it were of the + -- subtype specified by the subtype indication. For each index range, + -- if any, in the subtype, if the subtype defines the index range, the + -- object is viewed with that index range; otherwise, the object + -- is viewed with the index range of the object. The view specified + -- by the subtype shall include a matching element (see 9.2.3) for + -- each element of the object denoted by the external name. + -- + -- If the subtype indication denotes a scalar subtype, then the object + -- denoted by the external name is viewed as if it were of the subtype + -- specified by the subtype indication; moreover, it is a error when + -- evaluating the external name if this subtype does not have the same + -- bounds and direction as the subtype of the object denoted by the + -- external name. + + -- TODO. + + return Res; + end Synth_Pathname_Object; + function Synth_Pathname (Loc_Inst : Synth_Instance_Acc; Name : Node; Cur_Inst : Synth_Instance_Acc; Path : Node) return Valtyp is Suffix : constant Node := Get_Pathname_Suffix (Path); - Id : constant Name_Id := Get_Identifier (Path); - Scope : constant Node := Get_Source_Scope (Cur_Inst); + Id : Name_Id; + Scope : Node; Res : Node; begin if Suffix = Null_Node then -- Object simple name. - case Get_Kind (Scope) is - when Iir_Kind_Architecture_Body => - Res := Find_Name_In_Chain (Get_Declaration_Chain (Scope), Id); - when others => - Error_Kind ("synth_pathname(obj)", Scope); - end case; - if Res = Null_Node then - Error_Msg_Synth - (Loc_Inst, Path, "cannot find object %i in %i", (+Id, +Scope)); - return No_Valtyp; - end if; - case Get_Kind (Res) is - when Iir_Kind_Signal_Declaration => - case Iir_Kinds_External_Name (Get_Kind (Name)) is - when Iir_Kind_External_Signal_Name => - return Get_Value (Cur_Inst, Res); - when Iir_Kind_External_Constant_Name - | Iir_Kind_External_Variable_Name => - Error_Msg_Synth - (Loc_Inst, Path, "object name %i is a signal", +Res); - return No_Valtyp; - end case; - when others => - Error_Kind ("synth_pathname(1)", Res); - end case; - else - -- Find name in concurrent statements. - case Get_Kind (Scope) is - when Iir_Kind_Architecture_Body => - Res := Find_Name_In_Chain - (Get_Concurrent_Statement_Chain (Scope), Id); - when others => - Error_Kind ("synth_pathname(scope)", Scope); - end case; - if Res = Null_Node then - Error_Msg_Synth - (Loc_Inst, Path, - "cannot find path element %i in %i", (+Id, +Scope)); - return No_Valtyp; - end if; - case Get_Kind (Res) is - when Iir_Kind_Component_Instantiation_Statement => - if Is_Entity_Instantiation (Res) then - return Synth_Pathname - (Loc_Inst, Name, Get_Sub_Instance (Cur_Inst, Res), Suffix); - else - -- TODO: skip component. - raise Internal_Error; - end if; - when others => - Error_Kind ("synth_pathname(2)", Res); - end case; + return Synth_Pathname_Object (Loc_Inst, Name, Cur_Inst, Path); + end if; + + Id := Get_Identifier (Path); + Scope := Get_Source_Scope (Cur_Inst); + + -- Find name in concurrent statements. + case Get_Kind (Scope) is + when Iir_Kind_Architecture_Body => + Res := Find_Name_In_Chain + (Get_Concurrent_Statement_Chain (Scope), Id); + when others => + Error_Kind ("synth_pathname(scope)", Scope); + end case; + if Res = Null_Node then + Error_Msg_Synth + (Loc_Inst, Path, + "cannot find path element %i in %i", (+Id, +Scope)); + return No_Valtyp; end if; + case Get_Kind (Res) is + when Iir_Kind_Component_Instantiation_Statement => + if Is_Entity_Instantiation (Res) then + return Synth_Pathname + (Loc_Inst, Name, Get_Sub_Instance (Cur_Inst, Res), Suffix); + else + -- TODO: skip component. + raise Internal_Error; + end if; + when others => + Error_Kind ("synth_pathname(2)", Res); + end case; end Synth_Pathname; function Synth_Absolute_Pathname @@ -922,21 +987,14 @@ package body Synth.Vhdl_Expr is return Valtyp is Path : Node; - Res : Valtyp; begin Path := Get_External_Pathname (Name); case Get_Kind (Path) is when Iir_Kind_Absolute_Pathname => - Res := Synth_Absolute_Pathname (Syn_Inst, Name, Path); + return Synth_Absolute_Pathname (Syn_Inst, Name, Path); when others => Error_Kind ("synth_external_name", Path); end case; - if Res = No_Valtyp then - return No_Valtyp; - end if; - - -- TODO: type. - return Res; end Synth_External_Name; function Synth_Name (Syn_Inst : Synth_Instance_Acc; Name : Node) |