diff options
Diffstat (limited to 'src/ortho/llvm-nodebug/ortho_ident.adb')
-rw-r--r-- | src/ortho/llvm-nodebug/ortho_ident.adb | 134 |
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; |