Mercurial > hg > CbC > CbC_gcc

comparison gcc/fortran/trans-common.c @ 145:1830386684a0

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
gcc-9.2.0
author anatofuz
date Thu, 13 Feb 2020 11:34:05 +0900
parents 84e7813d76e9
children
comparison
equal deleted inserted replaced
131:84e7813d76e9 145:1830386684a0
1 /* Common block and equivalence list handling 1 /* Common block and equivalence list handling
2 Copyright (C) 2000-2018 Free Software Foundation, Inc. 2 Copyright (C) 2000-2020 Free Software Foundation, Inc.
3 Contributed by Canqun Yang <canqun@nudt.edu.cn> 3 Contributed by Canqun Yang <canqun@nudt.edu.cn>
4 4
5 This file is part of GCC. 5 This file is part of GCC.
6 6
7 GCC is free software; you can redistribute it and/or modify it under 7 GCC is free software; you can redistribute it and/or modify it under
280 tree name; 280 tree name;
281 HOST_WIDE_INT offset = h->offset; 281 HOST_WIDE_INT offset = h->offset;
282 unsigned HOST_WIDE_INT desired_align, known_align; 282 unsigned HOST_WIDE_INT desired_align, known_align;
283 283
284 name = get_identifier (h->sym->name); 284 name = get_identifier (h->sym->name);
285 field = build_decl (h->sym->declared_at.lb->location, 285 field = build_decl (gfc_get_location (&h->sym->declared_at),
286 FIELD_DECL, name, h->field); 286 FIELD_DECL, name, h->field);
287 known_align = (offset & -offset) * BITS_PER_UNIT; 287 known_align = (offset & -offset) * BITS_PER_UNIT;
288 if (known_align == 0 || known_align > BIGGEST_ALIGNMENT) 288 if (known_align == 0 || known_align > BIGGEST_ALIGNMENT)
289 known_align = BIGGEST_ALIGNMENT; 289 known_align = BIGGEST_ALIGNMENT;
290 290
337 337
338 338
339 /* Get storage for local equivalence. */ 339 /* Get storage for local equivalence. */
340 340
341 static tree 341 static tree
342 build_equiv_decl (tree union_type, bool is_init, bool is_saved) 342 build_equiv_decl (tree union_type, bool is_init, bool is_saved, bool is_auto)
343 { 343 {
344 tree decl; 344 tree decl;
345 char name[18]; 345 char name[18];
346 static int serial = 0; 346 static int serial = 0;
347 347
357 decl = build_decl (input_location, 357 decl = build_decl (input_location,
358 VAR_DECL, get_identifier (name), union_type); 358 VAR_DECL, get_identifier (name), union_type);
359 DECL_ARTIFICIAL (decl) = 1; 359 DECL_ARTIFICIAL (decl) = 1;
360 DECL_IGNORED_P (decl) = 1; 360 DECL_IGNORED_P (decl) = 1;
361 361
362 if (!gfc_can_put_var_on_stack (DECL_SIZE_UNIT (decl)) 362 if (!is_auto && (!gfc_can_put_var_on_stack (DECL_SIZE_UNIT (decl))
363 || is_saved) 363 || is_saved))
364 TREE_STATIC (decl) = 1; 364 TREE_STATIC (decl) = 1;
365 365
366 TREE_ADDRESSABLE (decl) = 1; 366 TREE_ADDRESSABLE (decl) = 1;
367 TREE_USED (decl) = 1; 367 TREE_USED (decl) = 1;
368 GFC_DECL_COMMON_OR_EQUIV (decl) = 1; 368 GFC_DECL_COMMON_OR_EQUIV (decl) = 1;
557 557
558 tmp = build_int_cst (gfc_array_index_type, length - 1); 558 tmp = build_int_cst (gfc_array_index_type, length - 1);
559 tmp = build_range_type (gfc_array_index_type, 559 tmp = build_range_type (gfc_array_index_type,
560 gfc_index_zero_node, tmp); 560 gfc_index_zero_node, tmp);
561 tmp = build_array_type (type, tmp); 561 tmp = build_array_type (type, tmp);
562 field = build_decl (gfc_current_locus.lb->location, 562 field = build_decl (gfc_get_location (&gfc_current_locus),
563 FIELD_DECL, NULL_TREE, tmp); 563 FIELD_DECL, NULL_TREE, tmp);
564 564
565 known_align = BIGGEST_ALIGNMENT; 565 known_align = BIGGEST_ALIGNMENT;
566 566
567 desired_align = update_alignment_for_field (rli, field, known_align); 567 desired_align = update_alignment_for_field (rli, field, known_align);
609 tree field_init = NULL_TREE; 609 tree field_init = NULL_TREE;
610 record_layout_info rli; 610 record_layout_info rli;
611 tree decl; 611 tree decl;
612 bool is_init = false; 612 bool is_init = false;
613 bool is_saved = false; 613 bool is_saved = false;
614 bool is_auto = false;
614 615
615 /* Declare the variables inside the common block. 616 /* Declare the variables inside the common block.
616 If the current common block contains any equivalence object, then 617 If the current common block contains any equivalence object, then
617 make a UNION_TYPE node, otherwise RECORD_TYPE. This will let the 618 make a UNION_TYPE node, otherwise RECORD_TYPE. This will let the
618 alias analyzer work well when there is no address overlapping for 619 alias analyzer work well when there is no address overlapping for
652 is_init = true; 653 is_init = true;
653 654
654 /* Has SAVE attribute. */ 655 /* Has SAVE attribute. */
655 if (s->sym->attr.save) 656 if (s->sym->attr.save)
656 is_saved = true; 657 is_saved = true;
658
659 /* Has AUTOMATIC attribute. */
660 if (s->sym->attr.automatic)
661 is_auto = true;
657 } 662 }
658 663
659 finish_record_layout (rli, true); 664 finish_record_layout (rli, true);
660 665
661 if (com) 666 if (com)
662 decl = build_common_decl (com, union_type, is_init); 667 decl = build_common_decl (com, union_type, is_init);
663 else 668 else
664 decl = build_equiv_decl (union_type, is_init, is_saved); 669 decl = build_equiv_decl (union_type, is_init, is_saved, is_auto);
665 670
666 if (is_init) 671 if (is_init)
667 { 672 {
668 tree ctor, tmp; 673 tree ctor, tmp;
669 vec<constructor_elt, va_gc> *v = NULL; 674 vec<constructor_elt, va_gc> *v = NULL;
704 /* Build component reference for each variable. */ 709 /* Build component reference for each variable. */
705 for (s = head; s; s = next_s) 710 for (s = head; s; s = next_s)
706 { 711 {
707 tree var_decl; 712 tree var_decl;
708 713
709 var_decl = build_decl (s->sym->declared_at.lb->location, 714 var_decl = build_decl (gfc_get_location (&s->sym->declared_at),
710 VAR_DECL, DECL_NAME (s->field), 715 VAR_DECL, DECL_NAME (s->field),
711 TREE_TYPE (s->field)); 716 TREE_TYPE (s->field));
712 TREE_STATIC (var_decl) = TREE_STATIC (decl); 717 TREE_STATIC (var_decl) = TREE_STATIC (decl);
713 /* Mark the variable as used in order to avoid warnings about 718 /* Mark the variable as used in order to avoid warnings about
714 unused variables. */ 719 unused variables. */
946 new_condition (f, eq1, eq2); 951 new_condition (f, eq1, eq2);
947 else 952 else
948 confirm_condition (f, eq1, n, eq2); 953 confirm_condition (f, eq1, n, eq2);
949 } 954 }
950 955
956 static void
957 accumulate_equivalence_attributes (symbol_attribute *dummy_symbol, gfc_equiv *e)
958 {
959 symbol_attribute attr = e->expr->symtree->n.sym->attr;
960
961 dummy_symbol->dummy |= attr.dummy;
962 dummy_symbol->pointer |= attr.pointer;
963 dummy_symbol->target |= attr.target;
964 dummy_symbol->external |= attr.external;
965 dummy_symbol->intrinsic |= attr.intrinsic;
966 dummy_symbol->allocatable |= attr.allocatable;
967 dummy_symbol->elemental |= attr.elemental;
968 dummy_symbol->recursive |= attr.recursive;
969 dummy_symbol->in_common |= attr.in_common;
970 dummy_symbol->result |= attr.result;
971 dummy_symbol->in_namelist |= attr.in_namelist;
972 dummy_symbol->optional |= attr.optional;
973 dummy_symbol->entry |= attr.entry;
974 dummy_symbol->function |= attr.function;
975 dummy_symbol->subroutine |= attr.subroutine;
976 dummy_symbol->dimension |= attr.dimension;
977 dummy_symbol->in_equivalence |= attr.in_equivalence;
978 dummy_symbol->use_assoc |= attr.use_assoc;
979 dummy_symbol->cray_pointer |= attr.cray_pointer;
980 dummy_symbol->cray_pointee |= attr.cray_pointee;
981 dummy_symbol->data |= attr.data;
982 dummy_symbol->value |= attr.value;
983 dummy_symbol->volatile_ |= attr.volatile_;
984 dummy_symbol->is_protected |= attr.is_protected;
985 dummy_symbol->is_bind_c |= attr.is_bind_c;
986 dummy_symbol->procedure |= attr.procedure;
987 dummy_symbol->proc_pointer |= attr.proc_pointer;
988 dummy_symbol->abstract |= attr.abstract;
989 dummy_symbol->asynchronous |= attr.asynchronous;
990 dummy_symbol->codimension |= attr.codimension;
991 dummy_symbol->contiguous |= attr.contiguous;
992 dummy_symbol->generic |= attr.generic;
993 dummy_symbol->automatic |= attr.automatic;
994 dummy_symbol->threadprivate |= attr.threadprivate;
995 dummy_symbol->omp_declare_target |= attr.omp_declare_target;
996 dummy_symbol->omp_declare_target_link |= attr.omp_declare_target_link;
997 dummy_symbol->oacc_declare_copyin |= attr.oacc_declare_copyin;
998 dummy_symbol->oacc_declare_create |= attr.oacc_declare_create;
999 dummy_symbol->oacc_declare_deviceptr |= attr.oacc_declare_deviceptr;
1000 dummy_symbol->oacc_declare_device_resident
1001 |= attr.oacc_declare_device_resident;
1002
1003 /* Not strictly correct, but probably close enough. */
1004 if (attr.save > dummy_symbol->save)
1005 dummy_symbol->save = attr.save;
1006 if (attr.access > dummy_symbol->access)
1007 dummy_symbol->access = attr.access;
1008 }
951 1009
952 /* Given a segment element, search through the equivalence lists for unused 1010 /* Given a segment element, search through the equivalence lists for unused
953 conditions that involve the symbol. Add these rules to the segment. */ 1011 conditions that involve the symbol. Add these rules to the segment. */
954 1012
955 static bool 1013 static bool
963 for (e1 = n->sym->ns->equiv; e1; e1 = e1->next) 1021 for (e1 = n->sym->ns->equiv; e1; e1 = e1->next)
964 { 1022 {
965 eq = NULL; 1023 eq = NULL;
966 1024
967 /* Search the equivalence list, including the root (first) element 1025 /* Search the equivalence list, including the root (first) element
968 for the symbol that owns the segment. */ 1026 for the symbol that owns the segment. */
1027 symbol_attribute dummy_symbol;
1028 memset (&dummy_symbol, 0, sizeof (dummy_symbol));
969 for (e2 = e1; e2; e2 = e2->eq) 1029 for (e2 = e1; e2; e2 = e2->eq)
970 { 1030 {
1031 accumulate_equivalence_attributes (&dummy_symbol, e2);
971 if (!e2->used && e2->expr->symtree->n.sym == n->sym) 1032 if (!e2->used && e2->expr->symtree->n.sym == n->sym)
972 { 1033 {
973 eq = e2; 1034 eq = e2;
974 break; 1035 break;
975 } 1036 }
976 } 1037 }
1038
1039 gfc_check_conflict (&dummy_symbol, e1->expr->symtree->name, &e1->expr->where);
977 1040
978 /* Go to the next root element. */ 1041 /* Go to the next root element. */
979 if (eq == NULL) 1042 if (eq == NULL)
980 continue; 1043 continue;
981 1044
1005 1068
1006 static void 1069 static void
1007 add_equivalences (bool *saw_equiv) 1070 add_equivalences (bool *saw_equiv)
1008 { 1071 {
1009 segment_info *f; 1072 segment_info *f;
1010 bool seen_one, more; 1073 bool more = TRUE;
1011 1074
1012 seen_one = false;
1013 more = TRUE;
1014 while (more) 1075 while (more)
1015 { 1076 {
1016 more = FALSE; 1077 more = FALSE;
1017 for (f = current_segment; f; f = f->next) 1078 for (f = current_segment; f; f = f->next)
1018 { 1079 {
1019 if (!f->sym->equiv_built) 1080 if (!f->sym->equiv_built)
1020 { 1081 {
1021 f->sym->equiv_built = 1; 1082 f->sym->equiv_built = 1;
1022 seen_one = find_equivalence (f); 1083 bool seen_one = find_equivalence (f);
1023 if (seen_one) 1084 if (seen_one)
1024 { 1085 {
1025 *saw_equiv = true; 1086 *saw_equiv = true;
1026 more = true; 1087 more = true;
1027 } 1088 }
1154 { 1215 {
1155 if (strcmp (common->name, BLANK_COMMON_NAME)) 1216 if (strcmp (common->name, BLANK_COMMON_NAME))
1156 gfc_warning (OPT_Walign_commons, 1217 gfc_warning (OPT_Walign_commons,
1157 "Padding of %d bytes required before %qs in " 1218 "Padding of %d bytes required before %qs in "
1158 "COMMON %qs at %L; reorder elements or use " 1219 "COMMON %qs at %L; reorder elements or use "
1159 "-fno-align-commons", (int)offset, 1220 "%<-fno-align-commons%>", (int)offset,
1160 s->sym->name, common->name, &common->where); 1221 s->sym->name, common->name, &common->where);
1161 else 1222 else
1162 gfc_warning (OPT_Walign_commons, 1223 gfc_warning (OPT_Walign_commons,
1163 "Padding of %d bytes required before %qs in " 1224 "Padding of %d bytes required before %qs in "
1164 "COMMON at %L; reorder elements or use " 1225 "COMMON at %L; reorder elements or use "
1165 "-fno-align-commons", (int)offset, 1226 "%<-fno-align-commons%>", (int)offset,
1166 s->sym->name, &common->where); 1227 s->sym->name, &common->where);
1167 } 1228 }
1168 } 1229 }
1169 1230
1170 /* Apply the offset to the new segments. */ 1231 /* Apply the offset to the new segments. */