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