------------------------------------------------------ -------------------------- -- -- -- OCARINA COMPONENTS -- -- -- -- G A I A . P R O C E S S O R . E N T I T I E S . C O M P O N E N T S -- -- -- -- 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 Namet; with Ocarina.Nodes; with Ocarina.AADL_Values; with Ocarina.Nutils; with Ocarina.Entities; with Ocarina.Analyzer.Queries; with Ocarina.Entities.Components; with Gaia.Messages; with Gaia.Processor.Messages; with Gaia.Processor.Entities.Features; with Gaia.Processor.Entities.Subprogram_Calls; with Gaia.Processor.Entities.Connections; with Gaia.Processor; with Gaia.Processor.Nodes; with Gaia.Processor.Nodes.Utils; package body Gaia.Processor.Entities.Components is use Ocarina.Entities; use Ocarina.Entities.Components; use Ocarina.AADL_Values; package ON renames Ocarina.Nodes; package ONU renames Ocarina.Nutils; package GN renames Gaia.Processor.Nodes; package GNU renames Gaia.Processor.Nodes.Utils; DTE_Null : name_id; DTE_Integer : name_id; DTE_Float : name_id; DTE_String : name_id; DTE_Boolean : name_id; -- Data types recognized by Gaia. TSP_Periodic : name_id; -- Thread scheduling protocol for which we need a period function Process_Features (Instance, Procedure_Node : node_id) return Boolean; function Process_Subprogram_Content (Instance, Sp : node_id) return Boolean; -- Process the content of the subprogram Instance (from the -- Ocarina tree) and store the result in the subprogram Sp (in the -- Gaia tree). function Create_Unique_Name (Name : name_id) return name_id; function Get_Thread_Period (Thread_Instance : node_id) return value_id; -------------------------------- -- Process_Subprogram_Content -- -------------------------------- function Process_Subprogram_Content (Instance, Sp : node_id) return Boolean is use Gaia.Processor.Entities.Subprogram_Calls; use Gaia.Processor.Entities.Connections; use Ocarina.Analyzer.Queries; use ON; use GN; use GNU; pragma assert (ON.Kind (Instance) = ON.k_component_instance and then Get_Category_Of_Component (Instance) = cc_subprogram and then GN.Kind (Sp) = GN.k_subprogram); Success : Boolean := True; Call_Sequence : node_id; Gaia_Call_Sequence : node_id; Identifier : node_id; begin -- Call sequences if not ONU.Is_Empty (ON.Calls (Instance)) then Call_Sequence := ON.First_Node (ON.Calls (Instance)); while Present (Call_Sequence) loop Gaia_Call_Sequence := GNU.New_Node (GN.k_call_sequence); Identifier := GNU.Make_Identifier (Get_Name_Of_Entity (Call_Sequence)); Bind_Identifier_To_Entity (Identifier, Gaia_Call_Sequence); GN.Set_Scoped_Name (Gaia_Call_Sequence, GNU.Map_Scoped_Name (Gaia_Call_Sequence, Call_Sequence)); Set_Statements (Gaia_Call_Sequence, GNU.New_List (GN.k_list_id)); Success := Process_Call_Sequence (Call_Sequence, Gaia_Call_Sequence) and then Success; GNU.Append_Node_To_List (Gaia_Call_Sequence, Call_Sequences (Sp)); Call_Sequence := ON.Next_Node (Call_Sequence); end loop; end if; -- Source language and Implementing package if Is_Defined_Enumeration_Property (Instance, "source_language") and then Is_Defined_String_Property (Instance, "source_name") then GN.Set_Implementation_Language (Sp, Get_Enumeration_Property (Instance, "source_language")); GN.Set_Implemented_By (Sp, Get_String_Property (Instance, "source_name")); end if; -- Connections Success := Process_Connections (Instance, Sp) and then Success; return Success; end Process_Subprogram_Content; ---------------------- -- Process_Features -- ---------------------- function Process_Features (Instance, Procedure_Node : node_id) return Boolean is use Gaia.Processor.Entities.Features; use Gaia.Processor.Messages; use ON; use GN; pragma assert (GN.Kind (Procedure_Node) = GN.k_subprogram or else GN.Kind (Procedure_Node) = GN.k_thread or else GN.Kind (Procedure_Node) = GN.k_process); List_Node : node_id; Success : Boolean := True; begin if not ONU.Is_Empty (ON.Features (Instance)) then List_Node := ON.First_Node (ON.Features (Instance)); while List_Node /= No_Node loop Success := Process_Feature (List_Node, Procedure_Node) and then Success; List_Node := ON.Next_Node (List_Node); end loop; end if; return Success; end Process_Features; ------------------ -- Process_Data -- ------------------ function Process_Data (Instance, Namespace : node_id) return Boolean is use Gaia.Messages; use Gaia.Processor.Messages; use Gaia.Processor; use Ocarina.Analyzer.Queries; use ON; use GN; use GNU; use Namet; pragma assert (ON.Kind (Instance) = ON.k_component_instance and then Get_Category_Of_Component (Instance) = cc_data and then GN.Kind (Namespace) = GN.k_namespace); function Get_Processed_Data (Instance : node_id; Namespace : node_id) return node_id; procedure Set_Processed_Data (Instance : node_id; Namespace : node_id; Data : node_id); function Get_Internal_Name (Instance : node_id; Namespace : node_id) return name_id; -- To avoid re-processing the same data in the same namespace ------------------------ -- Get_Processed_Data -- ------------------------ function Get_Processed_Data (Instance : node_id; Namespace : node_id) return node_id is I_Name : constant name_id := Get_Internal_Name (Instance, Namespace); begin return node_id (Get_Name_Table_Info (I_Name)); end Get_Processed_Data; ------------------------ -- Set_Processed_Data -- ------------------------ procedure Set_Processed_Data (Instance : node_id; Namespace : node_id; Data : node_id) is I_Name : constant name_id := Get_Internal_Name (Instance, Namespace); begin Set_Name_Table_Info (I_Name, nat (Data)); end Set_Processed_Data; ----------------------- -- Get_Internal_Name -- ----------------------- function Get_Internal_Name (Instance : node_id; Namespace : node_id) return name_id is begin Set_Str_To_Name_Buffer ("%Processed%Data%"); Add_Nat_To_Name_Buffer (nat (Instance)); Add_Char_To_Name_Buffer ('%'); Add_Nat_To_Name_Buffer (nat (Namespace)); return Name_Find; end Get_Internal_Name; List_Node : node_id; Subcomponent_Node : node_id; Success : Boolean := True; Data : constant node_id := GNU.New_Node (GN.k_type_definition); Field_Definition : node_id; Identifier : node_id; First_Instance : node_id; Data_Type_Name : name_id; N : node_id; S : node_id; V : node_id; Is_Protected : Boolean := False; begin -- First, we search whether the data have already been put in -- root data space or not. if Present (Get_Processed_Data (Instance, Namespace)) then return True; end if; GN.Set_Subtypes (Data, GNU.New_List (GN.k_list_id)); Identifier := GNU.Make_Identifier (Normalize_Name (Get_Name_Of_Entity (Instance))); Bind_Identifier_To_Entity (Identifier, Data); GN.Set_Scoped_Name (Data, GNU.Map_Scoped_Name (Data, Instance, Rewind => False)); GN.Set_Subprograms (Data, GNU.New_List (GN.k_list_id)); if Is_Defined_Enumeration_Property (Instance, "concurrency_control_protocol") then Data_Type_Name := Get_Enumeration_Property (Instance, "concurrency_control_protocol"); if Get_Name_String (Data_Type_Name) = "protected_access" then Is_Protected := True; Set_Str_To_Name_Buffer ("protected"); Set_Access_Protocol (Data, Name_Find); if Is_Defined_Enumeration_Property (Instance, "ARAO::Actual_Lock_Implementation") then Set_Updating_Policy (Data, Get_Enumeration_Property (Instance, "ARAO::Actual_Lock_Implementation")); else -- Asynchronous_Lock is default Policy Set_Updating_Policy (Data, Async_Update_Policy); end if; end if; end if; if not Is_Protected then Set_Access_Protocol (Data, No_Name); end if; if not Is_Defined_Enumeration_Property (Instance, "arao::data_type") then GN.Set_Predefined_Simple_Type (Data, predefined_data_type'pos (pdt_null)); else Data_Type_Name := Get_Enumeration_Property (Instance, "arao::data_type"); if Data_Type_Name = DTE_Integer then GN.Set_Predefined_Simple_Type (Data, predefined_data_type'pos (pdt_integer)); elsif Data_Type_Name = DTE_Float then GN.Set_Predefined_Simple_Type (Data, predefined_data_type'pos (pdt_float)); elsif Data_Type_Name = DTE_Boolean then GN.Set_Predefined_Simple_Type (Data, predefined_data_type'pos (pdt_boolean)); elsif Data_Type_Name = DTE_String then -- The user must provide a maximal length for string -- types if not Is_Defined_Integer_Property (Instance, "arao::max_length") then Display_Error ("String data type '" & Get_Name_String (GN.Name (Data)) & "' must have a arao::Max_Length property", Fatal => True); else GN.Set_Maximal_Length (Data, New_Integer_Value (unsigned_long_long (Get_Integer_Property (Instance, "arao::max_length")))); end if; GN.Set_Predefined_Simple_Type (Data, predefined_data_type'pos (pdt_string)); elsif Data_Type_Name = DTE_Null then GN.Set_Predefined_Simple_Type (Data, predefined_data_type'pos (pdt_null)); else Display_Unknown_Data_Type (Data_Type_Name); GN.Set_Predefined_Simple_Type (Data, predefined_data_type'pos (pdt_null)); end if; end if; -- Process subcomponents to create references to them if not ONU.Is_Empty (Subcomponents (Instance)) then List_Node := ON.First_Node (ON.Subcomponents (Instance)); while Present (List_Node) loop Subcomponent_Node := ON.Corresponding_Instance (List_Node); case Get_Category_Of_Component (Subcomponent_Node) is when cc_data => pragma assert (ON.Kind (Subcomponent_Node) = ON.k_component_instance); if not Process_Data (Subcomponent_Node, Namespace) then raise Program_Error with "Cannot process subcomponent"; end if; Field_Definition := GNU.New_Node (GN.k_variable_definition); Identifier := GNU.Make_Identifier (Normalize_Name (Get_Name_Of_Entity (List_Node))); Bind_Identifier_To_Entity (Identifier, Field_Definition); -- To set the type of the variable, we use the -- first instance of the type that was expanded. First_Instance := ON.First_Homonym_In_Namespace (Subcomponent_Node); if No (First_Instance) then First_Instance := Subcomponent_Node; end if; Try_Perform_Link (GN.Set_Type_Spec'access, Field_Definition, First_Instance, True); GNU.Append_Node_To_List (Field_Definition, GN.Subtypes (Data)); when others => Display_Wrong_Component_Category (List_Node); Success := False; end case; List_Node := ON.Next_Node (List_Node); end loop; end if; -- Process the features of the data component if not ONU.Is_Empty (ON.Features (Instance)) then List_Node := ON.First_Node (ON.Features (Instance)); while Present (List_Node) loop if ON.Kind (List_Node) = ON.k_subprogram_spec_instance then N := GNU.New_Node (GN.k_subprogram_reference); Identifier := Make_Identifier (Normalize_Name (Get_Name_Of_Entity (List_Node))); Bind_Identifier_To_Entity (Identifier, N); -- Link to the real subprogram S := Corresponding_Instance (List_Node); -- Mark the related subprogram as owned if Present (ON.Annotation (Corresponding_Instance (List_Node))) then Set_Owner_Data (ON.Annotation (S), N); else Set_Name_Table_Info (Create_Unique_Name (ON.Name (ON.Identifier (S))), int (N)); end if; Try_Perform_Link (GN.Set_Corresponding_Subprogram'access, N, S, False); -- Append the subprogram reference to the list of the -- data subprograms. Append_Node_To_List (N, GN.Subprograms (Data)); else raise Program_Error with "Incorrect kind of data feature: " & ON.node_kind'image (ON.Kind (List_Node)); end if; List_Node := ON.Next_Node (List_Node); end loop; end if; -- Set the corresponding AADL declaration to reference -- the current gaia data node (used by the Set_Type_Spec call) ON.Set_Annotation (Instance, Data); GN.Set_Frontend_Node (Data, Instance); -- We search for symbolic values Set_Symbolic_Values (Data, New_List (k_list_id)); if Is_Defined_Property (Instance, "arao::symbolic_values") then N := Get_Value_Of_Property_Association (Instance, "arao::symbolic_values"); while N /= No_Node loop V := New_Node (k_symbolic_value); GN.Set_Value_Name (V, ON.Value (N)); GNU.Append_Node_To_List (V, Symbolic_Values (Data)); N := ON.Next_Node (N); end loop; end if; -- Appending the data component to the namespace public -- declarations GNU.Append_Node_To_List (Data, GN.Public_Declarations (Namespace)); -- Mark the data as being processed Set_Processed_Data (Instance, Namespace, Data); return Success; end Process_Data; --------------------- -- Process_Process -- --------------------- function Process_Process (Instance, Namespace : node_id) return Boolean is use ON; use GN; use GNU; use Gaia.Processor.Entities.Connections; pragma assert (ON.Kind (Instance) = ON.k_component_instance and then Get_Category_Of_Component (Instance) = cc_process and then GN.Kind (Namespace) = GN.k_namespace); List_Node : node_id; Subcomponent_Node : node_id; Success : Boolean; Process : constant node_id := GNU.New_Node (GN.k_process); Thread_Declaration : node_id; Variable : node_id; Identifier : node_id; begin Identifier := GNU.Make_Identifier (Normalize_Name (Get_Name_Of_Entity (ON.Parent_Subcomponent (Instance)))); Bind_Identifier_To_Entity (Identifier, Process); GN.Set_Scoped_Name (Process, GNU.Map_Scoped_Name (Process, Instance)); GN.Set_Variables (Process, GNU.New_List (GN.k_list_id)); GN.Set_Connections (Process, GNU.New_List (GN.k_list_id)); GN.Set_Ports (Process, GNU.New_List (GN.k_list_id)); GNU.Append_Node_To_List (Process, GN.Public_Declarations (Namespace)); -- Process the features of the process Success := Process_Features (Instance, Process); if not ONU.Is_Empty (ON.Subcomponents (Instance)) then List_Node := ON.First_Node (ON.Subcomponents (Instance)); GN.Set_Threads (Process, GNU.New_List (GN.k_list_id)); while Present (List_Node) loop Subcomponent_Node := ON.Corresponding_Instance (List_Node); case Get_Category_Of_Component (Subcomponent_Node) is when cc_thread => Success := Process_Thread (Subcomponent_Node, Namespace) and then Success; Thread_Declaration := GNU.New_Node (GN.k_thread_reference); Identifier := GNU.Make_Identifier (Normalize_Name (Get_Name_Of_Entity (List_Node))); Bind_Identifier_To_Entity (Identifier, Thread_Declaration); -- Link it to the thread instance Try_Perform_Link (GN.Set_Corresponding_Thread'access, Thread_Declaration, Subcomponent_Node, False); GNU.Append_Node_To_List (Thread_Declaration, GN.Threads (Process)); when cc_data => Variable := GNU.New_Node (GN.k_variable_definition); Bind_Identifier_To_Entity (GNU.Make_Identifier (Normalize_Name (Get_Name_Of_Entity (List_Node))), Variable); GN.Set_Scoped_Name (Variable, GNU.Map_Scoped_Name (Variable, List_Node)); Try_Perform_Link (GN.Set_Type_Spec'access, Variable, Subcomponent_Node, True); ON.Set_Annotation (List_Node, Variable); GNU.Append_Node_To_List (Variable, Variables (Process)); Success := True; when others => null; end case; List_Node := ON.Next_Node (List_Node); end loop; end if; -- Process the process connections Success := Success and then Process_Connections (Instance, Process); return Success; end Process_Process; ------------------------ -- Process_Subprogram -- ------------------------ function Process_Subprogram (Instance, Namespace : node_id) return Boolean is use ON; use GN; use GNU; use Namet; pragma assert (ON.Kind (Instance) = ON.k_component_instance and then Get_Category_Of_Component (Instance) = cc_subprogram and then GN.Kind (Namespace) = GN.k_namespace); Success : Boolean := True; Subprogram : constant node_id := GNU.New_Node (GN.k_subprogram); Identifier : node_id; Val : int; begin Identifier := GNU.Make_Identifier (Normalize_Name (Get_Name_Of_Entity (Instance))); Bind_Identifier_To_Entity (Identifier, Subprogram); GN.Set_Scoped_Name (Subprogram, GNU.Map_Scoped_Name (Subprogram, Instance, Rewind => False)); Set_Implementation_Language (Subprogram, No_Name); GN.Set_Implemented_By (Subprogram, No_Name); GN.Set_Call_Sequences (Subprogram, GNU.New_List (GN.k_list_id)); GN.Set_Connections (Subprogram, GNU.New_List (GN.k_list_id)); GN.Set_Parameters (Subprogram, GNU.New_List (GN.k_list_id)); GN.Set_Variables (Subprogram, GNU.New_List (GN.k_list_id)); Val := Get_Name_Table_Info (Create_Unique_Name (ON.Name (ON.Identifier (Instance)))); if Val /= 0 then Set_Owner_Data (Subprogram, node_id (Val)); else Set_Owner_Data (Subprogram, No_Node); end if; GNU.Append_Node_To_List (Subprogram, GN.Public_Declarations (Namespace)); Success := Process_Features (Instance, Subprogram); GN.Set_Parameters (Subprogram, GN.Parameters (Subprogram)); Success := Process_Subprogram_Content (Instance, Subprogram) and then Success; -- We set the annotation in order to find back the related -- (current) Gaia subprogram node when dealing with the ocarina -- subprogram node ON.Set_Annotation (Instance, Subprogram); return Success; end Process_Subprogram; -------------------- -- Process_Thread -- -------------------- function Process_Thread (Instance, Namespace : node_id) return Boolean is use ON; use GN; use GNU; use Gaia.Processor.Entities.Subprogram_Calls; use Gaia.Processor.Entities.Connections; use Ocarina.Analyzer.Queries; pragma assert (ON.Kind (Instance) = ON.k_component_instance and then Get_Category_Of_Component (Instance) = cc_thread and then GN.Kind (Namespace) = GN.k_namespace); Success : Boolean := True; Thread : constant node_id := GNU.New_Node (GN.k_thread); Call_Sequence : node_id; Identifier : node_id; Gaia_Call_Sequence : node_id; begin Identifier := GNU.Make_Identifier (Normalize_Name (Get_Name_Of_Entity (ON.Parent_Subcomponent (Instance)))); Bind_Identifier_To_Entity (Identifier, Thread); GN.Set_Scoped_Name (Thread, GNU.Map_Scoped_Name (Thread, Instance)); GN.Set_Period (Thread, Get_Thread_Period (Instance)); GN.Set_Call_Sequences (Thread, GNU.New_List (GN.k_list_id)); GN.Set_Connections (Thread, GNU.New_List (GN.k_list_id)); GN.Set_Ports (Thread, GNU.New_List (GN.k_list_id)); GN.Set_Variables (Thread, GNU.New_List (GN.k_list_id)); GN.Set_Unique (Thread, True); GN.Set_Sources_Number (Thread, 0); -- We extract runtime-relative priorities if Is_Defined_Integer_Property (Instance, "arao::priority") then Set_Priority (Thread, New_Integer_Value (unsigned_long_long (Get_Integer_Property (Instance, "arao::priority")))); elsif Is_Defined_Integer_Property (Instance, "cheddar_properties::fixed_priority") then Set_Priority (Thread, New_Integer_Value (unsigned_long_long (Get_Integer_Property (Instance, "cheddar_properties::fixed_priority")))); else Set_Priority (Thread, No_Value); end if; if Is_Defined_Integer_Property (Instance, "source_stack_size") then Set_Storage_Size (Thread, New_Integer_Value (unsigned_long_long (Get_Integer_Property (Instance, "source_stack_size")))); else Set_Storage_Size (Thread, No_Value); end if; -- We set the annotation in order to find back the related -- (current) Gaia tread node when dealing with the ocarina -- thread instance node. ON.Set_Annotation (Instance, Thread); GNU.Append_Node_To_List (Thread, GN.Public_Declarations (Namespace)); Success := Process_Features (Instance, Thread); if not ONU.Is_Empty (ON.Calls (Instance)) then -- If call sequences are declared, we generate the -- corresponding code. Call_Sequence := ON.First_Node (ON.Calls (Instance)); while Call_Sequence /= No_Node loop Gaia_Call_Sequence := GNU.New_Node (GN.k_call_sequence); Identifier := GNU.Make_Identifier (Get_Name_Of_Entity (Call_Sequence)); Bind_Identifier_To_Entity (Identifier, Gaia_Call_Sequence); GN.Set_Scoped_Name (Gaia_Call_Sequence, GNU.Map_Scoped_Name (Gaia_Call_Sequence, Call_Sequence)); Set_Statements (Gaia_Call_Sequence, GNU.New_List (GN.k_list_id)); Success := Process_Call_Sequence (Call_Sequence, Gaia_Call_Sequence) and then Success; GNU.Append_Node_To_List (Gaia_Call_Sequence, Call_Sequences (Thread)); Call_Sequence := ON.Next_Node (Call_Sequence); end loop; end if; Success := Process_Connections (Instance, Thread) and then Success; return Success; end Process_Thread; ---------- -- Init -- ---------- procedure Init is use Namet; begin Set_Str_To_Name_Buffer ("null"); DTE_Null := Name_Find; Set_Str_To_Name_Buffer ("integer"); DTE_Integer := Name_Find; Set_Str_To_Name_Buffer ("float"); DTE_Float := Name_Find; Set_Str_To_Name_Buffer ("string"); DTE_String := Name_Find; Set_Str_To_Name_Buffer ("boolean"); DTE_Boolean := Name_Find; Set_Str_To_Name_Buffer ("periodic"); TSP_Periodic := Name_Find; end Init; ----------------------- -- Get_Thread_Period -- ----------------------- function Get_Thread_Period (Thread_Instance : node_id) return value_id is use ON; use Namet; use Ocarina.Analyzer.Queries; use Gaia.Processor.Messages; pragma assert (ON.Kind (Thread_Instance) = k_component_instance and then Get_Category_Of_Component (Thread_Instance) = cc_thread); Period : value_id; begin if Is_Defined_Enumeration_Property (Thread_Instance, "dispatch_protocol") and then TSP_Periodic = Get_Enumeration_Property (Thread_Instance, "dispatch_protocol") then if Is_Defined_Integer_Property (Thread_Instance, "period") then Period := New_Integer_Value (unsigned_long_long (Get_Integer_Property (Thread_Instance, "period"))); else Period := V_Zero; end if; else -- Period = 0 should mean aperiodic task (cf idl file), -- and 0 definitively != than No_Value Period := No_Value; end if; return Period; end Get_Thread_Period; ------------------------ -- Create_Unique_Name -- ------------------------ function Create_Unique_Name (Name : name_id) return name_id is use Namet; begin Set_Str_To_Name_Buffer (Get_Name_String (Name) & nat'image (nat (Name))); return Name_Find; end Create_Unique_Name; end Gaia.Processor.Entities.Components;