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 :
65 : /* Get FIELD_IDX'th field in struct TYPE. */
66 :
67 : static tree
68 2075568 : get_type_field (tree type, unsigned field_idx)
69 : {
70 2075568 : tree field = gfc_advance_chain (TYPE_FIELDS (type), field_idx);
71 2075568 : gcc_assert (field != NULL_TREE);
72 :
73 2075568 : return field;
74 : }
75 :
76 :
77 : /* Return a reference to the FIELD_IDX-th field of the descriptor DESC. */
78 :
79 : static tree
80 2075340 : gfc_get_descriptor_field (tree desc, unsigned field_idx)
81 : {
82 2075340 : tree type = TREE_TYPE (desc);
83 2075340 : gcc_assert (GFC_DESCRIPTOR_TYPE_P (type));
84 :
85 2075340 : tree field = get_type_field (type, field_idx);
86 :
87 2075340 : return fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (field),
88 2075340 : desc, field, NULL_TREE);
89 : }
90 :
91 :
92 : /* Return a reference to the data field of the array descriptor DESC. */
93 :
94 : static tree
95 457544 : conv_descriptor_data (tree desc)
96 : {
97 0 : return gfc_get_descriptor_field (desc, DATA_FIELD);
98 : }
99 :
100 : /* This provides READ-ONLY access to the data field. The field itself
101 : doesn't have the proper type. */
102 :
103 : tree
104 294161 : gfc_conv_descriptor_data_get (tree desc)
105 : {
106 294161 : tree type = TREE_TYPE (desc);
107 294161 : if (TREE_CODE (type) == REFERENCE_TYPE)
108 0 : gcc_unreachable ();
109 :
110 294161 : tree data = conv_descriptor_data (desc);
111 294161 : return fold_convert (GFC_TYPE_ARRAY_DATAPTR_TYPE (type), data);
112 : }
113 :
114 : /* This provides WRITE access to the data field. */
115 :
116 : void
117 163383 : gfc_conv_descriptor_data_set (stmtblock_t *block, tree desc, tree value)
118 : {
119 163383 : tree data = conv_descriptor_data (desc);
120 163383 : gfc_add_modify (block, data, fold_convert (TREE_TYPE (data), value));
121 163383 : }
122 :
123 :
124 : /* Return a reference to the offset field of the array descriptor DESC. */
125 :
126 : static tree
127 212070 : conv_descriptor_offset (tree desc)
128 : {
129 212070 : tree field = gfc_get_descriptor_field (desc, OFFSET_FIELD);
130 212070 : gcc_assert (TREE_TYPE (field) == gfc_array_index_type);
131 212070 : return field;
132 : }
133 :
134 : /* Return the offset value of the array descriptor DESC. */
135 :
136 : tree
137 79089 : gfc_conv_descriptor_offset_get (tree desc)
138 : {
139 79089 : return conv_descriptor_offset (desc);
140 : }
141 :
142 : /* Add code to BLOCK assigning VALUE to the offset field of the array descriptor
143 : DESC. */
144 :
145 : void
146 132981 : gfc_conv_descriptor_offset_set (stmtblock_t *block, tree desc, tree value)
147 : {
148 132981 : tree t = conv_descriptor_offset (desc);
149 132981 : gfc_add_modify (block, t, fold_convert (TREE_TYPE (t), value));
150 132981 : }
151 :
152 :
153 : /* Return a reference to the dtype field of the array descriptor DESC. */
154 :
155 : static tree
156 180881 : conv_descriptor_dtype (tree desc)
157 : {
158 180881 : tree field = gfc_get_descriptor_field (desc, DTYPE_FIELD);
159 180881 : gcc_assert (TREE_TYPE (field) == get_dtype_type_node ());
160 180881 : return field;
161 : }
162 :
163 : /* Return the dtype value of the array descriptor DESC. */
164 :
165 : tree
166 3392 : gfc_conv_descriptor_dtype_get (tree desc)
167 : {
168 3392 : return conv_descriptor_dtype (desc);
169 : }
170 :
171 : /* Add code to BLOCK assigning VALUE to the dtype field of the array descriptor
172 : DESC. */
173 :
174 : void
175 143731 : gfc_conv_descriptor_dtype_set (stmtblock_t *block, tree desc, tree value)
176 : {
177 143731 : location_t loc = input_location;
178 143731 : tree t = conv_descriptor_dtype (desc);
179 143731 : gfc_add_modify_loc (loc, block, t,
180 143731 : fold_convert_loc (loc, TREE_TYPE (t), value));
181 143731 : }
182 :
183 :
184 : /* Return a reference to the span field of the array descriptor DESC. */
185 :
186 : static tree
187 164449 : conv_descriptor_span (tree desc)
188 : {
189 164449 : tree field = gfc_get_descriptor_field (desc, SPAN_FIELD);
190 164449 : gcc_assert (TREE_TYPE (field) == gfc_array_index_type);
191 164449 : return field;
192 : }
193 :
194 : /* Return the span value of the array descriptor DESC. */
195 :
196 : tree
197 39353 : gfc_conv_descriptor_span_get (tree desc)
198 : {
199 39353 : return conv_descriptor_span (desc);
200 : }
201 :
202 : /* Add code to BLOCK assigning VALUE to the span field of the array descriptor
203 : DESC. */
204 :
205 : void
206 125096 : gfc_conv_descriptor_span_set (stmtblock_t *block, tree desc, tree value)
207 : {
208 125096 : tree t = conv_descriptor_span (desc);
209 125096 : gfc_add_modify (block, t, fold_convert (TREE_TYPE (t), value));
210 125096 : }
211 :
212 :
213 : /* Return a reference to the rank field of the array descriptor DESC. */
214 :
215 : static tree
216 22893 : conv_descriptor_rank (tree desc)
217 : {
218 22893 : tree tmp;
219 22893 : tree dtype;
220 :
221 22893 : dtype = conv_descriptor_dtype (desc);
222 22893 : tmp = gfc_advance_chain (TYPE_FIELDS (TREE_TYPE (dtype)), GFC_DTYPE_RANK);
223 22893 : gcc_assert (tmp != NULL_TREE
224 : && TREE_TYPE (tmp) == gfc_array_dim_rank_type);
225 22893 : return fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (tmp),
226 22893 : dtype, tmp, NULL_TREE);
227 : }
228 :
229 : /* Return the rank value of the array descriptor DESC. */
230 :
231 : tree
232 21813 : gfc_conv_descriptor_rank_get (tree desc)
233 : {
234 21813 : return conv_descriptor_rank (desc);
235 : }
236 :
237 : /* Add code to BLOCK assigning VALUE to the rank field of the array descriptor
238 : DESC. */
239 :
240 : void
241 1080 : gfc_conv_descriptor_rank_set (stmtblock_t *block, tree desc, tree value)
242 : {
243 1080 : location_t loc = input_location;
244 1080 : tree t = conv_descriptor_rank (desc);
245 1080 : gfc_add_modify_loc (loc, block, t,
246 1080 : fold_convert_loc (loc, TREE_TYPE (t), value));
247 1080 : }
248 :
249 : /* Add code to BLOCK assigning VALUE to the rank field of the array descriptor
250 : DESC. */
251 :
252 : void
253 493 : gfc_conv_descriptor_rank_set (stmtblock_t *block, tree desc, int value)
254 : {
255 493 : gfc_conv_descriptor_rank_set (block, desc, gfc_rank_cst[value]);
256 493 : }
257 :
258 :
259 : /* Return a reference to the format version field of the array descriptor
260 : DESC. */
261 :
262 : static tree
263 127 : conv_descriptor_version (tree desc)
264 : {
265 127 : tree tmp;
266 127 : tree dtype;
267 :
268 127 : dtype = conv_descriptor_dtype (desc);
269 127 : tmp = gfc_advance_chain (TYPE_FIELDS (TREE_TYPE (dtype)), GFC_DTYPE_VERSION);
270 127 : gcc_assert (tmp != NULL_TREE
271 : && TREE_TYPE (tmp) == integer_type_node);
272 127 : return fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (tmp),
273 127 : dtype, tmp, NULL_TREE);
274 : }
275 :
276 : /* Return the format version value of the array descriptor DESC. */
277 :
278 : tree
279 48 : gfc_conv_descriptor_version_get (tree desc)
280 : {
281 48 : return conv_descriptor_version (desc);
282 : }
283 :
284 : /* Add code to BLOCK assigning VALUE to the format version field of the array
285 : descriptor DESC. */
286 :
287 : void
288 79 : gfc_conv_descriptor_version_set (stmtblock_t *block, tree desc, tree value)
289 : {
290 79 : location_t loc = input_location;
291 79 : tree t = conv_descriptor_version (desc);
292 79 : gfc_add_modify_loc (loc, block, t,
293 79 : fold_convert_loc (loc, TREE_TYPE (t), value));
294 79 : }
295 :
296 :
297 : /* Return a reference to the element length field of the array descriptor
298 : DESC. */
299 :
300 : static tree
301 10551 : conv_descriptor_elem_len (tree desc)
302 : {
303 10551 : tree tmp;
304 10551 : tree dtype;
305 :
306 10551 : dtype = conv_descriptor_dtype (desc);
307 10551 : tmp = gfc_advance_chain (TYPE_FIELDS (TREE_TYPE (dtype)),
308 : GFC_DTYPE_ELEM_LEN);
309 10551 : gcc_assert (tmp != NULL_TREE
310 : && TREE_TYPE (tmp) == size_type_node);
311 10551 : return fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (tmp),
312 10551 : dtype, tmp, NULL_TREE);
313 : }
314 :
315 : /* Return the element length value of the array descriptor DESC. */
316 :
317 : tree
318 10117 : gfc_conv_descriptor_elem_len_get (tree desc)
319 : {
320 10117 : return conv_descriptor_elem_len (desc);
321 : }
322 :
323 : /* Add code to BLOCK assigning VALUE to the element length field of the array
324 : descriptor DESC. */
325 :
326 : void
327 434 : gfc_conv_descriptor_elem_len_set (stmtblock_t *block, tree desc, tree value)
328 : {
329 434 : location_t loc = input_location;
330 434 : tree t = conv_descriptor_elem_len (desc);
331 434 : gfc_add_modify_loc (loc, block, t,
332 434 : fold_convert_loc (loc, TREE_TYPE (t), value));
333 434 : }
334 :
335 :
336 : /* Return a reference to the type discriminator field of the array descriptor
337 : DESC. */
338 :
339 : static tree
340 187 : conv_descriptor_type (tree desc)
341 : {
342 187 : tree tmp;
343 187 : tree dtype;
344 :
345 187 : dtype = conv_descriptor_dtype (desc);
346 187 : tmp = gfc_advance_chain (TYPE_FIELDS (TREE_TYPE (dtype)), GFC_DTYPE_TYPE);
347 187 : gcc_assert (tmp!= NULL_TREE
348 : && TREE_TYPE (tmp) == signed_char_type_node);
349 187 : return fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (tmp),
350 187 : dtype, tmp, NULL_TREE);
351 : }
352 :
353 : /* Return the type discriminator value of the array descriptor DESC. */
354 :
355 : tree
356 54 : gfc_conv_descriptor_type_get (tree desc)
357 : {
358 54 : return conv_descriptor_type (desc);
359 : }
360 :
361 : /* Add code to BLOCK assigning VALUE to the type discriminator field of the
362 : array descriptor DESC. */
363 :
364 : void
365 133 : gfc_conv_descriptor_type_set (stmtblock_t *block, tree desc, tree value)
366 : {
367 133 : location_t loc = input_location;
368 133 : tree t = conv_descriptor_type (desc);
369 133 : gfc_add_modify_loc (loc, block, t,
370 133 : fold_convert_loc (loc, TREE_TYPE (t), value));
371 133 : }
372 :
373 : /* Add code to BLOCK assigning VALUE to the type discriminator field of the
374 : array descriptor DESC. */
375 :
376 : void
377 114 : gfc_conv_descriptor_type_set (stmtblock_t *block, tree desc, int value)
378 : {
379 114 : tree type = TREE_TYPE (desc);
380 114 : gcc_assert (GFC_DESCRIPTOR_TYPE_P (type));
381 :
382 114 : tree dtype = get_type_field (type, DTYPE_FIELD);
383 114 : tree field = get_type_field (TREE_TYPE (dtype), GFC_DTYPE_TYPE);
384 114 : tree type_value = build_int_cst (TREE_TYPE (field), value);
385 :
386 114 : gfc_conv_descriptor_type_set (block, desc, type_value);
387 114 : }
388 :
389 : /* Return a statement assigning VALUE to the type discriminator field of the
390 : array descriptor DESC. */
391 :
392 : tree
393 19 : gfc_conv_descriptor_type_set (tree desc, tree value)
394 : {
395 19 : stmtblock_t block;
396 :
397 19 : gfc_init_block (&block);
398 19 : gfc_conv_descriptor_type_set (&block, desc, value);
399 19 : return gfc_finish_block (&block);
400 : }
401 :
402 : /* Return a statement assigning VALUE to the type discriminator field of the
403 : array descriptor DESC. */
404 :
405 : tree
406 114 : gfc_conv_descriptor_type_set (tree desc, int value)
407 : {
408 114 : stmtblock_t block;
409 :
410 114 : gfc_init_block (&block);
411 114 : gfc_conv_descriptor_type_set (&block, desc, value);
412 114 : return gfc_finish_block (&block);
413 : }
414 :
415 :
416 : /* Return a reference to the array of dimension descriptors of the array
417 : descriptor DESC. */
418 :
419 : tree
420 1057984 : gfc_get_descriptor_dimension (tree desc)
421 : {
422 1057984 : tree field = gfc_get_descriptor_field (desc, DIMENSION_FIELD);
423 1057984 : gcc_assert (TREE_CODE (TREE_TYPE (field)) == ARRAY_TYPE
424 : && TREE_CODE (TREE_TYPE (TREE_TYPE (field))) == RECORD_TYPE);
425 1057984 : return field;
426 : }
427 :
428 :
429 : /* Return a reference to the dimension descriptor for the (zero-based) dimension
430 : DIM of the array descriptor DESC. */
431 :
432 : static tree
433 1053730 : conv_descriptor_dimension (tree desc, tree dim)
434 : {
435 1053730 : tree tmp;
436 :
437 1053730 : tmp = gfc_get_descriptor_dimension (desc);
438 :
439 1053730 : return gfc_build_array_ref (tmp, dim, NULL_TREE, true);
440 : }
441 :
442 :
443 : /* Return a reference to the coarray token field of the array descriptor
444 : DESC. */
445 :
446 : tree
447 2412 : gfc_conv_descriptor_token (tree desc)
448 : {
449 2412 : gcc_assert (flag_coarray == GFC_FCOARRAY_LIB);
450 2412 : tree field = gfc_get_descriptor_field (desc, CAF_TOKEN_FIELD);
451 : /* Should be a restricted pointer - except in the finalization wrapper. */
452 2412 : gcc_assert (TREE_TYPE (field) == prvoid_type_node
453 : || TREE_TYPE (field) == pvoid_type_node);
454 2412 : return field;
455 : }
456 :
457 : /* Add code to BLOCK assigning VALUE to the coarray token field of the array
458 : descriptor DESC. */
459 :
460 : void
461 585 : gfc_conv_descriptor_token_set (stmtblock_t *block, tree desc, tree value)
462 : {
463 585 : location_t loc = input_location;
464 585 : tree t = gfc_conv_descriptor_token (desc);
465 585 : gfc_add_modify_loc (loc, block, t,
466 585 : fold_convert_loc (loc, TREE_TYPE (t), value));
467 585 : }
468 :
469 :
470 : /* Return a reference to the FIELD_IDX'th subfield of the dimension descriptor
471 : of the (zero-based) dimension DIM of the array descriptor DESC. */
472 :
473 : static tree
474 1053730 : gfc_conv_descriptor_subfield (tree desc, tree dim, unsigned field_idx)
475 : {
476 1053730 : tree tmp = conv_descriptor_dimension (desc, dim);
477 1053730 : tree field = gfc_advance_chain (TYPE_FIELDS (TREE_TYPE (tmp)), field_idx);
478 1053730 : gcc_assert (field != NULL_TREE);
479 :
480 1053730 : return fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (field),
481 1053730 : tmp, field, NULL_TREE);
482 : }
483 :
484 :
485 : /* Return a reference to the stride field of the (zero-based) dimension DIM of
486 : the array descriptor DESC. */
487 :
488 : static tree
489 281483 : conv_descriptor_stride (tree desc, tree dim)
490 : {
491 281483 : tree field = gfc_conv_descriptor_subfield (desc, dim, STRIDE_SUBFIELD);
492 281483 : gcc_assert (TREE_TYPE (field) == gfc_array_index_type);
493 281483 : return field;
494 : }
495 :
496 : /* Return the stride value for the (zero-based) dimension DIM of the array
497 : descriptor DESC. */
498 :
499 : tree
500 174295 : gfc_conv_descriptor_stride_get (tree desc, tree dim)
501 : {
502 174295 : tree type = TREE_TYPE (desc);
503 174295 : gcc_assert (GFC_DESCRIPTOR_TYPE_P (type));
504 174295 : if (integer_zerop (dim)
505 174295 : && (GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_ALLOCATABLE
506 45303 : || GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_ASSUMED_SHAPE_CONT
507 44216 : || GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_ASSUMED_RANK_CONT
508 44060 : || GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_ASSUMED_RANK_ALLOCATABLE
509 43910 : || GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_ASSUMED_RANK_POINTER_CONT
510 43910 : || GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_POINTER_CONT))
511 73609 : return gfc_index_one_node;
512 :
513 100686 : return conv_descriptor_stride (desc, dim);
514 : }
515 :
516 : /* Add code to BLOCK assigning VALUE to the stride field of the (zero-based)
517 : dimension DIM of the array descriptor DESC. */
518 :
519 : void
520 180797 : gfc_conv_descriptor_stride_set (stmtblock_t *block, tree desc,
521 : tree dim, tree value)
522 : {
523 180797 : tree t = conv_descriptor_stride (desc, dim);
524 180797 : gfc_add_modify (block, t, fold_convert (TREE_TYPE (t), value));
525 180797 : }
526 :
527 :
528 : /* Return a reference to the lower bound field of the (zero-based) dimension DIM
529 : of the array descriptor DESC. */
530 :
531 : static tree
532 400766 : conv_descriptor_lbound (tree desc, tree dim)
533 : {
534 400766 : tree field = gfc_conv_descriptor_subfield (desc, dim, LBOUND_SUBFIELD);
535 400766 : gcc_assert (TREE_TYPE (field) == gfc_array_index_type);
536 400766 : return field;
537 : }
538 :
539 : /* Return the lower bound value for the (zero-based) dimension DIM of the array
540 : descriptor DESC. */
541 :
542 : tree
543 215096 : gfc_conv_descriptor_lbound_get (tree desc, tree dim)
544 : {
545 215096 : return conv_descriptor_lbound (desc, dim);
546 : }
547 :
548 : /* Add code to BLOCK assigning VALUE to the lower bound field of the
549 : (zero-based) dimension DIM of the array descriptor DESC. */
550 :
551 : void
552 185670 : gfc_conv_descriptor_lbound_set (stmtblock_t *block, tree desc,
553 : tree dim, tree value)
554 : {
555 185670 : tree t = conv_descriptor_lbound (desc, dim);
556 185670 : gfc_add_modify (block, t, fold_convert (TREE_TYPE (t), value));
557 185670 : }
558 :
559 :
560 : /* Return a reference to the upper bound field of the (zero-based) dimension DIM
561 : of the array descriptor DESC. */
562 :
563 : static tree
564 371481 : conv_descriptor_ubound (tree desc, tree dim)
565 : {
566 371481 : tree field = gfc_conv_descriptor_subfield (desc, dim, UBOUND_SUBFIELD);
567 371481 : gcc_assert (TREE_TYPE (field) == gfc_array_index_type);
568 371481 : return field;
569 : }
570 :
571 : /* Return the upper bound value for the (zero-based) dimension DIM of the array
572 : descriptor DESC. */
573 :
574 : tree
575 186077 : gfc_conv_descriptor_ubound_get (tree desc, tree dim)
576 : {
577 186077 : return conv_descriptor_ubound (desc, dim);
578 : }
579 :
580 : /* Add code to BLOCK assigning VALUE to the upper bound field of the
581 : (zero-based) dimension DIM of the array descriptor DESC. */
582 :
583 : void
584 185404 : gfc_conv_descriptor_ubound_set (stmtblock_t *block, tree desc,
585 : tree dim, tree value)
586 : {
587 185404 : tree t = conv_descriptor_ubound (desc, dim);
588 185404 : gfc_add_modify (block, t, fold_convert (TREE_TYPE (t), value));
589 185404 : }
590 :
591 :
592 : /* Obtain offsets for trans-types.cc(gfc_get_array_descr_info). */
593 :
594 : void
595 279577 : gfc_get_descriptor_offsets_for_info (const_tree desc_type, tree *data_off,
596 : tree *dtype_off, tree *span_off,
597 : tree *dim_off, tree *dim_size,
598 : tree *stride_suboff, tree *lower_suboff,
599 : tree *upper_suboff)
600 : {
601 279577 : tree field;
602 279577 : tree type;
603 :
604 279577 : type = TYPE_MAIN_VARIANT (desc_type);
605 279577 : field = gfc_advance_chain (TYPE_FIELDS (type), DATA_FIELD);
606 279577 : *data_off = byte_position (field);
607 279577 : field = gfc_advance_chain (TYPE_FIELDS (type), DTYPE_FIELD);
608 279577 : *dtype_off = byte_position (field);
609 279577 : field = gfc_advance_chain (TYPE_FIELDS (type), SPAN_FIELD);
610 279577 : *span_off = byte_position (field);
611 279577 : field = gfc_advance_chain (TYPE_FIELDS (type), DIMENSION_FIELD);
612 279577 : *dim_off = byte_position (field);
613 279577 : type = TREE_TYPE (TREE_TYPE (field));
614 279577 : *dim_size = TYPE_SIZE_UNIT (type);
615 279577 : field = gfc_advance_chain (TYPE_FIELDS (type), STRIDE_SUBFIELD);
616 279577 : *stride_suboff = byte_position (field);
617 279577 : field = gfc_advance_chain (TYPE_FIELDS (type), LBOUND_SUBFIELD);
618 279577 : *lower_suboff = byte_position (field);
619 279577 : field = gfc_advance_chain (TYPE_FIELDS (type), UBOUND_SUBFIELD);
620 279577 : *upper_suboff = byte_position (field);
621 279577 : }
622 :
623 :
624 : /* Array descriptor higher level routines.
625 : ******************************************************************************/
626 :
627 : /* Build a null array descriptor constructor. */
628 :
629 : tree
630 1100 : gfc_build_null_descriptor (tree type)
631 : {
632 1100 : tree field;
633 1100 : tree tmp;
634 :
635 1100 : gcc_assert (GFC_DESCRIPTOR_TYPE_P (type));
636 1100 : gcc_assert (DATA_FIELD == 0);
637 1100 : field = TYPE_FIELDS (type);
638 :
639 : /* Set a NULL data pointer. */
640 1100 : tmp = build_constructor_single (type, field, null_pointer_node);
641 1100 : TREE_CONSTANT (tmp) = 1;
642 : /* All other fields are ignored. */
643 :
644 1100 : return tmp;
645 : }
646 :
647 :
648 : /* Cleanup those #defines. */
649 :
650 : #undef DATA_FIELD
651 : #undef OFFSET_FIELD
652 : #undef DTYPE_FIELD
653 : #undef SPAN_FIELD
654 : #undef DIMENSION_FIELD
655 : #undef CAF_TOKEN_FIELD
656 : #undef STRIDE_SUBFIELD
657 : #undef LBOUND_SUBFIELD
658 : #undef UBOUND_SUBFIELD
659 :
660 :
661 : /* For an array descriptor, get the total number of elements. This is just
662 : the product of the extents along from_dim to to_dim. */
663 :
664 : static tree
665 1973 : gfc_conv_descriptor_size_1 (tree desc, int from_dim, int to_dim)
666 : {
667 1973 : tree res;
668 1973 : int dim;
669 :
670 1973 : res = gfc_index_one_node;
671 :
672 4815 : for (dim = from_dim; dim < to_dim; ++dim)
673 : {
674 2842 : tree lbound;
675 2842 : tree ubound;
676 2842 : tree extent;
677 :
678 2842 : lbound = gfc_conv_descriptor_lbound_get (desc, gfc_rank_cst[dim]);
679 2842 : ubound = gfc_conv_descriptor_ubound_get (desc, gfc_rank_cst[dim]);
680 :
681 2842 : extent = gfc_conv_array_extent_dim (lbound, ubound, NULL);
682 2842 : res = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
683 : res, extent);
684 : }
685 :
686 1973 : return res;
687 : }
688 :
689 :
690 : /* Full size of an array. */
691 :
692 : tree
693 1909 : gfc_conv_descriptor_size (tree desc, int rank)
694 : {
695 1909 : return gfc_conv_descriptor_size_1 (desc, 0, rank);
696 : }
697 :
698 :
699 : /* Size of a coarray for all dimensions but the last. */
700 :
701 : tree
702 64 : gfc_conv_descriptor_cosize (tree desc, int rank, int corank)
703 : {
704 64 : return gfc_conv_descriptor_size_1 (desc, rank, rank + corank - 1);
705 : }
706 :
707 :
708 : /* Modify a descriptor such that the lbound of a given dimension is the value
709 : specified. This also updates ubound and offset accordingly. */
710 :
711 : void
712 1009 : gfc_conv_shift_descriptor_lbound (stmtblock_t* block, tree desc,
713 : int dim, tree new_lbound)
714 : {
715 1009 : tree offs, ubound, lbound, stride;
716 1009 : tree diff, offs_diff;
717 :
718 1009 : new_lbound = fold_convert (gfc_array_index_type, new_lbound);
719 :
720 1009 : offs = gfc_conv_descriptor_offset_get (desc);
721 1009 : lbound = gfc_conv_descriptor_lbound_get (desc, gfc_rank_cst[dim]);
722 1009 : ubound = gfc_conv_descriptor_ubound_get (desc, gfc_rank_cst[dim]);
723 1009 : stride = gfc_conv_descriptor_stride_get (desc, gfc_rank_cst[dim]);
724 :
725 : /* Get difference (new - old) by which to shift stuff. */
726 1009 : diff = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
727 : new_lbound, lbound);
728 :
729 : /* Shift ubound and offset accordingly. This has to be done before
730 : updating the lbound, as they depend on the lbound expression! */
731 1009 : ubound = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
732 : ubound, diff);
733 1009 : gfc_conv_descriptor_ubound_set (block, desc, gfc_rank_cst[dim], ubound);
734 1009 : offs_diff = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
735 : diff, stride);
736 1009 : offs = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
737 : offs, offs_diff);
738 1009 : gfc_conv_descriptor_offset_set (block, desc, offs);
739 :
740 : /* Finally set lbound to value we want. */
741 1009 : gfc_conv_descriptor_lbound_set (block, desc, gfc_rank_cst[dim], new_lbound);
742 1009 : }
743 :
744 :
745 : void
746 1778 : gfc_copy_descriptor (stmtblock_t *block, tree dst, tree src, int rank)
747 : {
748 1778 : int n;
749 1778 : tree dim;
750 1778 : tree tmp;
751 1778 : tree tmp2;
752 1778 : tree size;
753 1778 : tree offset;
754 :
755 1778 : offset = gfc_index_zero_node;
756 :
757 : /* Use memcpy to copy the descriptor. The size is the minimum of
758 : the sizes of 'src' and 'dst'. This avoids a non-trivial conversion. */
759 1778 : tmp = TYPE_SIZE_UNIT (TREE_TYPE (src));
760 1778 : tmp2 = TYPE_SIZE_UNIT (TREE_TYPE (dst));
761 1778 : size = fold_build2_loc (input_location, MIN_EXPR,
762 1778 : TREE_TYPE (tmp), tmp, tmp2);
763 1778 : tmp = builtin_decl_explicit (BUILT_IN_MEMCPY);
764 1778 : tmp = build_call_expr_loc (input_location, tmp, 3,
765 : gfc_build_addr_expr (NULL_TREE, dst),
766 : gfc_build_addr_expr (NULL_TREE, src),
767 : fold_convert (size_type_node, size));
768 1778 : gfc_add_expr_to_block (block, tmp);
769 :
770 : /* Set the offset correctly. */
771 8792 : for (n = 0; n < rank; n++)
772 : {
773 5236 : dim = gfc_rank_cst[n];
774 5236 : tmp = gfc_conv_descriptor_lbound_get (src, dim);
775 5236 : tmp2 = gfc_conv_descriptor_stride_get (src, dim);
776 5236 : tmp = fold_build2_loc (input_location, MULT_EXPR, TREE_TYPE (tmp),
777 : tmp, tmp2);
778 5236 : offset = fold_build2_loc (input_location, MINUS_EXPR,
779 5236 : TREE_TYPE (offset), offset, tmp);
780 5236 : offset = gfc_evaluate_now (offset, block);
781 : }
782 :
783 1778 : gfc_conv_descriptor_offset_set (block, dst, offset);
784 1778 : }
785 :
786 :
787 : /* Extend the data in array DESC by EXTRA elements. */
788 :
789 : void
790 1066 : gfc_grow_array (stmtblock_t * pblock, tree desc, tree extra)
791 : {
792 1066 : tree arg0, arg1;
793 1066 : tree tmp;
794 1066 : tree size;
795 1066 : tree ubound;
796 :
797 1066 : if (integer_zerop (extra))
798 : return;
799 :
800 1036 : ubound = gfc_conv_descriptor_ubound_get (desc, gfc_rank_cst[0]);
801 :
802 : /* Add EXTRA to the upper bound. */
803 1036 : tmp = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
804 : ubound, extra);
805 1036 : gfc_conv_descriptor_ubound_set (pblock, desc, gfc_rank_cst[0], tmp);
806 :
807 : /* Get the value of the current data pointer. */
808 1036 : arg0 = gfc_conv_descriptor_data_get (desc);
809 :
810 : /* Calculate the new array size. */
811 1036 : size = TYPE_SIZE_UNIT (gfc_get_element_type (TREE_TYPE (desc)));
812 1036 : tmp = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
813 : ubound, gfc_index_one_node);
814 1036 : arg1 = fold_build2_loc (input_location, MULT_EXPR, size_type_node,
815 : fold_convert (size_type_node, tmp),
816 : fold_convert (size_type_node, size));
817 :
818 : /* Call the realloc() function. */
819 1036 : tmp = gfc_call_realloc (pblock, arg0, arg1);
820 1036 : gfc_conv_descriptor_data_set (pblock, desc, tmp);
821 : }
|
