aboutsummaryrefslogtreecommitdiffstats
path: root/src/ortho/llvm-nodebug/ortho_ident.adb
diff options
context:
space:
mode:
Diffstat (limited to 'src/ortho/llvm-nodebug/ortho_ident.adb')
-rw-r--r--src/ortho/llvm-nodebug/ortho_ident.adb134
1 files changed, 134 insertions, 0 deletions
diff --git a/src/ortho/llvm-nodebug/ortho_ident.adb b/src/ortho/llvm-nodebug/ortho_ident.adb
new file mode 100644
index 000000000..e7b650539
--- /dev/null
+++ b/src/ortho/llvm-nodebug/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;