Commit f3f39439 authored by Maxime Perrotin's avatar Maxime Perrotin

Work on the new AST

parent b9fe60b0
...@@ -185,458 +185,447 @@ procedure BuildSupport is ...@@ -185,458 +185,447 @@ procedure BuildSupport is
if Get_Category_Of_Component (CI) = CC_System then if Get_Category_Of_Component (CI) = CC_System then
-- Call C function "New_FV" and set the language -- 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 declare
(Get_Name_String (Name (Identifier (Current_Function))), -- Read the name of the function
Get_Name_String FV_Name_L : constant String := ATN_Lower (Current_Function);
(Name (Identifier (Current_Function)))'Length, FV_Name : constant String := ATN_Case (Current_Function);
Get_Name_String (Display_Name (Identifier -- Read the source language
(Current_Function)))); Source_Language : constant Supported_Source_Language :=
Get_Source_Language (CI);
-- Read the implementation language of the current -- To get the zipfile name where user code is stored
-- FV from the Source_Language property SourceText : constant Name_Array := Get_Source_Text (CI);
ZipId : Name_Id := No_Name;
declare begin
Source_Language : constant Supported_Source_Language C_New_FV (FV_Name_L, FV_Name'Length, FV_Name);
:= Get_Source_Language (CI);
begin case Source_Language is
case Source_Language is when Language_Ada_95 => C_Set_Language_To_Ada;
when Language_Ada_95 => C_Set_Language_To_Ada; when Language_C => C_Set_Language_To_C;
when Language_C => C_Set_Language_To_C; when Language_CPP => C_Set_Language_To_CPP;
when Language_CPP => C_Set_Language_To_CPP; when Language_VDM => C_Set_Language_To_VDM;
when Language_VDM => C_Set_Language_To_VDM; when Language_SDL_OpenGEODE => C_Set_Language_To_SDL;
when Language_SDL_OpenGEODE => C_Set_Language_To_SDL; when Language_Scade => C_Set_Language_To_Scade;
when Language_Scade => C_Set_Language_To_Scade; when Language_Lustre => C_Set_Language_To_Scade;
when Language_Lustre => C_Set_Language_To_Scade; when Language_SDL => C_Set_Language_To_SDL;
when Language_SDL => C_Set_Language_To_SDL; when Language_SDL_RTDS => C_Set_Language_To_RTDS;
when Language_SDL_RTDS => C_Set_Language_To_RTDS; when Language_Simulink => C_Set_Language_To_Simulink;
when Language_Simulink => C_Set_Language_To_Simulink; when Language_Rhapsody => C_Set_Language_To_Rhapsody;
when Language_Rhapsody => C_Set_Language_To_Rhapsody; when Language_Gui => C_Set_Language_To_GUI;
when Language_Gui => C_Set_Language_To_GUI; when Language_VHDL => C_Set_Language_To_VHDL;
when Language_VHDL => C_Set_Language_To_VHDL; when Language_System_C => C_Set_Language_To_System_C;
when Language_System_C => C_Set_Language_To_System_C; when Language_Device =>
when Language_Device => C_Set_Language_To_BlackBox_Device;
C_Set_Language_To_BlackBox_Device; when Language_QGenAda => C_Set_Language_To_QGenAda;
when Language_QGenAda => C_Set_Language_To_QGenAda; when Language_QGenC => C_Set_Language_To_QGenC;
when Language_QGenC => C_Set_Language_To_QGenC; when others => Exit_On_Error (True,
when others => C_Set_Language_To_Other; "Language is currently not supported: "
end case; & Source_Language'Img);
end; end case;
declare
SourceText : constant Name_Array := -- Retrieve the ZIP file (optionally set by the user)
Get_Source_Text (CI); if SourceText'Length /= 0 then
ZipId : Name_Id := No_Name; ZipId := SourceText (1);
begin end if;
if SourceText'Length /= 0 then if ZipId /= No_Name then
ZipId := SourceText (1); C_Set_Zipfile (Get_Name_String (ZipId),
end if; Get_Name_String (ZipId)'Length);
if ZipId /= No_Name then end if;
C_Set_Zipfile (Get_Name_String (ZipId), end;
Get_Name_String (ZipId)'Length);
-- 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 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 while Present (If_I) loop
if not Is_Empty (Subcomponents (CI)) then Sub_I := Get_RCM_Operation (If_I);
FV_Subco := First_Node (Subcomponents (CI));
while Present (FV_Subco) loop if Present (Sub_I) then
if Get_Category_Of_Component (FV_Subco) = CC_Data -- 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 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 declare
-- Name of the variable PI_string : String :=
FS_name : constant String := Get_Name_string
Get_Name_String (Name (Identifier (FV_Subco))); (Display_Name (Identifier (If_I)));
-- Name of the variable respecting case PI_Name : Name_Id;
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;
begin begin
-- Some special DATA components have no PI_Name := Get_Interface_Name (If_I);
-- Source_Text property in DataView.aadl if PI_Name /= No_Name then
-- (TASTE-Directive and Tunable Parameter) C_Add_PI (Get_Name_String (PI_Name),
if NA'Length > 0 then Get_Name_String (PI_Name)'Length);
FS_File := To_Unbounded_String
(Get_Name_String (NA (1)));
else 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; 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;
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 if Kind (If_I) = K_Subcomponent_Access_Instance
Sub_I := Get_RCM_Operation (If_I); 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 -- Set Provided Interface RCM kind
-- Call backend Add_PI or Add_RI and for each -- (cyclic, sporadic, etc).
-- parameter call C function Add_In_Param or Operation_Kind := Get_RCM_Operation_Kind (If_I);
-- Add_Out_Param
if Is_Subprogram_Access (If_I) and case Operation_Kind is
Is_Provided (If_I) 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 then
declare declare
PI_string : String := use Ocarina.Backends.Utils;
Get_Name_string Exec_Time : constant Time_Array :=
(Display_Name (Identifier (If_I))); Get_Execution_Time
PI_Name : Name_Id; (Corresponding_Instance
(Item
(First_Node (Sources (If_I)))));
begin begin
PI_Name := Get_Interface_Name (If_I); C_Set_Compute_Time
if PI_Name /= No_Name then (To_Milliseconds (Exec_Time (0)), "ms", 2,
C_Add_PI (Get_Name_String (PI_Name), To_Milliseconds (Exec_Time (1)), "ms", 2);
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;
end; end;
else
C_Set_Compute_Time (0, "ms", 2, 0, "ms", 2);
-- Default !
end if;
if Kind (If_I) = K_Subcomponent_Access_Instance -- Required interface:
and then elsif Is_Subprogram_Access (If_I) and
Is_Defined_Property not (Is_Provided (If_I))
(Corresponding_Instance (If_I), then
"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;
when Protected_Operation => -- the name of the feature (RI identifier) is:
C_Set_Protected_IF; -- Get_Name_String (Name (Identifier (If_I)));
when Unprotected_Operation => -- Find the distant PI connected to this RI
C_Set_Unprotected_IF; -- and the distant function
when others => Distant_Fv := No_Node;
C_Set_UndefinedKind_IF;
end case;
-- Set the period or MIAT of the PI if Present (Connections (My_System)) then
C_Set_Period (Get_RCM_Period (If_I)); Connection_I := First_Node
(Connections (My_System));
else
Connection_I := No_Node;
end if;
-- Set the WCET of the PI while Present (Connection_I) loop
if Is_Subprogram_Access (If_I) and then if Corresponding_instance
Sources (If_I) /= No_List and then (Get_Referenced_Entity
First_Node (Sources (If_I)) /= No_Node (Source (Connection_I))) =
and then Corresponding_Instance (If_I)
Get_Execution_Time
(Corresponding_Instance
(Item
(First_Node (Sources (If_I)))))
/= Empty_Time_Array
then then
declare Distant_FV := Item (First_Node
use Ocarina.Backends.Utils; (Path
Exec_Time : constant Time_Array := (Source
Get_Execution_Time (Connection_I))));
(Corresponding_Instance -- Get InterfaceName property if any
(Item Distant_PI_Name := Get_Interface_Name
(First_Node (Sources (If_I))))); (Get_Referenced_Entity (
begin Source (Connection_I)));
C_Set_Compute_Time -- Get RCM kind from remote PI
(To_Milliseconds (Exec_Time (0)), "ms", 2, Operation_Kind :=
To_Milliseconds (Exec_Time (1)), "ms", 2); Get_RCM_Operation_Kind
end; (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 else
C_Set_Compute_Time (0, "ms", 2, 0, "ms", 2); Local_RI_Name :=
-- Default ! Name (Identifier (If_I));
Distant_PI_Name :=
Name (Identifier (RI_To_Add));
end if; 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: case Operation_Kind is
elsif Is_Subprogram_Access (If_I) and when Sporadic_Operation =>
not (Is_Provided (If_I)) C_Set_ASync_IF;
then C_Set_Sporadic_IF;
-- the name of the feature (RI identifier) is: when Protected_Operation =>
-- Get_Name_String (Name (Identifier (If_I))); C_Set_Sync_IF;
C_Set_Protected_IF;
-- Find the distant PI connected to this RI when Unprotected_Operation =>
-- and the distant function 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 -- Parse the list of parameters
Connection_I := First_Node
(Connections (My_System));
else
Connection_I := No_Node;
end if;
while Present (Connection_I) loop if not Is_Empty (Features (Sub_I)) then
if Corresponding_instance Param_I := First_Node (Features (Sub_I));
(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;
-- inform C-code about the kind of PI it is while Present (Param_I) loop
-- (cyclic, sporadic, etc). Important: Has if Kind (Param_I) = K_Parameter_Instance then
-- to be updated in case of several Asntype := Corresponding_Instance
-- SPORADIC... (Param_I);
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;
-- Parse the list of parameters declare
NA : constant Name_Array
if not Is_Empty (Features (Sub_I)) then := Get_Source_Text (Asntype);
Param_I := First_Node (Features (Sub_I)); begin
ASN1_Filename := NA (1);
while Present (Param_I) loop end;
if Kind (Param_I) = K_Parameter_Instance then
Asntype := Corresponding_Instance Exit_On_Error
(Param_I); (ASN1_Filename = No_Name,
"Error: Source_Text not defined");
declare
NA : constant Name_Array Len_Name := Get_Name_String
:= Get_Source_Text (Asntype); (Name (Identifier (Param_I)))'Length;
begin Len_Type := Get_Name_String
ASN1_Filename := NA (1); (Name (Identifier (Asntype)))'Length;
end; ASN1_Module := Get_Ada_Package_Name
(Asntype);
Exit_On_Error Exit_On_Error
(ASN1_Filename = No_Name, (ASN1_Module = No_Name,
"Error: Source_Text not defined"); "Error: Data Model is incorrect.");
Len_Name := Get_Name_String if Is_In (Param_I) then
(Name (Identifier (Param_I)))'Length; C_Add_In_Param
Len_Type := Get_Name_String (Get_Name_String
(Name (Identifier (Asntype)))'Length; (Display_Name
ASN1_Module := Get_Ada_Package_Name (Identifier (Param_I))),
(Asntype);