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
Ocarina
Commits
9fe6cded
Commit
9fe6cded
authored
Oct 10, 2015
by
yoogx
Browse files
* Revisit property fetching circuitry: add a set of helper
routines to fetch various kind of property types. First step of #19
parent
9db2027a
Changes
12
Hide whitespace changes
Inline
Side-by-side
src/backends/ocarina-backends-c_common-types.adb
View file @
9fe6cded
...
...
@@ -390,8 +390,7 @@ package body Ocarina.Backends.C_Common.Types is
Data_Array_Size
:
constant
ULL_Array
:=
Get_Dimension
(
E
);
Number_Representation
:
constant
Supported_Number_Representation
:=
Get_Number_Representation
(
E
);
Is_Signed
:
constant
Boolean
:=
(
Number_Representation
=
Representation_Signed
);
Is_Signed
:
constant
Boolean
:=
Number_Representation
=
Signed
;
Type_Uint8
:
Node_Id
;
Type_Int8
:
Node_Id
;
...
...
@@ -801,16 +800,7 @@ package body Ocarina.Backends.C_Common.Types is
True
);
end
if
;
elsif
Get_Concurrency_Protocol
(
E
)
=
Concurrency_Protected_Access
or
else
Get_Concurrency_Protocol
(
E
)
=
Concurrency_Immediate_Priority_Ceiling
or
else
Get_Concurrency_Protocol
(
E
)
=
Concurrency_Priority_Inheritance
or
else
Get_Concurrency_Protocol
(
E
)
=
Concurrency_Priority_Ceiling
Priority_Ceiling
then
-- Protected type that does not have struct members.
...
...
src/backends/ocarina-backends-cheddar-mapping.adb
View file @
9fe6cded
...
...
@@ -234,8 +234,8 @@ package body Ocarina.Backends.Cheddar.Mapping is
Concurrency_Protocols
:
constant
array
(
Supported_Concurrency_Control_Protocol
'
Range
)
of
Name_Id
:=
(
C
on
currency_Non
eSpecified
=>
Get_String_Name
(
"NO_PROTOCOL"
),
Concurrency_
Priority_Ceiling
=>
(
N
one
_
Specified
=>
Get_String_Name
(
"NO_PROTOCOL"
),
Priority_Ceiling
=>
Get_String_Name
(
"PRIORITY_CEILING_PROTOCOL"
),
others
=>
No_Name
);
...
...
src/backends/ocarina-backends-mast-main.adb
View file @
9fe6cded
...
...
@@ -553,8 +553,7 @@ package body Ocarina.Backends.MAST.Main is
end
if
;
Append_Node_To_List
(
N
,
MTN
.
Declarations
(
MAST_File
));
if
CP
=
Concurrency_Protected_Access
or
else
CP
=
Concurrency_Priority_Ceiling
if
CP
=
Priority_Ceiling
or
else
Is_Protected_Data
(
E
)
or
else
Get_Data_Representation
(
E
)
=
Data_With_Accessors
then
...
...
src/backends/ocarina-backends-po_hi_ada-types.adb
View file @
9fe6cded
...
...
@@ -263,8 +263,7 @@ package body Ocarina.Backends.PO_HI_Ada.Types is
Data_Size
:
Size_Type
;
Number_Representation
:
constant
Supported_Number_Representation
:=
Get_Number_Representation
(
E
);
Is_Signed
:
constant
Boolean
:=
(
Number_Representation
=
Representation_Signed
);
Is_Signed
:
constant
Boolean
:=
Number_Representation
=
Signed
;
begin
-- Do not generate Ada type more than once
...
...
@@ -700,7 +699,7 @@ package body Ocarina.Backends.PO_HI_Ada.Types is
-- the AADL model.
CCP
:=
Get_Concurrency_Protocol
(
E
);
if
CCP
/=
Concurrency_
Priority_Ceiling
then
if
CCP
/=
Priority_Ceiling
then
Display_Located_Error
(
Loc
(
E
),
"Incompatible concurrency protocol, "
&
...
...
src/backends/ocarina-backends-po_hi_c-deployment.adb
View file @
9fe6cded
...
...
@@ -2014,7 +2014,7 @@ package body Ocarina.Backends.PO_HI_C.Deployment is
Make_Literal
(
New_Int_Value
(
0
,
1
,
10
));
case
Get_Concurrency_Protocol
(
Corresponding_Instance
(
C
))
is
when
Concurrency_
Priority_Ceiling
=>
when
Priority_Ceiling
=>
Protected_Priority
:=
Make_Literal
(
New_Int_Value
...
...
@@ -2024,12 +2024,6 @@ package body Ocarina.Backends.PO_HI_C.Deployment is
10
));
Protected_Protocol
:=
RE
(
RE_Protected_PCP
);
when
Concurrency_Immediate_Priority_Ceiling
=>
Protected_Protocol
:=
RE
(
RE_Protected_IPCP
);
when
Concurrency_Priority_Inheritance
=>
Protected_Protocol
:=
RE
(
RE_Protected_PIP
);
when
others
=>
Protected_Protocol
:=
RE
(
RE_Protected_Regular
);
end
case
;
...
...
src/backends/ocarina-backends-po_hi_c-main.adb
View file @
9fe6cded
...
...
@@ -494,7 +494,7 @@ package body Ocarina.Backends.PO_HI_C.Main is
Append_Node_To_List
(
N
,
CTN
.
Declarations
(
Current_File
));
if
Get_Concurrency_Protocol
(
Corresponding_Instance
(
S
))
/=
C
on
currency_Non
eSpecified
/=
N
one
_
Specified
then
N
:=
Make_Expression
...
...
src/backends/ocarina-backends-po_hi_c-marshallers.adb
View file @
9fe6cded
...
...
@@ -910,8 +910,7 @@ package body Ocarina.Backends.PO_HI_C.Marshallers is
To_Bytes
(
Data_Size
);
Number_Representation
:
constant
Supported_Number_Representation
:=
Get_Number_Representation
(
E
);
Is_Signed
:
constant
Boolean
:=
(
Number_Representation
=
Representation_Signed
);
Is_Signed
:
constant
Boolean
:=
Number_Representation
=
Signed
;
begin
case
Data_Representation
is
...
...
@@ -986,8 +985,7 @@ package body Ocarina.Backends.PO_HI_C.Marshallers is
To_Bytes
(
Data_Size
);
Number_Representation
:
constant
Supported_Number_Representation
:=
Get_Number_Representation
(
E
);
Is_Signed
:
constant
Boolean
:=
(
Number_Representation
=
Representation_Signed
);
Is_Signed
:
constant
Boolean
:=
Number_Representation
=
Signed
;
begin
case
Data_Representation
is
...
...
src/backends/ocarina-backends-properties-utils.adb
View file @
9fe6cded
...
...
@@ -33,10 +33,10 @@ with Ocarina.Backends.Messages;
with
Ocarina
.
Instances
.
Queries
;
with
Ocarina
.
ME_AADL
.
AADL_Instances
.
Nodes
;
with
Ocarina
.
Namet
;
with
Charset
;
use
Charset
;
with
Utils
;
with
Ocarina
.
ME_AADL
.
AADL_Tree
.
Nodes
;
with
Ocarina
.
ME_AADL
.
AADL_Tree
.
NUtils
;
with
Ocarina
.
AADL_Values
;
package
body
Ocarina
.
Backends
.
Properties
.
Utils
is
...
...
@@ -47,6 +47,7 @@ package body Ocarina.Backends.Properties.Utils is
use
Standard
.
Utils
;
package
ATN
renames
Ocarina
.
ME_AADL
.
AADL_Tree
.
Nodes
;
package
AIN
renames
Ocarina
.
ME_AADL
.
AADL_Instances
.
Nodes
;
package
ATNU
renames
Ocarina
.
ME_AADL
.
AADL_Tree
.
NUtils
;
use
type
ATN
.
Node_Kind
;
...
...
@@ -314,4 +315,161 @@ package body Ocarina.Backends.Properties.Utils is
return
Default_Value
;
end
Check_And_Get_Property
;
function
Check_And_Get_Property_Enumerator
(
E
:
Node_Id
;
Property_Name
:
Name_Id
)
return
T
is
Enumerator
:
Name_Id
;
begin
if
not
Is_Defined_Enumeration_Property
(
E
,
Property_Name
)
then
Display_Located_Error
(
AIN
.
Loc
(
E
),
"Property "
&
Get_Name_String
(
Property_Name
)
&
" not defined"
,
Fatal
=>
True
);
raise
Program_Error
;
end
if
;
Enumerator
:=
Get_Enumeration_Property
(
E
,
Property_Name
);
for
Elt
in
T
'
Range
loop
if
To_Upper
(
Get_Name_String
(
Enumerator
))
=
Elt
'
Img
then
return
Elt
;
end
if
;
end
loop
;
Display_Located_Error
(
AIN
.
Loc
(
E
),
"Enumerator
""
"
&
Get_Name_String
(
Enumerator
)
&
"
""
not supported"
,
Fatal
=>
True
);
raise
Program_Error
;
end
Check_And_Get_Property_Enumerator
;
function
Check_And_Get_Property_Enumerator_With_Default
(
E
:
Node_Id
;
Property_Name
:
Name_Id
)
return
T
is
Enumerator
:
Name_Id
;
begin
if
not
Is_Defined_Enumeration_Property
(
E
,
Property_Name
)
then
return
Default_Value
;
end
if
;
Enumerator
:=
Get_Enumeration_Property
(
E
,
Property_Name
);
declare
Enumerator_String
:
constant
String
:=
To_Upper
(
Get_Name_String
(
Enumerator
));
begin
for
Elt
in
T
'
Range
loop
if
Enumerator_String
=
Elt
'
Img
then
return
Elt
;
end
if
;
end
loop
;
end
;
Display_Located_Error
(
AIN
.
Loc
(
E
),
"Enumerator "
&
Get_Name_String
(
Enumerator
)
&
" not supported"
,
Fatal
=>
True
);
raise
Program_Error
;
end
Check_And_Get_Property_Enumerator_With_Default
;
function
Check_And_Get_Property
(
E
:
Node_Id
;
Property_Name
:
Name_Id
)
return
Name_Array
is
N_List
:
List_Id
;
begin
if
Is_Defined_List_Property
(
E
,
Property_Name
)
then
N_List
:=
Get_List_Property
(
E
,
Property_Name
);
declare
L
:
constant
Nat
:=
Nat
(
ATNU
.
Length
(
N_List
));
Res
:
Name_Array
(
1
..
L
);
N
:
Node_Id
;
begin
N
:=
ATN
.
First_Node
(
N_List
);
for
Elt
of
Res
loop
Elt
:=
Value
(
ATN
.
Value
(
N
)).
SVal
;
N
:=
ATN
.
Next_Node
(
N
);
end
loop
;
return
Res
;
end
;
else
return
Empty_Name_Array
;
end
if
;
end
Check_And_Get_Property
;
function
Check_And_Get_Property_Generic
(
E
:
Node_Id
;
Property_Name
:
Name_Id
)
return
Elt_Array
is
D_List
:
List_Id
;
begin
if
Is_Defined_List_Property
(
E
,
Property_Name
)
then
D_List
:=
Get_List_Property
(
E
,
Property_Name
);
declare
L
:
constant
Nat
:=
Nat
(
ATNU
.
Length
(
D_List
));
Res
:
Elt_Array
(
1
..
L
);
N
:
Node_Id
;
begin
N
:=
ATN
.
First_Node
(
D_List
);
for
J
in
Res
'
Range
loop
Res
(
J
)
:=
Extract_Value
(
Value
(
ATN
.
Value
(
ATN
.
Number_Value
(
N
))));
N
:=
ATN
.
Next_Node
(
N
);
end
loop
;
return
Res
;
end
;
else
return
Default_Value
;
end
if
;
end
Check_And_Get_Property_Generic
;
function
Check_And_Get_Property_ULL
is
new
Check_And_Get_Property_Generic
(
Elt_Type
=>
Unsigned_Long_Long
,
Elt_Array
=>
ULL_Array
,
Extract_Value
=>
Extract_Value
,
Default_Value
=>
Empty_ULL_Array
);
function
Check_And_Get_Property
(
E
:
Node_Id
;
Property_Name
:
Name_Id
)
return
ULL_Array
renames
Check_And_Get_Property_ULL
;
function
Check_And_Get_Property_LL
is
new
Check_And_Get_Property_Generic
(
Elt_Type
=>
Long_Long
,
Elt_Array
=>
LL_Array
,
Extract_Value
=>
Extract_Value
,
Default_Value
=>
Empty_LL_Array
);
function
Check_And_Get_Property
(
E
:
Node_Id
;
Property_Name
:
Name_Id
)
return
LL_Array
renames
Check_And_Get_Property_LL
;
function
Check_And_Get_Property_LD
is
new
Check_And_Get_Property_Generic
(
Elt_Type
=>
Long_Double
,
Elt_Array
=>
LD_Array
,
Extract_Value
=>
Extract_Value
,
Default_Value
=>
Empty_LD_Array
);
function
Check_And_Get_Property
(
E
:
Node_Id
;
Property_Name
:
Name_Id
)
return
LD_Array
renames
Check_And_Get_Property_LD
;
end
Ocarina
.
Backends
.
Properties
.
Utils
;
src/backends/ocarina-backends-properties-utils.ads
View file @
9fe6cded
...
...
@@ -30,6 +30,8 @@
------------------------------------------------------------------------------
with
GNAT
.
OS_Lib
;
use
GNAT
.
OS_Lib
;
with
Ocarina
.
AADL_Values
;
use
Ocarina
.
AADL_Values
;
with
Ocarina
.
Backends
.
Properties
;
use
Ocarina
.
Backends
.
Properties
;
package
Ocarina
.
Backends
.
Properties
.
Utils
is
...
...
@@ -99,4 +101,50 @@ package Ocarina.Backends.Properties.Utils is
Default_Value
:
Int
:=
Int
'
First
)
return
Int
;
function
Check_And_Get_Property
(
E
:
Node_Id
;
Property_Name
:
Name_Id
)
return
Name_Array
;
generic
type
Elt_Type
is
private
;
type
Elt_Array
is
array
(
Nat
range
<>
)
of
Elt_Type
;
with
function
Extract_Value
(
V
:
Value_Type
)
return
Elt_Type
;
Default_Value
:
Elt_Array
;
function
Check_And_Get_Property_Generic
(
E
:
Node_Id
;
Property_Name
:
Name_Id
)
return
Elt_Array
;
function
Check_And_Get_Property
(
E
:
Node_Id
;
Property_Name
:
Name_Id
)
return
ULL_Array
;
function
Check_And_Get_Property
(
E
:
Node_Id
;
Property_Name
:
Name_Id
)
return
LL_Array
;
function
Check_And_Get_Property
(
E
:
Node_Id
;
Property_Name
:
Name_Id
)
return
LD_Array
;
generic
type
T
is
(
<>
);
function
Check_And_Get_Property_Enumerator
(
E
:
Node_Id
;
Property_Name
:
Name_Id
)
return
T
;
generic
type
T
is
(
<>
);
Default_Value
:
T
;
function
Check_And_Get_Property_Enumerator_With_Default
(
E
:
Node_Id
;
Property_Name
:
Name_Id
)
return
T
;
end
Ocarina
.
Backends
.
Properties
.
Utils
;
src/backends/ocarina-backends-properties.adb
View file @
9fe6cded
...
...
@@ -43,7 +43,6 @@ with Ocarina.ME_AADL.AADL_Tree.Entities.Properties;
with
Ocarina
.
ME_AADL
.
AADL_Tree
.
Entities
;
with
Ocarina
.
AADL_Values
;
with
Ocarina
.
Instances
.
Queries
;
-- with Ocarina.Analyzer.AADL.Queries;
with
Ocarina
.
Backends
.
Utils
;
with
Ocarina
.
Backends
.
Messages
;
...
...
@@ -247,20 +246,6 @@ package body Ocarina.Backends.Properties is
Access_Read_Write_Name
:
Name_Id
;
Access_By_Method_Name
:
Name_Id
;
Precision_Simple_Name
:
Name_Id
;
Precision_Double_Name
:
Name_Id
;
Representation_Signed_Name
:
Name_Id
;
Representation_Unsigned_Name
:
Name_Id
;
Concurrency_NoneSpecified_Name
:
Name_Id
;
Concurrency_Read_Only_Name
:
Name_Id
;
Concurrency_Protected_Access_Name
:
Name_Id
;
Concurrency_Priority_Ceiling_Name
:
Name_Id
;
Concurrency_Immediate_Priority_Ceiling_Name
:
Name_Id
;
Concurrency_Priority_Ceiling_Protocol_Name
:
Name_Id
;
Concurrency_Priority_Inheritance_Name
:
Name_Id
;
Language_Ada_Name
:
Name_Id
;
Language_Ada_95_Name
:
Name_Id
;
Language_Ada_05_Name
:
Name_Id
;
...
...
@@ -844,32 +829,9 @@ package body Ocarina.Backends.Properties is
-------------------
function
Get_Dimension
(
D
:
Node_Id
)
return
ULL_Array
is
D_List
:
List_Id
;
begin
pragma
Assert
(
AINU
.
Is_Data
(
D
));
if
Is_Defined_List_Property
(
D
,
Dimension
)
then
D_List
:=
Get_List_Property
(
D
,
Dimension
);
declare
use
Ocarina
.
AADL_Values
;
L
:
constant
Nat
:=
Nat
(
ATNU
.
Length
(
D_List
));
Res
:
ULL_Array
(
1
..
L
);
N
:
Node_Id
;
begin
N
:=
ATN
.
First_Node
(
D_List
);
for
J
in
Res
'
Range
loop
Res
(
J
)
:=
Value
(
Value
(
Number_Value
(
N
))).
IVal
;
N
:=
ATN
.
Next_Node
(
N
);
end
loop
;
return
Res
;
end
;
else
return
Empty_ULL_Array
;
end
if
;
begin
return
Check_And_Get_Property
(
D
,
Dimension
);
end
Get_Dimension
;
-----------------------
...
...
@@ -877,32 +839,10 @@ package body Ocarina.Backends.Properties is
-----------------------
function
Get_Element_Names
(
D
:
Node_Id
)
return
Name_Array
is
N_List
:
List_Id
;
begin
pragma
Assert
(
AINU
.
Is_Data
(
D
));
if
Is_Defined_List_Property
(
D
,
Element_Names
)
then
N_List
:=
Get_List_Property
(
D
,
Element_Names
);
declare
use
Ocarina
.
AADL_Values
;
L
:
constant
Nat
:=
Nat
(
ATNU
.
Length
(
N_List
));
Res
:
Name_Array
(
1
..
L
);
N
:
Node_Id
;
begin
N
:=
ATN
.
First_Node
(
N_List
);
for
J
in
Res
'
Range
loop
Res
(
J
)
:=
Value
(
Value
(
N
)).
SVal
;
N
:=
ATN
.
Next_Node
(
N
);
end
loop
;
return
Res
;
end
;
else
return
Empty_Name_Array
;
end
if
;
begin
return
Check_And_Get_Property
(
D
,
Element_Names
);
end
Get_Element_Names
;
---------------------
...
...
@@ -910,32 +850,9 @@ package body Ocarina.Backends.Properties is
---------------------
function
Get_Enumerators
(
D
:
Node_Id
)
return
Name_Array
is
E_List
:
List_Id
;
begin
pragma
Assert
(
AINU
.
Is_Data
(
D
));
if
Is_Defined_List_Property
(
D
,
Enumerators
)
then
E_List
:=
Get_List_Property
(
D
,
Enumerators
);
declare
use
Ocarina
.
AADL_Values
;
L
:
constant
Nat
:=
Nat
(
ATNU
.
Length
(
E_List
));
Res
:
Name_Array
(
1
..
L
);
N
:
Node_Id
;
begin
N
:=
ATN
.
First_Node
(
E_List
);
for
J
in
Res
'
Range
loop
Res
(
J
)
:=
Value
(
Value
(
N
)).
SVal
;
N
:=
ATN
.
Next_Node
(
N
);
end
loop
;
return
Res
;
end
;
else
return
Empty_Name_Array
;
end
if
;
begin
return
Check_And_Get_Property
(
D
,
Enumerators
);
end
Get_Enumerators
;
---------------------------
...
...
@@ -947,24 +864,10 @@ package body Ocarina.Backends.Properties is
is
pragma
Assert
(
AINU
.
Is_Data
(
D
));
IEEE754_Names
:
constant
Name_Array
(
Supported_IEEE754_Precision
'
Pos
(
Supported_IEEE754_Precision
'
First
)
..
Supported_IEEE754_Precision
'
Pos
(
Supported_IEEE754_Precision
'
Last
))
:=
(
Supported_IEEE754_Precision
'
Pos
(
Precision_Simple
)
=>
Precision_Simple_Name
,
Supported_IEEE754_Precision
'
Pos
(
Precision_Double
)
=>
Precision_Double_Name
,
Supported_IEEE754_Precision
'
Pos
(
Precision_None
)
=>
No_Name
);
function
Get_IEEE754_Precision_Enumerator
is
new
Check_And_Get_Property_Enumerator
(
T
=>
Supported_IEEE754_Precision
);
begin
return
Supported_IEEE754_Precision
'
Val
(
Check_And_Get_Property
(
D
,
IEEE754_Precision
,
IEEE754_Names
,
Supported_IEEE754_Precision
'
Pos
(
Precision_None
)));
return
Get_IEEE754_Precision_Enumerator
(
D
,
IEEE754_Precision
);
end
Get_IEEE754_Precision
;
-----------------------
...
...
@@ -972,32 +875,10 @@ package body Ocarina.Backends.Properties is
-----------------------
function
Get_Initial_Value
(
D
:
Node_Id
)
return
Name_Array
is
I_List
:
List_Id
;
begin
pragma
Assert
(
AINU
.
Is_Data
(
D
));
if
Is_Defined_List_Property
(
D
,
Initial_Value
)
then
I_List
:=
Get_List_Property
(
D
,
Initial_Value
);
declare
use
Ocarina
.
AADL_Values
;
L
:
constant
Nat
:=
Nat
(
Length
(
I_List
));
Res
:
Name_Array
(
1
..
L
);
N
:
Node_Id
;
begin
N
:=
AIN
.
First_Node
(
I_List
);
for
J
in
Res
'
Range
loop
Res
(
J
)
:=
Value
(
Value
(
N
)).
SVal
;
N
:=
AIN
.
Next_Node
(
N
);
end
loop
;
return
Res
;
end
;
else
return
Empty_Name_Array
;
end
if
;
begin
return
Check_And_Get_Property
(
D
,
Initial_Value
);
end
Get_Initial_Value
;
-----------------------
...
...
@@ -1005,37 +886,9 @@ package body Ocarina.Backends.Properties is
-----------------------
function
Get_Integer_Range
(
D
:
Node_Id
)
return
LL_Array
is
R_List
:
List_Id
;
begin
pragma
Assert
(
AINU
.
Is_Data
(
D
));
if
Is_Defined_List_Property
(
D
,
Integer_Range
)
then
R_List
:=
Get_List_Property
(
D
,
Integer_Range
);
declare
use
Ocarina
.
AADL_Values
;
L
:
constant
Nat
:=
Nat
(
Length
(
R_List
));
Res
:
LL_Array
(
1
..
L
);
N
:
Node_Id
;
begin
N
:=
AIN
.
First_Node
(
R_List
);
for
J
in
Res
'
Range
loop
if
Value
(
Value
(
N
)).
ISign
then
Res
(
J
)
:=
-
Long_Long
(
Value
(
Value
(
N
)).
IVal
);
else
Res
(
J
)
:=
Long_Long
(
Value
(
Value
(
N
)).
IVal
);
end
if
;
N
:=
AIN
.
Next_Node
(
N
);
end
loop
;
return
Res
;
end
;
else
return
Empty_LL_Array
;
end
if
;
begin
return
Check_And_Get_Property
(
D
,
Integer_Range
);
end
Get_Integer_Range
;
-------------------------
...
...
@@ -1055,27 +908,15 @@ package body Ocarina.Backends.Properties is
function
Get_Number_Representation
(
D
:
Node_Id
)
return
Supported_Number_Representation
is
R_Name
:
Name_Id
;
begin