Commit 8925c270 authored by julien.delange's avatar julien.delange
Browse files

* import stub to generate ASN1 data types from AADL models



git-svn-id: https://tecsw.estec.esa.int/svn/taste/trunk/ocarina@665 129961e7-ef38-4bb5-a8f7-c9a525a55882
parent 8d056302
......@@ -63,10 +63,11 @@ BUILD_DIRS_STAMPS = $(BUILD_DIRS:=-stamp)
TREE_PIDL_SPECS = \
src/core/tree/ocarina-me_aadl-aadl_tree-nodes.idl \
src/core/tree/ocarina-me_aadl-aadl_instances-nodes.idl \
src/core/tree/ocarina-me_aadl_ba-ba_tree-nodes.idl \
src/core/tree/ocarina-me_real-real_tree-nodes.idl \
src/backends/ocarina-backends-ada_tree-nodes.idl \
src/core/tree/ocarina-me_aadl_ba-ba_tree-nodes.idl \
src/core/tree/ocarina-me_real-real_tree-nodes.idl \
src/backends/ocarina-backends-ada_tree-nodes.idl \
src/backends/ocarina-backends-c_tree-nodes.idl \
src/backends/ocarina-backends-asn1_tree-nodes.idl \
src/backends/ocarina-backends-xml_tree-nodes.idl \
src/backends/ocarina-backends-pn-nodes.idl \
src/backends/ocarina-backends-rtsj_tree-nodes.idl
......
------------------------------------------------------------------------------
-- --
-- OCARINA COMPONENTS --
-- --
-- O C A R I N A . B A C K E N D S . A S N 1 _ T R E E . D E B U G --
-- --
-- B o d y --
-- --
-- Copyright (C) 2010, GET-Telecom Paris. --
-- --
-- Ocarina is free software; you can redistribute it and/or modify --
-- it under terms of the GNU General Public License as published by the --
-- Free Software Foundation; either version 2, or (at your option) any --
-- later version. Ocarina is distributed in the hope that it will be --
-- useful, but WITHOUT ANY WARRANTY; without even the implied warranty of --
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General --
-- Public License for more details. You should have received a copy of the --
-- GNU General Public License distributed with Ocarina; see file COPYING. --
-- If not, write to the Free Software Foundation, 51 Franklin Street, Fifth --
-- Floor, Boston, MA 02111-1301, USA. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
-- --
-- Ocarina is maintained by the Ocarina team --
-- (ocarina-users@listes.enst.fr) --
-- --
------------------------------------------------------------------------------
with Charset; use Charset;
with Locations; use Locations;
with Namet; use Namet;
with Utils; use Utils;
with Ocarina.Backends.ASN1_Tree.Nutils; use Ocarina.Backends.ASN1_Tree.Nutils;
package body Ocarina.Backends.ASN1_Tree.Debug is
-----------
-- Image --
-----------
function Image (N : Node_Kind) return String is
S : String := Node_Kind'Image (N);
begin
To_Lower (S);
for I in S'Range loop
if S (I) = '_' then
S (I) := ' ';
end if;
end loop;
return S (3 .. S'Last);
end Image;
function Image (N : Name_Id) return String is
begin
if N = No_Name then
return No_Str;
else
return Get_Name_String (N);
end if;
end Image;
function Image (N : Node_Id) return String is
begin
return Image (Int (N));
end Image;
function Image (N : List_Id) return String is
begin
return Image (Int (N));
end Image;
function Image (N : Mode_Id) return String is
begin
case N is
when Mode_In =>
return Quoted ("in");
when Mode_Inout =>
return Quoted ("in out");
when Mode_Out =>
return Quoted ("out");
end case;
end Image;
function Image (N : Operator_Id) return String is
begin
return Quoted (Operator_Image (Integer (N)));
end Image;
function Image (N : Boolean) return String is
begin
return Boolean'Image (N);
end Image;
function Image (N : Byte) return String is
begin
return Image (Int (N));
end Image;
function Image (N : Int) return String is
S : constant String := Int'Image (N);
begin
return S (S'First + 1 .. S'Last);
end Image;
------------
-- W_Byte --
------------
procedure W_Byte (N : Byte) is
begin
Write_Int (Int (N));
end W_Byte;
---------------
-- W_Indents --
---------------
procedure W_Indents is
begin
for I in 1 .. N_Indents loop
Write_Str (" ");
end loop;
end W_Indents;
---------------
-- W_List_Id --
---------------
procedure W_List_Id (L : List_Id) is
N : Node_Id;
begin
if L = No_List then
return;
end if;
N := First_Node (L);
while Present (N) loop
W_Node_Id (N);
N := Next_Node (N);
end loop;
end W_List_Id;
----------------------
-- W_Node_Attribute --
----------------------
procedure W_Node_Attribute
(A : String;
K : String;
V : String;
N : Int := 0)
is
C : Node_Id;
begin
if A = "Next_Node"
or else A = "Package_Declaration"
then
return;
end if;
N_Indents := N_Indents + 1;
W_Indents;
Write_Str (A);
Write_Char (' ');
Write_Str (K);
Write_Char (' ');
C := Node_Id (N);
if K = "Name_Id" then
Write_Line (Quoted (V));
elsif K = "Node_Id"
and then Present (C)
then
case Kind (C) is
when others =>
Write_Line (V);
end case;
else
Write_Line (V);
end if;
if A /= "Frontend_Node"
and then A /= "Corresponding_Node"
and then A /= "Parent"
and then A /= "Distributed_Application_Unit"
and then A /= "Distributed_Application"
and then A /= "Partition"
then
if K = "Node_Id" then
W_Node_Id (Node_Id (N));
elsif K = "List_Id" then
W_List_Id (List_Id (N));
end if;
end if;
N_Indents := N_Indents - 1;
end W_Node_Attribute;
-------------------
-- W_Node_Header --
-------------------
procedure W_Node_Header (N : Node_Id) is
begin
W_Indents;
Write_Int (Int (N));
Write_Char (' ');
Write_Str (Image (Kind (N)));
Write_Char (' ');
Write_Line (Image (Loc (N)));
end W_Node_Header;
---------------
-- W_Node_Id --
---------------
procedure W_Node_Id (N : Node_Id) is
begin
if N = No_Node then
return;
end if;
W_Node (N);
end W_Node_Id;
end Ocarina.Backends.ASN1_Tree.Debug;
------------------------------------------------------------------------------
-- --
-- OCARINA COMPONENTS --
-- --
-- O C A R I N A . B A C K E N D S . A S N 1 _ T R E E . D E B U G --
-- --
-- S p e c --
-- --
-- Copyright (C) 2010, GET-Telecom Paris. --
-- --
-- Ocarina is free software; you can redistribute it and/or modify --
-- it under terms of the GNU General Public License as published by the --
-- Free Software Foundation; either version 2, or (at your option) any --
-- later version. Ocarina is distributed in the hope that it will be --
-- useful, but WITHOUT ANY WARRANTY; without even the implied warranty of --
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General --
-- Public License for more details. You should have received a copy of the --
-- GNU General Public License distributed with Ocarina; see file COPYING. --
-- If not, write to the Free Software Foundation, 51 Franklin Street, Fifth --
-- Floor, Boston, MA 02111-1301, USA. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
-- --
-- Ocarina is maintained by the Ocarina team --
-- (ocarina-users@listes.enst.fr) --
-- --
------------------------------------------------------------------------------
with Output; use Output;
with Ocarina.Backends.ASN1_Tree.Nodes; use Ocarina.Backends.ASN1_Tree.Nodes;
package Ocarina.Backends.ASN1_Tree.Debug is
N_Indents : Natural := 0;
procedure W_Eol (N : Natural := 1) renames Output.Write_Eol;
procedure W_Int (N : Int) renames Output.Write_Int;
procedure W_Line (N : String) renames Output.Write_Line;
procedure W_Str (N : String) renames Output.Write_Str;
procedure W_Indents;
procedure W_Byte (N : Byte);
procedure W_List_Id (L : List_Id);
procedure W_Node_Id (N : Node_Id);
procedure W_Node_Header (N : Node_Id);
procedure W_Node_Attribute
(A : String;
K : String;
V : String;
N : Int := 0);
function Image (N : Node_Kind) return String;
function Image (N : Name_Id) return String;
function Image (N : Node_Id) return String;
function Image (N : List_Id) return String;
function Image (N : Mode_Id) return String;
function Image (N : Operator_Id) return String;
function Image (N : Boolean) return String;
function Image (N : Byte) return String;
function Image (N : Int) return String;
end Ocarina.Backends.ASN1_Tree.Debug;
module Ocarina::Backends::ASN1_Tree::Nodes {
/******************/
/* Internal types */
/******************/
typedef octet Operator_Id;
typedef long Name_Id;
typedef long Value_Id;
/******************/
/* Internal nodes */
/******************/
interface Node_Id {
Node_Id Next_Node;
Node_Id Frontend_Node;
};
interface Definition : Node_Id {
Node_Id Defining_Identifier;
};
interface List_Id {
Node_Id First_Node;
Node_Id Last_Node;
};
interface Defining_Identifier : Node_Id {
Name_Id Name;
Node_Id Corresponding_Node;
Node_Id Compile_Unit;
boolean Is_Pointer;
};
interface ASN1_Module : Node_Id {
Name_Id Name;
Node_Id Oid;
boolean Automatic_Tags;
List_Id Imported_Clauses;
List_Id Exported_Clauses;
List_Id Definitions;
};
interface Import_Export_Clause : Node_Id {
Name_Id Name;
Name_Id Associated_Module;
};
interface Type_Definition : Definition
{
Node_Id Declaration;
};
};
------------------------------------------------------------------------------
-- --
-- OCARINA COMPONENTS --
-- --
-- O C A R I N A . B A C K E N D S . A S N 1 _ T R E E . N U T I L S --
-- --
-- B o d y --
-- --
-- Copyright (C) 2010, GET-Telecom Paris. --
-- --
-- Ocarina is free software; you can redistribute it and/or modify --
-- it under terms of the GNU General Public License as published by the --
-- Free Software Foundation; either version 2, or (at your option) any --
-- later version. Ocarina is distributed in the hope that it will be --
-- useful, but WITHOUT ANY WARRANTY; without even the implied warranty of --
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General --
-- Public License for more details. You should have received a copy of the --
-- GNU General Public License distributed with Ocarina; see file COPYING. --
-- If not, write to the Free Software Foundation, 51 Franklin Street, Fifth --
-- Floor, Boston, MA 02111-1301, USA. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
-- --
-- Ocarina is maintained by the Ocarina team --
-- (ocarina-users@listes.enst.fr) --
-- --
------------------------------------------------------------------------------
with GNAT.Table;
with Charset; use Charset;
with Namet; use Namet;
with Locations; use Locations;
with Ocarina.Backends;
with Ocarina.ME_AADL.AADL_Instances.Nodes;
use Ocarina.Backends;
package body Ocarina.Backends.ASN1_Tree.Nutils is
package AIN renames Ocarina.ME_AADL.AADL_Instances.Nodes;
Initialized : Boolean := False;
Keyword_Suffix : constant String := "%C";
-- Used to mark C keywords and avoid collision with other languages
type Entity_Stack_Entry is record
Current_File : Node_Id;
Current_Entity : Node_Id;
end record;
No_Depth : constant Int := -1;
package Entity_Stack is
new GNAT.Table (Entity_Stack_Entry, Int, No_Depth + 1, 10, 10);
use Entity_Stack;
procedure New_Operator
(O : Operator_Type;
I : String := "");
------------------------
-- Add_Prefix_To_Name --
------------------------
function Add_Prefix_To_Name
(Prefix : String;
Name : Name_Id)
return Name_Id
is
begin
Set_Str_To_Name_Buffer (Prefix);
Get_Name_String_And_Append (Name);
return Name_Find;
end Add_Prefix_To_Name;
------------------------
-- Add_Suffix_To_Name --
------------------------
function Add_Suffix_To_Name
(Suffix : String;
Name : Name_Id)
return Name_Id
is
begin
Get_Name_String (Name);
Add_Str_To_Name_Buffer (Suffix);
return Name_Find;
end Add_Suffix_To_Name;
-----------------------------
-- Remove_Suffix_From_Name --
-----------------------------
function Remove_Suffix_From_Name
(Suffix : String;
Name : Name_Id)
return Name_Id
is
Length : Natural;
Temp_Str : String (1 .. Suffix'Length);
begin
Set_Str_To_Name_Buffer (Suffix);
Length := Name_Len;
Get_Name_String (Name);
if Name_Len > Length then
Temp_Str := Name_Buffer (Name_Len - Length + 1 .. Name_Len);
if Suffix = Temp_Str then
Set_Str_To_Name_Buffer (Name_Buffer (1 .. Name_Len - Length));
return Name_Find;
end if;
end if;
return Name;
end Remove_Suffix_From_Name;
-------------------------
-- Append_Node_To_List --
-------------------------
procedure Append_Node_To_List (E : Node_Id; L : List_Id) is
Last : Node_Id;
begin
Last := ASN1_Nodes.Last_Node (L);
if No (Last) then
ASN1_Nodes.Set_First_Node (L, E);
else
ASN1_Nodes.Set_Next_Node (Last, E);
end if;
Last := E;
while Present (Last) loop
ASN1_Nodes.Set_Last_Node (L, Last);
Last := ASN1_Nodes.Next_Node (Last);
end loop;
end Append_Node_To_List;
-----------------------
-- Insert_After_Node --
-----------------------
procedure Insert_After_Node (E : Node_Id; N : Node_Id) is
Next : constant Node_Id := ASN1_Nodes.Next_Node (N);
begin
ASN1_Nodes.Set_Next_Node (N, E);
ASN1_Nodes.Set_Next_Node (E, Next);
end Insert_After_Node;
------------------------
-- Insert_Before_Node --
------------------------
procedure Insert_Before_Node (E : Node_Id; N : Node_Id; L : List_Id) is
Entity : Node_Id;
begin
Entity := ASN1_Nodes.First_Node (L);
if Entity = N then
ASN1_Nodes.Set_Next_Node (E, Entity);
ASN1_Nodes.Set_First_Node (L, E);
else
while Present (Entity) loop
exit when ASN1_Nodes.Next_Node (Entity) = N;
Entity := ASN1_Nodes.Next_Node (Entity);
end loop;
Insert_After_Node (E, Entity);
end if;
end Insert_Before_Node;
---------------
-- Copy_Node --
---------------
function Copy_Node (N : Node_Id) return Node_Id is
C : Node_Id;
begin
case ASN1_Nodes.Kind (N) is
when ASN1_Nodes.K_Defining_Identifier =>
C := New_Node (ASN1_Nodes.K_Defining_Identifier);
ASN1_Nodes.Set_Name (C, ASN1_Nodes.Name (N));
ASN1_Nodes.Set_Corresponding_Node
(C, ASN1_Nodes.Corresponding_Node (N));
when others =>
raise Program_Error;
end case;
return C;
end Copy_Node;
-----------
-- Image --
-----------
function Image (T : Token_Type) return String is
S : String := Token_Type'Image (T);
begin
To_Lower (S);
return S (5 .. S'Last);
end Image;
-----------
-- Image --
-----------
function Image (O : Operator_Type) return String is
S : String := Operator_Type'Image (O);
begin
To_Lower (S);
for I in S'First .. S'Last loop
if S (I) = '_' then
S (I) := ' ';
end if;
end loop;
return S (4 .. S'Last);
end Image;
----------------
-- Initialize --
----------------
procedure Initialize is
begin
-- Initialize Nutils only once
if Initialized then