---------------------------------------------- ---------------------------------- -- -- -- OCARINA COMPONENTS -- -- -- -- O C A R I N A . G E N E R A T O R S . P O _ H I _ C . A C T I V I T Y -- -- -- -- B o d y -- -- -- -- Copyright (C) 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.Nutils; with Ocarina.Generators.Utils; with Ocarina.Entities.Components; with Ocarina.Generators.Properties; with Ocarina.Generators.C_Tree.Nutils; with Ocarina.Generators.C_Tree.Nodes; with Ocarina.Generators.PO_HI_C.Mapping; with Ocarina.Generators.PO_HI_C.Runtime; with Ocarina.Generators.C_Values; with Ocarina.Generators.Messages; package body Ocarina.Generators.PO_HI_C.Activity is use Namet; use Ocarina.Nodes; use Ocarina.Generators.Utils; use Ocarina.Entities.Components; use Ocarina.Generators.Properties; use Ocarina.Generators.C_Tree.Nutils; use Ocarina.Generators.PO_HI_C.Mapping; use Ocarina.Generators.PO_HI_C.Runtime; use Ocarina.Generators.Messages; package AAU renames Ocarina.Nutils; package AAN renames Ocarina.Nodes; package CTN renames Ocarina.Generators.C_Tree.Nodes; package CTU renames Ocarina.Generators.C_Tree.Nutils; package CV renames Ocarina.Generators.C_Values; ------------ -- Header -- ------------ package body Header_File 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); function Task_Job_Spec (E : Node_Id) return Node_Id; function Task_Deliver_Spec (E : Node_Id) return Node_Id; Have_Main_Deliver : Boolean := False; ------------------- -- Task_Job_Spec -- ------------------- function Task_Job_Spec (E : Node_Id) return Node_Id is N : Node_Id; S : constant Node_Id := Parent_Subcomponent (E); begin N := Make_Function_Specification (Defining_Identifier => Map_Task_Job_Identifier (S), Parameters => No_List, Return_Type => CTU.Make_Pointer_Type (New_Node (CTN.K_Void))); return N; end Task_Job_Spec; ----------------------- -- Task_Deliver_Spec -- ----------------------- function Task_Deliver_Spec (E : Node_Id) return Node_Id is N : Node_Id; S : constant Node_Id := Parent_Subcomponent (E); Parameters : constant List_Id := New_List (CTN.K_Parameter_List); begin N := Make_Parameter_Specification (Defining_Identifier => Make_Defining_Identifier (PN (P_Request)), Parameter_Type => Make_Pointer_Type (RE (RE_Request_T))); Append_Node_To_List (N, Parameters); N := Make_Function_Specification (Defining_Identifier => Map_Task_Deliver_Identifier (S), Parameters => Parameters, Return_Type => New_Node (CTN.K_Void)); Have_Main_Deliver := True; return N; end Task_Deliver_Spec; ----------- -- 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 := CTN.Distributed_Application_Unit (CTN.Naming_Node (Backend_Node (Identifier (E)))); P : constant Node_Id := CTN.Entity (U); Parameters : constant List_Id := New_List (CTN.K_Parameter_List); S : Node_Id; N : Node_Id; begin Push_Entity (P); Push_Entity (U); Set_Activity_Header (U); Have_Main_Deliver := False; if not AAU.Is_Empty (Subcomponents (E)) then S := First_Node (Subcomponents (E)); while Present (S) loop Visit (Corresponding_Instance (S)); S := Next_Node (S); end loop; end if; if Have_Main_Deliver then N := Make_Parameter_Specification (Defining_Identifier => Make_Defining_Identifier (PN (P_Message)), Parameter_Type => Make_Pointer_Type (RE (RE_Msg_T))); Append_Node_To_List (N, Parameters); N := Make_Function_Specification (Defining_Identifier => RE (RE_Main_Deliver), Parameters => Parameters, Return_Type => New_Node (CTN.K_Void)); Append_Node_To_List (N, CTN.Declarations (Current_File)); Bind_AADL_To_Job (Identifier (Parent_Subcomponent (E)), N); -- Declare some variables as extern variables -- needed by the main_deliver function. -- We declare them immediatly in the activity body -- to have them at the top of the generated file. N := Make_Extern_Entity_Declaration (Make_Variable_Declaration (Defining_Identifier => Make_Array_Declaration (Defining_Identifier => RE (RE_Port_Global_To_Entity), Array_Size => RE (RE_Nb_Ports)), Used_Type => RE (RE_Entity_T))); Append_Node_To_List (N, CTN.Declarations (CTN.Activity_Source (U))); N := Make_Extern_Entity_Declaration (Make_Variable_Declaration (Defining_Identifier => Make_Array_Declaration (Defining_Identifier => RE (RE_Port_Global_To_Local), Array_Size => RE (RE_Nb_Ports)), Used_Type => RE (RE_Port_T))); Append_Node_To_List (N, CTN.Declarations (CTN.Activity_Source (U))); 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 P : constant Supported_Thread_Dispatch_Protocol := Get_Thread_Dispatch_Protocol (E); S : constant Node_Id := Parent_Subcomponent (E); N : Node_Id; begin if Has_Ports (E) then N := Task_Deliver_Spec (E); Append_Node_To_List (N, CTN.Declarations (Current_File)); Bind_AADL_To_Global_Port (Identifier (S), N); end if; case P is when Thread_Periodic => N := Message_Comment ("Periodic task : " & Get_Name_String (Display_Name (Identifier (S)))); Append_Node_To_List (N, CTN.Declarations (Current_File)); -- Create the spec of the parameterless subprogram -- that executes the thread job. N := Task_Job_Spec (E); Append_Node_To_List (N, CTN.Declarations (Current_File)); Bind_AADL_To_Job (Identifier (S), N); when Thread_Sporadic => N := Message_Comment ("Sporadic task : " & Get_Name_String (Display_Name (Identifier (S)))); Append_Node_To_List (N, CTN.Declarations (Current_File)); N := Task_Job_Spec (E); Append_Node_To_List (N, CTN.Declarations (Current_File)); Bind_AADL_To_Job (Identifier (S), N); when others => Display_Error ("unknown thread type", Fatal => True); end case; end Visit_Thread_Instance; end Header_File; ------------ -- Source -- ------------ package body Source_File 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); function Task_Job_Body (E : Node_Id) return Node_Id; -- Create the parameterless subprogram body that does the -- thread's job. Main_Deliver_Alternatives : List_Id; ------------------- -- Task_Job_Body -- ------------------- function Task_Job_Body (E : Node_Id) return Node_Id is S : constant Node_Id := Parent_Subcomponent (E); Spec : constant Node_Id := CTN.Job_Node (Backend_Node (Identifier (S))); Declarations : constant List_Id := New_List (CTN.K_Declaration_List); Statements : constant List_Id := New_List (CTN.K_Statement_List); WStatements : constant List_Id := New_List (CTN.K_Statement_List); P : constant Supported_Thread_Dispatch_Protocol := Get_Thread_Dispatch_Protocol (E); Impl_Kind : constant Supported_Thread_Implementation := Get_Thread_Implementation_Kind (E); Call_Parameters : List_Id; N : Node_Id; procedure Make_Wait_Event; procedure Make_Call_Sequence; procedure Make_Set_Out_Ports; procedure Make_Send_Out_Ports; procedure Make_Task_Blocking; procedure Make_Fetch_In_Ports; procedure Make_Thread_Compute_Entrypoint; procedure Make_Ports_Compute_Entrypoint; function Make_Get_Valid_Value (F : Node_Id) return Node_Id; -------------------------- -- Make_Get_Valid_Value -- -------------------------- function Make_Get_Valid_Value (F : Node_Id) return Node_Id is Then_Statements : constant List_Id := New_List (CTN.K_Statement_List); Condition : Node_Id; N : Node_Id; begin N := Make_Variable_Declaration (Defining_Identifier => Make_Defining_Identifier (Map_C_Variable_Name (F, Port_Request => True)), Used_Type => RE (RE_Request_T)); Append_Node_To_List (N, Declarations); Call_Parameters := New_List (CTN.K_Parameter_List); Append_Node_To_List (Make_Defining_Identifier (Map_C_Enumerator_Name (S)), Call_Parameters); Append_Node_To_List (Make_Defining_Identifier (Map_C_Enumerator_Name (F, Local_Port => True)), Call_Parameters); Condition := Make_Call_Profile (RE (RE_Gqueue_Get_Count), Call_Parameters); Call_Parameters := New_List (CTN.K_Parameter_List); Append_Node_To_List (Make_Defining_Identifier (Map_C_Enumerator_Name (S)), Call_Parameters); Append_Node_To_List (Make_Defining_Identifier (Map_C_Enumerator_Name (F, Local_Port => True)), Call_Parameters); Append_Node_To_List (Make_Variable_Address (Make_Defining_Identifier (Map_C_Variable_Name (F, Port_Request => True))), Call_Parameters); N := Make_Call_Profile (RE (RE_Gqueue_Get_Value), Call_Parameters); Append_Node_To_List (N, Then_Statements); -- Add the call to next_value Call_Parameters := New_List (CTN.K_Parameter_List); Append_Node_To_List (Make_Defining_Identifier (Map_C_Enumerator_Name (S)), Call_Parameters); Append_Node_To_List (Make_Defining_Identifier (Map_C_Enumerator_Name (F, Local_Port => True)), Call_Parameters); N := Make_Call_Profile (RE (RE_Gqueue_Next_Value), Call_Parameters); Append_Node_To_List (N, Then_Statements); return Make_If_Statement (Condition, Then_Statements); end Make_Get_Valid_Value; --------------------- -- Make_Wait_Event -- --------------------- procedure Make_Wait_Event is begin N := Make_Variable_Declaration (Defining_Identifier => Make_Defining_Identifier (VN (V_Port)), Used_Type => RE (RE_Port_T)); Append_Node_To_List (N, Declarations); -- Make the call to __po_hi_gqueue_wait_for_incoming_event Call_Parameters := New_List (CTN.K_Parameter_List); N := Make_Defining_Identifier (Map_C_Enumerator_Name (S)); Append_Node_To_List (N, Call_Parameters); N := Make_Variable_Address (Make_Defining_Identifier (VN (V_Port))); Append_Node_To_List (N, Call_Parameters); N := CTU.Make_Call_Profile (RE (RE_Gqueue_Wait_For_Incoming_Event), Call_Parameters); Append_Node_To_List (N, WStatements); -- Make the call to __po_hi_compute_next_period Call_Parameters := New_List (CTN.K_Parameter_List); N := Make_Defining_Identifier (Map_C_Enumerator_Name (S)); Append_Node_To_List (N, Call_Parameters); N := CTU.Make_Call_Profile (RE (RE_Compute_Next_Period), Call_Parameters); Append_Node_To_List (N, WStatements); end Make_Wait_Event; --------------------------------- -- Make_Sporadic_Task_Blocking -- --------------------------------- procedure Make_Task_Blocking is begin -- Make the __po_hi_wait_for_next_period call Call_Parameters := New_List (CTN.K_Parameter_List); N := Make_Defining_Identifier (Map_C_Enumerator_Name (S)); Append_Node_To_List (N, Call_Parameters); N := CTU.Make_Call_Profile (RE (RE_Wait_For_Next_Period), Call_Parameters); Append_Node_To_List (N, WStatements); end Make_Task_Blocking; ------------------------ -- Make_Set_Out_Ports -- ------------------------ procedure Make_Set_Out_Ports is N : Node_Id; F : Node_Id; begin N := Message_Comment ("Set the OUT port values"); Append_Node_To_List (N, WStatements); F := First_Node (Features (E)); while Present (F) loop if Kind (F) = K_Port_Spec_Instance and then Is_Out (F) then -- We do not set the ports that are connected to -- subprogram out ports, this should be done during -- the subprogram call sequence handling. declare D : Node_Id := First_Node (Sources (F)); Set : Boolean := True; begin while Present (D) loop Set := Kind (Item (D)) /= K_Port_Spec_Instance; exit when not Set; D := Next_Node (D); end loop; if Set then N := Make_Variable_Declaration (Make_Defining_Identifier (Map_C_Variable_Name (F, Port_Request => True)), RE (RE_Request_T)); Append_Node_To_List (N, Declarations); N := Make_Expression (Left_Expr => Make_Member_Designator (Defining_Identifier => Make_Member_Designator (Defining_Identifier => Make_Member_Designator (Defining_Identifier => Make_Defining_Identifier (Map_C_Enumerator_Name (F)), Aggregate_Name => Make_Defining_Identifier (Map_C_Enumerator_Name (F))), Aggregate_Name => Make_Defining_Identifier (MN (M_Vars))), Aggregate_Name => Make_Defining_Identifier (Map_C_Variable_Name (F, Port_Request => True))), Operator => Op_Equal, Right_Expr => Make_Defining_Identifier (Map_C_Variable_Name (F, Request_Variable => True))); Append_Node_To_List (N, WStatements); N := Make_Expression (Left_Expr => Make_Member_Designator (Defining_Identifier => Make_Defining_Identifier (MN (M_Port)), Aggregate_Name => Make_Defining_Identifier (Map_C_Variable_Name (F, Port_Request => True))), Operator => Op_Equal, Right_Expr => Make_Defining_Identifier (Map_C_Variable_Name (F, Request_Variable => True))); Append_Node_To_List (N, WStatements); Call_Parameters := New_List (CTN.K_Parameter_List); N := Make_Defining_Identifier (Map_C_Enumerator_Name (S)); Append_Node_To_List (N, Call_Parameters); N := Make_Defining_Identifier (Map_C_Enumerator_Name (F, Local_Port => True)); Append_Node_To_List (N, Call_Parameters); N := Make_Variable_Address (Make_Defining_Identifier (Map_C_Variable_Name (F, Port_Request => True))); Append_Node_To_List (N, Call_Parameters); N := CTU.Make_Call_Profile (RE (RE_Gqueue_Store_Out), Call_Parameters); Append_Node_To_List (N, WStatements); end if; end; end if; F := Next_Node (F); end loop; end Make_Set_Out_Ports; ------------------------- -- Make_Send_Out_Ports -- ------------------------- procedure Make_Send_Out_Ports is N : Node_Id; F : Node_Id; begin N := Message_Comment ("Send the OUT ports"); Append_Node_To_List (N, WStatements); F := First_Node (Features (E)); while Present (F) loop if Kind (F) = K_Port_Spec_Instance and then Is_Out (F) then Call_Parameters := New_List (CTN.K_Parameter_List); N := Make_Defining_Identifier (Map_C_Enumerator_Name (S)); Append_Node_To_List (N, Call_Parameters); N := Make_Defining_Identifier (Map_C_Enumerator_Name (F)); Append_Node_To_List (N, Call_Parameters); N := CTU.Make_Call_Profile (RE (RE_Gqueue_Send_Output), Call_Parameters); Append_Node_To_List (N, WStatements); end if; F := Next_Node (F); end loop; end Make_Send_Out_Ports; ------------------------- -- Make_Fetch_In_Ports -- ------------------------- procedure Make_Fetch_In_Ports is F : Node_Id; begin N := Message_Comment ("Get the IN ports values"); Append_Node_To_List (N, CTN.Declarations (Current_File)); F := First_Node (Features (E)); while Present (F) loop if Kind (F) = K_Port_Spec_Instance and then Is_In (F) and then AAN.Is_Data (F) then -- Assign the port value N := Make_Get_Valid_Value (F); Append_Node_To_List (N, WStatements); Call_Parameters := New_List (CTN.K_Parameter_List); Append_Node_To_List (Make_Defining_Identifier (Map_C_Enumerator_Name (S)), Call_Parameters); Append_Node_To_List (Make_Defining_Identifier (Map_C_Enumerator_Name (F)), Call_Parameters); N := Make_Call_Profile (RE (RE_Gqueue_Next_Value), Call_Parameters); end if; F := Next_Node (F); end loop; end Make_Fetch_In_Ports; ------------------------ -- Make_Call_Sequence -- ------------------------ procedure Make_Call_Sequence is Call_Seq : constant Node_Id := First_Node (Calls (E)); begin if not Has_Modes (E) or else AAU.Length (Calls (E)) = 1 then -- If the thread has no modes, then it should has one -- unique call sequence, handle it. CTU.Handle_Call_Sequence (S, Call_Seq, Declarations, WStatements); else N := Message_Comment ("not implemented yet"); Append_Node_To_List (N, WStatements); end if; end Make_Call_Sequence; ----------------------------------- -- Make_Ports_Compute_Entrypoint -- ----------------------------------- procedure Make_Ports_Compute_Entrypoint is N : Node_Id; F : Node_Id; Switch_Alternatives : List_Id; Switch_Statements : List_Id; Switch_Labels : List_Id; begin N := Message_Comment ("Make_Ports_Compute_Entrypoint"); Append_Node_To_List (N, WStatements); F := First_Node (Features (E)); Switch_Alternatives := New_List (CTN.K_Alternatives_List); while Present (F) loop if Kind (F) = K_Port_Spec_Instance and then Is_In (F) then Switch_Statements := New_List (CTN.K_Statement_List); Switch_Labels := New_List (CTN.K_Label_List); -- Declare local data variable if the port is a -- data port. if AAN.Is_Data (F) then N := Make_Get_Valid_Value (F); Append_Node_To_List (N, Switch_Statements); end if; if Is_Event (F) and then not AAN.Is_Data (F) then Call_Parameters := New_List (CTN.K_Parameter_List); Append_Node_To_List (Make_Defining_Identifier (Map_C_Enumerator_Name (S)), Call_Parameters); Append_Node_To_List (Make_Defining_Identifier (Map_C_Enumerator_Name (F, Local_Port => True)), Call_Parameters); N := Make_Call_Profile (RE (RE_Gqueue_Next_Value), Call_Parameters); Append_Node_To_List (N, Switch_Statements); end if; Call_Parameters := New_List (CTN.K_Parameter_List); if AAN.Is_Data (F) then N := Make_Member_Designator (Defining_Identifier => Make_Member_Designator (Defining_Identifier => Make_Member_Designator (Defining_Identifier => Make_Defining_Identifier (Map_C_Enumerator_Name (F)), Aggregate_Name => Make_Defining_Identifier (Map_C_Enumerator_Name (F))), Aggregate_Name => Make_Defining_Identifier (MN (M_Vars))), Aggregate_Name => Make_Defining_Identifier (Map_C_Variable_Name (F, Port_Request => True))); Append_Node_To_List (N, Call_Parameters); end if; N := Make_Call_Profile (Map_C_Subprogram_Identifier (F), Call_Parameters); Append_Node_To_List (N, Switch_Statements); Append_Node_To_List (Make_Defining_Identifier (Map_C_Enumerator_Name (F, Local_Port => True)), Switch_Labels); N := Make_Switch_Alternative (Switch_Labels, Switch_Statements); Append_Node_To_List (N, Switch_Alternatives); end if; F := Next_Node (F); end loop; N := Make_Switch_Alternative (No_List, No_List); Append_Node_To_List (N, Switch_Alternatives); -- Make the case statement N := Make_Switch_Statement (Expression => Make_Defining_Identifier (MN (M_Port)), Alternatives => Switch_Alternatives); Append_Node_To_List (N, WStatements); end Make_Ports_Compute_Entrypoint; ------------------------------------ -- Make_Thread_Compute_Entrypoint -- ------------------------------------ procedure Make_Thread_Compute_Entrypoint is N : Node_Id; begin N := Message_Comment ("Make_Thread_Compute_Entrypoint"); Append_Node_To_List (N, WStatements); if P = Thread_Periodic then Call_Parameters := No_List; elsif P = Thread_Sporadic then Call_Parameters := New_List (CTN.K_Parameter_List); Append_Node_To_List (Make_Defining_Identifier (VN (V_Port)), Call_Parameters); else -- This cannot happend unless a serious bug exists raise Program_Error with "A thread which is not periodic nor sporadic"; end if; if not Has_Modes (E) then N := Make_Call_Profile (Map_C_Subprogram_Identifier (E), Call_Parameters); Append_Node_To_List (N, WStatements); else Display_Located_Error (Loc (E), "Threads with mode controled compute entrypoints not" & " supported yet", Fatal => True); end if; end Make_Thread_Compute_Entrypoint; begin case P is when Thread_Periodic => N := Message_Comment ("Periodic task : " & Get_Name_String (Display_Name (Identifier (S)))); Append_Node_To_List (N, CTN.Declarations (Current_File)); when Thread_Sporadic => N := Message_Comment ("Sporadic task : " & Get_Name_String (Display_Name (Identifier (S)))); Append_Node_To_List (N, CTN.Declarations (Current_File)); when others => Display_Error ("unknown type of thread", Fatal => False); null; end case; Check_Thread_Consistency (E); if Has_Ports (E) then -- Make the __po_hi_gqueue_init call Call_Parameters := New_List (CTN.K_Parameter_List); Append_Node_To_List (Make_Defining_Identifier (Map_C_Enumerator_Name (S)), Call_Parameters); Append_Node_To_List (Make_Defining_Identifier (Map_C_Define_Name (S, Nb_Ports => True)), Call_Parameters); Append_Node_To_List (Make_Defining_Identifier (Map_C_Variable_Name (S, Port_Queue => True)), Call_Parameters); Append_Node_To_List (Make_Defining_Identifier (Map_C_Variable_Name (S, Port_Fifo_Size => True)), Call_Parameters); Append_Node_To_List (Make_Defining_Identifier (Map_C_Variable_Name (S, Port_First => True)), Call_Parameters); Append_Node_To_List (Make_Defining_Identifier (Map_C_Variable_Name (S, Port_Offsets => True)), Call_Parameters); Append_Node_To_List (Make_Defining_Identifier (Map_C_Variable_Name (S, Port_Woffsets => True)), Call_Parameters); Append_Node_To_List (Make_Defining_Identifier (Map_C_Variable_Name (S, Port_N_Dest => True)), Call_Parameters); Append_Node_To_List (Make_Defining_Identifier (Map_C_Variable_Name (S, Port_Destinations => True)), Call_Parameters); Append_Node_To_List (Make_Defining_Identifier (Map_C_Variable_Name (S, Port_Used_Size => True)), Call_Parameters); Append_Node_To_List (Make_Defining_Identifier (Map_C_Variable_Name (S, Port_History => True)), Call_Parameters); Append_Node_To_List (Make_Defining_Identifier (Map_C_Variable_Name (S, Port_Recent => True)), Call_Parameters); Append_Node_To_List (Make_Defining_Identifier (Map_C_Variable_Name (S, Port_Empties => True)), Call_Parameters); Append_Node_To_List (Make_Defining_Identifier (Map_C_Variable_Name (S, Port_Total_Fifo => True)), Call_Parameters); N := Make_Call_Profile (RE (RE_Gqueue_Init), Call_Parameters); Append_Node_To_List (N, Statements); end if; -- If the thread is sporadic, we generate the call to block -- waiting for events. if P = Thread_Sporadic then Make_Wait_Event; end if; -- Depending on the implementation kind, call the proper -- implementation routines. case Impl_Kind is -- This kind of implementation is the simplest -- one. The user has only to implementation the -- behaviour of subprograms and does not have to worry -- about sending and receiving ports. -- Get IN ports values and dequeue them when Thread_With_Call_Sequence => if Has_In_Ports (E) then Make_Fetch_In_Ports; end if; -- Handle the thread call sequences if not AAU.Is_Empty (Calls (E)) then Make_Call_Sequence; end if; -- Set OUT ports values if Has_Out_Ports (E) then Make_Set_Out_Ports; end if; -- Send OUT ports if Has_Out_Ports (E) then Make_Send_Out_Ports; end if; when Thread_With_Compute_Entrypoint => -- Call the compute entrypoint. The code of the -- compute entry point will include the setting of -- the thread OUT ports. Make_Thread_Compute_Entrypoint; -- Send OUT ports. -- FIXME: Depending on an AADL property, the code of -- the thread entrypoint may include the sending of -- OUT ports. if Has_Out_Ports (E) then Make_Send_Out_Ports; end if; when Thread_With_Port_Compute_Entrypoint => -- Call the compute entrypoints of the triggeing -- port. The code of the compute entry point will -- include the sentting of the thread OUT ports. Make_Ports_Compute_Entrypoint; -- Send OUT ports. -- FIXME: Depending on an AADL property, the code of -- the port entrypoints may include the sending of OUT -- ports. if Has_Out_Ports (E) then Make_Send_Out_Ports; end if; when others => raise Program_Error with "Unconsistency in Task_Job_Body"; end case; -- Block until the next dispatch with respect to the -- inter-arrival time in case of a sporadic thread. Make_Task_Blocking; -- Call __po_hi_wait_initialization N := CTU.Make_Call_Profile (RE (RE_Wait_Initialization), No_List); Append_Node_To_List (N, Statements); -- Make the while (1){} and add all statements N := Make_While_Statement (Make_Literal (CV.New_Int_Value (1, 0, 10)), WStatements); Append_Node_To_List (N, Statements); N := Make_Function_Implementation (Spec, Declarations, Statements); return N; end Task_Job_Body; ----------- -- 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 := CTN.Distributed_Application_Unit (CTN.Naming_Node (Backend_Node (Identifier (E)))); P : constant Node_Id := CTN.Entity (U); S : Node_Id; N : Node_Id; Declarations : constant List_Id := New_List (CTN.K_Declaration_List); Statements : constant List_Id := New_List (CTN.K_Statement_List); Parameters : List_Id; begin Push_Entity (P); Push_Entity (U); CTU.Set_Activity_Source (U); Main_Deliver_Alternatives := New_List (CTN.K_Alternatives_List); -- 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. if Utils.Is_Data (Corresponding_Instance (S)) then N := Make_Variable_Declaration (Map_C_Defining_Identifier (S), Map_C_Data_Type_Designator (Corresponding_Instance (S))); Append_Node_To_List (N, CTN.Declarations (Current_File)); Bind_AADL_To_Object (Identifier (S), N); -- When a variable is declared in a process, we declare -- it automatically in the subprograms source file. -- FIXME : This shoule be done in the -- PO_HI_C.Subprograms.Source_File package N := Make_Variable_Declaration (Map_C_Defining_Identifier (S), Map_C_Data_Type_Designator (Corresponding_Instance (S))); -- FIXME : This should be done in the -- PO_HI_C.Subprograms.Source_File package. N := Make_Extern_Entity_Declaration (N); Append_Node_To_List (N, CTN.Declarations (CTN.Subprograms_Source (U))); N := Make_Variable_Declaration (Map_C_Defining_Identifier (S), Map_C_Data_Type_Designator (Corresponding_Instance (S))); N := Make_Extern_Entity_Declaration (N); Append_Node_To_List (N, CTN.Declarations (CTN.Main_Source (U))); else -- Visit the component instance corresponding to -- the subcomponent S. Visit (Corresponding_Instance (S)); end if; S := Next_Node (S); end loop; end if; if Present (CTN.Job_Node (Backend_Node (Identifier (Parent_Subcomponent (E))))) then Append_Node_To_List (Make_Variable_Declaration (Defining_Identifier => Make_Defining_Identifier (VN (V_Request)), Used_Type => RE (RE_Request_T)), Declarations); Append_Node_To_List (Make_Variable_Declaration (Defining_Identifier => Make_Defining_Identifier (VN (V_Entity)), Used_Type => RE (RE_Entity_T)), Declarations); -- Add the __po_hi_unmarshall_request call -- in the main deliver function. Parameters := New_List (CTN.K_Parameter_List); Append_Node_To_List (Make_Variable_Address (Make_Defining_Identifier (VN (V_Request))), Parameters); Append_Node_To_List (Make_Defining_Identifier (PN (P_Message)), Parameters); N := Make_Call_Profile (RE (RE_Unmarshall_Request), Parameters); Append_Node_To_List (N, Statements); -- Add the call to entity = __po_hi_global...[port] N := Make_Expression (Left_Expr => Make_Defining_Identifier (VN (V_Entity)), Operator => Op_Equal, Right_Expr => Make_Array_Declaration (Defining_Identifier => RE (RE_Port_Global_To_Entity), Array_Size => Make_Member_Designator (Defining_Identifier => Make_Defining_Identifier (MN (M_Port)), Aggregate_Name => Make_Defining_Identifier (VN (V_Request))))); Append_Node_To_List (N, Statements); -- Add the switch which redirect to local deliver functions N := Make_Switch_Alternative (No_List, No_List); Append_Node_To_List (N, Main_Deliver_Alternatives); N := Make_Switch_Statement (Expression => Make_Defining_Identifier (VN (V_Entity)), Alternatives => Main_Deliver_Alternatives); Append_Node_To_List (N, Statements); N := Make_Function_Implementation (CTN.Job_Node (Backend_Node (Identifier (Parent_Subcomponent (E)))), Declarations, Statements); Append_Node_To_List (N, CTN.Declarations (Current_File)); 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 S : constant Node_Id := Parent_Subcomponent (E); N : Node_Id; F : Node_Id; D : Node_Id; Fifo_Size_Values : Node_Id; N_Dest_Values : Node_Id; Local_Dest_Values : Node_Id; Destinations_Values : Node_Id; Destinations : List_Id; Deliver_Declarations : List_Id; Deliver_Statements : List_Id; Deliver_Alternatives : List_Id; Switch_Labels : List_Id; Switch_Statements : List_Id; Parameters : List_Id; Queue_Size : Long_Long; Fifo_Size : Unsigned_Long_Long := 0; Nb_Dest : Unsigned_Long_Long := 0; Has_Local_Deliver : Boolean := False; begin if Has_Ports (E) then F := First_Node (Features (E)); Fifo_Size_Values := Make_Array_Values; N_Dest_Values := Make_Array_Values; Destinations_Values := Make_Array_Values; Deliver_Declarations := New_List (CTN.K_Declaration_List); Deliver_Statements := New_List (CTN.K_Statement_List); Deliver_Alternatives := New_List (CTN.K_Alternatives_List); while Present (F) loop if Kind (F) = K_Port_Spec_Instance then if Is_Out (F) then Destinations := Get_Destination_Ports (F); Local_Dest_Values := Make_Array_Values; if AAU.Is_Empty (Destinations) then Display_Located_Error (Loc (F), "This OUT port is not connected to any" & " destination", Fatal => True); end if; D := First_Node (Destinations); Nb_Dest := 0; while Present (D) loop Append_Node_To_List (Make_Defining_Identifier (Map_C_Enumerator_Name (Item (D), Port_Type => True)), CTN.Values (Local_Dest_Values)); Nb_Dest := Nb_Dest + 1; D := Next_Node (D); end loop; -- Make the array which indicate all destinations -- for an out port N := Make_Expression (Left_Expr => Make_Variable_Declaration (Defining_Identifier => Make_Array_Declaration (Defining_Identifier => Make_Defining_Identifier (Map_C_Variable_Name (F, Port_Local_Dest => True)), Array_Size => Make_Literal (CV.New_Int_Value (Nb_Dest, 0, 10))), Used_Type => RE (RE_Int8_T)), Operator => Op_Equal, Right_Expr => Local_Dest_Values); Append_Node_To_List (N, CTN.Declarations (Current_File)); -- Add the last array name in the destination array Append_Node_To_List (Make_Defining_Identifier (Map_C_Variable_Name (F, Port_Local_Dest => True)), CTN.Values (Destinations_Values)); -- Add the number of destinations in the nb_dest array N := RE (RE_Gqueue_Fifo_Out); Append_Node_To_List (Make_Literal (CV.New_Int_Value (Nb_Dest, 0, 10)), CTN.Values (N_Dest_Values)); Append_Node_To_List (N, CTN.Values (Fifo_Size_Values)); else if AAN.Is_Data (F) and then not Is_Event (F) then Has_Local_Deliver := True; N := RE (RE_Gqueue_Fifo_Indata); Queue_Size := 0; else Has_Local_Deliver := True; Queue_Size := Get_Queue_Size (F); if Queue_Size = -1 then Queue_Size := Default_Queue_Size; N := Make_Literal (CV.New_Int_Value (Default_Queue_Size, 0, 10)); elsif Queue_Size = 0 then -- 0 length queues are not supported Display_Located_Error (Loc (F), "Zero length port queues are not supported", Fatal => True); else N := Make_Literal (CV.New_Int_Value (Unsigned_Long_Long (Queue_Size), 0, 10)); end if; end if; Append_Node_To_List (N, CTN.Values (Fifo_Size_Values)); Append_Node_To_List (Make_Literal (CV.New_Int_Value (0, 0, 10)), CTN.Values (N_Dest_Values)); N := Make_Defining_Identifier (CONST (C_Null), C_Conversion => False); Append_Node_To_List (N, CTN.Values (Destinations_Values)); -- Make the switch alternative for the deliver function Parameters := New_List (CTN.K_Parameter_List); Switch_Statements := New_List (CTN.K_Statement_List); Switch_Labels := New_List (CTN.K_Label_List); Append_Node_To_List (Make_Defining_Identifier (Map_C_Enumerator_Name (F, Port_Type => True)), Switch_Labels); Append_Node_To_List (Make_Defining_Identifier (Map_C_Enumerator_Name (S)), Parameters); Append_Node_To_List (Make_Defining_Identifier (Map_C_Enumerator_Name (F, Local_Port => True)), Parameters); Append_Node_To_List (Make_Defining_Identifier (PN (P_Request)), Parameters); N := Make_Call_Profile (RE (RE_Gqueue_Store_In), Parameters); Append_Node_To_List (N, Switch_Statements); N := Make_Switch_Alternative (Switch_Labels, Switch_Statements); Append_Node_To_List (N, Deliver_Alternatives); Fifo_Size := Fifo_Size + Unsigned_Long_Long (Queue_Size); end if; end if; F := Next_Node (F); end loop; -- Declare all the needed tables by each thread in order -- to handle the ports. N := Make_Variable_Declaration (Defining_Identifier => Make_Array_Declaration (Defining_Identifier => Make_Defining_Identifier (Map_C_Variable_Name (S, Port_Woffsets => True)), Array_Size => Make_Defining_Identifier (Map_C_Define_Name (S, Nb_Ports => True))), Used_Type => RE (RE_Uint8_T)); Append_Node_To_List (N, CTN.Declarations (Current_File)); N := Make_Variable_Declaration (Defining_Identifier => Make_Array_Declaration (Defining_Identifier => Make_Defining_Identifier (Map_C_Variable_Name (S, Port_Offsets => True)), Array_Size => Make_Defining_Identifier (Map_C_Define_Name (S, Nb_Ports => True))), Used_Type => RE (RE_Uint8_T)); Append_Node_To_List (N, CTN.Declarations (Current_File)); N := Make_Variable_Declaration (Defining_Identifier => Make_Array_Declaration (Defining_Identifier => Make_Defining_Identifier (Map_C_Variable_Name (S, Port_Used_Size => True)), Array_Size => Make_Defining_Identifier (Map_C_Define_Name (S, Nb_Ports => True))), Used_Type => RE (RE_Uint8_T)); Append_Node_To_List (N, CTN.Declarations (Current_File)); N := Make_Variable_Declaration (Defining_Identifier => Make_Array_Declaration (Defining_Identifier => Make_Defining_Identifier (Map_C_Variable_Name (S, Port_Empties => True)), Array_Size => Make_Defining_Identifier (Map_C_Define_Name (S, Nb_Ports => True))), Used_Type => RE (RE_Uint8_T)); Append_Node_To_List (N, CTN.Declarations (Current_File)); N := Make_Variable_Declaration (Defining_Identifier => Make_Array_Declaration (Defining_Identifier => Make_Defining_Identifier (Map_C_Variable_Name (S, Port_First => True)), Array_Size => Make_Defining_Identifier (Map_C_Define_Name (S, Nb_Ports => True))), Used_Type => RE (RE_Uint8_T)); Append_Node_To_List (N, CTN.Declarations (Current_File)); N := Make_Variable_Declaration (Defining_Identifier => Make_Array_Declaration (Defining_Identifier => Make_Defining_Identifier (Map_C_Variable_Name (S, Port_Recent => True)), Array_Size => Make_Defining_Identifier (Map_C_Define_Name (S, Nb_Ports => True))), Used_Type => RE (RE_Request_T)); Append_Node_To_List (N, CTN.Declarations (Current_File)); N := Make_Variable_Declaration (Defining_Identifier => Make_Array_Declaration (Defining_Identifier => Make_Defining_Identifier (Map_C_Variable_Name (S, Port_Queue => True)), Array_Size => Make_Expression (Left_Expr => Make_Literal (CV.New_Int_Value (Fifo_Size, 0, 10)), Operator => Op_Asterisk, Right_Expr => Make_Call_Profile (Make_Defining_Identifier (FN (F_Sizeof)), Make_List_Id (RE (RE_Request_T))))), Used_Type => RE (RE_Uint8_T)); Append_Node_To_List (N, CTN.Declarations (Current_File)); N := Make_Variable_Declaration (Defining_Identifier => Make_Expression (Left_Expr => Make_Defining_Identifier (Map_C_Variable_Name (S, Port_Total_Fifo => True)), Operator => Op_Equal, Right_Expr => Make_Literal (CV.New_Int_Value (Fifo_Size, 0, 10))), Used_Type => RE (RE_Uint16_T)); Append_Node_To_List (N, CTN.Declarations (Current_File)); N := Make_Variable_Declaration (Defining_Identifier => Make_Array_Declaration (Defining_Identifier => Make_Defining_Identifier (Map_C_Variable_Name (S, Port_History => True)), Array_Size => Make_Literal (CV.New_Int_Value (Fifo_Size, 0, 10))), Used_Type => RE (RE_Port_T)); Append_Node_To_List (N, CTN.Declarations (Current_File)); N := Make_Expression (Left_Expr => Make_Variable_Declaration (Defining_Identifier => Make_Array_Declaration (Defining_Identifier => Make_Defining_Identifier (Map_C_Variable_Name (S, Port_N_Dest => True)), Array_Size => Make_Defining_Identifier (Map_C_Define_Name (S, Nb_Ports => True))), Used_Type => RE (RE_Uint8_T)), Operator => Op_Equal, Right_Expr => N_Dest_Values); Append_Node_To_List (N, CTN.Declarations (Current_File)); N := Make_Expression (Left_Expr => Make_Variable_Declaration (Defining_Identifier => Make_Array_Declaration (Defining_Identifier => Make_Defining_Identifier (Map_C_Variable_Name (S, Port_Fifo_Size => True)), Array_Size => Make_Defining_Identifier (Map_C_Define_Name (S, Nb_Ports => True))), Used_Type => RE (RE_Int8_T)), Operator => Op_Equal, Right_Expr => Fifo_Size_Values); Append_Node_To_List (N, CTN.Declarations (Current_File)); N := Make_Expression (Left_Expr => Make_Variable_Declaration (Defining_Identifier => Make_Array_Declaration (Defining_Identifier => Make_Defining_Identifier (Map_C_Variable_Name (S, Port_Destinations => True)), Array_Size => Make_Defining_Identifier (Map_C_Define_Name (S, Nb_Ports => True))), Used_Type => Make_Pointer_Type (RE (RE_Uint8_T))), Operator => Op_Equal, Right_Expr => Destinations_Values); Append_Node_To_List (N, CTN.Declarations (Current_File)); Append_Node_To_List (Make_Switch_Alternative (No_List, No_List), Deliver_Alternatives); if Has_Local_Deliver then N := Make_Switch_Statement (Expression => Make_Member_Designator (Defining_Identifier => Make_Defining_Identifier (MN (M_Port)), Aggregate_Name => Make_Defining_Identifier (VN (V_Request)), Is_Pointer => True), Alternatives => Deliver_Alternatives); Append_Node_To_List (N, Deliver_Statements); -- Make the deliver function specific to a thread N := Make_Function_Implementation (CTN.Global_Port_Node (Backend_Node (Identifier (S))), Deliver_Declarations, Deliver_Statements); Append_Node_To_List (N, CTN.Declarations (Current_File)); -- Add a switch alternative to the main deliver -- in order to used our local delivery function. Parameters := New_List (CTN.K_Parameter_List); Switch_Statements := New_List (CTN.K_Statement_List); Switch_Labels := New_List (CTN.K_Label_List); Append_Node_To_List (Make_Defining_Identifier (Map_C_Enumerator_Name (S, Entity => True)), Switch_Labels); Append_Node_To_List (Make_Variable_Address (Make_Defining_Identifier (VN (V_Request))), Parameters); N := Make_Call_Profile (Defining_Identifier => Map_Task_Deliver_Identifier (S), Parameters => Parameters); Append_Node_To_List (N, Switch_Statements); N := Make_Switch_Alternative (Switch_Labels, Switch_Statements); Append_Node_To_List (N, Main_Deliver_Alternatives); end if; end if; N := Task_Job_Body (E); Append_Node_To_List (N, CTN.Declarations (Current_File)); end Visit_Thread_Instance; end Source_File; end Ocarina.Generators.PO_HI_C.Activity;