gcc/fortran/data.c

   1 /* Supporting functions for resolving DATA statement.
   2    Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007
   3    Free Software Foundation, Inc.
   4    Contributed by Lifang Zeng <zlf605@hotmail.com>
   5
   6 This file is part of GCC.
   7
   8 GCC is free software; you can redistribute it and/or modify it under
   9 the terms of the GNU General Public License as published by the Free
  10 Software Foundation; either version 3, or (at your option) any later
  11 version.
  12
  13 GCC is distributed in the hope that it will be useful, but WITHOUT ANY
  14 WARRANTY; without even the implied warranty of MERCHANTABILITY or
  15 FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  16 for more details.
  17
  18 You should have received a copy of the GNU General Public License
  19 along with GCC; see the file COPYING3.  If not see
  20 <http://www.gnu.org/licenses/>.  */
  21
  22
  23 /* Notes for DATA statement implementation:
  24
  25    We first assign initial value to each symbol by gfc_assign_data_value
  26    during resolveing DATA statement. Refer to check_data_variable and
  27    traverse_data_list in resolve.c.
  28
  29    The complexity exists in the handling of array section, implied do
  30    and array of struct appeared in DATA statement.
  31
  32    We call gfc_conv_structure, gfc_con_array_array_initializer,
  33    etc., to convert the initial value. Refer to trans-expr.c and
  34    trans-array.c.  */
  35
  36 #include "config.h"
  37 #include "gfortran.h"
  38
  39 static void formalize_init_expr (gfc_expr *);
  40
  41 /* Calculate the array element offset.  */
  42
  43 static void
  44 get_array_index (gfc_array_ref *ar, mpz_t *offset)
  45 {
  46   gfc_expr *e;
  47   int i;
  48   try re;
  49   mpz_t delta;
  50   mpz_t tmp;
  51
  52   mpz_init (tmp);
  53   mpz_set_si (*offset, 0);
  54   mpz_init_set_si (delta, 1);
  55   for (i = 0; i < ar->dimen; i++)
  56     {
  57       e = gfc_copy_expr (ar->start[i]);
  58       re = gfc_simplify_expr (e, 1);
  59
  60       if ((gfc_is_constant_expr (ar->as->lower[i]) == 0)
  61           || (gfc_is_constant_expr (ar->as->upper[i]) == 0)
  62           || (gfc_is_constant_expr (e) == 0))
  63         gfc_error ("non-constant array in DATA statement %L", &ar->where);
  64
  65       mpz_set (tmp, e->value.integer);
  66       mpz_sub (tmp, tmp, ar->as->lower[i]->value.integer);
  67       mpz_mul (tmp, tmp, delta);
  68       mpz_add (*offset, tmp, *offset);
  69
  70       mpz_sub (tmp, ar->as->upper[i]->value.integer,
  71                ar->as->lower[i]->value.integer);
  72       mpz_add_ui (tmp, tmp, 1);
  73       mpz_mul (delta, tmp, delta);
  74     }
  75   mpz_clear (delta);
  76   mpz_clear (tmp);
  77 }
  78
  79
  80 /* Find if there is a constructor which offset is equal to OFFSET.  */
  81
  82 static gfc_constructor *
  83 find_con_by_offset (splay_tree spt, mpz_t offset)
  84 {
  85   mpz_t tmp;
  86   gfc_constructor *ret = NULL;
  87   gfc_constructor *con;
  88   splay_tree_node sptn;
  89
  90   /* The complexity is due to needing quick access to the linked list of
  91      constructors.  Both a linked list and a splay tree are used, and both
  92      are kept up to date if they are array elements (which is the only time
  93      that a specific constructor has to be found).  */
  94
  95   gcc_assert (spt != NULL);
  96   mpz_init (tmp);
  97
  98   sptn = splay_tree_lookup (spt, (splay_tree_key) mpz_get_si (offset));
  99
 100   if (sptn)
 101     ret = (gfc_constructor*) sptn->value;
 102   else
 103     {
 104        /* Need to check and see if we match a range, so we will pull
 105           the next lowest index and see if the range matches.  */
 106        sptn = splay_tree_predecessor (spt,
 107                                       (splay_tree_key) mpz_get_si (offset));
 108        if (sptn)
 109          {
 110             con = (gfc_constructor*) sptn->value;
 111             if (mpz_cmp_ui (con->repeat, 1) > 0)
 112               {
 113                  mpz_init (tmp);
 114                  mpz_add (tmp, con->n.offset, con->repeat);
 115                  if (mpz_cmp (offset, tmp) < 0)
 116                    ret = con;
 117                  mpz_clear (tmp);
 118               }
 119             else
 120               ret = NULL; /* The range did not match.  */
 121          }
 122       else
 123         ret = NULL; /* No pred, so no match.  */
 124     }
 125
 126   return ret;
 127 }
 128
 129
 130 /* Find if there is a constructor which component is equal to COM.  */
 131
 132 static gfc_constructor *
 133 find_con_by_component (gfc_component *com, gfc_constructor *con)
 134 {
 135   for (; con; con = con->next)
 136     {
 137       if (com == con->n.component)
 138         return con;
 139     }
 140   return NULL;
 141 }
 142
 143
 144 /* Create a character type initialization expression from RVALUE.
 145    TS [and REF] describe [the substring of] the variable being initialized.
 146    INIT is thh existing initializer, not NULL.  Initialization is performed
 147    according to normal assignment rules.  */
 148
 149 static gfc_expr *
 150 create_character_intializer (gfc_expr *init, gfc_typespec *ts,
 151                              gfc_ref *ref, gfc_expr *rvalue)
 152 {
 153   int len;
 154   int start;
 155   int end;
 156   char *dest, *rvalue_string;
 157
 158   gfc_extract_int (ts->cl->length, &len);
 159
 160   if (init == NULL)
 161     {
 162       /* Create a new initializer.  */
 163       init = gfc_get_expr ();
 164       init->expr_type = EXPR_CONSTANT;
 165       init->ts = *ts;
 166
 167       dest = gfc_getmem (len + 1);
 168       dest[len] = '\0';
 169       init->value.character.length = len;
 170       init->value.character.string = dest;
 171       /* Blank the string if we're only setting a substring.  */
 172       if (ref != NULL)
 173         memset (dest, ' ', len);
 174     }
 175   else
 176     dest = init->value.character.string;
 177
 178   if (ref)
 179     {
 180       gfc_expr *start_expr, *end_expr;
 181
 182       gcc_assert (ref->type == REF_SUBSTRING);
 183
 184       /* Only set a substring of the destination.  Fortran substring bounds
 185          are one-based [start, end], we want zero based [start, end).  */
 186       start_expr = gfc_copy_expr (ref->u.ss.start);
 187       end_expr = gfc_copy_expr (ref->u.ss.end);
 188
 189       if ((gfc_simplify_expr (start_expr, 1) == FAILURE)
 190           || (gfc_simplify_expr (end_expr, 1)) == FAILURE)
 191         {
 192           gfc_error ("failure to simplify substring reference in DATA "
 193                      "statement at %L", &ref->u.ss.start->where);
 194           return NULL;
 195         }
 196
 197       gfc_extract_int (start_expr, &start);
 198       start--;
 199       gfc_extract_int (end_expr, &end);
 200     }
 201   else
 202     {
 203       /* Set the whole string.  */
 204       start = 0;
 205       end = len;
 206     }
 207
 208   /* Copy the initial value.  */
 209   if (rvalue->ts.type == BT_HOLLERITH)
 210     {
 211       len = rvalue->representation.length;
 212       rvalue_string = rvalue->representation.string;
 213     }
 214   else
 215     {
 216       len = rvalue->value.character.length;
 217       rvalue_string = rvalue->value.character.string;
 218     }
 219
 220   if (len > end - start)
 221     {
 222       len = end - start;
 223       gfc_warning_now ("initialization string truncated to match variable "
 224                        "at %L", &rvalue->where);
 225     }
 226
 227   memcpy (&dest[start], rvalue_string, len);
 228
 229   /* Pad with spaces.  Substrings will already be blanked.  */
 230   if (len < end - start && ref == NULL)
 231     memset (&dest[start + len], ' ', end - (start + len));
 232
 233   if (rvalue->ts.type == BT_HOLLERITH)
 234     {
 235       init->representation.length = init->value.character.length;
 236       init->representation.string = init->value.character.string;
 237     }
 238
 239   return init;
 240 }
 241
 242
 243 /* Assign the initial value RVALUE to  LVALUE's symbol->value. If the
 244    LVALUE already has an initialization, we extend this, otherwise we
 245    create a new one.  */
 246
 247 try
 248 gfc_assign_data_value (gfc_expr *lvalue, gfc_expr *rvalue, mpz_t index)
 249 {
 250   gfc_ref *ref;
 251   gfc_expr *init;
 252   gfc_expr *expr;
 253   gfc_constructor *con;
 254   gfc_constructor *last_con;
 255   gfc_constructor *pred;
 256   gfc_symbol *symbol;
 257   gfc_typespec *last_ts;
 258   mpz_t offset;
 259   splay_tree spt;
 260   splay_tree_node sptn;
 261
 262   symbol = lvalue->symtree->n.sym;
 263   init = symbol->value;
 264   last_ts = &symbol->ts;
 265   last_con = NULL;
 266   mpz_init_set_si (offset, 0);
 267
 268   /* Find/create the parent expressions for subobject references.  */
 269   for (ref = lvalue->ref; ref; ref = ref->next)
 270     {
 271       /* Break out of the loop if we find a substring.  */
 272       if (ref->type == REF_SUBSTRING)
 273         {
 274           /* A substring should always be the last subobject reference.  */
 275           gcc_assert (ref->next == NULL);
 276           break;
 277         }
 278
 279       /* Use the existing initializer expression if it exists.  Otherwise
 280          create a new one.  */
 281       if (init == NULL)
 282         expr = gfc_get_expr ();
 283       else
 284         expr = init;
 285
 286       /* Find or create this element.  */
 287       switch (ref->type)
 288         {
 289         case REF_ARRAY:
 290           if (init && expr->expr_type != EXPR_ARRAY)
 291             {
 292               gfc_error ("'%s' at %L already is initialized at %L",
 293                          lvalue->symtree->n.sym->name, &lvalue->where,
 294                          &init->where);
 295               return FAILURE;
 296             }
 297
 298           if (init == NULL)
 299             {
 300               /* The element typespec will be the same as the array
 301                  typespec.  */
 302               expr->ts = *last_ts;
 303               /* Setup the expression to hold the constructor.  */
 304               expr->expr_type = EXPR_ARRAY;
 305               expr->rank = ref->u.ar.as->rank;
 306             }
 307
 308           if (ref->u.ar.type == AR_ELEMENT)
 309             get_array_index (&ref->u.ar, &offset);
 310           else
 311             mpz_set (offset, index);
 312
 313           /* Splay tree containing offset and gfc_constructor.  */
 314           spt = expr->con_by_offset;
 315
 316           if (spt == NULL)
 317             {
 318                spt = splay_tree_new (splay_tree_compare_ints, NULL, NULL);
 319                expr->con_by_offset = spt;
 320                con = NULL;
 321             }
 322          else
 323           con = find_con_by_offset (spt, offset);
 324
 325           if (con == NULL)
 326             {
 327               splay_tree_key j;
 328
 329               /* Create a new constructor.  */
 330               con = gfc_get_constructor ();
 331               mpz_set (con->n.offset, offset);
 332               j = (splay_tree_key) mpz_get_si (offset);
 333               sptn = splay_tree_insert (spt, j, (splay_tree_value) con);
 334               /* Fix up the linked list.  */
 335               sptn = splay_tree_predecessor (spt, j);
 336               if (sptn == NULL)
 337                 {  /* Insert at the head.  */
 338                    con->next = expr->value.constructor;
 339                    expr->value.constructor = con;
 340                 }
 341               else
 342                 {  /* Insert in the chain.  */
 343                    pred = (gfc_constructor*) sptn->value;
 344                    con->next = pred->next;
 345                    pred->next = con;
 346                 }
 347             }
 348           break;
 349
 350         case REF_COMPONENT:
 351           if (init == NULL)
 352             {
 353               /* Setup the expression to hold the constructor.  */
 354               expr->expr_type = EXPR_STRUCTURE;
 355               expr->ts.type = BT_DERIVED;
 356               expr->ts.derived = ref->u.c.sym;
 357             }
 358           else
 359             gcc_assert (expr->expr_type == EXPR_STRUCTURE);
 360           last_ts = &ref->u.c.component->ts;
 361
 362           /* Find the same element in the existing constructor.  */
 363           con = expr->value.constructor;
 364           con = find_con_by_component (ref->u.c.component, con);
 365
 366           if (con == NULL)
 367             {
 368               /* Create a new constructor.  */
 369               con = gfc_get_constructor ();
 370               con->n.component = ref->u.c.component;
 371               con->next = expr->value.constructor;
 372               expr->value.constructor = con;
 373             }
 374           break;
 375
 376         default:
 377           gcc_unreachable ();
 378         }
 379
 380       if (init == NULL)
 381         {
 382           /* Point the container at the new expression.  */
 383           if (last_con == NULL)
 384             symbol->value = expr;
 385           else
 386             last_con->expr = expr;
 387         }
 388       init = con->expr;
 389       last_con = con;
 390     }
 391
 392   if (ref || last_ts->type == BT_CHARACTER)
 393     expr = create_character_intializer (init, last_ts, ref, rvalue);
 394   else
 395     {
 396       /* Overwriting an existing initializer is non-standard but usually only
 397          provokes a warning from other compilers.  */
 398       if (init != NULL)
 399         {
 400           /* Order in which the expressions arrive here depends on whether
 401              they are from data statements or F95 style declarations.
 402              Therefore, check which is the most recent.  */
 403 #ifdef USE_MAPPED_LOCATION
 404           expr = (LOCATION_LINE (init->where.lb->location)
 405                   > LOCATION_LINE (rvalue->where.lb->location))
 406                ? init : rvalue;
 407 #else
 408           expr = (init->where.lb->linenum > rvalue->where.lb->linenum)
 409                ? init : rvalue;
 410 #endif
 411           gfc_notify_std (GFC_STD_GNU, "Extension: re-initialization "
 412                           "of '%s' at %L", symbol->name, &expr->where);
 413         }
 414
 415       expr = gfc_copy_expr (rvalue);
 416       if (!gfc_compare_types (&lvalue->ts, &expr->ts))
 417         gfc_convert_type (expr, &lvalue->ts, 0);
 418     }
 419
 420   if (last_con == NULL)
 421     symbol->value = expr;
 422   else
 423     last_con->expr = expr;
 424
 425   return SUCCESS;
 426 }
 427
 428
 429 /* Similarly, but initialize REPEAT consecutive values in LVALUE the same
 430    value in RVALUE.  For the nonce, LVALUE must refer to a full array, not
 431    an array section.  */
 432
 433 void
 434 gfc_assign_data_value_range (gfc_expr *lvalue, gfc_expr *rvalue,
 435                              mpz_t index, mpz_t repeat)
 436 {
 437   gfc_ref *ref;
 438   gfc_expr *init, *expr;
 439   gfc_constructor *con, *last_con;
 440   gfc_constructor *pred;
 441   gfc_symbol *symbol;
 442   gfc_typespec *last_ts;
 443   mpz_t offset;
 444   splay_tree spt;
 445   splay_tree_node sptn;
 446
 447   symbol = lvalue->symtree->n.sym;
 448   init = symbol->value;
 449   last_ts = &symbol->ts;
 450   last_con = NULL;
 451   mpz_init_set_si (offset, 0);
 452
 453   /* Find/create the parent expressions for subobject references.  */
 454   for (ref = lvalue->ref; ref; ref = ref->next)
 455     {
 456       /* Use the existing initializer expression if it exists.
 457          Otherwise create a new one.  */
 458       if (init == NULL)
 459         expr = gfc_get_expr ();
 460       else
 461         expr = init;
 462
 463       /* Find or create this element.  */
 464       switch (ref->type)
 465         {
 466         case REF_ARRAY:
 467           if (init == NULL)
 468             {
 469               /* The element typespec will be the same as the array
 470                  typespec.  */
 471               expr->ts = *last_ts;
 472               /* Setup the expression to hold the constructor.  */
 473               expr->expr_type = EXPR_ARRAY;
 474               expr->rank = ref->u.ar.as->rank;
 475             }
 476           else
 477             gcc_assert (expr->expr_type == EXPR_ARRAY);
 478
 479           if (ref->u.ar.type == AR_ELEMENT)
 480             {
 481               get_array_index (&ref->u.ar, &offset);
 482
 483               /* This had better not be the bottom of the reference.
 484                  We can still get to a full array via a component.  */
 485               gcc_assert (ref->next != NULL);
 486             }
 487           else
 488             {
 489               mpz_set (offset, index);
 490
 491               /* We're at a full array or an array section.  This means
 492                  that we've better have found a full array, and that we're
 493                  at the bottom of the reference.  */
 494               gcc_assert (ref->u.ar.type == AR_FULL);
 495               gcc_assert (ref->next == NULL);
 496             }
 497
 498           /* Find the same element in the existing constructor.  */
 499
 500           /* Splay tree containing offset and gfc_constructor.  */
 501           spt = expr->con_by_offset;
 502
 503           if (spt == NULL)
 504             {
 505                spt = splay_tree_new (splay_tree_compare_ints, NULL, NULL);
 506                expr->con_by_offset = spt;
 507                con = NULL;
 508             }
 509           else
 510             con = find_con_by_offset (spt, offset);
 511
 512           if (con == NULL)
 513             {
 514               splay_tree_key j;
 515               /* Create a new constructor.  */
 516               con = gfc_get_constructor ();
 517               mpz_set (con->n.offset, offset);
 518               j = (splay_tree_key) mpz_get_si (offset);
 519
 520               if (ref->next == NULL)
 521                 mpz_set (con->repeat, repeat);
 522               sptn = splay_tree_insert (spt, j, (splay_tree_value) con);
 523               /* Fix up the linked list.  */
 524               sptn = splay_tree_predecessor (spt, j);
 525               if (sptn == NULL)
 526                 {  /* Insert at the head.  */
 527                    con->next = expr->value.constructor;
 528                    expr->value.constructor = con;
 529                 }
 530               else
 531                 {  /* Insert in the chain.  */
 532                    pred = (gfc_constructor*) sptn->value;
 533                    con->next = pred->next;
 534                    pred->next = con;
 535                 }
 536             }
 537           else
 538             gcc_assert (ref->next != NULL);
 539           break;
 540
 541         case REF_COMPONENT:
 542           if (init == NULL)
 543             {
 544               /* Setup the expression to hold the constructor.  */
 545               expr->expr_type = EXPR_STRUCTURE;
 546               expr->ts.type = BT_DERIVED;
 547               expr->ts.derived = ref->u.c.sym;
 548             }
 549           else
 550             gcc_assert (expr->expr_type == EXPR_STRUCTURE);
 551           last_ts = &ref->u.c.component->ts;
 552
 553           /* Find the same element in the existing constructor.  */
 554           con = expr->value.constructor;
 555           con = find_con_by_component (ref->u.c.component, con);
 556
 557           if (con == NULL)
 558             {
 559               /* Create a new constructor.  */
 560               con = gfc_get_constructor ();
 561               con->n.component = ref->u.c.component;
 562               con->next = expr->value.constructor;
 563               expr->value.constructor = con;
 564             }
 565
 566           /* Since we're only intending to initialize arrays here,
 567              there better be an inner reference.  */
 568           gcc_assert (ref->next != NULL);
 569           break;
 570
 571         case REF_SUBSTRING:
 572         default:
 573           gcc_unreachable ();
 574         }
 575
 576       if (init == NULL)
 577         {
 578           /* Point the container at the new expression.  */
 579           if (last_con == NULL)
 580             symbol->value = expr;
 581           else
 582             last_con->expr = expr;
 583         }
 584       init = con->expr;
 585       last_con = con;
 586     }
 587
 588   if (last_ts->type == BT_CHARACTER)
 589     expr = create_character_intializer (init, last_ts, NULL, rvalue);
 590   else
 591     {
 592       /* We should never be overwriting an existing initializer.  */
 593       gcc_assert (!init);
 594
 595       expr = gfc_copy_expr (rvalue);
 596       if (!gfc_compare_types (&lvalue->ts, &expr->ts))
 597         gfc_convert_type (expr, &lvalue->ts, 0);
 598     }
 599
 600   if (last_con == NULL)
 601     symbol->value = expr;
 602   else
 603     last_con->expr = expr;
 604 }
 605
 606 /* Modify the index of array section and re-calculate the array offset.  */
 607
 608 void
 609 gfc_advance_section (mpz_t *section_index, gfc_array_ref *ar,
 610                      mpz_t *offset_ret)
 611 {
 612   int i;
 613   mpz_t delta;
 614   mpz_t tmp;
 615   bool forwards;
 616   int cmp;
 617
 618   for (i = 0; i < ar->dimen; i++)
 619     {
 620       if (ar->dimen_type[i] != DIMEN_RANGE)
 621         continue;
 622
 623       if (ar->stride[i])
 624         {
 625           mpz_add (section_index[i], section_index[i],
 626                    ar->stride[i]->value.integer);
 627         if (mpz_cmp_si (ar->stride[i]->value.integer, 0) >= 0)
 628           forwards = true;
 629         else
 630           forwards = false;
 631         }
 632       else
 633         {
 634           mpz_add_ui (section_index[i], section_index[i], 1);
 635           forwards = true;
 636         }
 637
 638       if (ar->end[i])
 639         cmp = mpz_cmp (section_index[i], ar->end[i]->value.integer);
 640       else
 641         cmp = mpz_cmp (section_index[i], ar->as->upper[i]->value.integer);
 642
 643       if ((cmp > 0 && forwards) || (cmp < 0 && !forwards))
 644         {
 645           /* Reset index to start, then loop to advance the next index.  */
 646           if (ar->start[i])
 647             mpz_set (section_index[i], ar->start[i]->value.integer);
 648           else
 649             mpz_set (section_index[i], ar->as->lower[i]->value.integer);
 650         }
 651       else
 652         break;
 653     }
 654
 655   mpz_set_si (*offset_ret, 0);
 656   mpz_init_set_si (delta, 1);
 657   mpz_init (tmp);
 658   for (i = 0; i < ar->dimen; i++)
 659     {
 660       mpz_sub (tmp, section_index[i], ar->as->lower[i]->value.integer);
 661       mpz_mul (tmp, tmp, delta);
 662       mpz_add (*offset_ret, tmp, *offset_ret);
 663
 664       mpz_sub (tmp, ar->as->upper[i]->value.integer,
 665                ar->as->lower[i]->value.integer);
 666       mpz_add_ui (tmp, tmp, 1);
 667       mpz_mul (delta, tmp, delta);
 668     }
 669   mpz_clear (tmp);
 670   mpz_clear (delta);
 671 }
 672
 673
 674 /* Rearrange a structure constructor so the elements are in the specified
 675    order.  Also insert NULL entries if necessary.  */
 676
 677 static void
 678 formalize_structure_cons (gfc_expr *expr)
 679 {
 680   gfc_constructor *head;
 681   gfc_constructor *tail;
 682   gfc_constructor *cur;
 683   gfc_constructor *last;
 684   gfc_constructor *c;
 685   gfc_component *order;
 686
 687   c = expr->value.constructor;
 688
 689   /* Constructor is already formalized.  */
 690   if (c->n.component == NULL)
 691     return;
 692
 693   head = tail = NULL;
 694   for (order = expr->ts.derived->components; order; order = order->next)
 695     {
 696       /* Find the next component.  */
 697       last = NULL;
 698       cur = c;
 699       while (cur != NULL && cur->n.component != order)
 700         {
 701           last = cur;
 702           cur = cur->next;
 703         }
 704
 705       if (cur == NULL)
 706         {
 707           /* Create a new one.  */
 708           cur = gfc_get_constructor ();
 709         }
 710       else
 711         {
 712           /* Remove it from the chain.  */
 713           if (last == NULL)
 714             c = cur->next;
 715           else
 716             last->next = cur->next;
 717           cur->next = NULL;
 718
 719           formalize_init_expr (cur->expr);
 720         }
 721
 722       /* Add it to the new constructor.  */
 723       if (head == NULL)
 724         head = tail = cur;
 725       else
 726         {
 727           tail->next = cur;
 728           tail = tail->next;
 729         }
 730     }
 731   gcc_assert (c == NULL);
 732   expr->value.constructor = head;
 733 }
 734
 735
 736 /* Make sure an initialization expression is in normalized form.  Ie. all
 737    elements of the constructors are in the correct order.  */
 738
 739 static void
 740 formalize_init_expr (gfc_expr *expr)
 741 {
 742   expr_t type;
 743   gfc_constructor *c;
 744
 745   if (expr == NULL)
 746     return;
 747
 748   type = expr->expr_type;
 749   switch (type)
 750     {
 751     case EXPR_ARRAY:
 752       c = expr->value.constructor;
 753       while (c)
 754         {
 755           formalize_init_expr (c->expr);
 756           c = c->next;
 757         }
 758       break;
 759
 760     case EXPR_STRUCTURE:
 761       formalize_structure_cons (expr);
 762       break;
 763
 764     default:
 765       break;
 766     }
 767 }
 768
 769
 770 /* Resolve symbol's initial value after all data statement.  */
 771
 772 void
 773 gfc_formalize_init_value (gfc_symbol *sym)
 774 {
 775   formalize_init_expr (sym->value);
 776 }
 777
 778
 779 /* Get the integer value into RET_AS and SECTION from AS and AR, and return
 780    offset.  */
 781
 782 void
 783 gfc_get_section_index (gfc_array_ref *ar, mpz_t *section_index, mpz_t *offset)
 784 {
 785   int i;
 786   mpz_t delta;
 787   mpz_t tmp;
 788
 789   mpz_set_si (*offset, 0);
 790   mpz_init (tmp);
 791   mpz_init_set_si (delta, 1);
 792   for (i = 0; i < ar->dimen; i++)
 793     {
 794       mpz_init (section_index[i]);
 795       switch (ar->dimen_type[i])
 796         {
 797         case DIMEN_ELEMENT:
 798         case DIMEN_RANGE:
 799           if (ar->start[i])
 800             {
 801               mpz_sub (tmp, ar->start[i]->value.integer,
 802                        ar->as->lower[i]->value.integer);
 803               mpz_mul (tmp, tmp, delta);
 804               mpz_add (*offset, tmp, *offset);
 805               mpz_set (section_index[i], ar->start[i]->value.integer);
 806             }
 807           else
 808               mpz_set (section_index[i], ar->as->lower[i]->value.integer);
 809           break;
 810
 811         case DIMEN_VECTOR:
 812           gfc_internal_error ("TODO: Vector sections in data statements");
 813
 814         default:
 815           gcc_unreachable ();
 816         }
 817
 818       mpz_sub (tmp, ar->as->upper[i]->value.integer,
 819                ar->as->lower[i]->value.integer);
 820       mpz_add_ui (tmp, tmp, 1);
 821       mpz_mul (delta, tmp, delta);
 822     }
 823
 824   mpz_clear (tmp);
 825   mpz_clear (delta);
 826 }
 827