Commit 7d861098 authored by Daniel Tuulik's avatar Daniel Tuulik
Browse files

Merge branch 'qgen_fix_adacore' of https://gitrepos.estec.esa.int/taste/kazoo into qgen_fix_adacore

parents 762a5387 c7683f55
......@@ -2,7 +2,7 @@ all:
mkdir -p tmp
mkdir -p new-templates
# Extract the latest template tags from any demo project and put them in the new-templates folder
cd ../test/test-cv && kazoo --doc -o ../../doc/tmp --gw -g --glue && mv ../../doc/tmp/Dump/Doc/* ../../doc/new-templates
cd ../test/Demo_Distrib && kazoo --doc -o ../../doc/tmp --gw -g --glue && mv ../../doc/tmp/Dump/Doc/* ../../doc/new-templates
mkdir -p preprocess
cp templates/templates_from_wiki preprocess # copy the previous one
mv templates/templates_from_wiki templates/templates_from_wiki.old # delete the old templates
......
......@@ -7,6 +7,7 @@ templates/skeletons/sub/function.tmplt
templates/skeletons/sub/interface.tmplt
templates/skeletons/sub/makefile.tmplt
templates/concurrency_view/sub/trigger.tmplt
templates/concurrency_view/sub/bus.tmplt
templates/concurrency_view/sub/thread.tmplt
templates/concurrency_view/sub/pi.tmplt
templates/concurrency_view/sub/ri.tmplt
......
......@@ -18,6 +18,12 @@ This template is evaluated only once. The output is saved to the Makefile within
|Has_Context_Param
|↳ and flag to indicate if function has context parameters
|-
|Instance_Of
|↳ and the instance name or empty string
|-
|Is_Shared_Type
|↳ true if component is an instance of a function stored in the shared types folder
|-
|CP_Files
|List of all context parameters ASN.1 files
|-
......@@ -118,7 +124,7 @@ This template is evaluated for every function which has context parameters. The
|DOCUMENTATION MISSING
|-
|Instance_Of
|DOCUMENTATION MISSING
|Name of instance or empty string
|}
=== templates/skeletons/sub/trigger.tmplt ===
This template is evaluated to trigger processing of other files from given directory.
......@@ -689,6 +695,28 @@ This file is processed for every node. The result of this file indicates if the
|Is_Distributed
|True if the system contains at least one bus
|}
=== templates/concurrency_view/sub/bus.tmplt ===
This template is parsed for all busses referenced in system.tmplt
{| class="wikitable"
!Parameter name
!Description
|-
|Bus_Name
|Name of the bus
|-
|Classifier
|AADL Classifier for the bus
|-
|Property_Names
|AADL property names (vector tag)
|-
|Property_Values
|AADL property values
|-
|AADL_Package
|AADL package name containing the bus
|}
=== templates/concurrency_view/sub/thread.tmplt ===
This file is processed for every thread in every partition in every node.
{| class="wikitable"
......@@ -1148,7 +1176,7 @@ This template is evaluated for every block.
|True if function is a function type
|-
|Instance_Of
|DOCUMENTATION MISSING
|Name of instance or empty string
|-
|Debug_Flag
|if -g is set in the command line
......@@ -1551,6 +1579,9 @@ filesys.tmplt.
|Bus_Classifier
| ↳ Corresponding AADL classifier
|-
|Bus_Properties
| ↳ Corresponding AADL properties (from bus.tmplt)
|-
|Device_Node_Name
|
|-
......@@ -1669,4 +1700,4 @@ filesys.tmplt.
|-
|Block_Languages
|DOCUMENTATION MISSING
|}
|}
\ No newline at end of file
......@@ -126,7 +126,7 @@ This template is evaluated for every block.
| Is_Type | True if function is a function |
| | type |
+-----------------------------------+-----------------------------------+
| Instance_Of | DOCUMENTATION MISSING |
| Instance_Of | Name of instance or empty string |
+-----------------------------------+-----------------------------------+
| Debug_Flag | if -g is set in the command line |
+-----------------------------------+-----------------------------------+
......
templates/concurrency_view/sub/bus.tmplt
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
This template is parsed for all busses referenced in system.tmplt
+-----------------+--------------------------------------+
| Parameter name | Description |
+=================+======================================+
| Bus_Name | Name of the bus |
+-----------------+--------------------------------------+
| Classifier | AADL Classifier for the bus |
+-----------------+--------------------------------------+
| Property_Names | AADL property names (vector tag) |
+-----------------+--------------------------------------+
| Property_Values | AADL property values |
+-----------------+--------------------------------------+
| AADL_Package | AADL package name containing the bus |
+-----------------+--------------------------------------+
......@@ -64,6 +64,9 @@ to the file with name returned by filesys.tmplt.
+-----------------------------------+-----------------------------------+
| Bus_Classifier | ↳ Corresponding AADL classifier |
+-----------------------------------+-----------------------------------+
| Bus_Properties | ↳ Corresponding AADL properties |
| | (from bus.tmplt) |
+-----------------------------------+-----------------------------------+
| Device_Node_Name | |
+-----------------------------------+-----------------------------------+
| Device_Partition | |
......
......@@ -18,6 +18,12 @@ This template is evaluated only once. The output is saved to the Makefile within
|Has_Context_Param
|↳ and flag to indicate if function has context parameters
|-
|Instance_Of
|↳ and the instance name or empty string
|-
|Is_Shared_Type
|↳ true if component is an instance of a function stored in the shared types folder
|-
|CP_Files
|List of all context parameters ASN.1 files
|-
......@@ -118,7 +124,7 @@ This template is evaluated for every function which has context parameters. The
|DOCUMENTATION MISSING
|-
|Instance_Of
|DOCUMENTATION MISSING
|Name of instance or empty string
|}
=== templates/skeletons/sub/trigger.tmplt ===
This template is evaluated to trigger processing of other files from given directory.
......@@ -689,6 +695,28 @@ This file is processed for every node. The result of this file indicates if the
|Is_Distributed
|True if the system contains at least one bus
|}
=== templates/concurrency_view/sub/bus.tmplt ===
This template is parsed for all busses referenced in system.tmplt
{| class="wikitable"
!Parameter name
!Description
|-
|Bus_Name
|Name of the bus
|-
|Classifier
|AADL Classifier for the bus
|-
|Property_Names
|AADL property names (vector tag)
|-
|Property_Values
|AADL property values
|-
|AADL_Package
|AADL package name containing the bus
|}
=== templates/concurrency_view/sub/thread.tmplt ===
This file is processed for every thread in every partition in every node.
{| class="wikitable"
......@@ -1148,7 +1176,7 @@ This template is evaluated for every block.
|True if function is a function type
|-
|Instance_Of
|DOCUMENTATION MISSING
|Name of instance or empty string
|-
|Debug_Flag
|if -g is set in the command line
......@@ -1551,6 +1579,9 @@ filesys.tmplt.
|Bus_Classifier
| ↳ Corresponding AADL classifier
|-
|Bus_Properties
| ↳ Corresponding AADL properties (from bus.tmplt)
|-
|Device_Node_Name
|
|-
......
......@@ -23,5 +23,5 @@ parameters. The output is saved to the file Context-.asn
+----------------+-----------------------------------------------------+
| Is_Type | DOCUMENTATION MISSING |
+----------------+-----------------------------------------------------+
| Instance_Of | DOCUMENTATION MISSING |
| Instance_Of | Name of instance or empty string |
+----------------+-----------------------------------------------------+
......@@ -19,6 +19,13 @@ Makefile within output directory.
| Has_Context_Param | ↳ and flag to indicate if |
| | function has context parameters |
+-----------------------------------+-----------------------------------+
| Instance_Of | ↳ and the instance name or empty |
| | string |
+-----------------------------------+-----------------------------------+
| Is_Shared_Type | ↳ true if component is an |
| | instance of a function stored in |
| | the shared types folder |
+-----------------------------------+-----------------------------------+
| CP_Files | List of all context parameters |
| | ASN.1 files |
+-----------------------------------+-----------------------------------+
......
-- ************************ TASTE AADL Parser ************************** --
-- Based on Ocarina **************************************************** --
-- (c) 2019-2020 Maxime Perrotin / ESA - maxime.perrotin@esa.int
-- (c) 2019-2021 Maxime Perrotin / ESA - maxime.perrotin@esa.int
-- ********************************************************************* --
--
with System.Assertions,
......@@ -348,9 +348,9 @@ package body TASTE.AADL_Parser is
Result : Ports.Map;
Visited_Functions : String_Sets.Set;
procedure Rec_Find_Thread (Ports_Map : in out Ports.Map;
Visited : in out String_Sets.Set;
Func : Taste_Terminal_Function) is
procedure Rec_Find_Thread (Ports_Map : in out Ports.Map;
Visited : in out String_Sets.Set;
Func : Taste_Terminal_Function) is
use String_Sets;
Current_Function : constant String_Sets.Set :=
String_Sets.To_Set (To_String (Func.Name));
......@@ -390,7 +390,13 @@ package body TASTE.AADL_Parser is
Remote_Thread_Name : constant Unbounded_String :=
To_Lower (To_String (Dist.Function_Name))
& "_" & Dist.Interface_Name;
Port_Name : constant Unbounded_String := RI.Name;
-- The port name cannot be RI.Name because that could
-- cause multiple ports with the same name if more than
-- one function connected through a chain of sync calls
-- have a RI of that name.
-- Port_Name : constant Unbounded_String := RI.Name;
Port_Name : constant Unbounded_String :=
Dist.Function_Name & "_" & RI.Name;
New_P : constant Thread_Port :=
(Name => Port_Name,
Remote_Thread => Remote_Thread_Name,
......@@ -637,7 +643,8 @@ package body TASTE.AADL_Parser is
Partition.Out_Ports.Insert
(Key => To_String (Out_Port.RI.Name),
New_Item => (Port_Name =>
Out_Port.RI.Name,
-- Out_Port.RI.Name,
Out_Port.Name,
Connected_Threads =>
String_Vectors.Empty_Vector
& To_String (T.Name),
......
......@@ -79,6 +79,8 @@ package body TASTE.Backend.Code_Generators is
Language_Tag,
Has_Context_Param_Tag,
Is_Type_Tag,
Is_Shared_Type_Tag,
Instance_Of_Tag,
Is_FPGA_Tag,
CPU_Platform_Tag : Vector_Tag;
Content_Set : Translate_Set;
......@@ -92,11 +94,18 @@ package body TASTE.Backend.Code_Generators is
end if;
for Each of Model.Interface_View.Flat_Functions loop
Languages := Languages or To_Set (US (Language_Spelling (Each)));
Functions_Tag := Functions_Tag & Each.Name;
Language_Tag := Language_Tag & Language_Spelling (Each);
Is_Type_Tag := Is_Type_Tag & Each.Is_Type;
Functions_Tag := Functions_Tag & Each.Name;
Language_Tag := Language_Tag & Language_Spelling (Each);
Is_Type_Tag := Is_Type_Tag & Each.Is_Type;
Instance_Of_Tag :=
Instance_Of_Tag & Each.Instance_Of.Value_Or (US (""));
Has_Context_Param_Tag := Has_Context_Param_Tag
& (not Each.Context_Params.Is_Empty);
-- Determine if the function type is in the shared folder
Is_Shared_Type_Tag := Is_Shared_Type_Tag
& (Each.Instance_Of.Has_Value and then not
Model.Interface_View.Flat_Functions.Contains
(To_String (Each.Instance_Of.Unsafe_Just)));
if Each.User_Properties.Contains
("TASTE_IV_Properties::FPGA_Configurations")
......@@ -126,6 +135,8 @@ package body TASTE.Backend.Code_Generators is
& Assoc ("Function_Names", Functions_Tag)
& Assoc ("Language", Language_Tag)
& Assoc ("Is_Type", Is_Type_Tag)
& Assoc ("Is_Shared_Type", Is_Shared_Type_Tag)
& Assoc ("Instance_Of", Instance_Of_Tag)
& Assoc ("CP_Files", All_CP_Files)
& Assoc ("Has_Context_Param", Has_Context_Param_Tag)
& Assoc ("Is_FPGA", Is_FPGA_Tag)
......
......@@ -223,6 +223,26 @@ package body TASTE.Concurrency_View is
declare
Path : constant String := Full_Name (Current);
-- Optional template for Busses, useful to render the bus
-- properties.
function Generate_Bus (Bus : Taste_Bus) return String
is
File_Id : constant String := Path & "/bus.tmplt";
Trigger : constant Boolean := Exists (File_Id);
Bus_Assoc : constant Translate_Set :=
Properties_To_Template (Bus.Properties)
& Assoc ("Bus_Name", Bus.Name)
& Assoc ("AADL_Package", Bus.AADL_Package)
& Assoc ("Classifier", Bus.Classifier);
Result : constant String :=
(if Trigger then Strip_String (Parse (File_Id, Bus_Assoc))
else "");
begin
Document_Template
(Templates_Concurrency_View_Sub_Bus, Bus_Assoc);
return Result;
end Generate_Bus;
function Generate_Partition (Node_Name : String;
Partition_Name : String)
return String
......@@ -676,6 +696,7 @@ package body TASTE.Concurrency_View is
Part_Dest_Name : Vector_Tag; -- Inter-partition connections (TSP)
Bus_Names,
Bus_AADL_Pkg,
Bus_Properties,
Bus_Classifier : Vector_Tag; -- System busses
Device_Node_Name,
Device_Partition_Name : Vector_Tag;
......@@ -699,6 +720,7 @@ package body TASTE.Concurrency_View is
Bus_Names := Bus_Names & Bus.Name;
Bus_AADL_Pkg := Bus_AADL_Pkg & Bus.AADL_Package;
Bus_Classifier := Bus_Classifier & Bus.Classifier;
Bus_Properties := Bus_Properties & Generate_Bus (Bus);
end loop;
-- Bus connections: we need the output port name, partition and
......@@ -910,6 +932,7 @@ package body TASTE.Concurrency_View is
& Assoc ("Bus_Names", Bus_Names)
& Assoc ("Bus_AADL_Package", Bus_AADL_Pkg)
& Assoc ("Bus_Classifier", Bus_Classifier)
& Assoc ("Bus_Properties", Bus_Properties)
& Assoc ("Device_Node_Name", Device_Node_Name)
& Assoc ("Device_Partition", Device_Partition_Name)
& Assoc ("Unique_Dev_ASN1_Files", Unique_ASN1_Files)
......
......@@ -774,7 +774,7 @@ package body TASTE.Deployment_View is
-- Update the information in the deployment view
C_DV.Source_Function := C_IV.Caller;
C_DV.Source_Port := C_IV.RI_Name;
C_DV.Source_Port := C_IV.Callee & "_" & C_IV.RI_Name;
C_DV.Dest_Function := C_IV.Callee;
C_DV.Dest_Port := C_IV.PI_Name;
end if;
......
-- *************************** taste aadl parser ************************* --
-- (c) 2008-2018 European Space Agency - maxime.perrotin@esa.int
-- (c) 2008-2021 European Space Agency - maxime.perrotin@esa.int
-- LGPL license, see LICENSE file
with Ada.Characters.Latin_1,
......@@ -144,6 +144,26 @@ package body TASTE.Parser_Utils is
Sep => Sep));
end Join_Strings;
function Filter_First_Elem
(unused_Value, Parameters : String;
Context : Filter_Context) return String
is
Assoc : Association;
Table : Tag;
begin
Assoc := Get (Context.Translations, Parameters);
if Assoc = Null_Association then
return "";
end if;
Table := Get (Assoc);
return Item (Table, 1);
exception
when Constraint_Error =>
-- If Association is not a Tag (table) or if zero elements
return "";
end Filter_First_Elem;
function Filter_Uniq
(Value, Parameters : String;
unused_Context : Filter_Context) return String
......@@ -414,6 +434,123 @@ package body TASTE.Parser_Utils is
-- Get all properties as a Map Key/String --
-- Input parameter is an AADL instance --
--------------------------------------------
function Numeric_Term_As_String (Node : Node_Id) return String is
function Signed_Number (Value, Unit : Node_Id) return String
is
Result : Unbounded_String;
begin
if ATN.Kind (Value) = K_Literal then
-- aadlinteger or aadlreal
Result := US (Ocarina.AADL_Values.Image (ATN.Value (Value)));
else
-- If this is ever needed, relevant code to adapt is in
-- ocarina-be_aadl-properties-values.adb
Result := US ("UNSUPPORTED CONSTANTS");
end if;
if Present (Unit) then
Result := Result & US (Get_Name_String (ATN.Display_Name (Unit)));
end if;
return To_String (Result);
end Signed_Number;
begin
return (case ATN.Kind (Node) is
when K_Minus_Numeric_Term =>
"-" & Numeric_Term_As_String (ATN.Numeric_Term (Node)),
when K_Signed_AADLNumber =>
Signed_Number (Number_Value (Node), Unit_Identifier (Node)),
when K_Entity_Reference =>
-- This comes from ocarina-be_aadl-identifiers.adb, function
-- Print_Entity_Reference
(if ATN.Namespace_Identifier (Node) /= No_Node
then Get_Name_String
(ATN.Display_Name (ATN.Namespace_Identifier (Node))) & "::"
else "")
& Get_Name_String (ATN.Display_Name (Node)),
when K_Property_Term |
K_Unique_Property_Const_Identifier =>
-- This comes from ocarina-be_aadl-identifiers.adb, function
-- Print_Entity_Reference
(if ATN.Property_Set_Identifier (Node) /= No_Node
then Get_Name_String
(ATN.Display_Name (ATN.Property_Set_Identifier (Node)))
& "::"
else "")
& Get_Name_String (ATN.Display_Name (Node)),
when others =>
"ERROR WITH NUMERIC TERM");
end Numeric_Term_As_String;
function Record_As_String (Node : Node_Id) return String;
function Property_Value_As_String (Single_Val : Node_Id;
Array_Value : Node_Id := No_Node)
return String
is
-- return the sting corresponding to a property value
begin
return (case ATN.Kind (Single_Val) is
when ATN.K_Signed_AADLNumber =>
Ocarina.AADL_Values.Image
(ATN.Value (ATN.Number_Value (single_val)))
& (if Present (ATN.Unit_Identifier (single_val))
then " "
& Get_Name_String
(ATN.Display_Name
(ATN.Unit_Identifier (single_val)))
else ""),
when ATN.K_Literal =>
Ocarina.AADL_Values.Image
(ATN.Value (single_val),
Quoted => False),
when ATN.K_Reference_Term =>
Get_Name_String
(ATN.Display_Name (ATN.First_Node -- XXX must iterate
(ATN.List_Items (ATN.Reference_Term (single_val))))),
when ATN.K_Enumeration_Term =>
Get_Name_String
(ATN.Display_Name (ATN.Identifier (Single_Val))),
when ATN.K_Number_Range_Term =>
Numeric_Term_As_String (Lower_Bound (Single_Val))
& ".."
& Numeric_Term_As_String (Upper_Bound (Single_Val)),
when ATN.K_Component_Classifier_Term =>
-- When property is "classifier (...)" the following
-- returns the name of the component (e.g. foo.other)
(if Array_Value /= No_Node then
Get_Name_String (AIN.Display_Name
(AIN.Identifier
(Get_Classifier_Of_Property_Value
(ATN.Expanded_Single_Value (Array_Value)))))
else "UNSUPPORTED CLASSIFIER HERE"),
when ATN.K_Record_Term =>
Record_As_String (single_val),
when others => "ERROR! Kazoo does not support Kind: "
& ATN.Kind (single_val)'Img);
end Property_Value_As_String;
function Record_As_String (Node : Node_Id) return String is
-- Get the string of a complex record property
-- We have to form this string as Ocarina does not have an API for that
-- (the closest is found in ocarina-be_aadl-properties-values.adb but
-- it only prints to screen)
List_Node : Node_Id := ATN.First_Node (ATN.List_Items (Node));
Result : Unbounded_String := US ("[ ");
begin
while Present (List_Node) loop
if Kind (List_Node) = K_Record_Term_Element then
Result := Result
& US (Get_Name_String
(ATN.Display_Name (ATN.Identifier (List_Node))))
& " => "
& Property_Value_As_String (Property_Expression (List_Node));
else
Result := Result & "ERROR - UNIDENTIFIED RECORD FIELD";
end if;
Result := Result & "; ";
List_Node := ATN.Next_Node (List_Node);
end loop;
return To_String (Result & " ]");
end Record_As_String;
function Get_Properties_Map (D : Node_Id) return Property_Maps.Map is
Properties : constant List_Id := AIN.Properties (D);
Result : Property_Maps.Map := Property_Maps.Empty_Map;
......@@ -422,50 +559,15 @@ package body TASTE.Parser_Utils is
Single_Val : Node_Id;
begin
while Present (property) loop
prop_value := AIN.Property_Association_Value (property);
Prop_Value := AIN.Property_Association_Value (property);
Single_Val := ATN.Single_Value (Prop_Value);
if Present (ATN.Single_Value (prop_value)) then
-- Only support single-value properties for now
Single_Val := ATN.Single_Value (Prop_Value);
Result.Insert
(Key => AIN_Case (property),
New_Item =>
(Name => US (AIN_Case (property)),
Value =>
US (case ATN.Kind (single_val) is
when ATN.K_Signed_AADLNumber =>
Ocarina.AADL_Values.Image
(ATN.Value (ATN.Number_Value (single_val))) &
(if Present (ATN.Unit_Identifier (single_val))
then " "
& Get_Name_String
(ATN.Display_Name
(ATN.Unit_Identifier (single_val)))
else ""),
when ATN.K_Literal =>
Ocarina.AADL_Values.Image
(ATN.Value (single_val),
Quoted => False),
when ATN.K_Reference_Term =>
Get_Name_String
(ATN.Display_Name (ATN.First_Node -- XXX must iterate
(ATN.List_Items (ATN.Reference_Term (single_val))))),
when ATN.K_Enumeration_Term =>
Get_Name_String
(ATN.Display_Name (ATN.Identifier (single_val))),
when ATN.K_Number_Range_Term =>
"RANGE NOT SUPPORTED!",
when ATN.K_Component_Classifier_Term =>
-- When property is "classifier (...)" the following
-- returns the name of the component (e.g. foo.other)
Get_Name_String
(AIN.Display_Name
(AIN.Identifier
(Get_Classifier_Of_Property_Value
(ATN.Expanded_Single_Value
(Prop_Value))))),
when others => "ERROR! Kazoo does not support Kind: "
& ATN.Kind (single_val)'Img)));
Value => US (Property_Value_As_String
(Single_Val, Prop_Value))));
end if;
Property := AIN.Next_Node (Property);
end loop;
......@@ -500,4 +602,5 @@ package body TASTE.Parser_Utils is
end Join_Sets;
begin
Register_Filter ("UNIQ", Filter_Uniq'Access);
Register_Filter ("FIRST_ELEM", Filter_First_Elem'Access);
end TASTE.Parser_Utils;
......@@ -85,6 +85,12 @@ package TASTE.Parser_Utils is
(Value, Parameters : String;
unused_Context : Filter_Context) return String;
-- Return the first value in a table
-- @_FIRST_ELEM(Tag_Name):Vector_Tag_@
function Filter_First_Elem
(unused_Value, Parameters : String;
Context : Filter_Context) return String;
-- Generate documentation for a translate set
-- Template_Category enumerants reflect the path containing the template
......@@ -110,6 +116,7 @@ package TASTE.Parser_Utils is
Templates_Concurrency_View_Sub_Partition,
Templates_Concurrency_View_Sub_Node,
Templates_Concurrency_View_Sub_System,
Templates_Concurrency_View_Sub_Bus,
Templates_Dump_Interfaceview,
Templates_Dump_Deploymentview);
......
......@@ -22,29 +22,50 @@ package body TASTE.Semantic_Check is
-- Allow case insensitive checks of unbounded strings:
function "="(A, B : Unbounded_String) return Boolean is
(To_Lower (To_String (A)) = (To_Lower (To_String (B))));
Error_Found : Boolean := False;
begin
-- Checks done when generating skeletons
for Each of Model.Interface_View.Flat_Functions loop