]> git.ipfire.org Git - thirdparty/gcc.git/blame - gcc/fortran/constructor.c
gfortran.h: Do not include coretypes.h here.
[thirdparty/gcc.git] / gcc / fortran / constructor.c
CommitLineData
b7e75771 1/* Array and structure constructors
21ea4922 2 Copyright (C) 2009, 2010, 2011
b7e75771
JD
3 Free Software Foundation, Inc.
4
5This file is part of GCC.
6
7GCC is free software; you can redistribute it and/or modify it under
8the terms of the GNU General Public License as published by the Free
9Software Foundation; either version 3, or (at your option) any later
10version.
11
12GCC is distributed in the hope that it will be useful, but WITHOUT ANY
13WARRANTY; without even the implied warranty of MERCHANTABILITY or
14FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
15for more details.
16
17You should have received a copy of the GNU General Public License
18along with GCC; see the file COPYING3. If not see
19<http://www.gnu.org/licenses/>. */
20
21#include "config.h"
22#include "system.h"
953bee7c 23#include "coretypes.h"
b7e75771
JD
24#include "gfortran.h"
25#include "constructor.h"
26
27
28static void
29node_free (splay_tree_value value)
30{
31 gfc_constructor *c = (gfc_constructor*)value;
32
33 if (c->expr)
34 gfc_free_expr (c->expr);
35
36 if (c->iterator)
37 gfc_free_iterator (c->iterator, 1);
38
39 mpz_clear (c->offset);
21ea4922 40 mpz_clear (c->repeat);
b7e75771 41
cede9502 42 free (c);
b7e75771
JD
43}
44
45
46static gfc_constructor *
47node_copy (splay_tree_node node, void *base)
48{
49 gfc_constructor *c, *src = (gfc_constructor*)node->value;
50
51 c = XCNEW (gfc_constructor);
52 c->base = (gfc_constructor_base)base;
53 c->expr = gfc_copy_expr (src->expr);
54 c->iterator = gfc_copy_iterator (src->iterator);
55 c->where = src->where;
56 c->n.component = src->n.component;
57
58 mpz_init_set (c->offset, src->offset);
21ea4922 59 mpz_init_set (c->repeat, src->repeat);
b7e75771
JD
60
61 return c;
62}
63
64
65static int
66node_copy_and_insert (splay_tree_node node, void *base)
67{
68 int n = mpz_get_si (((gfc_constructor*)node->value)->offset);
69 gfc_constructor_insert ((gfc_constructor_base*)base,
70 node_copy (node, base), n);
71 return 0;
72}
73
74
75gfc_constructor *
76gfc_constructor_get (void)
77{
78 gfc_constructor *c = XCNEW (gfc_constructor);
79 c->base = NULL;
80 c->expr = NULL;
81 c->iterator = NULL;
82
83 mpz_init_set_si (c->offset, 0);
21ea4922 84 mpz_init_set_si (c->repeat, 1);
b7e75771
JD
85
86 return c;
87}
88
89gfc_constructor_base gfc_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, 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{
21ea4922 176 gfc_constructor *c;
b7e75771
JD
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)
21ea4922 184 return (gfc_constructor *) node->value;
b7e75771 185
21ea4922
JJ
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;
b7e75771
JD
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
213int
214gfc_constructor_expr_foreach (gfc_constructor *ctor ATTRIBUTE_UNUSED,
215 int(*f)(gfc_expr *) ATTRIBUTE_UNUSED)
216{
217 gcc_assert (0);
218 return 0;
219}
220
221void
222gfc_constructor_swap (gfc_constructor *ctor ATTRIBUTE_UNUSED,
223 int n ATTRIBUTE_UNUSED, int m ATTRIBUTE_UNUSED)
224{
225 gcc_assert (0);
226}
227
228
229
230gfc_constructor *
231gfc_constructor_first (gfc_constructor_base base)
232{
233 if (base)
234 {
235 splay_tree_node node = splay_tree_min (base);
236 return node ? (gfc_constructor*) node->value : NULL;
237 }
238 else
239 return NULL;
240}
241
242
243gfc_constructor *
244gfc_constructor_next (gfc_constructor *ctor)
245{
246 if (ctor)
247 {
248 splay_tree_node node = splay_tree_successor (ctor->base,
249 mpz_get_si (ctor->offset));
250 return node ? (gfc_constructor*) node->value : NULL;
251 }
252 else
253 return NULL;
254}
21ea4922
JJ
255
256
257void
258gfc_constructor_remove (gfc_constructor *ctor)
259{
260 if (ctor)
261 splay_tree_remove (ctor->base, mpz_get_si (ctor->offset));
262}
263
264
265gfc_constructor *
266gfc_constructor_lookup_next (gfc_constructor_base base, int offset)
267{
268 splay_tree_node node;
269
270 if (!base)
271 return NULL;
272
273 node = splay_tree_successor (base, (splay_tree_key) offset);
274 if (!node)
275 return NULL;
276
277 return (gfc_constructor *) node->value;
278}