----------------------------------------------------------- --------------------- -- -- -- 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;