1 files changed, 134 insertions, 0 deletions
diff --git a/ortho/llvm/ortho_ident.adb b/ortho/llvm/ortho_ident.adb
new file mode 100644
index 0000000..e7b6505
--- /dev/null
+++ b/ortho/llvm/ortho_ident.adb
@@ -0,0 +1,134 @@
+--  LLVM back-end for ortho.
+--  Copyright (C) 2014 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.
+
+package body Ortho_Ident is
+   type Chunk (Max : Positive);
+   type Chunk_Acc is access Chunk;
+
+   type Chunk (Max : Positive) is record
+      Prev : Chunk_Acc;
+      Len : Natural := 0;
+      S : String (1 .. Max);
+   end record;
+
+   Cur_Chunk : Chunk_Acc := null;
+
+   subtype Fat_String is String (Positive);
+
+   function Get_Identifier (Str : String) return O_Ident
+   is
+      Len : constant Natural := Str'Length;
+      Max : Positive;
+      Org : Positive;
+   begin
+      if Cur_Chunk = null or else Cur_Chunk.Len + Len >= Cur_Chunk.Max then
+         if Cur_Chunk = null then
+            Max := 32 * 1024;
+         else
+            Max := 2 * Cur_Chunk.Max;
+         end if;
+         if Len + 2 > Max then
+            Max := 2 * (Len + 2);
+         end if;
+         declare
+            New_Chunk : Chunk_Acc;
+         begin
+            --  Do not use allocator by expression, as we don't want to
+            --  initialize S.
+            New_Chunk := new Chunk (Max);
+            New_Chunk.Len := 0;
+            New_Chunk.Prev := Cur_Chunk;
+            Cur_Chunk := New_Chunk;
+         end;
+      end if;
+
+      Org := Cur_Chunk.Len + 1;
+      Cur_Chunk.S (Org .. Org + Len - 1) := Str;
+      Cur_Chunk.S (Org + Len) := ASCII.NUL;
+      Cur_Chunk.Len := Org + Len;
+
+      return (Addr => Cur_Chunk.S (Org)'Address);
+   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
+      Str : Fat_String;
+      pragma Import (Ada, Str);
+      for Str'Address use Id.Addr;
+   begin
+      for I in Str'Range loop
+         if Str (I) = ASCII.NUL then
+            return I - 1;
+         end if;
+      end loop;
+      raise Program_Error;
+   end Get_String_Length;
+
+   function Get_String (Id : O_Ident) return String
+   is
+      Str : Fat_String;
+      pragma Import (Ada, Str);
+      for Str'Address use Id.Addr;
+   begin
+      for I in Str'Range loop
+         if Str (I) = ASCII.NUL then
+            return Str (1 .. I - 1);
+         end if;
+      end loop;
+      raise Program_Error;
+   end Get_String;
+
+   function Get_Cstring (Id : O_Ident) return System.Address is
+   begin
+      return Id.Addr;
+   end Get_Cstring;
+
+   function Is_Equal (Id : O_Ident; Str : String) return Boolean
+   is
+      Istr : Fat_String;
+      pragma Import (Ada, Istr);
+      for Istr'Address use Id.Addr;
+
+      Str_Len : constant Natural := Str'Length;
+   begin
+      for I in Istr'Range loop
+         if Istr (I) = ASCII.NUL then
+            return I - 1 = Str_Len;
+         end if;
+         if I > Str_Len then
+            return False;
+         end if;
+         if Istr (I) /= Str (Str'First + I - 1) then
+            return False;
+         end if;
+      end loop;
+      raise Program_Error;
+   end Is_Equal;
+
+   function Is_Nul (Id : O_Ident) return Boolean is
+   begin
+      return Id = O_Ident_Nul;
+   end Is_Nul;
+
+end Ortho_Ident;