1/* Array and structure constructors
2 Copyright (C) 2009-2023 Free Software Foundation, Inc.
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"
22#include "coretypes.h"
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);
39 mpz_clear (c->repeat);
40
41 free (ptr: c);
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);
58 mpz_init_set (c->repeat, src->repeat);
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 (base: (gfc_constructor_base*)base,
69 c: 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);
83 mpz_init_set_si (c->repeat, 1);
84
85 return c;
86}
87
88static gfc_constructor_base
89gfc_constructor_get_base (void)
90{
91 return splay_tree_new (splay_tree_compare_ints, NULL, node_free);
92}
93
94
95gfc_constructor_base
96gfc_constructor_copy (gfc_constructor_base base)
97{
98 gfc_constructor_base new_base;
99
100 if (!base)
101 return NULL;
102
103 new_base = gfc_constructor_get_base ();
104 splay_tree_foreach (base, node_copy_and_insert, &new_base);
105
106 return new_base;
107}
108
109
110void
111gfc_constructor_free (gfc_constructor_base base)
112{
113 if (base)
114 splay_tree_delete (base);
115}
116
117
118gfc_constructor *
119gfc_constructor_append (gfc_constructor_base *base, gfc_constructor *c)
120{
121 int offset = 0;
122 if (*base)
123 offset = (int)(splay_tree_max (*base)->key) + 1;
124
125 return gfc_constructor_insert (base, c, n: offset);
126}
127
128
129gfc_constructor *
130gfc_constructor_append_expr (gfc_constructor_base *base,
131 gfc_expr *e, locus *where)
132{
133 gfc_constructor *c = gfc_constructor_get ();
134 c->expr = e;
135 if (where)
136 c->where = *where;
137
138 return gfc_constructor_append (base, c);
139}
140
141
142gfc_constructor *
143gfc_constructor_insert (gfc_constructor_base *base, gfc_constructor *c, int n)
144{
145 splay_tree_node node;
146
147 if (*base == NULL)
148 *base = splay_tree_new (splay_tree_compare_ints, NULL, node_free);
149
150 c->base = *base;
151 mpz_set_si (c->offset, n);
152
153 node = splay_tree_insert (*base, (splay_tree_key) n, (splay_tree_value) c);
154 gcc_assert (node);
155
156 return (gfc_constructor*)node->value;
157}
158
159
160gfc_constructor *
161gfc_constructor_insert_expr (gfc_constructor_base *base,
162 gfc_expr *e, locus *where, int n)
163{
164 gfc_constructor *c = gfc_constructor_get ();
165 c->expr = e;
166 if (where)
167 c->where = *where;
168
169 return gfc_constructor_insert (base, c, n);
170}
171
172
173gfc_constructor *
174gfc_constructor_lookup (gfc_constructor_base base, int offset)
175{
176 gfc_constructor *c;
177 splay_tree_node node;
178
179 if (!base)
180 return NULL;
181
182 node = splay_tree_lookup (base, (splay_tree_key) offset);
183 if (node)
184 return (gfc_constructor *) node->value;
185
186 /* Check if the previous node has a repeat count big enough to
187 cover the offset looked for. */
188 node = splay_tree_predecessor (base, (splay_tree_key) offset);
189 if (!node)
190 return NULL;
191
192 c = (gfc_constructor *) node->value;
193 if (mpz_cmp_si (c->repeat, 1) > 0)
194 {
195 if (mpz_get_si (c->offset) + mpz_get_si (c->repeat) <= offset)
196 c = NULL;
197 }
198 else
199 c = NULL;
200
201 return c;
202}
203
204
205gfc_expr *
206gfc_constructor_lookup_expr (gfc_constructor_base base, int offset)
207{
208 gfc_constructor *c = gfc_constructor_lookup (base, offset);
209 return c ? c->expr : NULL;
210}
211
212
213gfc_constructor *
214gfc_constructor_first (gfc_constructor_base base)
215{
216 if (base)
217 {
218 splay_tree_node node = splay_tree_min (base);
219 return node ? (gfc_constructor*) node->value : NULL;
220 }
221 else
222 return NULL;
223}
224
225
226gfc_constructor *
227gfc_constructor_next (gfc_constructor *ctor)
228{
229 if (ctor)
230 {
231 splay_tree_node node = splay_tree_successor (ctor->base,
232 mpz_get_si (ctor->offset));
233 return node ? (gfc_constructor*) node->value : NULL;
234 }
235 else
236 return NULL;
237}
238
239
240void
241gfc_constructor_remove (gfc_constructor *ctor)
242{
243 if (ctor)
244 splay_tree_remove (ctor->base, mpz_get_si (ctor->offset));
245}
246
247
248gfc_constructor *
249gfc_constructor_lookup_next (gfc_constructor_base base, int offset)
250{
251 splay_tree_node node;
252
253 if (!base)
254 return NULL;
255
256 node = splay_tree_successor (base, (splay_tree_key) offset);
257 if (!node)
258 return NULL;
259
260 return (gfc_constructor *) node->value;
261}
262

source code of gcc/fortran/constructor.cc