]> git.ipfire.org Git - thirdparty/gcc.git/blame - gcc/fortran/constructor.c
Update copyright years.
[thirdparty/gcc.git] / gcc / fortran / constructor.c
CommitLineData
b7e75771 1/* Array and structure constructors
99dee823 2 Copyright (C) 2009-2021 Free Software Foundation, Inc.
b7e75771
JD
3
4This file is part of GCC.
5
6GCC is free software; you can redistribute it and/or modify it under
7the terms of the GNU General Public License as published by the Free
8Software Foundation; either version 3, or (at your option) any later
9version.
10
11GCC is distributed in the hope that it will be useful, but WITHOUT ANY
12WARRANTY; without even the implied warranty of MERCHANTABILITY or
13FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
14for more details.
15
16You should have received a copy of the GNU General Public License
17along with GCC; see the file COPYING3. If not see
18<http://www.gnu.org/licenses/>. */
19
20#include "config.h"
21#include "system.h"
953bee7c 22#include "coretypes.h"
b7e75771
JD
23#include "gfortran.h"
24#include "constructor.h"
25
26
27static void
28node_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);
21ea4922 39 mpz_clear (c->repeat);
b7e75771 40
cede9502 41 free (c);
b7e75771
JD
42}
43
44
45static gfc_constructor *
46node_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);
21ea4922 58 mpz_init_set (c->repeat, src->repeat);
b7e75771
JD
59
60 return c;
61}
62
63
64static int
65node_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
74gfc_constructor *
75gfc_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);
21ea4922 83 mpz_init_set_si (c->repeat, 1);
b7e75771
JD
84
85 return c;
86}
87
88gfc_constructor_base gfc_constructor_get_base (void)
89{
90 return splay_tree_new (splay_tree_compare_ints, NULL, node_free);
91}
92
93
94gfc_constructor_base
95gfc_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
109void
110gfc_constructor_free (gfc_constructor_base base)
111{
112 if (base)
113 splay_tree_delete (base);
114}
115
116
117gfc_constructor *
118gfc_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
128gfc_constructor *
129gfc_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
141gfc_constructor *
142gfc_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
159gfc_constructor *
160gfc_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
172gfc_constructor *
173gfc_constructor_lookup (gfc_constructor_base base, int offset)
174{
21ea4922 175 gfc_constructor *c;
b7e75771
JD
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)
21ea4922 183 return (gfc_constructor *) node->value;
b7e75771 184
21ea4922
JJ
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;
b7e75771
JD
201}
202
203
204gfc_expr *
205gfc_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
212int
213gfc_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
220void
221gfc_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
229gfc_constructor *
230gfc_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
242gfc_constructor *
243gfc_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}
21ea4922
JJ
254
255
256void
257gfc_constructor_remove (gfc_constructor *ctor)
258{
259 if (ctor)
260 splay_tree_remove (ctor->base, mpz_get_si (ctor->offset));
261}
262
263
264gfc_constructor *
265gfc_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}