blob: 245af9bb7ffecd58c13a128a78cf90f7bcdc284e (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
|
-- LLVM back-end for ortho.
-- Copyright (C) 2014 Tristan Gingold
--
-- This program 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 of the License, or
-- (at your option) any later version.
--
-- This program 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 this program. If not, see <gnu.org/licenses>.
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;
|
