Skip to content
GitLab
Commit 7044b453 authored by yoogx's avatar yoogx
Browse files

* 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
tools/mknodes/charset.adb 0 → 100644
View file @ 7044b453
------------------------------------------------------------------------------
-- --
-- OCARINA COMPONENTS --
-- --
-- C H A R S E T --
-- --
-- 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.Characters.Latin_1; use Ada.Characters.Latin_1;
package body Charset is
type Translate_Table is array (Character) of Character;
-- Type used to describe translate tables
Fold_Lower : constant Translate_Table :=
(
'A' => LC_A,
'B' => LC_B,
'C' => LC_C,
'D' => LC_D,
'E' => LC_E,
'F' => LC_F,
'G' => LC_G,
'H' => LC_H,
'I' => LC_I,
'J' => LC_J,
'K' => LC_K,
'L' => LC_L,
'M' => LC_M,
'N' => LC_N,
'O' => LC_O,
'P' => LC_P,
'Q' => LC_Q,
'R' => LC_R,
'S' => LC_S,
'T' => LC_T,
'U' => LC_U,
'V' => LC_V,
'W' => LC_W,
'X' => LC_X,
'Y' => LC_Y,
'Z' => LC_Z,
LC_A => LC_A,
LC_B => LC_B,
LC_C => LC_C,
LC_D => LC_D,
LC_E => LC_E,
LC_F => LC_F,
LC_G => LC_G,
LC_H => LC_H,
LC_I => LC_I,
LC_J => LC_J,
LC_K => LC_K,
LC_L => LC_L,
LC_M => LC_M,
LC_N => LC_N,
LC_O => LC_O,
LC_P => LC_P,
LC_Q => LC_Q,
LC_R => LC_R,
LC_S => LC_S,
LC_T => LC_T,
LC_U => LC_U,
LC_V => LC_V,
LC_W => LC_W,
LC_X => LC_X,
LC_Y => LC_Y,
LC_Z => LC_Z,
UC_A_Grave => LC_A_Grave,
UC_A_Acute => LC_A_Acute,
UC_A_Circumflex => LC_A_Circumflex,
UC_A_Tilde => LC_A_Tilde,
UC_A_Diaeresis => LC_A_Diaeresis,
UC_A_Ring => LC_A_Ring,
UC_AE_Diphthong => LC_AE_Diphthong,
UC_C_Cedilla => LC_C_Cedilla,
UC_E_Grave => LC_E_Grave,
UC_E_Acute => LC_E_Acute,
UC_E_Circumflex => LC_E_Circumflex,
UC_E_Diaeresis => LC_E_Diaeresis,
UC_I_Grave => LC_I_Grave,
UC_I_Acute => LC_I_Acute,
UC_I_Circumflex => LC_I_Circumflex,
UC_I_Diaeresis => LC_I_Diaeresis,
UC_Icelandic_Eth => LC_Icelandic_Eth,
UC_N_Tilde => LC_N_Tilde,
UC_O_Grave => LC_O_Grave,
UC_O_Acute => LC_O_Acute,
UC_O_Circumflex => LC_O_Circumflex,
UC_O_Tilde => LC_O_Tilde,
UC_O_Diaeresis => LC_O_Diaeresis,
UC_O_Oblique_Stroke => LC_O_Oblique_Stroke,
UC_U_Grave => LC_U_Grave,
UC_U_Acute => LC_U_Acute,
UC_U_Circumflex => LC_U_Circumflex,
UC_U_Diaeresis => LC_U_Diaeresis,
UC_Y_Acute => LC_Y_Acute,
UC_Icelandic_Thorn => LC_Icelandic_Thorn,
LC_German_Sharp_S => LC_German_Sharp_S,
LC_A_Grave => LC_A_Grave,
LC_A_Acute => LC_A_Acute,
LC_A_Circumflex => LC_A_Circumflex,
LC_A_Tilde => LC_A_Tilde,
LC_A_Diaeresis => LC_A_Diaeresis,
LC_A_Ring => LC_A_Ring,
LC_AE_Diphthong => LC_AE_Diphthong,
LC_C_Cedilla => LC_C_Cedilla,
LC_E_Grave => LC_E_Grave,
LC_E_Acute => LC_E_Acute,
LC_E_Circumflex => LC_E_Circumflex,
LC_E_Diaeresis => LC_E_Diaeresis,
LC_I_Grave => LC_I_Grave,
LC_I_Acute => LC_I_Acute,
LC_I_Circumflex => LC_I_Circumflex,
LC_I_Diaeresis => LC_I_Diaeresis,
LC_Icelandic_Eth => LC_Icelandic_Eth,
LC_N_Tilde => LC_N_Tilde,
LC_O_Grave => LC_O_Grave,
LC_O_Acute => LC_O_Acute,
LC_O_Circumflex => LC_O_Circumflex,
LC_O_Tilde => LC_O_Tilde,
LC_O_Diaeresis => LC_O_Diaeresis,
LC_O_Oblique_Stroke => LC_O_Oblique_Stroke,
LC_U_Grave => LC_U_Grave,
LC_U_Acute => LC_U_Acute,
LC_U_Circumflex => LC_U_Circumflex,
LC_U_Diaeresis => LC_U_Diaeresis,
LC_Y_Acute => LC_Y_Acute,
LC_Icelandic_Thorn => LC_Icelandic_Thorn,
LC_Y_Diaeresis => LC_Y_Diaeresis,
others => ' ');
Fold_Upper : constant Translate_Table :=
(
LC_A => 'A',
LC_B => 'B',
LC_C => 'C',
LC_D => 'D',
LC_E => 'E',
LC_F => 'F',
LC_G => 'G',
LC_H => 'H',
LC_I => 'I',
LC_J => 'J',
LC_K => 'K',
LC_L => 'L',
LC_M => 'M',
LC_N => 'N',
LC_O => 'O',
LC_P => 'P',
LC_Q => 'Q',
LC_R => 'R',
LC_S => 'S',
LC_T => 'T',
LC_U => 'U',
LC_V => 'V',
LC_W => 'W',
LC_X => 'X',
LC_Y => 'Y',
LC_Z => 'Z',
'A' => 'A',
'B' => 'B',
'C' => 'C',
'D' => 'D',
'E' => 'E',
'F' => 'F',
'G' => 'G',
'H' => 'H',
'I' => 'I',
'J' => 'J',
'K' => 'K',
'L' => 'L',
'M' => 'M',
'N' => 'N',
'O' => 'O',
'P' => 'P',
'Q' => 'Q',
'R' => 'R',
'S' => 'S',
'T' => 'T',
'U' => 'U',
'V' => 'V',
'W' => 'W',
'X' => 'X',
'Y' => 'Y',
'Z' => 'Z',
UC_A_Grave => UC_A_Grave,
UC_A_Acute => UC_A_Acute,
UC_A_Circumflex => UC_A_Circumflex,
UC_A_Tilde => UC_A_Tilde,
UC_A_Diaeresis => UC_A_Diaeresis,
UC_A_Ring => UC_A_Ring,
UC_AE_Diphthong => UC_AE_Diphthong,
UC_C_Cedilla => UC_C_Cedilla,
UC_E_Grave => UC_E_Grave,
UC_E_Acute => UC_E_Acute,
UC_E_Circumflex => UC_E_Circumflex,
UC_E_Diaeresis => UC_E_Diaeresis,
UC_I_Grave => UC_I_Grave,
UC_I_Acute => UC_I_Acute,
UC_I_Circumflex => UC_I_Circumflex,
UC_I_Diaeresis => UC_I_Diaeresis,
UC_Icelandic_Eth => UC_Icelandic_Eth,
UC_N_Tilde => UC_N_Tilde,
UC_O_Grave => UC_O_Grave,
UC_O_Acute => UC_O_Acute,
UC_O_Circumflex => UC_O_Circumflex,
UC_O_Tilde => UC_O_Tilde,
UC_O_Diaeresis => UC_O_Diaeresis,
UC_O_Oblique_Stroke => UC_O_Oblique_Stroke,
UC_U_Grave => UC_U_Grave,
UC_U_Acute => UC_U_Acute,
UC_U_Circumflex => UC_U_Circumflex,
UC_U_Diaeresis => UC_U_Diaeresis,
UC_Y_Acute => UC_Y_Acute,
UC_Icelandic_Thorn => UC_Icelandic_Thorn,
LC_German_Sharp_S => LC_German_Sharp_S,
LC_A_Grave => UC_A_Grave,
LC_A_Acute => UC_A_Acute,
LC_A_Circumflex => UC_A_Circumflex,
LC_A_Tilde => UC_A_Tilde,
LC_A_Diaeresis => UC_A_Diaeresis,
LC_A_Ring => UC_A_Ring,
LC_AE_Diphthong => UC_AE_Diphthong,
LC_C_Cedilla => UC_C_Cedilla,
LC_E_Grave => UC_E_Grave,
LC_E_Acute => UC_E_Acute,
LC_E_Circumflex => UC_E_Circumflex,
LC_E_Diaeresis => UC_E_Diaeresis,
LC_I_Grave => UC_I_Grave,
LC_I_Acute => UC_I_Acute,
LC_I_Circumflex => UC_I_Circumflex,
LC_I_Diaeresis => UC_I_Diaeresis,
LC_Icelandic_Eth => UC_Icelandic_Eth,
LC_N_Tilde => UC_N_Tilde,
LC_O_Grave => UC_O_Grave,
LC_O_Acute => UC_O_Acute,
LC_O_Circumflex => UC_O_Circumflex,
LC_O_Tilde => UC_O_Tilde,
LC_O_Diaeresis => UC_O_Diaeresis,
LC_O_Oblique_Stroke => UC_O_Oblique_Stroke,
LC_U_Grave => UC_U_Grave,
LC_U_Acute => UC_U_Acute,
LC_U_Circumflex => UC_U_Circumflex,
LC_U_Diaeresis => UC_U_Diaeresis,
LC_Y_Acute => UC_Y_Acute,
LC_Icelandic_Thorn => UC_Icelandic_Thorn,
LC_Y_Diaeresis => LC_Y_Diaeresis,
others => ' ');
-----------------------------
-- Is_Alphabetic_Character --
-----------------------------
function Is_Alphabetic_Character (C : Character) return Boolean is
begin
return Fold_Lower (C) /= ' ';
end Is_Alphabetic_Character;
-----------------------------
-- Is_Identifier_Character --
-----------------------------
function Is_Identifier_Character (C : Character) return Boolean is
begin
return C = '_'
or else C in '0' .. '9'
or else Fold_Lower (C) /= ' ';
end Is_Identifier_Character;
--------------
-- To_Lower --
--------------
procedure To_Lower (S : in out String) is
begin
for I in S'Range loop
if Fold_Lower (S (I)) /= ' ' then
S (I) := Fold_Lower (S (I));
end if;
end loop;
end To_Lower;
function To_Lower (C : Character) return Character is
begin
if Fold_Lower (C) /= ' ' then
return Fold_Lower (C);
else
return C;
end if;
end To_Lower;
function To_Lower (S : String) return String is
LS : String := S;
begin
To_Lower (LS);
return LS;
end To_Lower;
--------------
-- To_Upper --
--------------
procedure To_Upper (S : in out String) is
begin
for I in S'Range loop
if Fold_Lower (S (I)) /= ' ' then
S (I) := Fold_Upper (S (I));
end if;
end loop;
end To_Upper;
--------------
-- To_Upper --
--------------
function To_Upper (C : Character) return Character is
begin
if Fold_Lower (C) /= ' ' then
return Fold_Upper (C);
else
return C;
end if;
end To_Upper;
--------------
-- To_Upper --
--------------
function To_Upper (S : String) return String is
LS : String := S;
begin
To_Upper (LS);
return LS;
end To_Upper;
end Charset;
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 (" |");