|
111
|
1 /* Array and structure constructors
|
|
131
|
2 Copyright (C) 2009-2018 Free Software Foundation, Inc.
|
|
111
|
3
|
|
|
4 This file is part of GCC.
|
|
|
5
|
|
|
6 GCC is free software; you can redistribute it and/or modify it under
|
|
|
7 the terms of the GNU General Public License as published by the Free
|
|
|
8 Software Foundation; either version 3, or (at your option) any later
|
|
|
9 version.
|
|
|
10
|
|
|
11 GCC is distributed in the hope that it will be useful, but WITHOUT ANY
|
|
|
12 WARRANTY; without even the implied warranty of MERCHANTABILITY or
|
|
|
13 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
|
|
|
14 for more details.
|
|
|
15
|
|
|
16 You should have received a copy of the GNU General Public License
|
|
|
17 along with GCC; see the file COPYING3. If not see
|
|
|
18 <http://www.gnu.org/licenses/>. */
|
|
|
19
|
|
|
20 #include "config.h"
|
|
|
21 #include "system.h"
|
|
|
22 #include "coretypes.h"
|
|
|
23 #include "gfortran.h"
|
|
|
24 #include "constructor.h"
|
|
|
25
|
|
|
26
|
|
|
27 static void
|
|
|
28 node_free (splay_tree_value value)
|
|
|
29 {
|
|
|
30 gfc_constructor *c = (gfc_constructor*)value;
|
|
|
31
|
|
|
32 if (c->expr)
|
|
|
33 gfc_free_expr (c->expr);
|
|
|
34
|
|
|
35 if (c->iterator)
|
|
|
36 gfc_free_iterator (c->iterator, 1);
|
|
|
37
|
|
|
38 mpz_clear (c->offset);
|
|
|
39 mpz_clear (c->repeat);
|
|
|
40
|
|
|
41 free (c);
|
|
|
42 }
|
|
|
43
|
|
|
44
|
|
|
45 static gfc_constructor *
|
|
|
46 node_copy (splay_tree_node node, void *base)
|
|
|
47 {
|
|
|
48 gfc_constructor *c, *src = (gfc_constructor*)node->value;
|
|
|
49
|
|
|
50 c = XCNEW (gfc_constructor);
|
|
|
51 c->base = (gfc_constructor_base)base;
|
|
|
52 c->expr = gfc_copy_expr (src->expr);
|
|
|
53 c->iterator = gfc_copy_iterator (src->iterator);
|
|
|
54 c->where = src->where;
|
|
|
55 c->n.component = src->n.component;
|
|
|
56
|
|
|
57 mpz_init_set (c->offset, src->offset);
|
|
|
58 mpz_init_set (c->repeat, src->repeat);
|
|
|
59
|
|
|
60 return c;
|
|
|
61 }
|
|
|
62
|
|
|
63
|
|
|
64 static int
|
|
|
65 node_copy_and_insert (splay_tree_node node, void *base)
|
|
|
66 {
|
|
|
67 int n = mpz_get_si (((gfc_constructor*)node->value)->offset);
|
|
|
68 gfc_constructor_insert ((gfc_constructor_base*)base,
|
|
|
69 node_copy (node, base), n);
|
|
|
70 return 0;
|
|
|
71 }
|
|
|
72
|
|
|
73
|
|
|
74 gfc_constructor *
|
|
|
75 gfc_constructor_get (void)
|
|
|
76 {
|
|
|
77 gfc_constructor *c = XCNEW (gfc_constructor);
|
|
|
78 c->base = NULL;
|
|
|
79 c->expr = NULL;
|
|
|
80 c->iterator = NULL;
|
|
|
81
|
|
|
82 mpz_init_set_si (c->offset, 0);
|
|
|
83 mpz_init_set_si (c->repeat, 1);
|
|
|
84
|
|
|
85 return c;
|
|
|
86 }
|
|
|
87
|
|
|
88 gfc_constructor_base gfc_constructor_get_base (void)
|
|
|
89 {
|
|
|
90 return splay_tree_new (splay_tree_compare_ints, NULL, node_free);
|
|
|
91 }
|
|
|
92
|
|
|
93
|
|
|
94 gfc_constructor_base
|
|
|
95 gfc_constructor_copy (gfc_constructor_base base)
|
|
|
96 {
|
|
|
97 gfc_constructor_base new_base;
|
|
|
98
|
|
|
99 if (!base)
|
|
|
100 return NULL;
|
|
|
101
|
|
|
102 new_base = gfc_constructor_get_base ();
|
|
|
103 splay_tree_foreach (base, node_copy_and_insert, &new_base);
|
|
|
104
|
|
|
105 return new_base;
|
|
|
106 }
|
|
|
107
|
|
|
108
|
|
|
109 void
|
|
|
110 gfc_constructor_free (gfc_constructor_base base)
|
|
|
111 {
|
|
|
112 if (base)
|
|
|
113 splay_tree_delete (base);
|
|
|
114 }
|
|
|
115
|
|
|
116
|
|
|
117 gfc_constructor *
|
|
|
118 gfc_constructor_append (gfc_constructor_base *base, gfc_constructor *c)
|
|
|
119 {
|
|
|
120 int offset = 0;
|
|
|
121 if (*base)
|
|
|
122 offset = (int)(splay_tree_max (*base)->key) + 1;
|
|
|
123
|
|
|
124 return gfc_constructor_insert (base, c, offset);
|
|
|
125 }
|
|
|
126
|
|
|
127
|
|
|
128 gfc_constructor *
|
|
|
129 gfc_constructor_append_expr (gfc_constructor_base *base,
|
|
|
130 gfc_expr *e, locus *where)
|
|
|
131 {
|
|
|
132 gfc_constructor *c = gfc_constructor_get ();
|
|
|
133 c->expr = e;
|
|
|
134 if (where)
|
|
|
135 c->where = *where;
|
|
|
136
|
|
|
137 return gfc_constructor_append (base, c);
|
|
|
138 }
|
|
|
139
|
|
|
140
|
|
|
141 gfc_constructor *
|
|
|
142 gfc_constructor_insert (gfc_constructor_base *base, gfc_constructor *c, int n)
|
|
|
143 {
|
|
|
144 splay_tree_node node;
|
|
|
145
|
|
|
146 if (*base == NULL)
|
|
|
147 *base = splay_tree_new (splay_tree_compare_ints, NULL, node_free);
|
|
|
148
|
|
|
149 c->base = *base;
|
|
|
150 mpz_set_si (c->offset, n);
|
|
|
151
|
|
|
152 node = splay_tree_insert (*base, (splay_tree_key) n, (splay_tree_value) c);
|
|
|
153 gcc_assert (node);
|
|
|
154
|
|
|
155 return (gfc_constructor*)node->value;
|
|
|
156 }
|
|
|
157
|
|
|
158
|
|
|
159 gfc_constructor *
|
|
|
160 gfc_constructor_insert_expr (gfc_constructor_base *base,
|
|
|
161 gfc_expr *e, locus *where, int n)
|
|
|
162 {
|
|
|
163 gfc_constructor *c = gfc_constructor_get ();
|
|
|
164 c->expr = e;
|
|
|
165 if (where)
|
|
|
166 c->where = *where;
|
|
|
167
|
|
|
168 return gfc_constructor_insert (base, c, n);
|
|
|
169 }
|
|
|
170
|
|
|
171
|
|
|
172 gfc_constructor *
|
|
|
173 gfc_constructor_lookup (gfc_constructor_base base, int offset)
|
|
|
174 {
|
|
|
175 gfc_constructor *c;
|
|
|
176 splay_tree_node node;
|
|
|
177
|
|
|
178 if (!base)
|
|
|
179 return NULL;
|
|
|
180
|
|
|
181 node = splay_tree_lookup (base, (splay_tree_key) offset);
|
|
|
182 if (node)
|
|
|
183 return (gfc_constructor *) node->value;
|
|
|
184
|
|
|
185 /* Check if the previous node has a repeat count big enough to
|
|
|
186 cover the offset looked for. */
|
|
|
187 node = splay_tree_predecessor (base, (splay_tree_key) offset);
|
|
|
188 if (!node)
|
|
|
189 return NULL;
|
|
|
190
|
|
|
191 c = (gfc_constructor *) node->value;
|
|
|
192 if (mpz_cmp_si (c->repeat, 1) > 0)
|
|
|
193 {
|
|
|
194 if (mpz_get_si (c->offset) + mpz_get_si (c->repeat) <= offset)
|
|
|
195 c = NULL;
|
|
|
196 }
|
|
|
197 else
|
|
|
198 c = NULL;
|
|
|
199
|
|
|
200 return c;
|
|
|
201 }
|
|
|
202
|
|
|
203
|
|
|
204 gfc_expr *
|
|
|
205 gfc_constructor_lookup_expr (gfc_constructor_base base, int offset)
|
|
|
206 {
|
|
|
207 gfc_constructor *c = gfc_constructor_lookup (base, offset);
|
|
|
208 return c ? c->expr : NULL;
|
|
|
209 }
|
|
|
210
|
|
|
211
|
|
|
212 int
|
|
|
213 gfc_constructor_expr_foreach (gfc_constructor *ctor ATTRIBUTE_UNUSED,
|
|
|
214 int(*f)(gfc_expr *) ATTRIBUTE_UNUSED)
|
|
|
215 {
|
|
|
216 gcc_assert (0);
|
|
|
217 return 0;
|
|
|
218 }
|
|
|
219
|
|
|
220 void
|
|
|
221 gfc_constructor_swap (gfc_constructor *ctor ATTRIBUTE_UNUSED,
|
|
|
222 int n ATTRIBUTE_UNUSED, int m ATTRIBUTE_UNUSED)
|
|
|
223 {
|
|
|
224 gcc_assert (0);
|
|
|
225 }
|
|
|
226
|
|
|
227
|
|
|
228
|
|
|
229 gfc_constructor *
|
|
|
230 gfc_constructor_first (gfc_constructor_base base)
|
|
|
231 {
|
|
|
232 if (base)
|
|
|
233 {
|
|
|
234 splay_tree_node node = splay_tree_min (base);
|
|
|
235 return node ? (gfc_constructor*) node->value : NULL;
|
|
|
236 }
|
|
|
237 else
|
|
|
238 return NULL;
|
|
|
239 }
|
|
|
240
|
|
|
241
|
|
|
242 gfc_constructor *
|
|
|
243 gfc_constructor_next (gfc_constructor *ctor)
|
|
|
244 {
|
|
|
245 if (ctor)
|
|
|
246 {
|
|
|
247 splay_tree_node node = splay_tree_successor (ctor->base,
|
|
|
248 mpz_get_si (ctor->offset));
|
|
|
249 return node ? (gfc_constructor*) node->value : NULL;
|
|
|
250 }
|
|
|
251 else
|
|
|
252 return NULL;
|
|
|
253 }
|
|
|
254
|
|
|
255
|
|
|
256 void
|
|
|
257 gfc_constructor_remove (gfc_constructor *ctor)
|
|
|
258 {
|
|
|
259 if (ctor)
|
|
|
260 splay_tree_remove (ctor->base, mpz_get_si (ctor->offset));
|
|
|
261 }
|
|
|
262
|
|
|
263
|
|
|
264 gfc_constructor *
|
|
|
265 gfc_constructor_lookup_next (gfc_constructor_base base, int offset)
|
|
|
266 {
|
|
|
267 splay_tree_node node;
|
|
|
268
|
|
|
269 if (!base)
|
|
|
270 return NULL;
|
|
|
271
|
|
|
272 node = splay_tree_successor (base, (splay_tree_key) offset);
|
|
|
273 if (!node)
|
|
|
274 return NULL;
|
|
|
275
|
|
|
276 return (gfc_constructor *) node->value;
|
|
|
277 }
|
