Skip to content
GitLab
Menu
Projects
Groups
Snippets
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in
Toggle navigation
Menu
Open sidebar
TASTE
buildsupport
Commits
f3f39439
Commit
f3f39439
authored
Mar 26, 2017
by
Maxime Perrotin
Browse files
Work on the new AST
parent
b9fe60b0
Changes
4
Hide whitespace changes
Inline
Side-by-side
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
w
he
n
Protected_Operation
=>
C_Set_Protected_IF
;
--
t
he
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
;