Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in
Toggle navigation
Menu
Open sidebar
TASTE
buildsupport
Commits
42d26a97
Commit
42d26a97
authored
Apr 04, 2017
by
Maxime Perrotin
Browse files
Parse interfaces to the new AST
parent
fc727098
Changes
3
Hide whitespace changes
Inline
Side-by-side
ada/buildsupport.adb
View file @
42d26a97
...
...
@@ -345,7 +345,7 @@ procedure BuildSupport is
when
Cyclic_Operation
=>
C_Set_Cyclic_IF
;
when
Sporadic_Operation
=>
when
Sporadic_Operation
|
Any_Operation
=>
C_Set_Sporadic_IF
;
when
Protected_Operation
=>
...
...
ada/buildsupport_utils.adb
View file @
42d26a97
...
...
@@ -10,6 +10,7 @@ with Ada.Text_IO,
Ocarina
.
Instances
.
Queries
,
Ocarina
.
ME_AADL
.
AADL_Instances
.
Nutils
,
Ocarina
.
ME_AADL
.
AADL_Instances
.
Entities
,
Ocarina
.
Backends
.
Utils
,
Ada
.
Characters
.
Latin_1
;
package
body
Buildsupport_Utils
is
...
...
@@ -20,7 +21,8 @@ package body Buildsupport_Utils is
Ocarina
.
ME_AADL
.
AADL_Instances
.
Nutils
,
Ada
.
Characters
.
Latin_1
,
Ocarina
.
ME_AADL
.
AADL_Instances
.
Entities
,
Ocarina
.
ME_AADL
;
Ocarina
.
ME_AADL
,
Ocarina
.
Backends
.
Utils
;
------------
-- Banner --
...
...
@@ -114,10 +116,11 @@ package body Buildsupport_Utils is
Protected_Name
:
constant
Name_Id
:=
Get_String_Name
(
"protected"
);
Cyclic_Name
:
constant
Name_Id
:=
Get_String_Name
(
"cyclic"
);
Sporadic_Name
:
constant
Name_Id
:=
Get_String_Name
(
"sporadic"
);
Any_Name
:
constant
Name_Id
:=
Get_String_Name
(
"any"
);
begin
if
Is_Defined_Enumeration_Property
(
E
,
RCM_Operation_Kind
)
then
RCM_Operation_Kind_N
:=
Get_Enumeration_Property
(
E
,
RCM_Operation_Kind
);
RCM_Operation_Kind_N
:=
Get_Enumeration_Property
(
E
,
RCM_Operation_Kind
);
if
RCM_Operation_Kind_N
=
Unprotected_Name
then
return
Unprotected_Operation
;
...
...
@@ -130,9 +133,13 @@ package body Buildsupport_Utils is
elsif
RCM_Operation_Kind_N
=
Sporadic_Name
then
return
Sporadic_Operation
;
elsif
RCM_Operation_Kind_N
=
Any_Name
then
return
Any_Operation
;
end
if
;
end
if
;
Exit_On_Error
(
True
,
"Could not determine interface kind"
);
Exit_On_Error
(
True
,
"Could not determine interface kind: "
&
Get_Name_String
(
RCM_Operation_Kind_N
));
return
Sporadic_Operation
;
end
Get_RCM_Operation_Kind
;
...
...
@@ -374,6 +381,20 @@ package body Buildsupport_Utils is
return
ASN1_Unknown
;
end
Get_ASN1_Basic_Type
;
----------------------------------------------------------------
-- Get Optional Worse Case Execution Time (Upper bound in ms) --
----------------------------------------------------------------
function
Get_Upper_WCET
(
Func
:
Node_Id
)
return
Optional_Long_Long
is
(
if
Is_Subprogram_Access
(
Func
)
and
then
Sources
(
Func
)
/=
No_List
and
then
AIN
.
First_Node
(
Sources
(
Func
))
/=
No_Node
and
then
Get_Execution_Time
(
Corresponding_Instance
(
AIN
.
Item
(
AIN
.
First_Node
(
Sources
(
Func
)))))
/=
Empty_Time_Array
then
Just
(
To_Milliseconds
(
Get_Execution_Time
(
Corresponding_Instance
(
AIN
.
Item
(
AIN
.
First_Node
(
Sources
(
Func
)))))(
1
)))
else
Nothing
);
---------------------------
-- AST Builder Functions --
---------------------------
...
...
@@ -383,6 +404,7 @@ package body Buildsupport_Utils is
use
type
Channels
.
Vector
;
use
type
Ctxt_Params
.
Vector
;
use
type
Interfaces
.
Vector
;
use
type
Parameters
.
Vector
;
Funcs
:
Functions
.
Vector
:=
Functions
.
Empty_Vector
;
Routes
:
Channels
.
Vector
;
-- := Channels.Empty_Vector;
Current_Function
:
Node_Id
;
...
...
@@ -402,21 +424,46 @@ package body Buildsupport_Utils is
else
Nothing
));
end
Parse_CP
;
-- Parse a single parameter of an interface
-- * Name (Unbounded string)
-- * Sort (Unbounded string)
-- * ASN1_Module (Unbounded string)
-- * ASN1_Basic_Type (Supported_ASN1_Basic_Type)
-- * ASN1_File_Name (Unbounded string)
-- * Encoding (Supported_ASN1_Encoding)
-- * Direction (Parameter_Direction: IN or OUT)
function
Parse_Parameter
(
Param_I
:
Node_Id
)
return
ASN1_Parameter
is
Asntype
:
constant
Node_Id
:=
Corresponding_Instance
(
Param_I
);
begin
return
(
Name
=>
US
(
AIN_Case
(
Param_I
)),
Sort
=>
US
(
Get_Name_String
(
Get_Type_Source_Name
(
Asntype
))),
ASN1_Module
=>
US
(
Get_Name_String
(
Get_Ada_Package_Name
(
Asntype
))),
ASN1_Basic_Type
=>
Get_ASN1_Basic_Type
(
Asntype
),
ASN1_File_Name
=>
US
(
Get_Name_String
(
Get_Source_Text
(
Asntype
)(
1
))),
Encoding
=>
Get_ASN1_Encoding
(
Param_I
),
Direction
=>
(
if
AIN
.
Is_In
(
Param_I
)
then
param_in
else
param_out
));
end
Parse_Parameter
;
-- Parse a function interface :
-- * 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)
-- * Name (Unbounded string)
-- * Params (Parameters.Vector)
-- * RCM (Supported_RCM_Operation_Kind)
-- * Period_Or_MIAT (Unsigned long long)
-- * WCET_ms (Optional unsigned long long)
-- * Queue_Size (Optional unsigned long long)
-- * User_Properties (Property_Maps.Map)
function
Parse_Interface
(
If_I
:
Node_Id
)
return
Taste_Interface
is
Name
:
constant
Name_Id
:=
Get_Interface_Name
(
If_I
);
CI
:
constant
Node_Id
:=
Corresponding_Instance
(
If_I
);
Result
:
Taste_Interface
;
Name
:
constant
Name_Id
:=
Get_Interface_Name
(
If_I
);
CI
:
constant
Node_Id
:=
Corresponding_Instance
(
If_I
);
Result
:
Taste_Interface
;
Sub_I
:
constant
Node_Id
:=
Get_RCM_Operation
(
If_I
);
Param_I
:
Node_Id
;
begin
pragma
Assert
(
Present
(
Sub_I
));
-- Keep compatibility with 1.2 models for the interface name
Result
.
Name
:=
(
if
Name
=
No_Name
then
US
(
AIN_Case
(
If_I
))
else
US
(
Get_Name_String
(
Name
)));
...
...
@@ -428,10 +475,19 @@ package body Buildsupport_Utils is
else
Nothing
);
Result
.
RCM
:=
Get_RCM_Operation_Kind
(
If_I
);
Result
.
Period_Or_MIAT
:=
Get_RCM_Period
(
If_I
);
-- Still to do: WCET (& unit), and Parameters
Result
.
WCET_ms
:=
Get_Upper_WCET
(
If_I
);
-- Parameters:
if
not
Is_Empty
(
AIN
.
Features
(
Sub_I
))
then
Param_I
:=
AIN
.
First_Node
(
AIN
.
Features
(
Sub_I
));
while
Present
(
Param_I
)
loop
if
Kind
(
Param_I
)
=
K_Parameter_Instance
then
Result
.
Params
:=
Result
.
Params
&
Parse_Parameter
(
Param_I
);
end
if
;
Param_I
:=
AIN
.
Next_Node
(
Param_I
);
end
loop
;
end
if
;
return
Result
;
end
Parse_Interface
;
pragma
Unreferenced
(
Parse_Interface
);
-- Parse the content of a single function :
-- * Name
...
...
@@ -479,10 +535,14 @@ package body Buildsupport_Utils is
if
Present
(
AIN
.
Features
(
Inst
))
then
PI_Or_RI
:=
AIN
.
First_Node
(
AIN
.
Features
(
Inst
));
while
Present
(
PI_Or_RI
)
loop
-- If_AST.RCM := Get_RCM_Operation_Kind (PI_Or_RI);
if
AIN
.
Is_Provided
(
PI_Or_RI
)
then
Result
.
Provided
:=
Result
.
Provided
&
Parse_Interface
(
PI_Or_RI
);
else
Result
.
Required
:=
Result
.
Required
&
Parse_Interface
(
PI_Or_RI
);
end
if
;
PI_Or_RI
:=
AIN
.
Next_Node
(
PI_Or_RI
);
-- PI or RI - test to be added:
-- Result.Provided := Result.Provided & If_AST;
end
loop
;
end
if
;
...
...
ada/buildsupport_utils.ads
View file @
42d26a97
...
...
@@ -42,7 +42,8 @@ package Buildsupport_Utils is
type
Supported_RCM_Operation_Kind
is
(
Unprotected_Operation
,
Protected_Operation
,
Cyclic_Operation
,
Sporadic_Operation
);
Sporadic_Operation
,
Any_Operation
);
function
Get_RCM_Operation_Kind
(
E
:
Node_Id
)
return
Supported_RCM_Operation_Kind
;
...
...
@@ -128,12 +129,10 @@ package Buildsupport_Utils is
type
Taste_Interface
is
record
Name
:
Unbounded_String
;
In_Parameters
:
Parameters
.
Vector
;
Out_Parameters
:
Parameters
.
Vector
;
Params
:
Parameters
.
Vector
;
RCM
:
Supported_RCM_Operation_Kind
;
Period_Or_MIAT
:
Unsigned_Long_Long
;
WCET
:
Natural
;
WCET_Unit
:
Unbounded_String
;
WCET_ms
:
Optional_Long_Long
;
Queue_Size
:
Optional_Long_Long
;
User_Properties
:
Property_Maps
.
Map
;
end
record
;
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment