* generate a new function in activity.c : __po_hi_send_output

   This function sends the request of each thread using
   appropriate drivers functions.



git-svn-id: https://tecsw.estec.esa.int/svn/taste/trunk/ocarina@534 129961e7-ef38-4bb5-a8f7-c9a525a55882

src/backends/ocarina-backends-c_tree-nutils.ads

@@ -159,7 +159,9 @@ package Ocarina.Backends.C_Tree.Nutils is
       P_Msg,
       P_Request,
       P_Status,
+      P_Entity,
       P_Partition,
+      P_Port,
       P_Error,
       P_Offset,
       P_Self,

src/backends/ocarina-backends-po_hi_c-activity.adb

@@ -65,6 +65,8 @@ package body Ocarina.Backends.PO_HI_C.Activity is
    package CTU renames Ocarina.Backends.C_Tree.Nutils;
    package CV renames Ocarina.Backends.C_Values;
 
+   Send_Output_Specification : Node_Id;
+
    ------------
    -- Header --
    ------------
@@ -80,7 +82,8 @@ package body Ocarina.Backends.PO_HI_C.Activity is
       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;
+      Have_Main_Deliver          : Boolean := False;
+      Has_Send_Output_Declared   : Boolean := False;
 
       -------------------
       -- Task_Job_Spec --
@@ -193,7 +196,8 @@ package body Ocarina.Backends.PO_HI_C.Activity is
          Push_Entity (U);
          Set_Activity_Header (U);
 
-         Have_Main_Deliver := False;
+         Have_Main_Deliver          := False;
+         Has_Send_Output_Declared   := False;
 
          if not AAU.Is_Empty (Subcomponents (E)) then
             S := First_Node (Subcomponents (E));
@@ -337,6 +341,29 @@ package body Ocarina.Backends.PO_HI_C.Activity is
             N := Task_Deliver_Spec (E);
             Append_Node_To_List (N, CTN.Declarations (Current_File));
             Bind_AADL_To_Global_Port (Identifier (S), N);
+
+            N := Task_Deliver_Spec (E);
+
+            if Has_Output_Ports (E) and then
+               Has_Send_Output_Declared = False then
+               Send_Output_Specification := Make_Function_Specification
+                 (Defining_Identifier => RE (RE_Send_Output),
+                  Parameters          => Make_List_Id
+                     (Make_Parameter_Specification
+                        (Defining_Identifier =>
+                           Make_Defining_Identifier (PN (P_Entity)),
+                        Parameter_Type => RE (RE_Entity_T)),
+                     Make_Parameter_Specification
+                        (Defining_Identifier =>
+                           Make_Defining_Identifier (PN (P_Port)),
+                        Parameter_Type => RE (RE_Port_T))),
+                  Return_Type         => New_Node (CTN.K_Void));
+               Append_Node_To_List
+                  (Send_Output_Specification,
+                  CTN.Declarations (Current_File));
+
+               Has_Send_Output_Declared := True;
+            end if;
          end if;
 
          case P is
@@ -391,7 +418,11 @@ package body Ocarina.Backends.PO_HI_C.Activity is
       --  Create the parameterless subprogram body that does the
       --  thread's job.
 
-      Main_Deliver_Alternatives : List_Id;
+      Main_Deliver_Alternatives     : List_Id;
+      Has_Send_Output_Declared      : Boolean := False;
+      Send_Output_Statements        : List_Id;
+      Send_Output_Declarations      : List_Id;
+      Send_Output_Alternatives      : List_Id;
 
       Current_Device : Node_Id := No_Node;
 
@@ -718,10 +749,13 @@ package body Ocarina.Backends.PO_HI_C.Activity is
          -------------------------
 
          procedure Make_Send_Out_Ports is
-            N : Node_Id;
-            F : Node_Id;
-            Error_Already_Defined : Boolean := False;
-
+            N                       : Node_Id;
+            F                       : Node_Id;
+            Send_Alternative_Label  : constant List_Id
+                  := New_List (CTN.K_Label_List);
+            Send_Alternative_Stmts  : constant List_Id
+                  := New_List (CTN.K_Statement_List);
+            Error_Already_Defined   : Boolean := False;
          begin
             N := Message_Comment ("Send the OUT ports");
             Append_Node_To_List (N, WStatements);
@@ -730,6 +764,29 @@ package body Ocarina.Backends.PO_HI_C.Activity is
 
             while Present (F) loop
                if Kind (F) = K_Port_Spec_Instance and then Is_Out (F) then
+                  Has_Send_Output_Declared := True;
+
+                  Append_Node_To_List
+                    (Make_Defining_Identifier
+                     (Map_C_Enumerator_Name (F)),
+                     Send_Alternative_Label);
+
+                  Append_Node_To_List
+                     (CTU.Make_Call_Profile
+                        (RE (RE_Protocols_Send_Default),
+                        Make_List_Id
+                           (Make_Defining_Identifier (VN (V_Entity)),
+                           Make_Defining_Identifier (PN (P_Port)))),
+                     Send_Alternative_Stmts);
+
+                  N := Make_Switch_Alternative
+                    (Send_Alternative_Label, Send_Alternative_Stmts);
+                  Append_Node_To_List (N, Send_Output_Alternatives);
+
+                  --  Generate appropriate source code to deliver
+                  --  the message when we send it.
+
+                  --  Then, call the send_output in the main loop.
                   Call_Parameters := New_List (CTN.K_Parameter_List);
                   N := Make_Defining_Identifier
                     (Map_C_Enumerator_Name (S));
@@ -739,8 +796,9 @@ package body Ocarina.Backends.PO_HI_C.Activity is
                     (Map_C_Enumerator_Name (F));
                   Append_Node_To_List (N, Call_Parameters);
 
-                  N := CTU.Make_Call_Profile (RE (RE_Gqueue_Send_Output),
+                  N := CTU.Make_Call_Profile (RE (RE_Send_Output),
                                               Call_Parameters);
+
                   if Get_Miss_Rate (F) /= 0 then
                      --  XXX is this required ? from PolyORB-HI/C,
                      --  looks like it is some hack to add fake miss
@@ -1380,6 +1438,11 @@ package body Ocarina.Backends.PO_HI_C.Activity is
 
          Main_Deliver_Alternatives := New_List (CTN.K_Alternatives_List);
 
+         Has_Send_Output_Declared      := False;
+         Send_Output_Statements        := New_List (CTN.K_Statement_List);
+         Send_Output_Declarations      := New_List (CTN.K_Declaration_List);
+         Send_Output_Alternatives      := New_List (CTN.K_Alternatives_List);
+
          --  Visit all the subcomponents of the process
 
          if not AAU.Is_Empty (Subcomponents (E)) then
@@ -1513,6 +1576,39 @@ package body Ocarina.Backends.PO_HI_C.Activity is
             Append_Node_To_List (N, CTN.Declarations (Current_File));
          end if;
 
+         if Has_Send_Output_Declared then
+            Append_Node_To_List
+               (Make_Switch_Alternative
+                  (No_List,
+                  Make_List_Id (CTU.Make_Call_Profile
+                     (RE (RE_Protocols_Send_Default),
+                     Make_List_Id
+                        (Make_Defining_Identifier (VN (V_Entity)),
+                        Make_Defining_Identifier (PN (P_Port)))))),
+               Send_Output_Alternatives);
+
+            Append_Node_To_List
+               (Message_Comment
+                  ("By default, we try to use the default protocol"),
+               Send_Output_Alternatives);
+
+            Append_Node_To_List
+               (Make_Switch_Statement
+                  (Expression    => Make_Defining_Identifier (VN (V_Port)),
+                  Alternatives   => Send_Output_Alternatives),
+               Send_Output_Statements);
+
+            N := Make_Function_Implementation
+               (Send_Output_Specification,
+               Send_Output_Declarations,
+               Send_Output_Statements);
+
+            Append_Node_To_List (N, CTN.Declarations (Current_File));
+         end if;
+         --  If some threads are connected to other nodes, we declare
+         --  a send_output function that is responsible to send
+         --  data over the network using device drivers functions.
+
          --  Visit all devices attached to the parent system that
          --  share the same processor as process E.
 

src/backends/ocarina-backends-po_hi_c-runtime.ads

@@ -106,6 +106,7 @@ package Ocarina.Backends.PO_HI_C.Runtime is
       RE_Unmarshall_Port,                -- __po_hi_unmarshall_port
       RE_Marshall_Array,                 -- __po_hi_marshall_array
       RE_Unmarshall_Array,               -- __po_hi_unmarshall_array
+      RE_Send_Output,                    -- __po_hi_send_output
       RE_Gqueue_Init,                    -- __po_hi_gqueue_init
       RE_Gqueue_Store_In,                -- __po_hi_gqueue_store_in
       RE_Gqueue_Store_Out,               -- __po_hi_gqueue_store_out
@@ -120,6 +121,7 @@ package Ocarina.Backends.PO_HI_C.Runtime is
       RE_Compute_Miss,                   -- __po_hi_compute_miss
       RE_Sporadic_Wait_Release,          -- __po_hi_sporadic_wait_release
       RE_Protocols_Send,                 -- __po_hi_protocols_send
+      RE_Protocols_Send_Default,         -- __po_hi_protocols_send_default
       RE_Main_Deliver,                   -- __po_hi_main_deliver
       RE_Protocols_Receive,              -- __po_hi_protocols_receive
       RE_Protocols_Nonblocking_Receive,  -- __po_hi_protocols_receive
@@ -202,6 +204,7 @@ package Ocarina.Backends.PO_HI_C.Runtime is
          RE_Seconds                        => RH_PO_HI_Time,
          RE_Minutes                        => RH_PO_HI_Time,
          RE_Protocols_Send                 => RH_PO_HI_Protocols,
+         RE_Protocols_Send_Default         => RH_PO_HI_Protocols,
          RE_Protocols_Receive              => RH_PO_HI_Protocols,
          RE_Protocols_Nonblocking_Receive  => RH_PO_HI_Protocols,
          RE_Unused_Node                    => RH_PO_HI_Types,
@@ -252,6 +255,7 @@ package Ocarina.Backends.PO_HI_C.Runtime is
          RE_Protected_Lock                 => RH_PO_HI_Protected,
          RE_Protected_Unlock               => RH_PO_HI_Protected,
          RE_Copy_Array                     => RH_PO_HI_Types,
+         RE_Send_Output                    => RH_Activity,
          RE_Gqueue_Store_In                => RH_PO_HI_Gqueue,
          RE_Gqueue_Store_Out               => RH_PO_HI_Gqueue,
          RE_Gqueue_Send_Output             => RH_PO_HI_Gqueue,

src/backends/ocarina-backends-utils.adb

@@ -560,6 +560,52 @@ package body Ocarina.Backends.Utils is
       return False;
    end Has_Ports;
 
+   ----------------------
+   -- Has_Output_Ports --
+   ----------------------
+
+   function Has_Output_Ports (E : Node_Id) return Boolean is
+      F : Node_Id;
+   begin
+      if not AAU.Is_Empty (Features (E)) then
+         F := First_Node (Features (E));
+
+         while Present (F) loop
+            if Kind (F) = K_Port_Spec_Instance and then
+               Is_Out (F) then
+               return True;
+            end if;
+
+            F := Next_Node (F);
+         end loop;
+      end if;
+
+      return False;
+   end Has_Output_Ports;
+
+   ---------------------
+   -- Has_Input_Ports --
+   ---------------------
+
+   function Has_Input_Ports (E : Node_Id) return Boolean is
+      F : Node_Id;
+   begin
+      if not AAU.Is_Empty (Features (E)) then
+         F := First_Node (Features (E));
+
+         while Present (F) loop
+            if Kind (F) = K_Port_Spec_Instance and then
+               Is_In (F) then
+               return True;
+            end if;
+
+            F := Next_Node (F);
+         end loop;
+      end if;
+
+      return False;
+   end Has_Input_Ports;
+
    ---------------
    -- Has_Modes --
    ---------------

src/backends/ocarina-backends-utils.ads

@@ -111,6 +111,14 @@ package Ocarina.Backends.Utils is
    --  Return True IFF the component instance E contains at least one
    --  port.
 
+   function Has_Output_Ports (E : Node_Id) return Boolean;
+   --  Return True IFF the component instance E contains at least one
+   --  output port.
+
+   function Has_Input_Ports (E : Node_Id) return Boolean;
+   --  Return True IFF the component instance E contains at least one
+   --  input port.
+
    function Has_Modes (E : Node_Id) return Boolean;
    --  Return True IFF the entity instance E has AADL operational
    --  modes.