Commit f3f39439 authored by Maxime Perrotin's avatar Maxime Perrotin

Work on the new AST

parent b9fe60b0
...@@ -185,21 +185,22 @@ procedure BuildSupport is ...@@ -185,21 +185,22 @@ procedure BuildSupport is
if Get_Category_Of_Component (CI) = CC_System then if Get_Category_Of_Component (CI) = CC_System then
-- Call C function "New_FV" and set the language -- Call C function "New_FV" and set the language
C_New_FV
(Get_Name_String (Name (Identifier (Current_Function))),
Get_Name_String
(Name (Identifier (Current_Function)))'Length,
Get_Name_String (Display_Name (Identifier
(Current_Function))));
-- Read the implementation language of the current -- Read the implementation language of the current
-- FV from the Source_Language property -- FV from the Source_Language property
declare declare
Source_Language : constant Supported_Source_Language -- Read the name of the function
:= Get_Source_Language (CI); FV_Name_L : constant String := ATN_Lower (Current_Function);
FV_Name : constant String := ATN_Case (Current_Function);
-- Read the source language
Source_Language : constant Supported_Source_Language :=
Get_Source_Language (CI);
-- To get the zipfile name where user code is stored
SourceText : constant Name_Array := Get_Source_Text (CI);
ZipId : Name_Id := No_Name;
begin begin
C_New_FV (FV_Name_L, FV_Name'Length, FV_Name);
case Source_Language is case Source_Language is
when Language_Ada_95 => C_Set_Language_To_Ada; when Language_Ada_95 => C_Set_Language_To_Ada;
when Language_C => C_Set_Language_To_C; when Language_C => C_Set_Language_To_C;
...@@ -219,14 +220,12 @@ procedure BuildSupport is ...@@ -219,14 +220,12 @@ procedure BuildSupport is
C_Set_Language_To_BlackBox_Device; C_Set_Language_To_BlackBox_Device;
when Language_QGenAda => C_Set_Language_To_QGenAda; when Language_QGenAda => C_Set_Language_To_QGenAda;
when Language_QGenC => C_Set_Language_To_QGenC; when Language_QGenC => C_Set_Language_To_QGenC;
when others => C_Set_Language_To_Other; when others => Exit_On_Error (True,
"Language is currently not supported: "
& Source_Language'Img);
end case; end case;
end;
declare -- Retrieve the ZIP file (optionally set by the user)
SourceText : constant Name_Array :=
Get_Source_Text (CI);
ZipId : Name_Id := No_Name;
begin
if SourceText'Length /= 0 then if SourceText'Length /= 0 then
ZipId := SourceText (1); ZipId := SourceText (1);
end if; end if;
...@@ -277,15 +276,16 @@ procedure BuildSupport is ...@@ -277,15 +276,16 @@ procedure BuildSupport is
NA : constant Name_Array := NA : constant Name_Array :=
Get_Source_Text (Asn1type); Get_Source_Text (Asn1type);
FS_File : Unbounded_String; FS_File : Unbounded_String;
-- For the Ada AST:
CP : Context_Parameter;
begin begin
-- Some special DATA components have no -- Some special DATA components have no
-- Source_Text property in DataView.aadl -- Source_Text property in DataView.aadl
-- (TASTE-Directive and Tunable Parameter) -- (TASTE-Directive and Tunable Parameter)
if NA'Length > 0 then if NA'Length > 0 then
FS_File := To_Unbounded_String FS_File := US (Get_Name_String (NA (1)));
(Get_Name_String (NA (1)));
else else
FS_File := To_Unbounded_String ("dummy"); FS_File := US ("dummy");
end if; end if;
C_Set_Context_Variable C_Set_Context_Variable
(FS_name, FS_name'Length, (FS_name, FS_name'Length,
...@@ -295,6 +295,11 @@ procedure BuildSupport is ...@@ -295,6 +295,11 @@ procedure BuildSupport is
To_String (FS_file), To_String (FS_file),
To_String (FS_file)'Length, To_String (FS_file)'Length,
FS_Fullname); FS_Fullname);
CP := (Name => US (FS_Fullname),
Sort => US (FS_type),
Default_Value => US (FS_value),
ASN1_Module => US (FS_module),
ASN1_File_Name => FS_file);
end; end;
end if; end if;
FV_Subco := Next_Node (FV_Subco); FV_Subco := Next_Node (FV_Subco);
...@@ -357,18 +362,11 @@ procedure BuildSupport is ...@@ -357,18 +362,11 @@ procedure BuildSupport is
when Sporadic_Operation => when Sporadic_Operation =>
C_Set_Sporadic_IF; C_Set_Sporadic_IF;
when Variator_Operation
| Modifier_Operation =>
C_Set_Variator_IF;
when Protected_Operation => when Protected_Operation =>
C_Set_Protected_IF; C_Set_Protected_IF;
when Unprotected_Operation => when Unprotected_Operation =>
C_Set_Unprotected_IF; C_Set_Unprotected_IF;
when others =>
C_Set_UndefinedKind_IF;
end case; end case;
-- Set the period or MIAT of the PI -- Set the period or MIAT of the PI
...@@ -490,21 +488,11 @@ procedure BuildSupport is ...@@ -490,21 +488,11 @@ procedure BuildSupport is
Get_Name_String (Local_RI_Name)'Length); Get_Name_String (Local_RI_Name)'Length);
end if; end if;
-- inform C-code about the kind of PI it is
-- (cyclic, sporadic, etc). Important: Has
-- to be updated in case of several
-- SPORADIC...
case Operation_Kind is case Operation_Kind is
when Sporadic_Operation => when Sporadic_Operation =>
C_Set_ASync_IF; C_Set_ASync_IF;
C_Set_Sporadic_IF; C_Set_Sporadic_IF;
when Variator_Operation
| Modifier_Operation =>
C_Set_ASync_IF;
C_Set_Variator_IF;
when Protected_Operation => when Protected_Operation =>
C_Set_Sync_IF; C_Set_Sync_IF;
C_Set_Protected_IF; C_Set_Protected_IF;
...@@ -514,8 +502,9 @@ procedure BuildSupport is ...@@ -514,8 +502,9 @@ procedure BuildSupport is
C_Set_Unprotected_IF; C_Set_Unprotected_IF;
when others => when others =>
C_Set_ASync_IF; Exit_On_Error (True,
C_Set_UndefinedKind_IF; "Unsupported kind of RI: "
& Get_Name_String (Local_RI_Name));
end case; end case;
end if; end if;
...@@ -858,16 +847,14 @@ procedure BuildSupport is ...@@ -858,16 +847,14 @@ procedure BuildSupport is
If2_Name := Get_Interface_Name (Dst_Port); If2_Name := Get_Interface_Name (Dst_Port);
-- Get_Interface_Name is v1.3.5+ only -- Get_Interface_Name is v1.3.5+ only
if If1_Name /= No_Name and If2_Name /= No_Name then if If1_Name /= No_Name and If2_Name /= No_Name then
Src_Name := To_Unbounded_String (Get_Name_String (If1_Name)); Src_Name := US (Get_Name_String (If1_Name));
Dst_Name := To_Unbounded_String (Get_Name_String (If2_Name)); Dst_Name := US (Get_Name_String (If2_Name));
else else
-- Keep compatibility with v1.2 -- Keep compatibility with v1.2
Src_Name := To_Unbounded_String (Get_Name_String Src_Name := US (Get_Name_String (Display_Name
(Display_Name
(Identifier (Src_Port)))); (Identifier (Src_Port))));
Dst_Name := To_Unbounded_String (Get_Name_String Dst_Name := US (Get_Name_String (Display_Name
(Display_Name
(Identifier (Dst_Port)))); (Identifier (Dst_Port))));
end if; end if;
-- Put_Line (To_String (Src_Name) & " -> " & To_String (Dst_Name)); -- Put_Line (To_String (Src_Name) & " -> " & To_String (Dst_Name));
...@@ -1193,7 +1180,7 @@ procedure BuildSupport is ...@@ -1193,7 +1180,7 @@ procedure BuildSupport is
Bound_APLC_Name : Unbounded_String; Bound_APLC_Name : Unbounded_String;
begin begin
begin begin
Bound_APLC_Name := To_Unbounded_String Bound_APLC_Name := US
(Get_Name_String (Get_Name_String
(ATN.Name (ATN.Name
(ATN.Component_Type_Identifier (ATN.Component_Type_Identifier
...@@ -1202,7 +1189,7 @@ procedure BuildSupport is ...@@ -1202,7 +1189,7 @@ procedure BuildSupport is
when System.Assertions.Assert_Failure => when System.Assertions.Assert_Failure =>
Put_Line Put_Line
("Detected DV from TASTE version 1.2"); ("Detected DV from TASTE version 1.2");
Bound_APLC_Name := To_Unbounded_String Bound_APLC_Name := US
(Get_Name_String (Get_Name_String
(Name (Identifier (Processes2)))); (Name (Identifier (Processes2))));
end; end;
......
...@@ -6,12 +6,11 @@ with Ada.Text_IO; ...@@ -6,12 +6,11 @@ with Ada.Text_IO;
with GNAT.OS_Lib; with GNAT.OS_Lib;
-- with Ocarina.Namet; -- with Ocarina.Namet;
with Namet;
with Ocarina.Configuration; with Ocarina.Configuration;
with Ocarina.AADL_Values; with Ocarina.AADL_Values;
with Ocarina.Instances.Queries; with Ocarina.Instances.Queries;
with Ocarina.ME_AADL.AADL_Tree.Nodes; -- with Ocarina.ME_AADL.AADL_Tree.Nodes;
with Ocarina.ME_AADL.AADL_Instances.Nodes; -- with Ocarina.ME_AADL.AADL_Instances.Nodes;
with Ocarina.ME_AADL.AADL_Instances.Nutils; with Ocarina.ME_AADL.AADL_Instances.Nutils;
with Ada.Characters.Latin_1; with Ada.Characters.Latin_1;
...@@ -21,14 +20,13 @@ package body Buildsupport_Utils is ...@@ -21,14 +20,13 @@ package body Buildsupport_Utils is
use GNAT.OS_Lib; use GNAT.OS_Lib;
-- use Ocarina.Namet; -- use Ocarina.Namet;
use Namet;
use Ocarina.Instances.Queries; use Ocarina.Instances.Queries;
use Ocarina.ME_AADL.AADL_Instances.Nodes; -- use Ocarina.ME_AADL.AADL_Instances.Nodes;
use Ocarina.ME_AADL.AADL_Instances.Nutils; use Ocarina.ME_AADL.AADL_Instances.Nutils;
use Ada.Characters.Latin_1; use Ada.Characters.Latin_1;
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 AIN renames Ocarina.ME_AADL.AADL_Instances.Nodes;
use type ATN.Node_Kind; -- use type ATN.Node_Kind;
------------ ------------
-- Banner -- -- Banner --
...@@ -115,8 +113,6 @@ package body Buildsupport_Utils is ...@@ -115,8 +113,6 @@ package body Buildsupport_Utils is
RCM_Operation_Kind : Name_Id; RCM_Operation_Kind : Name_Id;
Unprotected_Name : Name_Id; Unprotected_Name : Name_Id;
Protected_Name : Name_Id; Protected_Name : Name_Id;
Variator_Name : Name_Id;
Modifier_Name : Name_Id;
Cyclic_Name : Name_Id; Cyclic_Name : Name_Id;
Sporadic_Name : Name_Id; Sporadic_Name : Name_Id;
...@@ -136,12 +132,6 @@ package body Buildsupport_Utils is ...@@ -136,12 +132,6 @@ package body Buildsupport_Utils is
elsif RCM_Operation_Kind_N = Protected_Name then elsif RCM_Operation_Kind_N = Protected_Name then
return Protected_Operation; return Protected_Operation;
elsif RCM_Operation_Kind_N = Variator_Name then
return Variator_Operation;
elsif RCM_Operation_Kind_N = Modifier_Name then
return Modifier_Operation;
elsif RCM_Operation_Kind_N = Cyclic_Name then elsif RCM_Operation_Kind_N = Cyclic_Name then
return Cyclic_Operation; return Cyclic_Operation;
...@@ -149,7 +139,7 @@ package body Buildsupport_Utils is ...@@ -149,7 +139,7 @@ package body Buildsupport_Utils is
return Sporadic_Operation; return Sporadic_Operation;
end if; end if;
end if; end if;
return Unknown_Operation; Exit_On_Error (True, "Could not determine interface kind");
end Get_RCM_Operation_Kind; end Get_RCM_Operation_Kind;
----------------------- -----------------------
...@@ -256,10 +246,9 @@ package body Buildsupport_Utils is ...@@ -256,10 +246,9 @@ package body Buildsupport_Utils is
-- Input parameter is an AADL instance -- -- Input parameter is an AADL instance --
-------------------------------------------- --------------------------------------------
function Get_Properties_Map (D : Node_Id) return Property_Maps.Map is function Get_Properties_Map (D : Node_Id) return Property_Maps.Map is
properties : constant List_Id := properties : constant List_Id := AIN.Properties (D);
Ocarina.ME_AADL.AADL_Instances.Nodes.Properties (D);
result : Property_Maps.Map := Empty_Map; result : Property_Maps.Map := Empty_Map;
property : Node_Id := First_Node (properties); property : Node_Id := AIN.First_Node (properties);
prop_value : Node_Id; prop_value : Node_Id;
single_val : Node_Id; single_val : Node_Id;
begin begin
...@@ -268,8 +257,7 @@ package body Buildsupport_Utils is ...@@ -268,8 +257,7 @@ package body Buildsupport_Utils is
if Present (ATN.Single_Value (prop_value)) then if Present (ATN.Single_Value (prop_value)) then
-- Only support single-value properties for now -- Only support single-value properties for now
single_val := ATN.Single_Value (prop_value); single_val := ATN.Single_Value (prop_value);
result.Insert (Key => Get_Name_String result.Insert (Key => AIN_Case (property),
(Display_Name (Identifier (property))),
New_Item => New_Item =>
(case ATN.Kind (single_val) is (case ATN.Kind (single_val) is
when ATN.K_Signed_AADLNumber => when ATN.K_Signed_AADLNumber =>
...@@ -294,7 +282,7 @@ package body Buildsupport_Utils is ...@@ -294,7 +282,7 @@ package body Buildsupport_Utils is
when others => "ERROR! Unsupported kind: " when others => "ERROR! Unsupported kind: "
& ATN.Kind (single_val)'Img)); & ATN.Kind (single_val)'Img));
end if; end if;
property := Next_Node (property); property := AIN.Next_Node (property);
end loop; end loop;
return result; return result;
end Get_Properties_Map; end Get_Properties_Map;
...@@ -426,8 +414,6 @@ package body Buildsupport_Utils is ...@@ -426,8 +414,6 @@ package body Buildsupport_Utils is
Unprotected_Name := Get_String_Name ("unprotected"); Unprotected_Name := Get_String_Name ("unprotected");
Protected_Name := Get_String_Name ("protected"); Protected_Name := Get_String_Name ("protected");
Variator_Name := Get_String_Name ("variator");
Modifier_Name := Get_String_Name ("modifier");
Cyclic_Name := Get_String_Name ("cyclic"); Cyclic_Name := Get_String_Name ("cyclic");
Sporadic_Name := Get_String_Name ("sporadic"); Sporadic_Name := Get_String_Name ("sporadic");
......
...@@ -6,20 +6,29 @@ ...@@ -6,20 +6,29 @@
with Ocarina, with Ocarina,
-- Ocarina.Types, -- Ocarina.Types,
Types, Types,
Namet,
Ocarina.Backends.Properties, Ocarina.Backends.Properties,
Ada.Containers.Indefinite_Ordered_Maps, Ada.Containers.Indefinite_Ordered_Maps,
Ada.Containers.Indefinite_Vectors, Ada.Containers.Indefinite_Vectors,
Ocarina.ME_AADL.AADL_Tree.Nodes,
Ocarina.ME_AADL.AADL_Instances.Nodes,
Ada.Strings.Unbounded; Ada.Strings.Unbounded;
use Ocarina, use Ocarina,
Types,
Namet,
Ocarina.Backends.Properties, Ocarina.Backends.Properties,
Ocarina.ME_AADL.AADL_Tree.Nodes,
Ocarina.ME_AADL.AADL_Instances.Nodes,
Ada.Containers, Ada.Containers,
Ada.Strings.Unbounded; Ada.Strings.Unbounded;
package Buildsupport_Utils is package Buildsupport_Utils is
-- use Ocarina.Types; package ATN renames Ocarina.ME_AADL.AADL_Tree.Nodes;
use Types; package AIN renames Ocarina.ME_AADL.AADL_Instances.Nodes;
function US (Source : in String) return Unbounded_String renames
To_Unbounded_String;
procedure Banner; procedure Banner;
...@@ -33,11 +42,8 @@ package Buildsupport_Utils is ...@@ -33,11 +42,8 @@ package Buildsupport_Utils is
type Supported_RCM_Operation_Kind is (Unprotected_Operation, type Supported_RCM_Operation_Kind is (Unprotected_Operation,
Protected_Operation, Protected_Operation,
Variator_Operation,
Modifier_Operation,
Cyclic_Operation, Cyclic_Operation,
Sporadic_Operation, Sporadic_Operation);
Unknown_Operation);
function Get_RCM_Operation_Kind (E : Node_Id) function Get_RCM_Operation_Kind (E : Node_Id)
return Supported_RCM_Operation_Kind; return Supported_RCM_Operation_Kind;
...@@ -81,6 +87,22 @@ package Buildsupport_Utils is ...@@ -81,6 +87,22 @@ package Buildsupport_Utils is
function Get_Properties_Map (D : Node_Id) return Property_Maps.Map; function Get_Properties_Map (D : Node_Id) return Property_Maps.Map;
-- Shortcut to read an identifier from the parser, in lowercase
function ATN_Lower (N : Node_Id) return String is
(Get_Name_String (ATN.Name (ATN.Identifier (N))));
-- Shortcut to read an identifier from the parser, with original case
function ATN_Case (N : Node_Id) return String is
(Get_Name_String (ATN.Display_Name (ATN.Identifier (N))));
-- Shortcut to read an identifier from the parser, in lowercase
function AIN_Lower (N : Node_Id) return String is
(Get_Name_String (AIN.Name (AIN.Identifier (N))));
-- Shortcut to read an identifier from the parser, with original case
function AIN_Case (N : Node_Id) return String is
(Get_Name_String (AIN.Display_Name (AIN.Identifier (N))));
-- Types needed to build the AST of the TASTE Interface View in Ada -- Types needed to build the AST of the TASTE Interface View in Ada
type Parameter_Direction is (param_in, param_out); type Parameter_Direction is (param_in, param_out);
...@@ -107,16 +129,29 @@ package Buildsupport_Utils is ...@@ -107,16 +129,29 @@ package Buildsupport_Utils is
WCET : Natural; WCET : Natural;
WCET_Unit : Unbounded_String; WCET_Unit : Unbounded_String;
Queue_Size : Natural; Queue_Size : Natural;
User_Properties : Property_Maps.Map;
end record; end record;
package Interfaces is new Indefinite_Vectors (Natural, Taste_Interface); package Interfaces is new Indefinite_Vectors (Natural, Taste_Interface);
type Context_Parameter is
record
Name : Unbounded_String;
Sort : Unbounded_String;
Default_Value : Unbounded_String;
ASN1_Module : Unbounded_String;
ASN1_File_Name : Unbounded_String;
end record;
package Ctxt_Params is new Indefinite_Vectors (Natural, Context_Parameter);
type Taste_Terminal_Function is type Taste_Terminal_Function is
record record
Name : Unbounded_String; Name : Unbounded_String;
Language : Supported_Source_Language; Language : Supported_Source_Language;
Zip_File : Unbounded_String; Zip_File : Unbounded_String;
Context_Params : Property_Maps.Map; Context_Params : Ctxt_Params.Vector;
User_Properties : Property_Maps.Map;
Timers : String_Vectors.Vector; Timers : String_Vectors.Vector;
Provided : Interfaces.Vector; Provided : Interfaces.Vector;
Required : Interfaces.Vector; Required : Interfaces.Vector;
......
with "ocarina"; with "ocarina";
with "templates_parser"; -- from libtemplates-parser11.10.1-dev
project BuildSupport is project BuildSupport is
...@@ -26,10 +27,10 @@ project BuildSupport is ...@@ -26,10 +27,10 @@ project BuildSupport is
package Compiler is package Compiler is
for Default_Switches ("Ada") use for Default_Switches ("Ada") use
("-g", ("-g",
"-gnat05", "-gnat12",
"-gnatf", "-gnatf",
"-gnaty", "-gnaty",
-- "-gnatwa", "-gnatwa",
"-gnatoa", "-gnatoa",
"-gnatg", "-gnatg",
"-fstack-check"); "-fstack-check");
......
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