Skip to content

GitLab

O
Ocarina
Commit 7044b453 authored by yoogx's avatar yoogx
Browse files
Options

* Put a copy of packages specific to mknodes to avoid 

          dependencies to Ocarina core
parent cfade00d
Expand all Hide whitespace changes
Inline Side-by-side
Showing with 3615 additions and 567 deletions
tools/mknodes/charset.adb 0 → 100644
View file @ 7044b453
This diff is collapsed.
tools/mknodes/charset.ads 0 → 100644
View file @ 7044b453
------------------------------------------------------------------------------
-- --
-- OCARINA COMPONENTS --
-- --
-- C H A R S E T --
-- --
-- S p e c --
-- --
-- Copyright (C) 2014 ESA & ISAE. --
-- --
-- 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 TASTE project --
-- (taste-users@lists.tuxfamily.org) --
-- --
------------------------------------------------------------------------------
package Charset is
function Is_Alphabetic_Character (C : Character) return Boolean;
-- Alphabetic characters of ISO Latin-1
function Is_Identifier_Character (C : Character) return Boolean;
-- Alphabetic character or digit or underscore character
procedure To_Lower (S : in out String);
function To_Lower (S : String) return String;
function To_Lower (C : Character) return Character;
-- Translate into lower case form
procedure To_Upper (S : in out String);
function To_Upper (S : String) return String;
function To_Upper (C : Character) return Character;
-- Translate into upper case form
end Charset;
tools/mknodes/errors.adb 0 → 100644
View file @ 7044b453
------------------------------------------------------------------------------
-- --
-- OCARINA COMPONENTS --
-- --
-- E R R O R S --
-- --
-- B o d y --
-- --
-- Copyright (C) 2014 ESA & ISAE. --
-- --
-- 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 TASTE project --
-- (taste-users@lists.tuxfamily.org) --
-- --
------------------------------------------------------------------------------
with Ada.Command_Line; use Ada.Command_Line;
with GNAT.OS_Lib; use GNAT.OS_Lib;
with GNAT.Directory_Operations; use GNAT.Directory_Operations;
with Output; use Output;
with Namet; use Namet;
package body Errors is
procedure Internal_Display_Message (S : String);
procedure Check_Space;
-- Check there is a trailing space in order to append a string to
-- name buffer.
-----------------
-- Check_Space --
-----------------
procedure Check_Space is
begin
if Name_Len > 0 and then Name_Buffer (Name_Len) /= ' ' then
Add_Char_To_Name_Buffer (' ');
end if;
end Check_Space;
------------------------------
-- Internal_Display_Message --
------------------------------
procedure Internal_Display_Message (S : String) is
L : Natural := 1;
I : Natural := 1;
N : Natural := 1;
M : Boolean := False; -- Meta-character
J : Natural := S'First;
begin
if Error_Loc (L) = No_Location then
Set_Str_To_Name_Buffer
(Base_Name (Command_Name, Get_Executable_Suffix.all));
else
Set_Str_To_Name_Buffer (Image (Error_Loc (L)));
end if;
L := L + 1;
Add_Str_To_Name_Buffer (": ");
while J <= S'Last loop
-- Escape meta-character
if S (J) = '|' then
if J < S'Last then
J := J + 1;
end if;
Add_Char_To_Name_Buffer (S (J));
elsif S (J) = '%' then
Check_Space;
Get_Name_String_And_Append (Error_Name (N));
N := N + 1;
M := True;
elsif S (J) = '#' then
Check_Space;
Add_Char_To_Name_Buffer ('"'); -- "
Get_Name_String_And_Append (Error_Name (N));
Add_Char_To_Name_Buffer ('"'); -- "
N := N + 1;
M := True;
elsif S (J) = '!' then
if Error_Loc (1).Base_Name = Error_Loc (L).Base_Name then
Check_Space;
Add_Str_To_Name_Buffer ("at line ");
Add_Nat_To_Name_Buffer (Error_Loc (L).Line);
else
Check_Space;
Add_Str_To_Name_Buffer ("in ");
Add_Str_To_Name_Buffer (Image (Error_Loc (L)));
end if;
L := L + 1;
M := True;
elsif S (J) = '$' then
Add_Nat_To_Name_Buffer (Error_Int (I));
I := I + 1;
M := False;
else
if M then
Add_Char_To_Name_Buffer (' ');
M := False;
end if;
Add_Char_To_Name_Buffer (S (J));
end if;
J := J + 1;
end loop;
Set_Standard_Error;
Write_Line (Name_Buffer (1 .. Name_Len));
Set_Standard_Output;
Initialize;
end Internal_Display_Message;
-------------------
-- Display_Error --
-------------------
procedure Display_Error (S : String) is
begin
N_Errors := N_Errors + 1;
Internal_Display_Message (S);
end Display_Error;
---------------------
-- Display_Message --
---------------------
procedure Display_Message (S : String) is
begin
Internal_Display_Message (S);
end Display_Message;
---------------------
-- Display_Warning --
---------------------
procedure Display_Warning (S : String) is
begin
N_Warnings := N_Warnings + 1;
Internal_Display_Message ("warning: " & S);
end Display_Warning;
----------------
-- Initialize --
----------------
procedure Initialize is
begin
Error_Loc := (others => No_Location);
Error_Name := (others => No_Name);
Error_Int := (others => 0);
end Initialize;
---------------------
-- Display_Bug_Box --
---------------------
procedure Display_Bug_Box (E : Ada.Exceptions.Exception_Occurrence) is
Exception_String : constant String := "| Detected exception: "
& Ada.Exceptions.Exception_Name (E);
Error_String : constant String :=
"| Error: "
& Ada.Exceptions.Exception_Message (E);
begin
Set_Standard_Error;
Write_Line ("+========================== OCARINA BUG DETECTED"
& " =========================+");
Write_Str (Exception_String);
for J in Exception_String'Length .. 72 loop
Write_Str (" ");
end loop;
Write_Str (" |");
Write_Eol;
Write_Str (Error_String);
for J in Error_String'Length .. 72 loop
Write_Str (" ");
end loop;
Write_Str (" |");
Write_Eol;
Write_Str ("| Please refer to the User's Guide for more details."
& " |");
Write_Eol;
Write_Line ("+============================================="
& "============================+");
Write_Eol;
Write_Line (Ada.Exceptions.Exception_Information (E));
OS_Exit (3);
end Display_Bug_Box;
-------------------
-- Exit_On_Error --
-------------------
procedure Exit_On_Error (Error : Boolean; Reason : String) is
begin
if Error then
Set_Standard_Error;
Write_Line (Reason);
OS_Exit (1);
end if;
end Exit_On_Error;
end Errors;
tools/mknodes/errors.ads 0 → 100644
View file @ 7044b453
------------------------------------------------------------------------------
-- --
-- OCARINA COMPONENTS --
-- --
-- E R R O R S --
-- --
-- S p e c --
-- --
-- Copyright (C) 2014 ESA & ISAE. --
-- --
-- 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 TASTE project --
-- (taste-users@lists.tuxfamily.org) --
-- --
------------------------------------------------------------------------------
with Locations; use Locations;
with Types; use Types;
with Ada.Exceptions;
package Errors is
procedure Display_Error (S : String);
procedure DE (S : String) renames Display_Error;
procedure Display_Warning (S : String);
procedure DW (S : String) renames Display_Warning;
procedure Display_Message (S : String);
procedure DM (S : String) renames Display_Message;
-- Display an error and output error message S. S may include
-- meta-characters.
--
-- '%' designates a string representing Error_Name (N) where N is
-- the number of '%' and '#' in the substring.
--
-- '#' designates a quoted string representing Error_Name (N).
--
-- '!' designates a location representing Error_Loc (L) where L is
-- the number of '!' in the substring.
--
-- '$' designates an integer representing Error_Int (I) where I is
-- the number of '$' in the substring.
procedure Initialize;
Error_Loc : array (1 .. 2) of Location;
Error_Int : array (1 .. 2) of Int;
Error_Name : array (1 .. 2) of Name_Id;
N_Errors : Int := 0;
N_Warnings : Int := 0;
procedure Display_Bug_Box (E : Ada.Exceptions.Exception_Occurrence);
procedure Exit_On_Error (Error : Boolean; Reason : String);
end Errors;
tools/mknodes/lexer.adb
View file @ 7044b453
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2005-2009 Telecom ParisTech, 2010-2014 ESA & ISAE. --
-- Copyright (C) 2005-2009 Telecom ParisTech, 2010-2012 ESA & ISAE. --
-- --
-- Ocarina is free software; you can redistribute it and/or modify --
-- it under terms of the GNU General Public License as published by the --
......@@ -33,19 +33,21 @@
with Charset;
with Errors;
with Ocarina.Namet;
with Ocarina.Output; use Ocarina.Output;
with Ocarina.Types; use Ocarina.Types;
with Namet;
with Output;
with Types;
use type Types.Text_Buffer_Ptr, Types.Text_Ptr;
use type Types.Int, Types.Byte;
package body Lexer is
Buffer : Text_Buffer_Ptr;
Buffer : Types.Text_Buffer_Ptr;
-- Once preprocessed, the idl file is loaded in Buffer and
-- Token_Location.Scan is used to scan the source file.
Initialized : Boolean := False;
type Token_Image_Array is array (Token_Type) of Name_Id;
type Token_Image_Array is array (Token_Type) of Types.Name_Id;
Token_Image : Token_Image_Array;
-----------
......@@ -54,7 +56,7 @@ package body Lexer is
function Image (T : Token_Type) return String is
begin
return Ocarina.Namet.Get_Name_String (Token_Image (T));
return Namet.Get_Name_String (Token_Image (T));
end Image;
---------------
......@@ -71,13 +73,13 @@ package body Lexer is
Len := Integer (GNAT.OS_Lib.File_Length (Source_File));
if Buffer /= null then
Free (Buffer);
Types.Free (Buffer);
end if;
Buffer := new Text_Buffer (1 .. Text_Ptr (Len + 1));
Buffer := new Types.Text_Buffer (1 .. Types.Text_Ptr (Len + 1));
-- Force the last character to be EOF
Buffer (Text_Ptr (Len + 1)) := EOF;
Buffer (Types.Text_Ptr (Len + 1)) := Types.EOF;
Token_Location.Scan := 1;
loop
......@@ -88,7 +90,7 @@ package body Lexer is
Errors.DE ("cannot read preprocessor output");
GNAT.OS_Lib.OS_Exit (4);
end if;
Token_Location.Scan := Token_Location.Scan + Text_Ptr (Code);
Token_Location.Scan := Token_Location.Scan + Types.Text_Ptr (Code);
Len := Len - Code;
end loop;
GNAT.OS_Lib.Close (Source_File);
......@@ -115,16 +117,16 @@ package body Lexer is
(Token : Token_Type;
Image : String) is
begin
Ocarina.Namet.Set_Str_To_Name_Buffer (Image);
Token_Image (Token) := Ocarina.Namet.Name_Find;
Namet.Set_Str_To_Name_Buffer (Image);
Token_Image (Token) := Namet.Name_Find;
if Token in Keyword_Type then
for I in Natural range 1 .. Ocarina.Namet.Name_Len loop
Ocarina.Namet.Name_Buffer (I)
:= Charset.To_Lower (Ocarina.Namet.Name_Buffer (I));
for I in Natural range 1 .. Namet.Name_Len loop
Namet.Name_Buffer (I)
:= Charset.To_Lower (Namet.Name_Buffer (I));
end loop;
Ocarina.Namet.Set_Name_Table_Byte
(Ocarina.Namet.Name_Find, Byte (Token_Type'Pos (Token)));
Namet.Set_Name_Table_Byte
(Namet.Name_Find, Types.Byte (Token_Type'Pos (Token)));
end if;
end New_Token;
......@@ -133,7 +135,7 @@ package body Lexer is
----------------
function Next_Token return Token_Type is
Current_Token_Name : Name_Id;
Current_Token_Name : Types.Name_Id;
Current_Token : Token_Type;
Current_Token_Location : Locations.Location;
Next_Token_Value : Token_Type;
......@@ -155,7 +157,7 @@ package body Lexer is
procedure Process
(Source_File : GNAT.OS_Lib.File_Descriptor;
Source_Name : Name_Id)
Source_Name : Types.Name_Id)
is
begin
......@@ -208,13 +210,13 @@ package body Lexer is
function Quoted_Image (T : Token_Type) return String is
begin
if T in T_Interface .. T_Octet then
Ocarina.Namet.Set_Char_To_Name_Buffer ('"');
Ocarina.Namet.Add_Str_To_Name_Buffer
(Ocarina.Namet.Get_Name_String (Token_Image (T)));
Ocarina.Namet.Add_Char_To_Name_Buffer ('"');
return Ocarina.Namet.Get_Name_String (Ocarina.Namet.Name_Find);
Namet.Set_Char_To_Name_Buffer ('"');
Namet.Add_Str_To_Name_Buffer
(Namet.Get_Name_String (Token_Image (T)));
Namet.Add_Char_To_Name_Buffer ('"');
return Namet.Get_Name_String (Namet.Name_Find);
end if;
return Ocarina.Namet.Get_Name_String (Token_Image (T));
return Namet.Get_Name_String (Token_Image (T));
end Quoted_Image;
-------------------
......@@ -252,23 +254,23 @@ package body Lexer is
-- Read identifier
Ocarina.Namet.Name_Len := 0;
Namet.Name_Len := 0;
while Charset.Is_Identifier_Character (Buffer (Token_Location.Scan)) loop
Ocarina.Namet.Name_Len := Ocarina.Namet.Name_Len + 1;
Ocarina.Namet.Name_Buffer (Ocarina.Namet.Name_Len) := Buffer (Token_Location.Scan);
Namet.Name_Len := Namet.Name_Len + 1;
Namet.Name_Buffer (Namet.Name_Len) := Buffer (Token_Location.Scan);
Token_Location.Scan := Token_Location.Scan + 1;
end loop;
if Ocarina.Namet.Name_Len = 0 then
if Namet.Name_Len = 0 then
if Fatal then
Errors.Error_Loc (1) := Token_Location;
Errors.DE ("identifier must start with alphabetic character");
end if;
Ocarina.Namet.Name_Buffer (1) := ' ';
Ocarina.Namet.Name_Len := 1;
Namet.Name_Buffer (1) := ' ';
Namet.Name_Len := 1;
else
Token_Name := Ocarina.Namet.Name_Find;
Token_Name := Namet.Name_Find;
Token := T_Identifier;
-- Check whether it is a keyword or a pragma
......@@ -283,7 +285,7 @@ package body Lexer is
-- Check that identifier is well-formed
if Token = T_Identifier then
if not Charset.Is_Alphabetic_Character (Ocarina.Namet.Name_Buffer (1)) then
if not Charset.Is_Alphabetic_Character (Namet.Name_Buffer (1)) then
if Escaped then
if Fatal then
Errors.Error_Loc (1) := Token_Location;
......@@ -347,19 +349,19 @@ package body Lexer is
end loop;
if not Found then
Ocarina.Namet.Set_Str_To_Name_Buffer ("expected token");
Namet.Set_Str_To_Name_Buffer ("expected token");
if L'Length > 1 then
Ocarina.Namet.Add_Char_To_Name_Buffer ('s');
Namet.Add_Char_To_Name_Buffer ('s');
end if;
Ocarina.Namet.Add_Char_To_Name_Buffer (' ');
Ocarina.Namet.Add_Str_To_Name_Buffer (Quoted_Image (L (L'First)));
Namet.Add_Char_To_Name_Buffer (' ');
Namet.Add_Str_To_Name_Buffer (Quoted_Image (L (L'First)));
for Index in Natural range L'First + 1 .. L'Last loop
Ocarina.Namet.Add_Str_To_Name_Buffer (" or ");
Ocarina.Namet.Add_Str_To_Name_Buffer (Quoted_Image (L (Index)));
Namet.Add_Str_To_Name_Buffer (" or ");
Namet.Add_Str_To_Name_Buffer (Quoted_Image (L (Index)));
end loop;
Errors.Error_Loc (1) := Token_Location;
Errors.DE (Ocarina.Namet.Get_Name_String (Ocarina.Namet.Name_Find));
Errors.DE (Namet.Get_Name_String (Namet.Name_Find));
Token := T_Error;
end if;
......@@ -435,7 +437,7 @@ package body Lexer is
elsif Buffer (Token_Location.Scan + 1) = '*' then
Token_Location.Scan := Token_Location.Scan + 2;
while Buffer (Token_Location.Scan) /= EOF
while Buffer (Token_Location.Scan) /= Types.EOF
and then
(Buffer (Token_Location.Scan) /= '*'
or else Buffer (Token_Location.Scan + 1) /= '/')
......@@ -448,7 +450,7 @@ package body Lexer is
end case;
end loop;
if Buffer (Token_Location.Scan) = EOF then
if Buffer (Token_Location.Scan) = Types.EOF then
Errors.Error_Loc (1) := Token_Location;
Errors.DE ("unterminated comment");
end if;
......@@ -466,7 +468,7 @@ package body Lexer is
when '_' =>
Scan_Identifier (Fatal);
when EOF =>
when Types.EOF =>
Token_Location.Scan := Token_Location.Scan + 1;
Token := T_EOF;
......@@ -573,15 +575,14 @@ package body Lexer is
-- To_Token --
--------------
function To_Token (Name : Name_Id) return Token_Type is
B : Byte;
function To_Token (Name : Types.Name_Id) return Token_Type is
B : Types.Byte;
begin
Ocarina.Namet.Get_Name_String (Name);
for I in Natural range 1 .. Ocarina.Namet.Name_Len loop
Ocarina.Namet.Name_Buffer (I)
:= Charset.To_Lower (Ocarina.Namet.Name_Buffer (I));
Namet.Get_Name_String (Name);
for I in Natural range 1 .. Namet.Name_Len loop
Namet.Name_Buffer (I) := Charset.To_Lower (Namet.Name_Buffer (I));
end loop;
B := Ocarina.Namet.Get_Name_Table_Byte (Ocarina.Namet.Name_Find);
B := Namet.Get_Name_Table_Byte (Namet.Name_Find);
if B <= Last_Token_Pos then
return Token_Type'Val (B);
end if;
......@@ -594,7 +595,7 @@ package body Lexer is
procedure Write (T : Token_Type) is
begin
Write_Str (Image (T));
Output.Write_Str (Image (T));
end Write;
end Lexer;
tools/mknodes/lexer.ads
View file @ 7044b453
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2005-2009 Telecom ParisTech, 2010-2014 ESA & ISAE. --
-- Copyright (C) 2005-2009 Telecom ParisTech, 2010-2012 ESA & ISAE. --
-- --
-- Ocarina is free software; you can redistribute it and/or modify --
-- it under terms of the GNU General Public License as published by the --
......@@ -34,7 +34,7 @@
with GNAT.OS_Lib;
with Locations;
with Ocarina.Types; use Ocarina.Types;
with Types;
package Lexer is
pragma Elaborate_Body (Lexer);
......@@ -86,7 +86,7 @@ pragma Elaborate_Body (Lexer);
range T_Interface .. T_Octet;
Token : Token_Type;
Token_Name : Name_Id;
Token_Name : Types.Name_Id;
Token_Location : Locations.Location;
function Image (T : Token_Type) return String;
......@@ -128,7 +128,7 @@ pragma Elaborate_Body (Lexer);
procedure Process
(Source_File : GNAT.OS_Lib.File_Descriptor;
Source_Name : Name_Id);
Source_Name : Types.Name_Id);
-- Load file Source in the lexer
procedure Write (T : Token_Type);
......@@ -178,7 +178,7 @@ private
procedure Skip_Spaces;
-- Skip all spaces
function To_Token (Name : Name_Id) return Token_Type;
function To_Token (Name : Types.Name_Id) return Token_Type;
-- Return the token matching Name. Otherwise, return T_Error.
end Lexer;
tools/mknodes/locations.adb 0 → 100644
View file @ 7044b453
------------------------------------------------------------------------------
-- --
-- OCARINA COMPONENTS --
-- --
-- L O C A T I O N S --
-- --
-- B o d y --
-- --
-- Copyright (C) 2014 ESA & ISAE. --
-- --
-- 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, --