mirror of
https://github.com/AdaCore/PolyORB.git
synced 2026-02-12 13:01:15 -08:00
159 lines
5.4 KiB
Ada
159 lines
5.4 KiB
Ada
------------------------------------------------------------------------------
|
|
-- --
|
|
-- POLYORB COMPONENTS --
|
|
-- --
|
|
-- B A C K E N D --
|
|
-- --
|
|
-- B o d y --
|
|
-- --
|
|
-- Copyright (C) 2005-2012, Free Software Foundation, Inc. --
|
|
-- --
|
|
-- This is free software; you can redistribute it and/or modify it under --
|
|
-- terms of the GNU General Public License as published by the Free Soft- --
|
|
-- ware Foundation; either version 3, or (at your option) any later ver- --
|
|
-- sion. This software is distributed in the hope that it will be useful, --
|
|
-- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- --
|
|
-- TABILITY 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 and --
|
|
-- a copy of the GCC Runtime Library Exception along with this program; --
|
|
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
|
|
-- <http://www.gnu.org/licenses/>. --
|
|
-- --
|
|
-- PolyORB is maintained by AdaCore --
|
|
-- (email: sales@adacore.com) --
|
|
-- --
|
|
------------------------------------------------------------------------------
|
|
|
|
with GNAT.OS_Lib; use GNAT.OS_Lib;
|
|
|
|
with Errors; use Errors;
|
|
with Output; use Output;
|
|
|
|
package body Backend is
|
|
|
|
type Backend_Record is record
|
|
Language : String_Access;
|
|
Comments : String_Access;
|
|
Generate : Generate_Procedure;
|
|
Usage : Usage_Procedure;
|
|
end record;
|
|
|
|
type Table_Index is range 1 .. 8;
|
|
subtype Table_Count is Table_Index'Base range 0 .. Table_Index'Last;
|
|
Table : array (Table_Index) of Backend_Record;
|
|
First : constant Table_Index := Table'First;
|
|
Last : Table_Count := 0;
|
|
|
|
Current : Table_Count := 0;
|
|
-- Initialized to proper value in Backend.Config
|
|
|
|
----------------------
|
|
-- Current_Language --
|
|
----------------------
|
|
|
|
function Current_Language return String is
|
|
pragma Assert (Current in Table_Index);
|
|
begin
|
|
return Table (Current).Language.all;
|
|
end Current_Language;
|
|
|
|
--------------
|
|
-- Generate --
|
|
--------------
|
|
|
|
procedure Generate (IDL_Spec : Node_Id) is
|
|
begin
|
|
if Current /= 0 then
|
|
Table (Current).Generate (IDL_Spec);
|
|
end if;
|
|
end Generate;
|
|
|
|
-----------------------
|
|
-- Is_Valid_Language --
|
|
-----------------------
|
|
|
|
function Is_Valid_Language (L : String) return Boolean is
|
|
begin
|
|
for N in First .. Last loop
|
|
if Table (N).Language.all = L then
|
|
return True;
|
|
end if;
|
|
end loop;
|
|
return False;
|
|
end Is_Valid_Language;
|
|
|
|
--------------
|
|
-- Register --
|
|
--------------
|
|
|
|
procedure Register_Language
|
|
(Generate : Generate_Procedure;
|
|
Usage : Usage_Procedure;
|
|
Language : String;
|
|
Comments : String)
|
|
is
|
|
begin
|
|
if Last = Table'Last then
|
|
DE ("too many target languages");
|
|
end if;
|
|
for I in First .. Last loop
|
|
if Table (I).Language.all = Language then
|
|
DE ("already declared target language");
|
|
raise Internal_Error;
|
|
end if;
|
|
end loop;
|
|
Last := Last + 1;
|
|
Table (Last).Generate := Generate;
|
|
Table (Last).Usage := Usage;
|
|
Table (Last).Language := new String'(Language);
|
|
Table (Last).Comments := new String'(Comments);
|
|
end Register_Language;
|
|
|
|
--------------------------
|
|
-- Set_Current_Language --
|
|
--------------------------
|
|
|
|
procedure Set_Current_Language (Language : String) is
|
|
begin
|
|
Current := 0;
|
|
for I in First .. Last loop
|
|
if Table (I).Language.all = Language then
|
|
Current := I;
|
|
exit;
|
|
end if;
|
|
end loop;
|
|
if Current = 0 then
|
|
DE ("unknown target language");
|
|
raise Fatal_Error;
|
|
end if;
|
|
end Set_Current_Language;
|
|
|
|
---------------------
|
|
-- Write_Languages --
|
|
---------------------
|
|
|
|
procedure Write_Languages
|
|
(L, C : Natural)
|
|
is
|
|
S : String (1 .. 64);
|
|
begin
|
|
for I in reverse First .. Last loop
|
|
S := (others => ' ');
|
|
declare
|
|
Language : constant String := Table (I).Language.all;
|
|
Comments : constant String := Table (I).Comments.all;
|
|
Usage : constant Usage_Procedure := Table (I).Usage;
|
|
begin
|
|
S (L .. L + Language'Length - 1) := Language;
|
|
S (C .. C + Comments'Length - 1) := Comments;
|
|
Write_Line (S (1 .. C + Comments'Length - 1));
|
|
Usage (C);
|
|
Write_Eol;
|
|
end;
|
|
end loop;
|
|
end Write_Languages;
|
|
|
|
end Backend;
|