Line data Source code
1 : /* Copyright (C) 2002-2025 Free Software Foundation, Inc.
2 :
3 : This file is part of GCC.
4 :
5 : GCC is free software; you can redistribute it and/or modify it under
6 : the terms of the GNU General Public License as published by the Free
7 : Software Foundation; either version 3, or (at your option) any later
8 : version.
9 :
10 : GCC is distributed in the hope that it will be useful, but WITHOUT ANY
11 : WARRANTY; without even the implied warranty of MERCHANTABILITY or
12 : FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
13 : for more details.
14 :
15 : You should have received a copy of the GNU General Public License
16 : along with GCC; see the file COPYING3. If not see
17 : <http://www.gnu.org/licenses/>. */
18 :
19 :
20 : #include "config.h"
21 : #include "system.h"
22 : #include "coretypes.h"
23 : #include "tree.h"
24 : #include "fold-const.h"
25 : #include "gfortran.h"
26 : #include "trans.h"
27 : #include "trans-const.h"
28 : #include "trans-types.h"
29 : #include "trans-array.h"
30 :
31 :
32 : /* Array descriptor low level access routines.
33 : ******************************************************************************/
34 :
35 : /* Build expressions to access the members of an array descriptor.
36 : It's surprisingly easy to mess up here, so never access
37 : an array descriptor by "brute force", always use these
38 : functions. This also avoids problems if we change the format
39 : of an array descriptor.
40 :
41 : To understand these magic numbers, look at the comments
42 : before gfc_build_array_type() in trans-types.cc.
43 :
44 : The code within these defines should be the only code which knows the format
45 : of an array descriptor.
46 :
47 : Any code just needing to read obtain the bounds of an array should use
48 : gfc_conv_array_* rather than the following functions as these will return
49 : know constant values, and work with arrays which do not have descriptors.
50 :
51 : Don't forget to #undef these! */
52 :
53 : #define DATA_FIELD 0
54 : #define OFFSET_FIELD 1
55 : #define DTYPE_FIELD 2
56 : #define SPAN_FIELD 3
57 : #define DIMENSION_FIELD 4
58 : #define CAF_TOKEN_FIELD 5
59 :
60 : #define STRIDE_SUBFIELD 0
61 : #define LBOUND_SUBFIELD 1
62 : #define UBOUND_SUBFIELD 2
63 :
64 : static tree
65 2048953 : gfc_get_descriptor_field (tree desc, unsigned field_idx)
66 : {
67 2048953 : tree type = TREE_TYPE (desc);
68 2048953 : gcc_assert (GFC_DESCRIPTOR_TYPE_P (type));
69 :
70 2048953 : tree field = gfc_advance_chain (TYPE_FIELDS (type), field_idx);
71 2048953 : gcc_assert (field != NULL_TREE);
72 :
73 2048953 : return fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (field),
74 2048953 : desc, field, NULL_TREE);
75 : }
76 :
77 : /* This provides READ-ONLY access to the data field. The field itself
78 : doesn't have the proper type. */
79 :
80 : tree
81 290777 : gfc_conv_descriptor_data_get (tree desc)
82 : {
83 290777 : tree type = TREE_TYPE (desc);
84 290777 : if (TREE_CODE (type) == REFERENCE_TYPE)
85 0 : gcc_unreachable ();
86 :
87 290777 : tree field = gfc_get_descriptor_field (desc, DATA_FIELD);
88 290777 : return fold_convert (GFC_TYPE_ARRAY_DATAPTR_TYPE (type), field);
89 : }
90 :
91 : /* This provides WRITE access to the data field. */
92 :
93 : void
94 160567 : gfc_conv_descriptor_data_set (stmtblock_t *block, tree desc, tree value)
95 : {
96 160567 : tree field = gfc_get_descriptor_field (desc, DATA_FIELD);
97 160567 : gfc_add_modify (block, field, fold_convert (TREE_TYPE (field), value));
98 160567 : }
99 :
100 :
101 : tree
102 210719 : gfc_conv_descriptor_offset (tree desc)
103 : {
104 210719 : tree field = gfc_get_descriptor_field (desc, OFFSET_FIELD);
105 210719 : gcc_assert (TREE_TYPE (field) == gfc_array_index_type);
106 210719 : return field;
107 : }
108 :
109 : tree
110 78492 : gfc_conv_descriptor_offset_get (tree desc)
111 : {
112 78492 : return gfc_conv_descriptor_offset (desc);
113 : }
114 :
115 : void
116 125572 : gfc_conv_descriptor_offset_set (stmtblock_t *block, tree desc, tree value)
117 : {
118 125572 : tree t = gfc_conv_descriptor_offset (desc);
119 125572 : gfc_add_modify (block, t, fold_convert (TREE_TYPE (t), value));
120 125572 : }
121 :
122 :
123 : tree
124 177156 : gfc_conv_descriptor_dtype (tree desc)
125 : {
126 177156 : tree field = gfc_get_descriptor_field (desc, DTYPE_FIELD);
127 177156 : gcc_assert (TREE_TYPE (field) == get_dtype_type_node ());
128 177156 : return field;
129 : }
130 :
131 : static tree
132 155749 : gfc_conv_descriptor_span (tree desc)
133 : {
134 155749 : tree field = gfc_get_descriptor_field (desc, SPAN_FIELD);
135 155749 : gcc_assert (TREE_TYPE (field) == gfc_array_index_type);
136 155749 : return field;
137 : }
138 :
139 : tree
140 34234 : gfc_conv_descriptor_span_get (tree desc)
141 : {
142 34234 : return gfc_conv_descriptor_span (desc);
143 : }
144 :
145 : void
146 121515 : gfc_conv_descriptor_span_set (stmtblock_t *block, tree desc, tree value)
147 : {
148 121515 : tree t = gfc_conv_descriptor_span (desc);
149 121515 : gfc_add_modify (block, t, fold_convert (TREE_TYPE (t), value));
150 121515 : }
151 :
152 :
153 : tree
154 22235 : gfc_conv_descriptor_rank (tree desc)
155 : {
156 22235 : tree tmp;
157 22235 : tree dtype;
158 :
159 22235 : dtype = gfc_conv_descriptor_dtype (desc);
160 22235 : tmp = gfc_advance_chain (TYPE_FIELDS (TREE_TYPE (dtype)), GFC_DTYPE_RANK);
161 22235 : gcc_assert (tmp != NULL_TREE
162 : && TREE_TYPE (tmp) == gfc_array_dim_rank_type);
163 22235 : return fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (tmp),
164 22235 : dtype, tmp, NULL_TREE);
165 : }
166 :
167 :
168 : tree
169 127 : gfc_conv_descriptor_version (tree desc)
170 : {
171 127 : tree tmp;
172 127 : tree dtype;
173 :
174 127 : dtype = gfc_conv_descriptor_dtype (desc);
175 127 : tmp = gfc_advance_chain (TYPE_FIELDS (TREE_TYPE (dtype)), GFC_DTYPE_VERSION);
176 127 : gcc_assert (tmp != NULL_TREE
177 : && TREE_TYPE (tmp) == integer_type_node);
178 127 : return fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (tmp),
179 127 : dtype, tmp, NULL_TREE);
180 : }
181 :
182 :
183 : /* Return the element length from the descriptor dtype field. */
184 :
185 : tree
186 9331 : gfc_conv_descriptor_elem_len (tree desc)
187 : {
188 9331 : tree tmp;
189 9331 : tree dtype;
190 :
191 9331 : dtype = gfc_conv_descriptor_dtype (desc);
192 9331 : tmp = gfc_advance_chain (TYPE_FIELDS (TREE_TYPE (dtype)),
193 : GFC_DTYPE_ELEM_LEN);
194 9331 : gcc_assert (tmp != NULL_TREE
195 : && TREE_TYPE (tmp) == size_type_node);
196 9331 : return fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (tmp),
197 9331 : dtype, tmp, NULL_TREE);
198 : }
199 :
200 :
201 : tree
202 0 : gfc_conv_descriptor_attribute (tree desc)
203 : {
204 0 : tree tmp;
205 0 : tree dtype;
206 :
207 0 : dtype = gfc_conv_descriptor_dtype (desc);
208 0 : tmp = gfc_advance_chain (TYPE_FIELDS (TREE_TYPE (dtype)),
209 : GFC_DTYPE_ATTRIBUTE);
210 0 : gcc_assert (tmp!= NULL_TREE
211 : && TREE_TYPE (tmp) == short_integer_type_node);
212 0 : return fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (tmp),
213 0 : dtype, tmp, NULL_TREE);
214 : }
215 :
216 : tree
217 73 : gfc_conv_descriptor_type (tree desc)
218 : {
219 73 : tree tmp;
220 73 : tree dtype;
221 :
222 73 : dtype = gfc_conv_descriptor_dtype (desc);
223 73 : tmp = gfc_advance_chain (TYPE_FIELDS (TREE_TYPE (dtype)), GFC_DTYPE_TYPE);
224 73 : gcc_assert (tmp!= NULL_TREE
225 : && TREE_TYPE (tmp) == signed_char_type_node);
226 73 : return fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (tmp),
227 73 : dtype, tmp, NULL_TREE);
228 : }
229 :
230 : tree
231 1051721 : gfc_get_descriptor_dimension (tree desc)
232 : {
233 1051721 : tree field = gfc_get_descriptor_field (desc, DIMENSION_FIELD);
234 1051721 : gcc_assert (TREE_CODE (TREE_TYPE (field)) == ARRAY_TYPE
235 : && TREE_CODE (TREE_TYPE (TREE_TYPE (field))) == RECORD_TYPE);
236 1051721 : return field;
237 : }
238 :
239 :
240 : tree
241 1047479 : gfc_conv_descriptor_dimension (tree desc, tree dim)
242 : {
243 1047479 : tree tmp;
244 :
245 1047479 : tmp = gfc_get_descriptor_dimension (desc);
246 :
247 1047479 : return gfc_build_array_ref (tmp, dim, NULL_TREE, true);
248 : }
249 :
250 :
251 : tree
252 2264 : gfc_conv_descriptor_token (tree desc)
253 : {
254 2264 : gcc_assert (flag_coarray == GFC_FCOARRAY_LIB);
255 2264 : tree field = gfc_get_descriptor_field (desc, CAF_TOKEN_FIELD);
256 : /* Should be a restricted pointer - except in the finalization wrapper. */
257 2264 : gcc_assert (TREE_TYPE (field) == prvoid_type_node
258 : || TREE_TYPE (field) == pvoid_type_node);
259 2264 : return field;
260 : }
261 :
262 : static tree
263 1047479 : gfc_conv_descriptor_subfield (tree desc, tree dim, unsigned field_idx)
264 : {
265 1047479 : tree tmp = gfc_conv_descriptor_dimension (desc, dim);
266 1047479 : tree field = gfc_advance_chain (TYPE_FIELDS (TREE_TYPE (tmp)), field_idx);
267 1047479 : gcc_assert (field != NULL_TREE);
268 :
269 1047479 : return fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (field),
270 1047479 : tmp, field, NULL_TREE);
271 : }
272 :
273 : static tree
274 279539 : gfc_conv_descriptor_stride (tree desc, tree dim)
275 : {
276 279539 : tree field = gfc_conv_descriptor_subfield (desc, dim, STRIDE_SUBFIELD);
277 279539 : gcc_assert (TREE_TYPE (field) == gfc_array_index_type);
278 279539 : return field;
279 : }
280 :
281 : tree
282 172573 : gfc_conv_descriptor_stride_get (tree desc, tree dim)
283 : {
284 172573 : tree type = TREE_TYPE (desc);
285 172573 : gcc_assert (GFC_DESCRIPTOR_TYPE_P (type));
286 172573 : if (integer_zerop (dim)
287 172573 : && (GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_ALLOCATABLE
288 44719 : || GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_ASSUMED_SHAPE_CONT
289 43632 : || GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_ASSUMED_RANK_CONT
290 43476 : || GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_ASSUMED_RANK_ALLOCATABLE
291 43326 : || GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_ASSUMED_RANK_POINTER_CONT
292 43326 : || GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_POINTER_CONT))
293 72972 : return gfc_index_one_node;
294 :
295 99601 : return gfc_conv_descriptor_stride (desc, dim);
296 : }
297 :
298 : void
299 179938 : gfc_conv_descriptor_stride_set (stmtblock_t *block, tree desc,
300 : tree dim, tree value)
301 : {
302 179938 : tree t = gfc_conv_descriptor_stride (desc, dim);
303 179938 : gfc_add_modify (block, t, fold_convert (TREE_TYPE (t), value));
304 179938 : }
305 :
306 : static tree
307 398577 : gfc_conv_descriptor_lbound (tree desc, tree dim)
308 : {
309 398577 : tree field = gfc_conv_descriptor_subfield (desc, dim, LBOUND_SUBFIELD);
310 398577 : gcc_assert (TREE_TYPE (field) == gfc_array_index_type);
311 398577 : return field;
312 : }
313 :
314 : tree
315 213848 : gfc_conv_descriptor_lbound_get (tree desc, tree dim)
316 : {
317 213848 : return gfc_conv_descriptor_lbound (desc, dim);
318 : }
319 :
320 : void
321 184729 : gfc_conv_descriptor_lbound_set (stmtblock_t *block, tree desc,
322 : tree dim, tree value)
323 : {
324 184729 : tree t = gfc_conv_descriptor_lbound (desc, dim);
325 184729 : gfc_add_modify (block, t, fold_convert (TREE_TYPE (t), value));
326 184729 : }
327 :
328 : static tree
329 369363 : gfc_conv_descriptor_ubound (tree desc, tree dim)
330 : {
331 369363 : tree field = gfc_conv_descriptor_subfield (desc, dim, UBOUND_SUBFIELD);
332 369363 : gcc_assert (TREE_TYPE (field) == gfc_array_index_type);
333 369363 : return field;
334 : }
335 :
336 : tree
337 184872 : gfc_conv_descriptor_ubound_get (tree desc, tree dim)
338 : {
339 184872 : return gfc_conv_descriptor_ubound (desc, dim);
340 : }
341 :
342 : void
343 184491 : gfc_conv_descriptor_ubound_set (stmtblock_t *block, tree desc,
344 : tree dim, tree value)
345 : {
346 184491 : tree t = gfc_conv_descriptor_ubound (desc, dim);
347 184491 : gfc_add_modify (block, t, fold_convert (TREE_TYPE (t), value));
348 184491 : }
349 :
350 :
351 : /* Obtain offsets for trans-types.cc(gfc_get_array_descr_info). */
352 :
353 : void
354 277244 : gfc_get_descriptor_offsets_for_info (const_tree desc_type, tree *data_off,
355 : tree *dtype_off, tree *span_off,
356 : tree *dim_off, tree *dim_size,
357 : tree *stride_suboff, tree *lower_suboff,
358 : tree *upper_suboff)
359 : {
360 277244 : tree field;
361 277244 : tree type;
362 :
363 277244 : type = TYPE_MAIN_VARIANT (desc_type);
364 277244 : field = gfc_advance_chain (TYPE_FIELDS (type), DATA_FIELD);
365 277244 : *data_off = byte_position (field);
366 277244 : field = gfc_advance_chain (TYPE_FIELDS (type), DTYPE_FIELD);
367 277244 : *dtype_off = byte_position (field);
368 277244 : field = gfc_advance_chain (TYPE_FIELDS (type), SPAN_FIELD);
369 277244 : *span_off = byte_position (field);
370 277244 : field = gfc_advance_chain (TYPE_FIELDS (type), DIMENSION_FIELD);
371 277244 : *dim_off = byte_position (field);
372 277244 : type = TREE_TYPE (TREE_TYPE (field));
373 277244 : *dim_size = TYPE_SIZE_UNIT (type);
374 277244 : field = gfc_advance_chain (TYPE_FIELDS (type), STRIDE_SUBFIELD);
375 277244 : *stride_suboff = byte_position (field);
376 277244 : field = gfc_advance_chain (TYPE_FIELDS (type), LBOUND_SUBFIELD);
377 277244 : *lower_suboff = byte_position (field);
378 277244 : field = gfc_advance_chain (TYPE_FIELDS (type), UBOUND_SUBFIELD);
379 277244 : *upper_suboff = byte_position (field);
380 277244 : }
381 :
382 :
383 : /* Array descriptor higher level routines.
384 : ******************************************************************************/
385 :
386 : /* Build a null array descriptor constructor. */
387 :
388 : tree
389 1085 : gfc_build_null_descriptor (tree type)
390 : {
391 1085 : tree field;
392 1085 : tree tmp;
393 :
394 1085 : gcc_assert (GFC_DESCRIPTOR_TYPE_P (type));
395 1085 : gcc_assert (DATA_FIELD == 0);
396 1085 : field = TYPE_FIELDS (type);
397 :
398 : /* Set a NULL data pointer. */
399 1085 : tmp = build_constructor_single (type, field, null_pointer_node);
400 1085 : TREE_CONSTANT (tmp) = 1;
401 : /* All other fields are ignored. */
402 :
403 1085 : return tmp;
404 : }
405 :
406 :
407 : /* Cleanup those #defines. */
408 :
409 : #undef DATA_FIELD
410 : #undef OFFSET_FIELD
411 : #undef DTYPE_FIELD
412 : #undef SPAN_FIELD
413 : #undef DIMENSION_FIELD
414 : #undef CAF_TOKEN_FIELD
415 : #undef STRIDE_SUBFIELD
416 : #undef LBOUND_SUBFIELD
417 : #undef UBOUND_SUBFIELD
418 :
419 :
420 : /* For an array descriptor, get the total number of elements. This is just
421 : the product of the extents along from_dim to to_dim. */
422 :
423 : static tree
424 1948 : gfc_conv_descriptor_size_1 (tree desc, int from_dim, int to_dim)
425 : {
426 1948 : tree res;
427 1948 : int dim;
428 :
429 1948 : res = gfc_index_one_node;
430 :
431 4765 : for (dim = from_dim; dim < to_dim; ++dim)
432 : {
433 2817 : tree lbound;
434 2817 : tree ubound;
435 2817 : tree extent;
436 :
437 2817 : lbound = gfc_conv_descriptor_lbound_get (desc, gfc_rank_cst[dim]);
438 2817 : ubound = gfc_conv_descriptor_ubound_get (desc, gfc_rank_cst[dim]);
439 :
440 2817 : extent = gfc_conv_array_extent_dim (lbound, ubound, NULL);
441 2817 : res = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
442 : res, extent);
443 : }
444 :
445 1948 : return res;
446 : }
447 :
448 :
449 : /* Full size of an array. */
450 :
451 : tree
452 1884 : gfc_conv_descriptor_size (tree desc, int rank)
453 : {
454 1884 : return gfc_conv_descriptor_size_1 (desc, 0, rank);
455 : }
456 :
457 :
458 : /* Size of a coarray for all dimensions but the last. */
459 :
460 : tree
461 64 : gfc_conv_descriptor_cosize (tree desc, int rank, int corank)
462 : {
463 64 : return gfc_conv_descriptor_size_1 (desc, rank, rank + corank - 1);
464 : }
465 :
466 :
467 : /* Modify a descriptor such that the lbound of a given dimension is the value
468 : specified. This also updates ubound and offset accordingly. */
469 :
470 : void
471 955 : gfc_conv_shift_descriptor_lbound (stmtblock_t* block, tree desc,
472 : int dim, tree new_lbound)
473 : {
474 955 : tree offs, ubound, lbound, stride;
475 955 : tree diff, offs_diff;
476 :
477 955 : new_lbound = fold_convert (gfc_array_index_type, new_lbound);
478 :
479 955 : offs = gfc_conv_descriptor_offset_get (desc);
480 955 : lbound = gfc_conv_descriptor_lbound_get (desc, gfc_rank_cst[dim]);
481 955 : ubound = gfc_conv_descriptor_ubound_get (desc, gfc_rank_cst[dim]);
482 955 : stride = gfc_conv_descriptor_stride_get (desc, gfc_rank_cst[dim]);
483 :
484 : /* Get difference (new - old) by which to shift stuff. */
485 955 : diff = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
486 : new_lbound, lbound);
487 :
488 : /* Shift ubound and offset accordingly. This has to be done before
489 : updating the lbound, as they depend on the lbound expression! */
490 955 : ubound = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
491 : ubound, diff);
492 955 : gfc_conv_descriptor_ubound_set (block, desc, gfc_rank_cst[dim], ubound);
493 955 : offs_diff = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
494 : diff, stride);
495 955 : offs = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
496 : offs, offs_diff);
497 955 : gfc_conv_descriptor_offset_set (block, desc, offs);
498 :
499 : /* Finally set lbound to value we want. */
500 955 : gfc_conv_descriptor_lbound_set (block, desc, gfc_rank_cst[dim], new_lbound);
501 955 : }
502 :
503 :
504 : void
505 1750 : gfc_copy_descriptor (stmtblock_t *block, tree dst, tree src, int rank)
506 : {
507 1750 : int n;
508 1750 : tree dim;
509 1750 : tree tmp;
510 1750 : tree tmp2;
511 1750 : tree size;
512 1750 : tree offset;
513 :
514 1750 : offset = gfc_index_zero_node;
515 :
516 : /* Use memcpy to copy the descriptor. The size is the minimum of
517 : the sizes of 'src' and 'dst'. This avoids a non-trivial conversion. */
518 1750 : tmp = TYPE_SIZE_UNIT (TREE_TYPE (src));
519 1750 : tmp2 = TYPE_SIZE_UNIT (TREE_TYPE (dst));
520 1750 : size = fold_build2_loc (input_location, MIN_EXPR,
521 1750 : TREE_TYPE (tmp), tmp, tmp2);
522 1750 : tmp = builtin_decl_explicit (BUILT_IN_MEMCPY);
523 1750 : tmp = build_call_expr_loc (input_location, tmp, 3,
524 : gfc_build_addr_expr (NULL_TREE, dst),
525 : gfc_build_addr_expr (NULL_TREE, src),
526 : fold_convert (size_type_node, size));
527 1750 : gfc_add_expr_to_block (block, tmp);
528 :
529 : /* Set the offset correctly. */
530 8694 : for (n = 0; n < rank; n++)
531 : {
532 5194 : dim = gfc_rank_cst[n];
533 5194 : tmp = gfc_conv_descriptor_lbound_get (src, dim);
534 5194 : tmp2 = gfc_conv_descriptor_stride_get (src, dim);
535 5194 : tmp = fold_build2_loc (input_location, MULT_EXPR, TREE_TYPE (tmp),
536 : tmp, tmp2);
537 5194 : offset = fold_build2_loc (input_location, MINUS_EXPR,
538 5194 : TREE_TYPE (offset), offset, tmp);
539 5194 : offset = gfc_evaluate_now (offset, block);
540 : }
541 :
542 1750 : gfc_conv_descriptor_offset_set (block, dst, offset);
543 1750 : }
544 :
545 :
546 : /* Extend the data in array DESC by EXTRA elements. */
547 :
548 : void
549 1066 : gfc_grow_array (stmtblock_t * pblock, tree desc, tree extra)
550 : {
551 1066 : tree arg0, arg1;
552 1066 : tree tmp;
553 1066 : tree size;
554 1066 : tree ubound;
555 :
556 1066 : if (integer_zerop (extra))
557 : return;
558 :
559 1036 : ubound = gfc_conv_descriptor_ubound_get (desc, gfc_rank_cst[0]);
560 :
561 : /* Add EXTRA to the upper bound. */
562 1036 : tmp = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
563 : ubound, extra);
564 1036 : gfc_conv_descriptor_ubound_set (pblock, desc, gfc_rank_cst[0], tmp);
565 :
566 : /* Get the value of the current data pointer. */
567 1036 : arg0 = gfc_conv_descriptor_data_get (desc);
568 :
569 : /* Calculate the new array size. */
570 1036 : size = TYPE_SIZE_UNIT (gfc_get_element_type (TREE_TYPE (desc)));
571 1036 : tmp = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
572 : ubound, gfc_index_one_node);
573 1036 : arg1 = fold_build2_loc (input_location, MULT_EXPR, size_type_node,
574 : fold_convert (size_type_node, tmp),
575 : fold_convert (size_type_node, size));
576 :
577 : /* Call the realloc() function. */
578 1036 : tmp = gfc_call_realloc (pblock, arg0, arg1);
579 1036 : gfc_conv_descriptor_data_set (pblock, desc, tmp);
580 : }
|
