Skip to content

GitLab

B
buildsupport
Commit f3f39439 authored by Maxime Perrotin's avatar Maxime Perrotin
Browse files
Options

Work on the new AST

parent b9fe60b0
Hide whitespace changes
Inline Side-by-side
Showing with 482 additions and 473 deletions
ada/buildsupport.adb
View file @ f3f39439
......@@ -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,