Commit 9fe6cded authored by yoogx's avatar 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
...@@ -390,8 +390,7 @@ package body Ocarina.Backends.C_Common.Types is ...@@ -390,8 +390,7 @@ package body Ocarina.Backends.C_Common.Types is
Data_Array_Size : constant ULL_Array := Get_Dimension (E); Data_Array_Size : constant ULL_Array := Get_Dimension (E);
Number_Representation : constant Supported_Number_Representation := Number_Representation : constant Supported_Number_Representation :=
Get_Number_Representation (E); Get_Number_Representation (E);
Is_Signed : constant Boolean := Is_Signed : constant Boolean := Number_Representation = Signed;
(Number_Representation = Representation_Signed);
Type_Uint8 : Node_Id; Type_Uint8 : Node_Id;
Type_Int8 : Node_Id; Type_Int8 : Node_Id;
...@@ -801,16 +800,7 @@ package body Ocarina.Backends.C_Common.Types is ...@@ -801,16 +800,7 @@ package body Ocarina.Backends.C_Common.Types is
True); True);
end if; end if;
elsif Get_Concurrency_Protocol (E) = elsif Get_Concurrency_Protocol (E) =
Concurrency_Protected_Access Priority_Ceiling
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
then then
-- Protected type that does not have struct members. -- Protected type that does not have struct members.
......
...@@ -234,8 +234,8 @@ package body Ocarina.Backends.Cheddar.Mapping is ...@@ -234,8 +234,8 @@ package body Ocarina.Backends.Cheddar.Mapping is
Concurrency_Protocols : constant array Concurrency_Protocols : constant array
(Supported_Concurrency_Control_Protocol'Range) of Name_Id := (Supported_Concurrency_Control_Protocol'Range) of Name_Id :=
(Concurrency_NoneSpecified => Get_String_Name ("NO_PROTOCOL"), (None_Specified => Get_String_Name ("NO_PROTOCOL"),
Concurrency_Priority_Ceiling => Priority_Ceiling =>
Get_String_Name ("PRIORITY_CEILING_PROTOCOL"), Get_String_Name ("PRIORITY_CEILING_PROTOCOL"),
others => No_Name); others => No_Name);
......
...@@ -553,8 +553,7 @@ package body Ocarina.Backends.MAST.Main is ...@@ -553,8 +553,7 @@ package body Ocarina.Backends.MAST.Main is
end if; end if;
Append_Node_To_List (N, MTN.Declarations (MAST_File)); Append_Node_To_List (N, MTN.Declarations (MAST_File));
if CP = Concurrency_Protected_Access if CP = Priority_Ceiling
or else CP = Concurrency_Priority_Ceiling
or else Is_Protected_Data (E) or else Is_Protected_Data (E)
or else Get_Data_Representation (E) = Data_With_Accessors or else Get_Data_Representation (E) = Data_With_Accessors
then then
......
...@@ -263,8 +263,7 @@ package body Ocarina.Backends.PO_HI_Ada.Types is ...@@ -263,8 +263,7 @@ package body Ocarina.Backends.PO_HI_Ada.Types is
Data_Size : Size_Type; Data_Size : Size_Type;
Number_Representation : constant Supported_Number_Representation := Number_Representation : constant Supported_Number_Representation :=
Get_Number_Representation (E); Get_Number_Representation (E);
Is_Signed : constant Boolean := Is_Signed : constant Boolean := Number_Representation = Signed;
(Number_Representation = Representation_Signed);
begin begin
-- Do not generate Ada type more than once -- Do not generate Ada type more than once
...@@ -700,7 +699,7 @@ package body Ocarina.Backends.PO_HI_Ada.Types is ...@@ -700,7 +699,7 @@ package body Ocarina.Backends.PO_HI_Ada.Types is
-- the AADL model. -- the AADL model.
CCP := Get_Concurrency_Protocol (E); CCP := Get_Concurrency_Protocol (E);
if CCP /= Concurrency_Priority_Ceiling then if CCP /= Priority_Ceiling then
Display_Located_Error Display_Located_Error
(Loc (E), (Loc (E),
"Incompatible concurrency protocol, " & "Incompatible concurrency protocol, " &
......
...@@ -2014,7 +2014,7 @@ package body Ocarina.Backends.PO_HI_C.Deployment is ...@@ -2014,7 +2014,7 @@ package body Ocarina.Backends.PO_HI_C.Deployment is
Make_Literal (New_Int_Value (0, 1, 10)); Make_Literal (New_Int_Value (0, 1, 10));
case Get_Concurrency_Protocol (Corresponding_Instance (C)) is case Get_Concurrency_Protocol (Corresponding_Instance (C)) is
when Concurrency_Priority_Ceiling => when Priority_Ceiling =>
Protected_Priority := Protected_Priority :=
Make_Literal Make_Literal
(New_Int_Value (New_Int_Value
...@@ -2024,12 +2024,6 @@ package body Ocarina.Backends.PO_HI_C.Deployment is ...@@ -2024,12 +2024,6 @@ package body Ocarina.Backends.PO_HI_C.Deployment is
10)); 10));
Protected_Protocol := RE (RE_Protected_PCP); 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 => when others =>
Protected_Protocol := RE (RE_Protected_Regular); Protected_Protocol := RE (RE_Protected_Regular);
end case; end case;
......
...@@ -494,7 +494,7 @@ package body Ocarina.Backends.PO_HI_C.Main is ...@@ -494,7 +494,7 @@ package body Ocarina.Backends.PO_HI_C.Main is
Append_Node_To_List (N, CTN.Declarations (Current_File)); Append_Node_To_List (N, CTN.Declarations (Current_File));
if Get_Concurrency_Protocol (Corresponding_Instance (S)) if Get_Concurrency_Protocol (Corresponding_Instance (S))
/= Concurrency_NoneSpecified /= None_Specified
then then
N := N :=
Make_Expression Make_Expression
......
...@@ -910,8 +910,7 @@ package body Ocarina.Backends.PO_HI_C.Marshallers is ...@@ -910,8 +910,7 @@ package body Ocarina.Backends.PO_HI_C.Marshallers is
To_Bytes (Data_Size); To_Bytes (Data_Size);
Number_Representation : constant Supported_Number_Representation := Number_Representation : constant Supported_Number_Representation :=
Get_Number_Representation (E); Get_Number_Representation (E);
Is_Signed : constant Boolean := Is_Signed : constant Boolean := Number_Representation = Signed;
(Number_Representation = Representation_Signed);
begin begin
case Data_Representation is case Data_Representation is
...@@ -986,8 +985,7 @@ package body Ocarina.Backends.PO_HI_C.Marshallers is ...@@ -986,8 +985,7 @@ package body Ocarina.Backends.PO_HI_C.Marshallers is
To_Bytes (Data_Size); To_Bytes (Data_Size);
Number_Representation : constant Supported_Number_Representation := Number_Representation : constant Supported_Number_Representation :=
Get_Number_Representation (E); Get_Number_Representation (E);
Is_Signed : constant Boolean := Is_Signed : constant Boolean := Number_Representation = Signed;
(Number_Representation = Representation_Signed);
begin begin
case Data_Representation is case Data_Representation is
......
...@@ -33,10 +33,10 @@ with Ocarina.Backends.Messages; ...@@ -33,10 +33,10 @@ with Ocarina.Backends.Messages;
with Ocarina.Instances.Queries; with Ocarina.Instances.Queries;
with Ocarina.ME_AADL.AADL_Instances.Nodes; with Ocarina.ME_AADL.AADL_Instances.Nodes;
with Ocarina.Namet; with Ocarina.Namet;
with Charset; use Charset;
with Utils; with Utils;
with Ocarina.ME_AADL.AADL_Tree.Nodes; with Ocarina.ME_AADL.AADL_Tree.Nodes;
with Ocarina.ME_AADL.AADL_Tree.NUtils; with Ocarina.ME_AADL.AADL_Tree.NUtils;
with Ocarina.AADL_Values;
package body Ocarina.Backends.Properties.Utils is package body Ocarina.Backends.Properties.Utils is
...@@ -47,6 +47,7 @@ package body Ocarina.Backends.Properties.Utils is ...@@ -47,6 +47,7 @@ package body Ocarina.Backends.Properties.Utils is
use Standard.Utils; use Standard.Utils;
package ATN renames Ocarina.ME_AADL.AADL_Tree.Nodes; 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; package ATNU renames Ocarina.ME_AADL.AADL_Tree.NUtils;
use type ATN.Node_Kind; use type ATN.Node_Kind;
...@@ -314,4 +315,161 @@ package body Ocarina.Backends.Properties.Utils is ...@@ -314,4 +315,161 @@ package body Ocarina.Backends.Properties.Utils is
return Default_Value; return Default_Value;
end Check_And_Get_Property; 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; end Ocarina.Backends.Properties.Utils;
...@@ -30,6 +30,8 @@ ...@@ -30,6 +30,8 @@
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
with GNAT.OS_Lib; use GNAT.OS_Lib; 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 package Ocarina.Backends.Properties.Utils is
...@@ -99,4 +101,50 @@ package Ocarina.Backends.Properties.Utils is ...@@ -99,4 +101,50 @@ package Ocarina.Backends.Properties.Utils is
Default_Value : Int := Int'First) Default_Value : Int := Int'First)
return Int; 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; end Ocarina.Backends.Properties.Utils;
...@@ -43,7 +43,6 @@ with Ocarina.ME_AADL.AADL_Tree.Entities.Properties; ...@@ -43,7 +43,6 @@ with Ocarina.ME_AADL.AADL_Tree.Entities.Properties;
with Ocarina.ME_AADL.AADL_Tree.Entities; with Ocarina.ME_AADL.AADL_Tree.Entities;
with Ocarina.AADL_Values; with Ocarina.AADL_Values;
with Ocarina.Instances.Queries; with Ocarina.Instances.Queries;
-- with Ocarina.Analyzer.AADL.Queries;
with Ocarina.Backends.Utils; with Ocarina.Backends.Utils;
with Ocarina.Backends.Messages; with Ocarina.Backends.Messages;
...@@ -247,20 +246,6 @@ package body Ocarina.Backends.Properties is ...@@ -247,20 +246,6 @@ package body Ocarina.Backends.Properties is
Access_Read_Write_Name : Name_Id; Access_Read_Write_Name : Name_Id;
Access_By_Method_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_Name : Name_Id;
Language_Ada_95_Name : Name_Id; Language_Ada_95_Name : Name_Id;
Language_Ada_05_Name : Name_Id; Language_Ada_05_Name : Name_Id;
...@@ -844,32 +829,9 @@ package body Ocarina.Backends.Properties is ...@@ -844,32 +829,9 @@ package body Ocarina.Backends.Properties is
------------------- -------------------
function Get_Dimension (D : Node_Id) return ULL_Array is function Get_Dimension (D : Node_Id) return ULL_Array is
D_List : List_Id;
begin
pragma Assert (AINU.Is_Data (D)); pragma Assert (AINU.Is_Data (D));
begin
if Is_Defined_List_Property (D, Dimension) then return Check_And_Get_Property (D, Dimension);
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;
end Get_Dimension; end Get_Dimension;
----------------------- -----------------------
...@@ -877,32 +839,10 @@ package body Ocarina.Backends.Properties is ...@@ -877,32 +839,10 @@ package body Ocarina.Backends.Properties is
----------------------- -----------------------
function Get_Element_Names (D : Node_Id) return Name_Array is function Get_Element_Names (D : Node_Id) return Name_Array is
N_List : List_Id;
begin
pragma Assert (AINU.Is_Data (D)); pragma Assert (AINU.Is_Data (D));
if Is_Defined_List_Property (D, Element_Names) then begin
N_List := Get_List_Property (D, Element_Names); return Check_And_Get_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;
end Get_Element_Names; end Get_Element_Names;
--------------------- ---------------------
...@@ -910,32 +850,9 @@ package body Ocarina.Backends.Properties is ...@@ -910,32 +850,9 @@ package body Ocarina.Backends.Properties is
--------------------- ---------------------
function Get_Enumerators (D : Node_Id) return Name_Array is function Get_Enumerators (D : Node_Id) return Name_Array is
E_List : List_Id;
begin
pragma Assert (AINU.Is_Data (D)); pragma Assert (AINU.Is_Data (D));
begin
if Is_Defined_List_Property (D, Enumerators) then return Check_And_Get_Property (D, Enumerators);
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;
end Get_Enumerators; end Get_Enumerators;
--------------------------- ---------------------------
...@@ -947,24 +864,10 @@ package body Ocarina.Backends.Properties is ...@@ -947,24 +864,10 @@ package body Ocarina.Backends.Properties is
is is