----------------------------------------------------------- --------------------- -- -- -- OCARINA COMPONENTS -- -- -- -- OCARINA.PROCESSOR.INSTANCES.PROPERTIES -- -- -- -- B o d y -- -- -- -- Copyright (C) 2005-2007, GET-Telecom Paris. -- -- -- -- Ocarina is free software; you can redistribute it and/or modify -- -- it under terms of the GNU General Public License as published by the -- -- Free Software Foundation; either version 2, or (at your option) any -- -- later version. Ocarina 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 distributed with Ocarina; see file COPYING. -- -- If not, write to the Free Software Foundation, 51 Franklin Street, Fifth -- -- Floor, Boston, MA 02111-1301, USA. -- -- -- -- As a special exception, if other files instantiate generics from this -- -- unit, or you link this unit with other files to produce an executable, -- -- this unit does not by itself cause the resulting executable to be -- -- covered by the GNU General Public License. This exception does not -- -- however invalidate any other reasons why the executable file might be -- -- covered by the GNU Public License. -- -- -- -- Ocarina is maintained by the Ocarina team -- -- (ocarina-users@listes.enst.fr) -- -- -- ------------------------------------------------------------------------------ with Ocarina.Nodes; with Ocarina.AADL_Values; with Ocarina.Nutils; with Ocarina.Entities; with Ocarina.Visitor.Instances.Properties; with Ocarina.Expander.Finder; package body Ocarina.Processor.Instances.Properties is use Ocarina.Nodes; use Ocarina.AADL_Values; use Ocarina.Nutils; use Ocarina.Entities; use Ocarina.Visitor.Instances.Properties; use Ocarina.Expander.Finder; function Evaluate_Property_Value (Instance_Root : Node_Id; Container : Node_Id; Property_Value : Node_Id) return Node_Id; -- Compute the value by fetching the property terms and applying -- the operations described in the property value. Return the -- first evaluated value (the following ones are chainded using -- Next_Node), or No_Node if nothing could be evaluated. procedure Expand_Property_Value (Instance_Root : Node_Id; Container : Node_Id; Property : Node_Id; Result_Node : out Node_Id; Result_List : out List_Id); -- Expand the property terms of the property, and return all the -- property values. If the property is a list property then the -- result will be returned in Result_List and Result_Node will be -- set to No_Node. Otherwise, the result will be returned in -- Result_Node and Result_List will be set to No_List. function Resolve_Values_Of_Property_Association (Root : Node_Id; Container : Node_Id; Property : Node_Id) return Boolean; -- Set a direct value (i.e. without value ()) for each value of -- the property association. -------------------------------------- -- Compute_Property_Instance_Values -- -------------------------------------- procedure Compute_Property_Instance_Values (Root : Node_Id) is Success : Boolean; pragma Unreferenced (Success); -- Not read begin Success := Visit_All_Property_Instances (Root => Root, Callback => Resolve_Values_Of_Property_Association'Access); end Compute_Property_Instance_Values; -------------------------------------------- -- Resolve_Values_Of_Property_Association -- -------------------------------------------- function Resolve_Values_Of_Property_Association (Root : Node_Id; Container : Node_Id; Property : Node_Id) return Boolean is pragma Assert (Kind (Root) = K_Architecture_Instance); pragma Assert (Kind (Property) = K_Property_Association); pragma Assert (Present (Container)); Prop_Value : constant Node_Id := Property_Association_Value (Property); Expanded_Node : Node_Id; Expanded_List : List_Id; begin Expand_Property_Value (Root, Container, Property, Expanded_Node, Expanded_List); Set_Expanded_Single_Value (Prop_Value, Expanded_Node); Set_Expanded_Multi_Value (Prop_Value, Expanded_List); return True; end Resolve_Values_Of_Property_Association; --------------------------- -- Expand_Property_Value -- --------------------------- procedure Expand_Property_Value (Instance_Root : Node_Id; Container : Node_Id; Property : Node_Id; Result_Node : out Node_Id; Result_List : out List_Id) is pragma Assert (Kind (Instance_Root) = K_Architecture_Instance); pragma Assert (Present (Container)); pragma Assert (No (Property) or else Kind (Property) = K_Property_Association or else Kind (Property) = K_Constant_Property_Declaration or else Kind (Property) = K_Property_Name_Declaration); Value : Node_Id; List_Node : Node_Id; Computed_Value : Node_Id; Evaluation_Container : Node_Id; begin Result_Node := No_Node; Result_List := No_List; if No (Property) then return; end if; -- First get the value of the property. For property -- associations, the evaluation context is the entity in which -- it has been declared. case Kind (Property) is when K_Property_Association => Value := Property_Association_Value (Property); Evaluation_Container := Value_Container (Property_Association_Value (Property)); when K_Constant_Property_Declaration => Value := Constant_Value (Property); Evaluation_Container := Container; when K_Property_Name_Declaration => Value := Default_Value (Property); Evaluation_Container := Container; when others => raise Program_Error; end case; if Present (Value) then if Present (Single_Value (Value)) then Result_Node := Evaluate_Property_Value (Instance_Root => Instance_Root, Container => Evaluation_Container, Property_Value => Single_Value (Value)); end if; if not Is_Empty (Multi_Value (Value)) then Result_List := New_List (K_List_Id, Loc (Value)); List_Node := First_Node (Multi_Value (Value)); while Present (List_Node) loop Computed_Value := Evaluate_Property_Value (Instance_Root => Instance_Root, Container => Evaluation_Container, Property_Value => List_Node); if Present (Computed_Value) then -- The computed value may be No_Node if nothing is -- pointed to. Then we simply ignore it. Else we -- append the computed values. Append_Node_To_List (Computed_Value, Result_List); end if; List_Node := Next_Node (List_Node); end loop; end if; end if; end Expand_Property_Value; ----------------------------- -- Evaluate_Property_Value -- ----------------------------- function Evaluate_Property_Value (Instance_Root : Node_Id; Container : Node_Id; Property_Value : Node_Id) return Node_Id is pragma Assert (No (Property_Value) or else Kind (Property_Value) = K_Literal or else Kind (Property_Value) = K_Property_Term or else Kind (Property_Value) = K_Number_Range_Term or else Kind (Property_Value) = K_Reference_Term or else Kind (Property_Value) = K_Property_Term or else Kind (Property_Value) = K_Minus_Numeric_Term or else Kind (Property_Value) = K_Signed_AADLNumber or else Kind (Property_Value) = K_Not_Boolean_Term or else Kind (Property_Value) = K_And_Boolean_Term or else Kind (Property_Value) = K_Or_Boolean_Term or else Kind (Property_Value) = K_Parenthesis_Boolean_Term or else Kind (Property_Value) = K_Component_Classifier_Term); Evaluated_Value : Node_Id; Dummy : List_Id; pragma Warnings (Off, Dummy); -- Not read in realease mode begin if No (Property_Value) then Evaluated_Value := No_Node; else case Kind (Property_Value) is when K_Literal => -- We clone the literal value Evaluated_Value := New_Node (Kind (Property_Value), Loc (Property_Value)); Set_Value (Evaluated_Value, New_Value (Value (Value (Property_Value)))); when K_Number_Range_Term => declare Evaluated_Lower_Bound : Node_Id; Evaluated_Upper_Bound : Node_Id; Evaluated_Delta_Term : Node_Id; begin Evaluated_Lower_Bound := Evaluate_Property_Value (Instance_Root => Instance_Root, Container => Container, Property_Value => Lower_Bound (Property_Value)); Evaluated_Upper_Bound := Evaluate_Property_Value (Instance_Root => Instance_Root, Container => Container, Property_Value => Upper_Bound (Property_Value)); Evaluated_Delta_Term := Evaluate_Property_Value (Instance_Root => Instance_Root, Container => Container, Property_Value => Delta_Term (Property_Value)); if Present (Evaluated_Lower_Bound) and then Kind (Evaluated_Lower_Bound) = K_Literal and then Present (Evaluated_Upper_Bound) and then Kind (Evaluated_Upper_Bound) = K_Literal and then Present (Evaluated_Delta_Term) and then Kind (Evaluated_Delta_Term) = K_Literal then Evaluated_Value := New_Node (Kind (Property_Value), Loc (Property_Value)); Set_Lower_Bound (Evaluated_Value, Evaluated_Lower_Bound); Set_Upper_Bound (Evaluated_Value, Evaluated_Upper_Bound); Set_Delta_Term (Evaluated_Value, Evaluated_Delta_Term); else Evaluated_Value := No_Node; end if; end; when K_Reference_Term => Evaluated_Value := New_Node (Kind (Property_Value), Loc (Property_Value)); Set_Identifier (Evaluated_Value, Duplicate_Identifier (Identifier (Property_Value))); Set_Path (Evaluated_Value, Path (Property_Value)); Set_Namespace_Path (Evaluated_Value, Namespace_Path (Property_Value)); Set_Namespace_Identifier (Evaluated_Value, Duplicate_Identifier (Namespace_Identifier (Property_Value))); Set_Referenced_Entity (Evaluated_Value, Find_Instance (Instance_Root => Instance_Root, Reference_Instance => Container, Path => Path (Property_Value))); when K_Property_Term => Expand_Property_Value (Instance_Root => Instance_Root, Container => Container, Property => Get_Referenced_Entity (Property_Value), Result_Node => Evaluated_Value, Result_List => Dummy); pragma Assert (Dummy = No_List); when K_Minus_Numeric_Term => declare Val : Value_Type; Literal : Node_Id; begin Evaluated_Value := Evaluate_Property_Value (Instance_Root => Instance_Root, Container => Container, Property_Value => Numeric_Term (Property_Value)); pragma Assert (Dummy = No_List); if Present (Evaluated_Value) then if Kind (Evaluated_Value) = K_Literal then Literal := Evaluated_Value; elsif Kind (Evaluated_Value) = K_Signed_AADLNumber then Literal := Number_Value (Evaluated_Value); -- Since the number has been evaluated, the -- number_value can only be a literal else Literal := No_Node; end if; if Present (Literal) then if Get_Value_Type (Value (Literal)).T = LT_Integer then Val := Get_Value_Type (Value (Literal)); Val.ISign := not Get_Value_Type (Value (Literal)).ISign; Set_Value (Value (Literal), Val); elsif Get_Value_Type (Value (Literal)).T = LT_Real then Val := Get_Value_Type (Value (Literal)); Val.RSign := not Val.RSign; Set_Value (Value (Literal), Val); else Evaluated_Value := No_Node; end if; if Present (Evaluated_Value) then if Kind (Evaluated_Value) = K_Literal then Evaluated_Value := Literal; elsif Kind (Evaluated_Value) = K_Signed_AADLNumber then Set_Number_Value (Evaluated_Value, Literal); end if; end if; else Evaluated_Value := No_Node; end if; end if; end; when K_Signed_AADLNumber => declare Evaluated_Number_Value : Node_Id; begin Evaluated_Value := New_Node (Kind (Property_Value), Loc (Property_Value)); Set_Unit_Identifier (Evaluated_Value, Unit_Identifier (Property_Value)); Evaluated_Number_Value := Evaluate_Property_Value (Instance_Root => Instance_Root, Container => Container, Property_Value => Number_Value (Property_Value)); if Present (Evaluated_Number_Value) then -- XXX we should check the type Set_Number_Value (Evaluated_Value, Evaluated_Number_Value); else Evaluated_Value := No_Node; end if; end; when K_Not_Boolean_Term => declare Val : Value_Type; begin Evaluated_Value := Evaluate_Property_Value (Instance_Root => Instance_Root, Container => Container, Property_Value => Boolean_Term (Property_Value)); if Present (Evaluated_Value) and then Kind (Evaluated_Value) = K_Literal and then Get_Value_Type (Value (Evaluated_Value)).T = LT_Boolean then Val := Get_Value_Type (Value (Evaluated_Value)); Val.BVal := not Val.BVal; Set_Value (Value (Evaluated_Value), Val); else Evaluated_Value := No_Node; end if; end; when K_And_Boolean_Term => declare Auxiliary_Value : Node_Id; Val : Value_Type; begin Evaluated_Value := Evaluate_Property_Value (Instance_Root => Instance_Root, Container => Container, Property_Value => First_Term (Property_Value)); Auxiliary_Value := Evaluate_Property_Value (Instance_Root => Instance_Root, Container => Container, Property_Value => Second_Term (Property_Value)); if Present (Evaluated_Value) and then Kind (Evaluated_Value) = K_Literal and then Get_Value_Type (Value (Evaluated_Value)).T = LT_Boolean and then Present (Auxiliary_Value) and then Kind (Auxiliary_Value) = K_Literal and then Get_Value_Type (Value (Auxiliary_Value)).T = LT_Boolean then Val := Get_Value_Type (Value (Evaluated_Value)); Val.BVal := Val.BVal and then Get_Value_Type (Value (Auxiliary_Value)).BVal; Set_Value (Value (Evaluated_Value), Val); else Evaluated_Value := No_Node; end if; end; when K_Or_Boolean_Term => declare Auxiliary_Value : Node_Id; Val : Value_Type; begin Evaluated_Value := Evaluate_Property_Value (Instance_Root => Instance_Root, Container => Container, Property_Value => First_Term (Property_Value)); Auxiliary_Value := Evaluate_Property_Value (Instance_Root => Instance_Root, Container => Container, Property_Value => Second_Term (Property_Value)); if Present (Evaluated_Value) and then Kind (Evaluated_Value) = K_Literal and then Get_Value_Type (Value (Evaluated_Value)).T = LT_Boolean and then Present (Auxiliary_Value) and then Kind (Auxiliary_Value) = K_Literal and then Get_Value_Type (Value (Auxiliary_Value)).T = LT_Boolean then Val := Get_Value_Type (Value (Evaluated_Value)); Val.BVal := Val.BVal or else Get_Value_Type (Value (Auxiliary_Value)).BVal; Set_Value (Value (Evaluated_Value), Val); else Evaluated_Value := No_Node; end if; end; when K_Parenthesis_Boolean_Term => Evaluated_Value := Evaluate_Property_Value (Instance_Root => Instance_Root, Container => Container, Property_Value => Boolean_Term (Property_Value)); if Present (Evaluated_Value) and then Kind (Evaluated_Value) = K_Literal and then Get_Value_Type (Value (Evaluated_Value)).T = LT_Boolean then null; else Evaluated_Value := No_Node; end if; when K_Component_Classifier_Term => Evaluated_Value := New_Node (Kind (Property_Value), Loc (Property_Value)); Set_Referenced_Entity (Evaluated_Value, Get_Referenced_Entity (Property_Value)); Set_Component_Cat (Evaluated_Value, Component_Cat (Property_Value)); when others => raise Program_Error; end case; end if; return Evaluated_Value; end Evaluate_Property_Value; end Ocarina.Processor.Instances.Properties;