From f3f394392060e3ebe7e43476f8e1662c77ca0970 Mon Sep 17 00:00:00 2001 From: Maxime Perrotin Date: Sun, 26 Mar 2017 23:29:00 +0200 Subject: [PATCH] Work on the new AST --- ada/buildsupport.adb | 833 ++++++++++++++++++------------------- ada/buildsupport_utils.adb | 36 +- ada/buildsupport_utils.ads | 77 +++- buildsupport.gpr | 9 +- 4 files changed, 482 insertions(+), 473 deletions(-) diff --git a/ada/buildsupport.adb b/ada/buildsupport.adb index b7e45d7..ab074dc 100644 --- a/ada/buildsupport.adb +++ b/ada/buildsupport.adb @@ -185,458 +185,447 @@ procedure BuildSupport is if Get_Category_Of_Component (CI) = CC_System then -- Call C function "New_FV" and set the language + -- Read the implementation language of the current + -- FV from the Source_Language property - C_New_FV - (Get_Name_String (Name (Identifier (Current_Function))), - Get_Name_String - (Name (Identifier (Current_Function)))'Length, - Get_Name_String (Display_Name (Identifier - (Current_Function)))); - - -- Read the implementation language of the current - -- FV from the Source_Language property - - declare - Source_Language : constant Supported_Source_Language - := Get_Source_Language (CI); - begin - case Source_Language is - when Language_Ada_95 => C_Set_Language_To_Ada; - when Language_C => C_Set_Language_To_C; - when Language_CPP => C_Set_Language_To_CPP; - when Language_VDM => C_Set_Language_To_VDM; - when Language_SDL_OpenGEODE => C_Set_Language_To_SDL; - when Language_Scade => C_Set_Language_To_Scade; - when Language_Lustre => C_Set_Language_To_Scade; - when Language_SDL => C_Set_Language_To_SDL; - when Language_SDL_RTDS => C_Set_Language_To_RTDS; - when Language_Simulink => C_Set_Language_To_Simulink; - when Language_Rhapsody => C_Set_Language_To_Rhapsody; - when Language_Gui => C_Set_Language_To_GUI; - when Language_VHDL => C_Set_Language_To_VHDL; - when Language_System_C => C_Set_Language_To_System_C; - when Language_Device => - C_Set_Language_To_BlackBox_Device; - when Language_QGenAda => C_Set_Language_To_QGenAda; - when Language_QGenC => C_Set_Language_To_QGenC; - when others => C_Set_Language_To_Other; - end case; - end; - declare - SourceText : constant Name_Array := - Get_Source_Text (CI); - ZipId : Name_Id := No_Name; - begin - if SourceText'Length /= 0 then - ZipId := SourceText (1); - end if; - if ZipId /= No_Name then - C_Set_Zipfile (Get_Name_String (ZipId), - Get_Name_String (ZipId)'Length); + declare + -- Read the name of the function + FV_Name_L : constant String := ATN_Lower (Current_Function); + FV_Name : constant String := ATN_Case (Current_Function); + -- Read the source language + Source_Language : constant Supported_Source_Language := + Get_Source_Language (CI); + -- To get the zipfile name where user code is stored + SourceText : constant Name_Array := Get_Source_Text (CI); + ZipId : Name_Id := No_Name; + begin + C_New_FV (FV_Name_L, FV_Name'Length, FV_Name); + + case Source_Language is + when Language_Ada_95 => C_Set_Language_To_Ada; + when Language_C => C_Set_Language_To_C; + when Language_CPP => C_Set_Language_To_CPP; + when Language_VDM => C_Set_Language_To_VDM; + when Language_SDL_OpenGEODE => C_Set_Language_To_SDL; + when Language_Scade => C_Set_Language_To_Scade; + when Language_Lustre => C_Set_Language_To_Scade; + when Language_SDL => C_Set_Language_To_SDL; + when Language_SDL_RTDS => C_Set_Language_To_RTDS; + when Language_Simulink => C_Set_Language_To_Simulink; + when Language_Rhapsody => C_Set_Language_To_Rhapsody; + when Language_Gui => C_Set_Language_To_GUI; + when Language_VHDL => C_Set_Language_To_VHDL; + when Language_System_C => C_Set_Language_To_System_C; + when Language_Device => + C_Set_Language_To_BlackBox_Device; + when Language_QGenAda => C_Set_Language_To_QGenAda; + when Language_QGenC => C_Set_Language_To_QGenC; + when others => Exit_On_Error (True, + "Language is currently not supported: " + & Source_Language'Img); + end case; + + -- Retrieve the ZIP file (optionally set by the user) + if SourceText'Length /= 0 then + ZipId := SourceText (1); + end if; + if ZipId /= No_Name then + C_Set_Zipfile (Get_Name_String (ZipId), + Get_Name_String (ZipId)'Length); + end if; + end; + + -- Parse the functional states of this FV + if not Is_Empty (Subcomponents (CI)) then + FV_Subco := First_Node (Subcomponents (CI)); + while Present (FV_Subco) loop + if Get_Category_Of_Component (FV_Subco) = CC_Data + then + -- Check that the value of the FS is set + Exit_On_Error (Get_String_Property + (Corresponding_Instance (FV_Subco), + "taste::fs_default_value") = No_Name, + "Error: Missing value for context parameter " & + Get_Name_String + (Name (Identifier (FV_Subco))) & + " in function " & + Get_Name_String + (Name (Identifier (Current_Function)))); + declare + -- Name of the variable + FS_name : constant String := + Get_Name_String (Name (Identifier (FV_Subco))); + -- Name of the variable respecting case + FS_fullname : constant String := + Get_Name_String (Display_Name (Identifier + (FV_Subco))); + -- ASN.1 type + Asn1type : constant Node_Id := + Corresponding_Instance (FV_Subco); + + FS_type : constant String := + Get_Name_String + (Get_Type_Source_Name (Asn1type)); + -- Variable default value + FS_value : constant String := + Get_Name_String (Get_String_Property + (Asn1type, "taste::fs_default_value")); + FS_module : constant String := + Get_ASN1_Module_Name (Asn1type); + -- ASN.1 filename + NA : constant Name_Array := + Get_Source_Text (Asn1type); + FS_File : Unbounded_String; + -- For the Ada AST: + CP : Context_Parameter; + begin + -- Some special DATA components have no + -- Source_Text property in DataView.aadl + -- (TASTE-Directive and Tunable Parameter) + if NA'Length > 0 then + FS_File := US (Get_Name_String (NA (1))); + else + FS_File := US ("dummy"); + end if; + C_Set_Context_Variable + (FS_name, FS_name'Length, + FS_type, FS_type'Length, + FS_value, FS_value'Length, + FS_module, FS_module'Length, + To_String (FS_file), + To_String (FS_file)'Length, + FS_Fullname); + CP := (Name => US (FS_Fullname), + Sort => US (FS_type), + Default_Value => US (FS_value), + ASN1_Module => US (FS_module), + ASN1_File_Name => FS_file); + end; end if; - end; + FV_Subco := Next_Node (FV_Subco); + end loop; + end if; + + -- Parse the interfaces of the FV + if not Is_Empty (Features (CI)) then + If_I := First_Node (Features (CI)); - -- Parse the functional states of this FV - if not Is_Empty (Subcomponents (CI)) then - FV_Subco := First_Node (Subcomponents (CI)); - while Present (FV_Subco) loop - if Get_Category_Of_Component (FV_Subco) = CC_Data + while Present (If_I) loop + Sub_I := Get_RCM_Operation (If_I); + + if Present (Sub_I) then + -- Call backend Add_PI or Add_RI and for each + -- parameter call C function Add_In_Param or + -- Add_Out_Param + if Is_Subprogram_Access (If_I) and + Is_Provided (If_I) then - -- Check that the value of the FS is set - Exit_On_Error (Get_String_Property - (Corresponding_Instance (FV_Subco), - "taste::fs_default_value") = No_Name, - "Error: Missing value for context parameter " & - Get_Name_String - (Name (Identifier (FV_Subco))) & - " in function " & - Get_Name_String - (Name (Identifier (Current_Function)))); declare - -- Name of the variable - FS_name : constant String := - Get_Name_String (Name (Identifier (FV_Subco))); - -- Name of the variable respecting case - FS_fullname : constant String := - Get_Name_String (Display_Name (Identifier - (FV_Subco))); - -- ASN.1 type - Asn1type : constant Node_Id := - Corresponding_Instance (FV_Subco); - - FS_type : constant String := - Get_Name_String - (Get_Type_Source_Name (Asn1type)); - -- Variable default value - FS_value : constant String := - Get_Name_String (Get_String_Property - (Asn1type, "taste::fs_default_value")); - FS_module : constant String := - Get_ASN1_Module_Name (Asn1type); - -- ASN.1 filename - NA : constant Name_Array := - Get_Source_Text (Asn1type); - FS_File : Unbounded_String; + PI_string : String := + Get_Name_string + (Display_Name (Identifier (If_I))); + PI_Name : Name_Id; begin - -- Some special DATA components have no - -- Source_Text property in DataView.aadl - -- (TASTE-Directive and Tunable Parameter) - if NA'Length > 0 then - FS_File := To_Unbounded_String - (Get_Name_String (NA (1))); + PI_Name := Get_Interface_Name (If_I); + if PI_Name /= No_Name then + C_Add_PI (Get_Name_String (PI_Name), + Get_Name_String (PI_Name)'Length); else - FS_File := To_Unbounded_String ("dummy"); + -- Keep compatibility with V1.2 + if not Keep_case then + PI_string := to_lower (PI_string); + end if; + C_Add_PI (PI_String, PI_String'Length); end if; - C_Set_Context_Variable - (FS_name, FS_name'Length, - FS_type, FS_type'Length, - FS_value, FS_value'Length, - FS_module, FS_module'Length, - To_String (FS_file), - To_String (FS_file)'Length, - FS_Fullname); end; - end if; - FV_Subco := Next_Node (FV_Subco); - end loop; - end if; - - -- Parse the interfaces of the FV - if not Is_Empty (Features (CI)) then - If_I := First_Node (Features (CI)); - while Present (If_I) loop - Sub_I := Get_RCM_Operation (If_I); + if Kind (If_I) = K_Subcomponent_Access_Instance + and then + Is_Defined_Property + (Corresponding_Instance (If_I), + "taste::associated_queue_size") + then + C_Set_Interface_Queue_Size + (Get_Integer_Property + (Corresponding_Instance (If_I), + "taste::associated_queue_size")); + end if; - if Present (Sub_I) then - -- Call backend Add_PI or Add_RI and for each - -- parameter call C function Add_In_Param or - -- Add_Out_Param - if Is_Subprogram_Access (If_I) and - Is_Provided (If_I) + -- Set Provided Interface RCM kind + -- (cyclic, sporadic, etc). + Operation_Kind := Get_RCM_Operation_Kind (If_I); + + case Operation_Kind is + when Cyclic_Operation => + C_Set_Cyclic_IF; + + when Sporadic_Operation => + C_Set_Sporadic_IF; + + when Protected_Operation => + C_Set_Protected_IF; + + when Unprotected_Operation => + C_Set_Unprotected_IF; + end case; + + -- Set the period or MIAT of the PI + C_Set_Period (Get_RCM_Period (If_I)); + + -- Set the WCET of the PI + if Is_Subprogram_Access (If_I) and then + Sources (If_I) /= No_List and then + First_Node (Sources (If_I)) /= No_Node + and then + Get_Execution_Time + (Corresponding_Instance + (Item + (First_Node (Sources (If_I))))) + /= Empty_Time_Array then declare - PI_string : String := - Get_Name_string - (Display_Name (Identifier (If_I))); - PI_Name : Name_Id; + use Ocarina.Backends.Utils; + Exec_Time : constant Time_Array := + Get_Execution_Time + (Corresponding_Instance + (Item + (First_Node (Sources (If_I))))); begin - PI_Name := Get_Interface_Name (If_I); - if PI_Name /= No_Name then - C_Add_PI (Get_Name_String (PI_Name), - Get_Name_String (PI_Name)'Length); - else - -- Keep compatibility with V1.2 - if not Keep_case then - PI_string := to_lower (PI_string); - end if; - C_Add_PI (PI_String, PI_String'Length); - end if; + C_Set_Compute_Time + (To_Milliseconds (Exec_Time (0)), "ms", 2, + To_Milliseconds (Exec_Time (1)), "ms", 2); end; + else + C_Set_Compute_Time (0, "ms", 2, 0, "ms", 2); + -- Default ! + end if; - if Kind (If_I) = K_Subcomponent_Access_Instance - and then - Is_Defined_Property - (Corresponding_Instance (If_I), - "taste::associated_queue_size") - then - C_Set_Interface_Queue_Size - (Get_Integer_Property - (Corresponding_Instance (If_I), - "taste::associated_queue_size")); - end if; - - -- Set Provided Interface RCM kind - -- (cyclic, sporadic, etc). - Operation_Kind := Get_RCM_Operation_Kind (If_I); - - case Operation_Kind is - when Cyclic_Operation => - C_Set_Cyclic_IF; - - when Sporadic_Operation => - C_Set_Sporadic_IF; - - when Variator_Operation - | Modifier_Operation => - C_Set_Variator_IF; + -- Required interface: + elsif Is_Subprogram_Access (If_I) and + not (Is_Provided (If_I)) + then - when Protected_Operation => - C_Set_Protected_IF; + -- the name of the feature (RI identifier) is: + -- Get_Name_String (Name (Identifier (If_I))); - when Unprotected_Operation => - C_Set_Unprotected_IF; + -- Find the distant PI connected to this RI + -- and the distant function - when others => - C_Set_UndefinedKind_IF; - end case; + Distant_Fv := No_Node; - -- Set the period or MIAT of the PI - C_Set_Period (Get_RCM_Period (If_I)); + if Present (Connections (My_System)) then + Connection_I := First_Node + (Connections (My_System)); + else + Connection_I := No_Node; + end if; - -- Set the WCET of the PI - if Is_Subprogram_Access (If_I) and then - Sources (If_I) /= No_List and then - First_Node (Sources (If_I)) /= No_Node - and then - Get_Execution_Time - (Corresponding_Instance - (Item - (First_Node (Sources (If_I))))) - /= Empty_Time_Array + while Present (Connection_I) loop + if Corresponding_instance + (Get_Referenced_Entity + (Source (Connection_I))) = + Corresponding_Instance (If_I) then - declare - use Ocarina.Backends.Utils; - Exec_Time : constant Time_Array := - Get_Execution_Time - (Corresponding_Instance - (Item - (First_Node (Sources (If_I))))); - begin - C_Set_Compute_Time - (To_Milliseconds (Exec_Time (0)), "ms", 2, - To_Milliseconds (Exec_Time (1)), "ms", 2); - end; + Distant_FV := Item (First_Node + (Path + (Source + (Connection_I)))); + -- Get InterfaceName property if any + Distant_PI_Name := Get_Interface_Name + (Get_Referenced_Entity ( + Source (Connection_I))); + -- Get RCM kind from remote PI + Operation_Kind := + Get_RCM_Operation_Kind + (Get_Referenced_Entity + (Source (Connection_I))); + end if; + Connection_I := Next_Node (Connection_I); + end loop; + -- Found Distant PI name and distant function + + RI_To_Add := Corresponding_Instance (If_I); + -- a RI can have a local name which is different + -- from the name of the PI it is connected to. + Local_RI_Name := Get_Interface_Name (If_I); + if Local_RI_Name = No_Name + or Distant_PI_Name = No_Name + then + if Keep_case then + Local_RI_Name := + Display_Name (Identifier (If_I)); + Distant_PI_Name := + Display_Name (Identifier (RI_To_Add)); else - C_Set_Compute_Time (0, "ms", 2, 0, "ms", 2); - -- Default ! + Local_RI_Name := + Name (Identifier (If_I)); + Distant_PI_Name := + Name (Identifier (RI_To_Add)); end if; + end if; + -- The 3 arguments to C_Add_RI are: + -- (1) the name of the local RI (feature) + -- (2) the name of the distant function + -- (3) the name of the corresponding PI + if Present (Distant_FV) then + C_Add_RI + (Get_Name_String (Local_RI_Name), + Get_Name_String (Local_RI_Name)'Length, + Get_Name_String + (Name (Identifier (Distant_FV))), + Get_Name_String + (Name + (Identifier (Distant_FV)))'Length, + Get_Name_String (Distant_PI_Name), + Get_Name_String (Distant_PI_Name)'Length); + else + C_Add_RI + (Get_Name_String (Local_RI_Name), + Get_Name_String (Local_RI_Name)'Length, + Get_Name_String (Local_RI_Name), + 0, + Get_Name_String (Local_RI_Name), + Get_Name_String (Local_RI_Name)'Length); + end if; - -- Required interface: - elsif Is_Subprogram_Access (If_I) and - not (Is_Provided (If_I)) - then + case Operation_Kind is + when Sporadic_Operation => + C_Set_ASync_IF; + C_Set_Sporadic_IF; - -- the name of the feature (RI identifier) is: - -- Get_Name_String (Name (Identifier (If_I))); + when Protected_Operation => + C_Set_Sync_IF; + C_Set_Protected_IF; - -- Find the distant PI connected to this RI - -- and the distant function + when Unprotected_Operation => + C_Set_Sync_IF; + C_Set_Unprotected_IF; - Distant_Fv := No_Node; + when others => + Exit_On_Error (True, + "Unsupported kind of RI: " + & Get_Name_String (Local_RI_Name)); + end case; + end if; - if Present (Connections (My_System)) then - Connection_I := First_Node - (Connections (My_System)); - else - Connection_I := No_Node; - end if; + -- Parse the list of parameters - while Present (Connection_I) loop - if Corresponding_instance - (Get_Referenced_Entity - (Source (Connection_I))) = - Corresponding_Instance (If_I) - then - Distant_FV := Item (First_Node - (Path - (Source - (Connection_I)))); - -- Get InterfaceName property if any - Distant_PI_Name := Get_Interface_Name - (Get_Referenced_Entity ( - Source (Connection_I))); - -- Get RCM kind from remote PI - Operation_Kind := - Get_RCM_Operation_Kind - (Get_Referenced_Entity - (Source (Connection_I))); - end if; - Connection_I := Next_Node (Connection_I); - end loop; - -- Found Distant PI name and distant function - - RI_To_Add := Corresponding_Instance (If_I); - -- a RI can have a local name which is different - -- from the name of the PI it is connected to. - Local_RI_Name := Get_Interface_Name (If_I); - if Local_RI_Name = No_Name - or Distant_PI_Name = No_Name - then - if Keep_case then - Local_RI_Name := - Display_Name (Identifier (If_I)); - Distant_PI_Name := - Display_Name (Identifier (RI_To_Add)); - else - Local_RI_Name := - Name (Identifier (If_I)); - Distant_PI_Name := - Name (Identifier (RI_To_Add)); - end if; - end if; - -- The 3 arguments to C_Add_RI are: - -- (1) the name of the local RI (feature) - -- (2) the name of the distant function - -- (3) the name of the corresponding PI - if Present (Distant_FV) then - C_Add_RI - (Get_Name_String (Local_RI_Name), - Get_Name_String (Local_RI_Name)'Length, - Get_Name_String - (Name (Identifier (Distant_FV))), - Get_Name_String - (Name - (Identifier (Distant_FV)))'Length, - Get_Name_String (Distant_PI_Name), - Get_Name_String (Distant_PI_Name)'Length); - else - C_Add_RI - (Get_Name_String (Local_RI_Name), - Get_Name_String (Local_RI_Name)'Length, - Get_Name_String (Local_RI_Name), - 0, - Get_Name_String (Local_RI_Name), - Get_Name_String (Local_RI_Name)'Length); - end if; + if not Is_Empty (Features (Sub_I)) then + Param_I := First_Node (Features (Sub_I)); - -- inform C-code about the kind of PI it is - -- (cyclic, sporadic, etc). Important: Has - -- to be updated in case of several - -- SPORADIC... - - case Operation_Kind is - when Sporadic_Operation => - C_Set_ASync_IF; - C_Set_Sporadic_IF; - - when Variator_Operation - | Modifier_Operation => - C_Set_ASync_IF; - C_Set_Variator_IF; - - when Protected_Operation => - C_Set_Sync_IF; - C_Set_Protected_IF; - - when Unprotected_Operation => - C_Set_Sync_IF; - C_Set_Unprotected_IF; - - when others => - C_Set_ASync_IF; - C_Set_UndefinedKind_IF; - end case; - end if; + while Present (Param_I) loop + if Kind (Param_I) = K_Parameter_Instance then + Asntype := Corresponding_Instance + (Param_I); - -- Parse the list of parameters - - if not Is_Empty (Features (Sub_I)) then - Param_I := First_Node (Features (Sub_I)); - - while Present (Param_I) loop - if Kind (Param_I) = K_Parameter_Instance then - Asntype := Corresponding_Instance - (Param_I); - - declare - NA : constant Name_Array - := Get_Source_Text (Asntype); - begin - ASN1_Filename := NA (1); - end; - - Exit_On_Error - (ASN1_Filename = No_Name, - "Error: Source_Text not defined"); - - Len_Name := Get_Name_String - (Name (Identifier (Param_I)))'Length; - Len_Type := Get_Name_String - (Name (Identifier (Asntype)))'Length; - ASN1_Module := Get_Ada_Package_Name - (Asntype); - Exit_On_Error - (ASN1_Module = No_Name, - "Error: Data Model is incorrect."); - - if Is_In (Param_I) then - C_Add_In_Param - (Get_Name_String - (Display_Name - (Identifier (Param_I))), - Len_Name, - Get_Name_String - (Get_Type_Source_Name (Asntype)), - Len_Type, - Get_Name_String (ASN1_Module), - Get_Name_String - (ASN1_Module)'Length, - Get_Name_String (ASN1_Filename), - Get_Name_String - (ASN1_Filename)'Length); - else - C_Add_Out_Param - (Get_Name_String - (Display_Name - (Identifier (Param_I))), - Len_Name, - Get_Name_String - (Get_Type_Source_Name (Asntype)), - Len_Type, - Get_Name_String (ASN1_Module), - Get_Name_String - (ASN1_Module)'Length, - Get_Name_String (ASN1_Filename), - Get_Name_String - (ASN1_Filename)'Length); - end if; - - -- Get the Encoding property: - - Encoding := Get_ASN1_Encoding (Param_I); - case Encoding is - when Native => C_Set_Native_Encoding; - when UPER => C_Set_UPER_Encoding; - when ACN => C_Set_ACN_Encoding; - when others => null; - end case; - - -- Get ASN.1 basic type of the parameter - Basic_type := Get_ASN1_Basic_Type - (Asntype); - case Basic_Type is - pragma Style_Checks (Off); - when Asn1_Sequence => - C_Set_ASN1_BasicType_Sequence; - when ASN1_SequenceOf => - C_Set_ASN1_BasicType_SequenceOf; - when ASN1_Enumerated => - C_Set_ASN1_BasicType_Enumerated; - when ASN1_Set => - C_Set_ASN1_BasicType_Set; - when ASN1_SetOf => - C_Set_ASN1_BasicType_SetOf; - when ASN1_Integer => - C_Set_ASN1_BasicType_Integer; - when ASN1_Boolean => - C_Set_ASN1_BasicType_Boolean; - when ASN1_Real => - C_Set_ASN1_BasicType_Real; - when ASN1_OctetString => - C_Set_ASN1_BasicType_OctetString; - when ASN1_Choice => - C_Set_ASN1_BasicType_Choice; - when ASN1_String => - C_Set_ASN1_BasicType_String; - when others => - C_Set_ASN1_BasicType_Unknown; - pragma Style_Checks (On); - end case; + declare + NA : constant Name_Array + := Get_Source_Text (Asntype); + begin + ASN1_Filename := NA (1); + end; + + Exit_On_Error + (ASN1_Filename = No_Name, + "Error: Source_Text not defined"); + + Len_Name := Get_Name_String + (Name (Identifier (Param_I)))'Length; + Len_Type := Get_Name_String + (Name (Identifier (Asntype)))'Length; + ASN1_Module := Get_Ada_Package_Name + (Asntype); + Exit_On_Error + (ASN1_Module = No_Name, + "Error: Data Model is incorrect."); + + if Is_In (Param_I) then + C_Add_In_Param + (Get_Name_String + (Display_Name + (Identifier (Param_I))), + Len_Name, + Get_Name_String + (Get_Type_Source_Name (Asntype)), + Len_Type, + Get_Name_String (ASN1_Module), + Get_Name_String + (ASN1_Module)'Length, + Get_Name_String (ASN1_Filename), + Get_Name_String + (ASN1_Filename)'Length); + else + C_Add_Out_Param + (Get_Name_String + (Display_Name + (Identifier (Param_I))), + Len_Name, + Get_Name_String + (Get_Type_Source_Name (Asntype)), + Len_Type, + Get_Name_String (ASN1_Module), + Get_Name_String + (ASN1_Module)'Length, + Get_Name_String (ASN1_Filename), + Get_Name_String + (ASN1_Filename)'Length); end if; - Param_I := Next_Node (Param_I); - end loop; - end if; -- End processing parameters. + -- Get the Encoding property: + + Encoding := Get_ASN1_Encoding (Param_I); + case Encoding is + when Native => C_Set_Native_Encoding; + when UPER => C_Set_UPER_Encoding; + when ACN => C_Set_ACN_Encoding; + when others => null; + end case; + + -- Get ASN.1 basic type of the parameter + Basic_type := Get_ASN1_Basic_Type + (Asntype); + case Basic_Type is + pragma Style_Checks (Off); + when Asn1_Sequence => + C_Set_ASN1_BasicType_Sequence; + when ASN1_SequenceOf => + C_Set_ASN1_BasicType_SequenceOf; + when ASN1_Enumerated => + C_Set_ASN1_BasicType_Enumerated; + when ASN1_Set => + C_Set_ASN1_BasicType_Set; + when ASN1_SetOf => + C_Set_ASN1_BasicType_SetOf; + when ASN1_Integer => + C_Set_ASN1_BasicType_Integer; + when ASN1_Boolean => + C_Set_ASN1_BasicType_Boolean; + when ASN1_Real => + C_Set_ASN1_BasicType_Real; + when ASN1_OctetString => + C_Set_ASN1_BasicType_OctetString; + when ASN1_Choice => + C_Set_ASN1_BasicType_Choice; + when ASN1_String => + C_Set_ASN1_BasicType_String; + when others => + C_Set_ASN1_BasicType_Unknown; + pragma Style_Checks (On); + end case; + end if; - C_End_IF; - end if; + Param_I := Next_Node (Param_I); + end loop; + end if; -- End processing parameters. - If_I := Next_Node (If_I); - end loop; -- Go to next interface of this FV + C_End_IF; + end if; - end if; - C_End_FV; + If_I := Next_Node (If_I); + end loop; -- Go to next interface of this FV + + end if; + C_End_FV; end if; Current_Function := Next_Node (Current_Function); end loop; @@ -858,16 +847,14 @@ procedure BuildSupport is If2_Name := Get_Interface_Name (Dst_Port); -- Get_Interface_Name is v1.3.5+ only if If1_Name /= No_Name and If2_Name /= No_Name then - Src_Name := To_Unbounded_String (Get_Name_String (If1_Name)); - Dst_Name := To_Unbounded_String (Get_Name_String (If2_Name)); + Src_Name := US (Get_Name_String (If1_Name)); + Dst_Name := US (Get_Name_String (If2_Name)); else -- Keep compatibility with v1.2 - Src_Name := To_Unbounded_String (Get_Name_String - (Display_Name + Src_Name := US (Get_Name_String (Display_Name (Identifier (Src_Port)))); - Dst_Name := To_Unbounded_String (Get_Name_String - (Display_Name + Dst_Name := US (Get_Name_String (Display_Name (Identifier (Dst_Port)))); end if; -- Put_Line (To_String (Src_Name) & " -> " & To_String (Dst_Name)); @@ -1193,7 +1180,7 @@ procedure BuildSupport is Bound_APLC_Name : Unbounded_String; begin begin - Bound_APLC_Name := To_Unbounded_String + Bound_APLC_Name := US (Get_Name_String (ATN.Name (ATN.Component_Type_Identifier @@ -1202,7 +1189,7 @@ procedure BuildSupport is when System.Assertions.Assert_Failure => Put_Line ("Detected DV from TASTE version 1.2"); - Bound_APLC_Name := To_Unbounded_String + Bound_APLC_Name := US (Get_Name_String (Name (Identifier (Processes2)))); end; diff --git a/ada/buildsupport_utils.adb b/ada/buildsupport_utils.adb index ba4b806..77d878b 100644 --- a/ada/buildsupport_utils.adb +++ b/ada/buildsupport_utils.adb @@ -6,12 +6,11 @@ with Ada.Text_IO; with GNAT.OS_Lib; -- with Ocarina.Namet; -with Namet; with Ocarina.Configuration; with Ocarina.AADL_Values; with Ocarina.Instances.Queries; -with Ocarina.ME_AADL.AADL_Tree.Nodes; -with Ocarina.ME_AADL.AADL_Instances.Nodes; +-- with Ocarina.ME_AADL.AADL_Tree.Nodes; +-- with Ocarina.ME_AADL.AADL_Instances.Nodes; with Ocarina.ME_AADL.AADL_Instances.Nutils; with Ada.Characters.Latin_1; @@ -21,14 +20,13 @@ package body Buildsupport_Utils is use GNAT.OS_Lib; -- use Ocarina.Namet; - use Namet; use Ocarina.Instances.Queries; - use Ocarina.ME_AADL.AADL_Instances.Nodes; +-- use Ocarina.ME_AADL.AADL_Instances.Nodes; use Ocarina.ME_AADL.AADL_Instances.Nutils; use Ada.Characters.Latin_1; - package ATN renames Ocarina.ME_AADL.AADL_Tree.Nodes; - package AIN renames Ocarina.ME_AADL.AADL_Instances.Nodes; - use type ATN.Node_Kind; +-- package ATN renames Ocarina.ME_AADL.AADL_Tree.Nodes; +-- package AIN renames Ocarina.ME_AADL.AADL_Instances.Nodes; +-- use type ATN.Node_Kind; ------------ -- Banner -- @@ -115,8 +113,6 @@ package body Buildsupport_Utils is RCM_Operation_Kind : Name_Id; Unprotected_Name : Name_Id; Protected_Name : Name_Id; - Variator_Name : Name_Id; - Modifier_Name : Name_Id; Cyclic_Name : Name_Id; Sporadic_Name : Name_Id; @@ -136,12 +132,6 @@ package body Buildsupport_Utils is elsif RCM_Operation_Kind_N = Protected_Name then return Protected_Operation; - elsif RCM_Operation_Kind_N = Variator_Name then - return Variator_Operation; - - elsif RCM_Operation_Kind_N = Modifier_Name then - return Modifier_Operation; - elsif RCM_Operation_Kind_N = Cyclic_Name then return Cyclic_Operation; @@ -149,7 +139,7 @@ package body Buildsupport_Utils is return Sporadic_Operation; end if; end if; - return Unknown_Operation; + Exit_On_Error (True, "Could not determine interface kind"); end Get_RCM_Operation_Kind; ----------------------- @@ -256,10 +246,9 @@ package body Buildsupport_Utils is -- Input parameter is an AADL instance -- -------------------------------------------- function Get_Properties_Map (D : Node_Id) return Property_Maps.Map is - properties : constant List_Id := - Ocarina.ME_AADL.AADL_Instances.Nodes.Properties (D); + properties : constant List_Id := AIN.Properties (D); result : Property_Maps.Map := Empty_Map; - property : Node_Id := First_Node (properties); + property : Node_Id := AIN.First_Node (properties); prop_value : Node_Id; single_val : Node_Id; begin @@ -268,8 +257,7 @@ package body Buildsupport_Utils is if Present (ATN.Single_Value (prop_value)) then -- Only support single-value properties for now single_val := ATN.Single_Value (prop_value); - result.Insert (Key => Get_Name_String - (Display_Name (Identifier (property))), + result.Insert (Key => AIN_Case (property), New_Item => (case ATN.Kind (single_val) is when ATN.K_Signed_AADLNumber => @@ -294,7 +282,7 @@ package body Buildsupport_Utils is when others => "ERROR! Unsupported kind: " & ATN.Kind (single_val)'Img)); end if; - property := Next_Node (property); + property := AIN.Next_Node (property); end loop; return result; end Get_Properties_Map; @@ -426,8 +414,6 @@ package body Buildsupport_Utils is Unprotected_Name := Get_String_Name ("unprotected"); Protected_Name := Get_String_Name ("protected"); - Variator_Name := Get_String_Name ("variator"); - Modifier_Name := Get_String_Name ("modifier"); Cyclic_Name := Get_String_Name ("cyclic"); Sporadic_Name := Get_String_Name ("sporadic"); diff --git a/ada/buildsupport_utils.ads b/ada/buildsupport_utils.ads index 914ddbe..4451778 100644 --- a/ada/buildsupport_utils.ads +++ b/ada/buildsupport_utils.ads @@ -6,20 +6,29 @@ with Ocarina, -- Ocarina.Types, Types, + Namet, Ocarina.Backends.Properties, Ada.Containers.Indefinite_Ordered_Maps, Ada.Containers.Indefinite_Vectors, + Ocarina.ME_AADL.AADL_Tree.Nodes, + Ocarina.ME_AADL.AADL_Instances.Nodes, Ada.Strings.Unbounded; use Ocarina, + Types, + Namet, Ocarina.Backends.Properties, + Ocarina.ME_AADL.AADL_Tree.Nodes, + Ocarina.ME_AADL.AADL_Instances.Nodes, Ada.Containers, Ada.Strings.Unbounded; package Buildsupport_Utils is --- use Ocarina.Types; - use Types; + package ATN renames Ocarina.ME_AADL.AADL_Tree.Nodes; + package AIN renames Ocarina.ME_AADL.AADL_Instances.Nodes; + function US (Source : in String) return Unbounded_String renames + To_Unbounded_String; procedure Banner; @@ -33,11 +42,8 @@ package Buildsupport_Utils is type Supported_RCM_Operation_Kind is (Unprotected_Operation, Protected_Operation, - Variator_Operation, - Modifier_Operation, Cyclic_Operation, - Sporadic_Operation, - Unknown_Operation); + Sporadic_Operation); function Get_RCM_Operation_Kind (E : Node_Id) return Supported_RCM_Operation_Kind; @@ -81,6 +87,22 @@ package Buildsupport_Utils is function Get_Properties_Map (D : Node_Id) return Property_Maps.Map; + -- Shortcut to read an identifier from the parser, in lowercase + function ATN_Lower (N : Node_Id) return String is + (Get_Name_String (ATN.Name (ATN.Identifier (N)))); + + -- Shortcut to read an identifier from the parser, with original case + function ATN_Case (N : Node_Id) return String is + (Get_Name_String (ATN.Display_Name (ATN.Identifier (N)))); + + -- Shortcut to read an identifier from the parser, in lowercase + function AIN_Lower (N : Node_Id) return String is + (Get_Name_String (AIN.Name (AIN.Identifier (N)))); + + -- Shortcut to read an identifier from the parser, with original case + function AIN_Case (N : Node_Id) return String is + (Get_Name_String (AIN.Display_Name (AIN.Identifier (N)))); + -- Types needed to build the AST of the TASTE Interface View in Ada type Parameter_Direction is (param_in, param_out); @@ -99,27 +121,40 @@ package Buildsupport_Utils is type Taste_Interface is record - Name : Unbounded_String; - In_Parameters : Parameters.Vector; - Out_Parameters : Parameters.Vector; - RCM : Supported_RCM_Operation_Kind; - Period_Or_MIAT : Natural; - WCET : Natural; - WCET_Unit : Unbounded_String; - Queue_Size : Natural; + Name : Unbounded_String; + In_Parameters : Parameters.Vector; + Out_Parameters : Parameters.Vector; + RCM : Supported_RCM_Operation_Kind; + Period_Or_MIAT : Natural; + WCET : Natural; + WCET_Unit : Unbounded_String; + Queue_Size : Natural; + User_Properties : Property_Maps.Map; end record; package Interfaces is new Indefinite_Vectors (Natural, Taste_Interface); - type Taste_Terminal_Function is + type Context_Parameter is record Name : Unbounded_String; - Language : Supported_Source_Language; - Zip_File : Unbounded_String; - Context_Params : Property_Maps.Map; - Timers : String_Vectors.Vector; - Provided : Interfaces.Vector; - Required : Interfaces.Vector; + Sort : Unbounded_String; + Default_Value : Unbounded_String; + ASN1_Module : Unbounded_String; + ASN1_File_Name : Unbounded_String; + end record; + + package Ctxt_Params is new Indefinite_Vectors (Natural, Context_Parameter); + + type Taste_Terminal_Function is + record + Name : Unbounded_String; + Language : Supported_Source_Language; + Zip_File : Unbounded_String; + Context_Params : Ctxt_Params.Vector; + User_Properties : Property_Maps.Map; + Timers : String_Vectors.Vector; + Provided : Interfaces.Vector; + Required : Interfaces.Vector; end record; package Functions is new Indefinite_Vectors (Natural, diff --git a/buildsupport.gpr b/buildsupport.gpr index 9a5ee68..f0ed036 100644 --- a/buildsupport.gpr +++ b/buildsupport.gpr @@ -1,4 +1,5 @@ with "ocarina"; +with "templates_parser"; -- from libtemplates-parser11.10.1-dev project BuildSupport is @@ -21,17 +22,17 @@ project BuildSupport is package binder is for default_switches ("Ada") use ("-E", "-t", "-static"); - end binder; + end binder; package Compiler is for Default_Switches ("Ada") use ("-g", - "-gnat05", + "-gnat12", "-gnatf", "-gnaty", - -- "-gnatwa", + "-gnatwa", "-gnatoa", - "-gnatg", + "-gnatg", "-fstack-check"); for Default_Switches ("C") use ("-g"); -- GitLab