1 files changed, 117 insertions, 0 deletions
diff --git a/src/ortho/mcode/ortho_ident.adb b/src/ortho/mcode/ortho_ident.adb
new file mode 100644
index 0000000..0893b75
--- /dev/null
+++ b/src/ortho/mcode/ortho_ident.adb
@@ -0,0 +1,117 @@
+--  Mcode back-end for ortho.
+--  Copyright (C) 2006 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL 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
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Ada.Text_IO;
+with GNAT.Table;
+
+package body Ortho_Ident is
+   package Ids is new GNAT.Table
+     (Table_Component_Type => Natural,
+      Table_Index_Type => O_Ident,
+      Table_Low_Bound => 2,
+      Table_Initial => 128,
+      Table_Increment => 100);
+
+   package Strs is new GNAT.Table
+     (Table_Component_Type => Character,
+      Table_Index_Type => Natural,
+      Table_Low_Bound => 2,
+      Table_Initial => 128,
+      Table_Increment => 100);
+
+   function Get_Identifier (Str : String) return O_Ident
+   is
+      Start : Natural;
+   begin
+      Start := Strs.Allocate (Str'Length + 1);
+      for I in Str'Range loop
+         Strs.Table (Start + I - Str'First) := Str (I);
+      end loop;
+      Strs.Table (Start + Str'Length) := ASCII.Nul;
+      Ids.Append (Start);
+      return Ids.Last;
+   end Get_Identifier;
+
+   function Is_Equal (L, R : O_Ident) return Boolean
+   is
+   begin
+      return L = R;
+   end Is_Equal;
+
+   function Get_String_Length (Id : O_Ident) return Natural
+   is
+      Start : Natural;
+   begin
+      Start := Ids.Table (Id);
+      if Id = Ids.Last then
+         return Strs.Last - Start + 1 - 1;
+      else
+         return Ids.Table (Id + 1) - 1 - Start;
+      end if;
+   end Get_String_Length;
+
+   function Get_String (Id : O_Ident) return String
+   is
+      Res : String (1 .. Get_String_Length (Id));
+      Start : constant Natural := Ids.Table (Id);
+   begin
+      for I in Res'Range loop
+         Res (I) := Strs.Table (Start + I - Res'First);
+      end loop;
+      return Res;
+   end Get_String;
+
+   function Get_Cstring (Id : O_Ident) return System.Address is
+   begin
+      return Strs.Table (Ids.Table (Id))'Address;
+   end Get_Cstring;
+
+   function Is_Equal (Id : O_Ident; Str : String) return Boolean
+   is
+      Start : constant Natural := Ids.Table (Id);
+      Len : constant Natural := Get_String_Length (Id);
+   begin
+      if Len /= Str'Length then
+         return False;
+      end if;
+      for I in Str'Range loop
+         if Str (I) /= Strs.Table (Start + I - Str'First) then
+            return False;
+         end if;
+      end loop;
+      return True;
+   end Is_Equal;
+
+   function Is_Nul (Id : O_Ident) return Boolean is
+   begin
+      return Id = O_Ident_Nul;
+   end Is_Nul;
+
+   procedure Disp_Stats
+   is
+      use Ada.Text_IO;
+   begin
+      Put_Line ("Number of Ident: " & O_Ident'Image (Ids.Last));
+      Put_Line ("Number of Ident-Strs: " & Natural'Image (Strs.Last));
+   end Disp_Stats;
+
+   procedure Finish is
+   begin
+      Ids.Free;
+      Strs.Free;
+   end Finish;
+end Ortho_Ident;