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
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.
......
......@@ -234,8 +234,8 @@ package body Ocarina.Backends.Cheddar.Mapping is
Concurrency_Protocols : constant array
(Supported_Concurrency_Control_Protocol'Range) of Name_Id :=
(Concurrency_NoneSpecified => Get_String_Name ("NO_PROTOCOL"),
Concurrency_Priority_Ceiling =>
(None_Specified => Get_String_Name ("NO_PROTOCOL"),
Priority_Ceiling =>
Get_String_Name ("PRIORITY_CEILING_PROTOCOL"),
others => No_Name);
......
......@@ -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
......
......@@ -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, " &
......
......@@ -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;
......
......@@ -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))
/= Concurrency_NoneSpecified
/= None_Specified
then
N :=
Make_Expression
......
......@@ -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
......
......@@ -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;
......@@ -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;
......@@ -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
pragma Assert (AINU.Is_Data (D));