----------------------------------- --------------------------------------------- -- -- -- OCARINA COMPONENTS -- -- -- -- O C A R I N A . G E N E R A T O R S . P O _ H I _ A D A . M A I N -- -- -- -- B o d y -- -- -- -- Copyright (C) 2006-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.Nutils; with Ocarina.Entities.Components; with Ocarina.Generators.Utils; with Ocarina.Generators.Properties; with Ocarina.Generators.Messages; with Ocarina.Generators.Ada_Tree.Nutils; with Ocarina.Generators.Ada_Tree.Nodes; with Ocarina.Generators.PO_HI_Ada.Runtime; with Ocarina.Generators.PO_HI_Ada.Mapping; package body Ocarina.Generators.PO_HI_Ada.Main is use Ocarina.Nodes; use Ocarina.Entities.Components; use Ocarina.Generators.Utils; use Ocarina.Generators.Properties; use Ocarina.Generators.Messages; use Ocarina.Generators.Ada_Tree.Nutils; use Ocarina.Generators.PO_HI_Ada.Runtime; use Ocarina.Generators.PO_HI_Ada.Mapping; package AAU renames Ocarina.Nutils; package ADN renames Ocarina.Generators.Ada_Tree.Nodes; --------------------- -- Subprogram_Body -- --------------------- package body Subprogram_Body is procedure Visit_Architecture_Instance (E : Node_Id); procedure Visit_Component_Instance (E : Node_Id); procedure Visit_System_Instance (E : Node_Id); procedure Visit_Process_Instance (E : Node_Id); procedure Visit_Thread_Instance (E : Node_Id); ----------- -- Visit -- ----------- procedure Visit (E : Node_Id) is begin case Kind (E) is when K_Architecture_Instance => Visit_Architecture_Instance (E); when K_Component_Instance => Visit_Component_Instance (E); when others => null; end case; end Visit; --------------------------------- -- Visit_Architecture_Instance -- --------------------------------- procedure Visit_Architecture_Instance (E : Node_Id) is begin Visit (Root_System (E)); end Visit_Architecture_Instance; ------------------------------ -- Visit_Component_Instance -- ------------------------------ procedure Visit_Component_Instance (E : Node_Id) is Cathegory : constant Component_Category := Get_Category_Of_Component (E); begin case Cathegory is when CC_System => Visit_System_Instance (E); when CC_Process => Visit_Process_Instance (E); when CC_Thread => Visit_Thread_Instance (E); when others => null; end case; end Visit_Component_Instance; ---------------------------- -- Visit_Process_Instance -- ---------------------------- procedure Visit_Process_Instance (E : Node_Id) is U : constant Node_Id := ADN.Distributed_Application_Unit (ADN.Naming_Node (Backend_Node (Identifier (E)))); P : constant Node_Id := ADN.Entity (U); N : Node_Id; S : Node_Id; Transport_API : constant Supported_Transport_APIs := Fetch_Transport_API (E); begin Push_Entity (P); Push_Entity (U); Set_Main_Body; -- Declarative part N := Make_Pragma_Statement (Pragma_Priority, Make_List_Id (Make_Attribute_Designator (RE (RE_Priority), A_Last))); Append_Node_To_List (N, ADN.Declarations (Current_Package)); -- Statements -- Initialize transport if any. There are 4 kinds of nodes: if Need_Delivery (E) then -- (1) Nodes which belongs to distributed applications -- and which receive messages (and may send). For these -- nodes, there is a delivery routine and a transport -- layer. -- (2) Nodes which belong to a monolithic application but -- whose threads communicate with each others. These -- nodes have a delivery routine and a transport layer. N := Message_Comment ("Initialize the communication subsystem"); Append_Node_To_List (N, ADN.Statements (Current_Package)); N := Make_Attribute_Designator (Extract_Designator (ADN.Deliver_Node (Backend_Node (Identifier (E)))), A_Access); N := Make_Subprogram_Call (RE (RE_Initialize), Make_List_Id (N)); Append_Node_To_List (N, ADN.Statements (Current_Package)); elsif Transport_API /= Transport_None then -- (3) Nodes which belongs to distributed applications -- and which send messages only. For these nodes, -- there is no delivery routine but there is a -- transport layer. N := Message_Comment ("Initialize the communication subsystem"); Append_Node_To_List (N, ADN.Statements (Current_Package)); N := Make_Null_Statement; N := Make_Subprogram_Call (RE (RE_Initialize), Make_List_Id (N)); Append_Node_To_List (N, ADN.Statements (Current_Package)); else -- (4) Nodes which belong to a monolithic application -- whose threads do not communicate. For these nodes, -- there is no delivery routine nor a transport layer. In -- this case, it is up to the main task to un block all -- the tasks mapped frome the AADL threds. N := Message_Comment ("Unblock all user tasks"); Append_Node_To_List (N, ADN.Statements (Current_Package)); N := Make_Subprogram_Call (RE (RE_Unblock_All_Tasks)); Append_Node_To_List (N, ADN.Statements (Current_Package)); end if; -- If we generate the code for the SpaceWire target and -- that the process has IN ports, then initialize the -- SpaceWire daemon. if Transport_API = Transport_SpaceWire and then Has_In_Ports (E) then Add_With_Package (E => RU (RU_PolyORB_HI_Transport_Low_Level_Extras), Used => False, Warnings_Off => True, Elaborated => True); end if; -- Suspend forever the main task N := Message_Comment ("Suspend forever instead of putting an" & " endless loop. This saves the CPU" & " resources."); Append_Node_To_List (N, ADN.Statements (Current_Package)); N := Make_Subprogram_Call (RE (RE_Suspend_Forever)); Append_Node_To_List (N, ADN.Statements (Current_Package)); -- Visit all the subcomponents of the process if not AAU.Is_Empty (Subcomponents (E)) then S := First_Node (Subcomponents (E)); while Present (S) loop -- Visit the component instance corresponding to the -- subcomponent S. Visit (Corresponding_Instance (S)); S := Next_Node (S); end loop; end if; Pop_Entity; -- U Pop_Entity; -- P end Visit_Process_Instance; --------------------------- -- Visit_System_Instance -- --------------------------- procedure Visit_System_Instance (E : Node_Id) is S : Node_Id; begin Push_Entity (HI_Distributed_Application_Root); -- Visit all the subcomponents of the system if not AAU.Is_Empty (Subcomponents (E)) then S := First_Node (Subcomponents (E)); while Present (S) loop -- Visit the component instance corresponding to the -- subcomponent S. Visit (Corresponding_Instance (S)); S := Next_Node (S); end loop; end if; Pop_Entity; -- HI_Distributed_Application_Root end Visit_System_Instance; --------------------------- -- Visit_Thread_Instance -- --------------------------- procedure Visit_Thread_Instance (E : Node_Id) is begin case Get_Thread_Dispatch_Protocol (E) is when Thread_Periodic | Thread_Sporadic => Add_With_Package (E => Extract_Designator (ADN.Activity_Package (Current_Entity)), Used => False, Warnings_Off => True, Elaborated => True); when others => Display_Located_Error (Loc (E), "Thread is not periodic nor sporadic", Fatal => True); end case; end Visit_Thread_Instance; end Subprogram_Body; end Ocarina.Generators.PO_HI_Ada.Main;