Commit 9fe6cded authored by yoogx's avatar yoogx

* 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;
......@@ -36,9 +36,16 @@
package Ocarina.Backends.Properties is
type Name_Array is array (Nat range <>) of Name_Id;
Empty_Name_Array : constant Name_Array;
type ULL_Array is array (Nat range <>) of Unsigned_Long_Long;
Empty_ULL_Array : constant ULL_Array;
type LL_Array is array (Nat range <>) of Long_Long;
Empty_LL_Array : constant LL_Array;
type LD_Array is array (Nat range <>) of Long_Double;
Empty_LD_Array : constant LD_Array;
-- Common types to several components and entities
......@@ -237,19 +244,16 @@ package Ocarina.Backends.Properties is
Access_By_Method,
Access_None);
type Supported_Concurrency_Control_Protocol is
(Concurrency_NoneSpecified,
Concurrency_Read_Only,
Concurrency_Protected_Access,
Concurrency_Immediate_Priority_Ceiling,
Concurrency_Priority_Inheritance,
Concurrency_Priority_Ceiling);
type Supported_Concurrency_Control_Protocol is -- XXX
(None_Specified,
Priority_Inheritance,
Priority_Ceiling);
type Supported_IEEE754_Precision is
(Precision_Simple, Precision_Double, Precision_None);
type Supported_Number_Representation is
(Representation_Signed, Representation_Unsigned, Representation_None);
(Signed, Unsigned, None);
function Get_Base_Type (D : Node_Id) return List_Id;
-- Return the component instance that defines the base data type
......
......@@ -3328,12 +3328,10 @@ package body Ocarina.Backends.Utils is
-----------------------
function Is_Protected_Data (Data_Component : Node_Id) return Boolean is
Concurrency_Protocol : Supported_Concurrency_Control_Protocol;
Concurrency_Protocol : constant Supported_Concurrency_Control_Protocol
:= Get_Concurrency_Protocol (Data_Component);
begin
Concurrency_Protocol := Get_Concurrency_Protocol (Data_Component);
return Concurrency_Protocol = Concurrency_Protected_Access
or else Concurrency_Protocol = Concurrency_Priority_Ceiling;
return Concurrency_Protocol = Priority_Ceiling;
end Is_Protected_Data;
----------------------
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment