gcc/fortran/target-memory.c

   1 /* Simulate storage of variables into target memory.
   2    Copyright (C) 2007, 2008, 2009
   3    Free Software Foundation, Inc.
   4    Contributed by Paul Thomas and Brooks Moses
   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 #include "config.h"
  23 #include "system.h"
  24 #include "flags.h"
  25 #include "machmode.h"
  26 #include "tree.h"
  27 #include "gfortran.h"
  28 #include "arith.h"
  29 #include "trans.h"
  30 #include "trans-const.h"
  31 #include "trans-types.h"
  32 #include "target-memory.h"
  33
  34 /* --------------------------------------------------------------- */
  35 /* Calculate the size of an expression.  */
  36
  37 static size_t
  38 size_array (gfc_expr *e)
  39 {
  40   mpz_t array_size;
  41   size_t elt_size = gfc_target_expr_size (e->value.constructor->expr);
  42
  43   gfc_array_size (e, &array_size);
  44   return (size_t)mpz_get_ui (array_size) * elt_size;
  45 }
  46
  47 static size_t
  48 size_integer (int kind)
  49 {
  50   return GET_MODE_SIZE (TYPE_MODE (gfc_get_int_type (kind)));;
  51 }
  52
  53
  54 static size_t
  55 size_float (int kind)
  56 {
  57   return GET_MODE_SIZE (TYPE_MODE (gfc_get_real_type (kind)));;
  58 }
  59
  60
  61 static size_t
  62 size_complex (int kind)
  63 {
  64   return 2 * size_float (kind);
  65 }
  66
  67
  68 static size_t
  69 size_logical (int kind)
  70 {
  71   return GET_MODE_SIZE (TYPE_MODE (gfc_get_logical_type (kind)));;
  72 }
  73
  74
  75 static size_t
  76 size_character (int length, int kind)
  77 {
  78   int i = gfc_validate_kind (BT_CHARACTER, kind, false);
  79   return length * gfc_character_kinds[i].bit_size / 8;
  80 }
  81
  82
  83 size_t
  84 gfc_target_expr_size (gfc_expr *e)
  85 {
  86   tree type;
  87
  88   gcc_assert (e != NULL);
  89
  90   if (e->expr_type == EXPR_ARRAY)
  91     return size_array (e);
  92
  93   switch (e->ts.type)
  94     {
  95     case BT_INTEGER:
  96       return size_integer (e->ts.kind);
  97     case BT_REAL:
  98       return size_float (e->ts.kind);
  99     case BT_COMPLEX:
 100       return size_complex (e->ts.kind);
 101     case BT_LOGICAL:
 102       return size_logical (e->ts.kind);
 103     case BT_CHARACTER:
 104       if (e->expr_type == EXPR_SUBSTRING && e->ref)
 105         {
 106           int start, end;
 107
 108           gfc_extract_int (e->ref->u.ss.start, &start);
 109           gfc_extract_int (e->ref->u.ss.end, &end);
 110           return size_character (MAX(end - start + 1, 0), e->ts.kind);
 111         }
 112       else
 113         return size_character (e->value.character.length, e->ts.kind);
 114     case BT_HOLLERITH:
 115       return e->representation.length;
 116     case BT_DERIVED:
 117       type = gfc_typenode_for_spec (&e->ts);
 118       return int_size_in_bytes (type);
 119     default:
 120       gfc_internal_error ("Invalid expression in gfc_target_expr_size.");
 121       return 0;
 122     }
 123 }
 124
 125
 126 /* The encode_* functions export a value into a buffer, and
 127    return the number of bytes of the buffer that have been
 128    used.  */
 129
 130 static int
 131 encode_array (gfc_expr *expr, unsigned char *buffer, size_t buffer_size)
 132 {
 133   mpz_t array_size;
 134   int i;
 135   int ptr = 0;
 136
 137   gfc_array_size (expr, &array_size);
 138   for (i = 0; i < (int)mpz_get_ui (array_size); i++)
 139     {
 140       ptr += gfc_target_encode_expr (gfc_get_array_element (expr, i),
 141                                      &buffer[ptr], buffer_size - ptr);
 142     }
 143
 144   mpz_clear (array_size);
 145   return ptr;
 146 }
 147
 148
 149 static int
 150 encode_integer (int kind, mpz_t integer, unsigned char *buffer,
 151                 size_t buffer_size)
 152 {
 153   return native_encode_expr (gfc_conv_mpz_to_tree (integer, kind),
 154                              buffer, buffer_size);
 155 }
 156
 157
 158 static int
 159 encode_float (int kind, mpfr_t real, unsigned char *buffer, size_t buffer_size)
 160 {
 161   return native_encode_expr (gfc_conv_mpfr_to_tree (real, kind), buffer,
 162                              buffer_size);
 163 }
 164
 165
 166 static int
 167 encode_complex (int kind, mpfr_t real, mpfr_t imaginary, unsigned char *buffer,
 168                 size_t buffer_size)
 169 {
 170   int size;
 171   size = encode_float (kind, real, &buffer[0], buffer_size);
 172   size += encode_float (kind, imaginary, &buffer[size], buffer_size - size);
 173   return size;
 174 }
 175
 176
 177 static int
 178 encode_logical (int kind, int logical, unsigned char *buffer, size_t buffer_size)
 179 {
 180   return native_encode_expr (build_int_cst (gfc_get_logical_type (kind),
 181                                             logical),
 182                              buffer, buffer_size);
 183 }
 184
 185
 186 int
 187 gfc_encode_character (int kind, int length, const gfc_char_t *string,
 188                       unsigned char *buffer, size_t buffer_size)
 189 {
 190   size_t elsize = size_character (1, kind);
 191   tree type = gfc_get_char_type (kind);
 192   int i;
 193
 194   gcc_assert (buffer_size >= size_character (length, kind));
 195
 196   for (i = 0; i < length; i++)
 197     native_encode_expr (build_int_cst (type, string[i]), &buffer[i*elsize],
 198                         elsize);
 199
 200   return length;
 201 }
 202
 203
 204 static int
 205 encode_derived (gfc_expr *source, unsigned char *buffer, size_t buffer_size)
 206 {
 207   gfc_constructor *ctr;
 208   gfc_component *cmp;
 209   int ptr;
 210   tree type;
 211
 212   type = gfc_typenode_for_spec (&source->ts);
 213
 214   ctr = source->value.constructor;
 215   cmp = source->ts.derived->components;
 216   for (;ctr; ctr = ctr->next, cmp = cmp->next)
 217     {
 218       gcc_assert (cmp);
 219       if (!ctr->expr)
 220         continue;
 221       ptr = TREE_INT_CST_LOW(DECL_FIELD_OFFSET(cmp->backend_decl))
 222             + TREE_INT_CST_LOW(DECL_FIELD_BIT_OFFSET(cmp->backend_decl))/8;
 223
 224       if (ctr->expr->expr_type == EXPR_NULL)
 225         memset (&buffer[ptr], 0,
 226                 int_size_in_bytes (TREE_TYPE (cmp->backend_decl)));
 227       else
 228         gfc_target_encode_expr (ctr->expr, &buffer[ptr],
 229                                 buffer_size - ptr);
 230     }
 231
 232   return int_size_in_bytes (type);
 233 }
 234
 235
 236 /* Write a constant expression in binary form to a buffer.  */
 237 int
 238 gfc_target_encode_expr (gfc_expr *source, unsigned char *buffer,
 239                         size_t buffer_size)
 240 {
 241   if (source == NULL)
 242     return 0;
 243
 244   if (source->expr_type == EXPR_ARRAY)
 245     return encode_array (source, buffer, buffer_size);
 246
 247   gcc_assert (source->expr_type == EXPR_CONSTANT
 248               || source->expr_type == EXPR_STRUCTURE
 249               || source->expr_type == EXPR_SUBSTRING);
 250
 251   /* If we already have a target-memory representation, we use that rather
 252      than recreating one.  */
 253   if (source->representation.string)
 254     {
 255       memcpy (buffer, source->representation.string,
 256               source->representation.length);
 257       return source->representation.length;
 258     }
 259
 260   switch (source->ts.type)
 261     {
 262     case BT_INTEGER:
 263       return encode_integer (source->ts.kind, source->value.integer, buffer,
 264                              buffer_size);
 265     case BT_REAL:
 266       return encode_float (source->ts.kind, source->value.real, buffer,
 267                            buffer_size);
 268     case BT_COMPLEX:
 269       return encode_complex (source->ts.kind, source->value.complex.r,
 270                              source->value.complex.i, buffer, buffer_size);
 271     case BT_LOGICAL:
 272       return encode_logical (source->ts.kind, source->value.logical, buffer,
 273                              buffer_size);
 274     case BT_CHARACTER:
 275       if (source->expr_type == EXPR_CONSTANT || source->ref == NULL)
 276         return gfc_encode_character (source->ts.kind,
 277                                      source->value.character.length,
 278                                      source->value.character.string,
 279                                      buffer, buffer_size);
 280       else
 281         {
 282           int start, end;
 283
 284           gcc_assert (source->expr_type == EXPR_SUBSTRING);
 285           gfc_extract_int (source->ref->u.ss.start, &start);
 286           gfc_extract_int (source->ref->u.ss.end, &end);
 287           return gfc_encode_character (source->ts.kind, MAX(end - start + 1, 0),
 288                                        &source->value.character.string[start-1],
 289                                        buffer, buffer_size);
 290         }
 291
 292     case BT_DERIVED:
 293       return encode_derived (source, buffer, buffer_size);
 294     default:
 295       gfc_internal_error ("Invalid expression in gfc_target_encode_expr.");
 296       return 0;
 297     }
 298 }
 299
 300
 301 static int
 302 interpret_array (unsigned char *buffer, size_t buffer_size, gfc_expr *result)
 303 {
 304   int array_size = 1;
 305   int i;
 306   int ptr = 0;
 307   gfc_constructor *head = NULL, *tail = NULL;
 308
 309   /* Calculate array size from its shape and rank.  */
 310   gcc_assert (result->rank > 0 && result->shape);
 311
 312   for (i = 0; i < result->rank; i++)
 313     array_size *= (int)mpz_get_ui (result->shape[i]);
 314
 315   /* Iterate over array elements, producing constructors.  */
 316   for (i = 0; i < array_size; i++)
 317     {
 318       if (head == NULL)
 319         head = tail = gfc_get_constructor ();
 320       else
 321         {
 322           tail->next = gfc_get_constructor ();
 323           tail = tail->next;
 324         }
 325
 326       tail->where = result->where;
 327       tail->expr = gfc_constant_result (result->ts.type,
 328                                           result->ts.kind, &result->where);
 329       tail->expr->ts = result->ts;
 330
 331       if (tail->expr->ts.type == BT_CHARACTER)
 332         tail->expr->value.character.length = result->value.character.length;
 333
 334       ptr += gfc_target_interpret_expr (&buffer[ptr], buffer_size - ptr,
 335                                         tail->expr);
 336     }
 337   result->value.constructor = head;
 338
 339   return ptr;
 340 }
 341
 342
 343 int
 344 gfc_interpret_integer (int kind, unsigned char *buffer, size_t buffer_size,
 345                    mpz_t integer)
 346 {
 347   mpz_init (integer);
 348   gfc_conv_tree_to_mpz (integer,
 349                         native_interpret_expr (gfc_get_int_type (kind),
 350                                                buffer, buffer_size));
 351   return size_integer (kind);
 352 }
 353
 354
 355 int
 356 gfc_interpret_float (int kind, unsigned char *buffer, size_t buffer_size,
 357                      mpfr_t real)
 358 {
 359   gfc_set_model_kind (kind);
 360   mpfr_init (real);
 361   gfc_conv_tree_to_mpfr (real,
 362                          native_interpret_expr (gfc_get_real_type (kind),
 363                                                 buffer, buffer_size));
 364
 365   return size_float (kind);
 366 }
 367
 368
 369 int
 370 gfc_interpret_complex (int kind, unsigned char *buffer, size_t buffer_size,
 371                    mpfr_t real, mpfr_t imaginary)
 372 {
 373   int size;
 374   size = gfc_interpret_float (kind, &buffer[0], buffer_size, real);
 375   size += gfc_interpret_float (kind, &buffer[size], buffer_size - size,
 376                                imaginary);
 377   return size;
 378 }
 379
 380
 381 int
 382 gfc_interpret_logical (int kind, unsigned char *buffer, size_t buffer_size,
 383                    int *logical)
 384 {
 385   tree t = native_interpret_expr (gfc_get_logical_type (kind), buffer,
 386                                   buffer_size);
 387   *logical = double_int_zero_p (tree_to_double_int (t))
 388              ? 0 : 1;
 389   return size_logical (kind);
 390 }
 391
 392
 393 int
 394 gfc_interpret_character (unsigned char *buffer, size_t buffer_size,
 395                          gfc_expr *result)
 396 {
 397   int i;
 398
 399   if (result->ts.cl && result->ts.cl->length)
 400     result->value.character.length =
 401       (int) mpz_get_ui (result->ts.cl->length->value.integer);
 402
 403   gcc_assert (buffer_size >= size_character (result->value.character.length,
 404                                              result->ts.kind));
 405   result->value.character.string =
 406     gfc_get_wide_string (result->value.character.length + 1);
 407
 408   if (result->ts.kind == gfc_default_character_kind)
 409     for (i = 0; i < result->value.character.length; i++)
 410       result->value.character.string[i] = (gfc_char_t) buffer[i];
 411   else
 412     {
 413       mpz_t integer;
 414       unsigned bytes = size_character (1, result->ts.kind);
 415       mpz_init (integer);
 416       gcc_assert (bytes <= sizeof (unsigned long));
 417
 418       for (i = 0; i < result->value.character.length; i++)
 419         {
 420           gfc_conv_tree_to_mpz (integer,
 421             native_interpret_expr (gfc_get_char_type (result->ts.kind),
 422                                    &buffer[bytes*i], buffer_size-bytes*i));
 423           result->value.character.string[i]
 424             = (gfc_char_t) mpz_get_ui (integer);
 425         }
 426
 427       mpz_clear (integer);
 428     }
 429
 430   result->value.character.string[result->value.character.length] = '\0';
 431
 432   return result->value.character.length;
 433 }
 434
 435
 436 int
 437 gfc_interpret_derived (unsigned char *buffer, size_t buffer_size, gfc_expr *result)
 438 {
 439   gfc_component *cmp;
 440   gfc_constructor *head = NULL, *tail = NULL;
 441   int ptr;
 442   tree type;
 443
 444   /* The attributes of the derived type need to be bolted to the floor.  */
 445   result->expr_type = EXPR_STRUCTURE;
 446
 447   type = gfc_typenode_for_spec (&result->ts);
 448   cmp = result->ts.derived->components;
 449
 450   /* Run through the derived type components.  */
 451   for (;cmp; cmp = cmp->next)
 452     {
 453       if (head == NULL)
 454         head = tail = gfc_get_constructor ();
 455       else
 456         {
 457           tail->next = gfc_get_constructor ();
 458           tail = tail->next;
 459         }
 460
 461       /* The constructor points to the component.  */
 462       tail->n.component = cmp;
 463
 464       tail->expr = gfc_constant_result (cmp->ts.type, cmp->ts.kind,
 465                                         &result->where);
 466       tail->expr->ts = cmp->ts;
 467
 468       /* Copy shape, if needed.  */
 469       if (cmp->as && cmp->as->rank)
 470         {
 471           int n;
 472
 473           tail->expr->expr_type = EXPR_ARRAY;
 474           tail->expr->rank = cmp->as->rank;
 475
 476           tail->expr->shape = gfc_get_shape (tail->expr->rank);
 477           for (n = 0; n < tail->expr->rank; n++)
 478              {
 479                mpz_init_set_ui (tail->expr->shape[n], 1);
 480                mpz_add (tail->expr->shape[n], tail->expr->shape[n],
 481                         cmp->as->upper[n]->value.integer);
 482                mpz_sub (tail->expr->shape[n], tail->expr->shape[n],
 483                         cmp->as->lower[n]->value.integer);
 484              }
 485         }
 486
 487       ptr = TREE_INT_CST_LOW (DECL_FIELD_OFFSET (cmp->backend_decl));
 488       gfc_target_interpret_expr (&buffer[ptr], buffer_size - ptr,
 489                                  tail->expr);
 490
 491       result->value.constructor = head;
 492     }
 493
 494   return int_size_in_bytes (type);
 495 }
 496
 497
 498 /* Read a binary buffer to a constant expression.  */
 499 int
 500 gfc_target_interpret_expr (unsigned char *buffer, size_t buffer_size,
 501                            gfc_expr *result)
 502 {
 503   if (result->expr_type == EXPR_ARRAY)
 504     return interpret_array (buffer, buffer_size, result);
 505
 506   switch (result->ts.type)
 507     {
 508     case BT_INTEGER:
 509       result->representation.length =
 510         gfc_interpret_integer (result->ts.kind, buffer, buffer_size,
 511                                result->value.integer);
 512       break;
 513
 514     case BT_REAL:
 515       result->representation.length =
 516         gfc_interpret_float (result->ts.kind, buffer, buffer_size,
 517                              result->value.real);
 518       break;
 519
 520     case BT_COMPLEX:
 521       result->representation.length =
 522         gfc_interpret_complex (result->ts.kind, buffer, buffer_size,
 523                                result->value.complex.r,
 524                                result->value.complex.i);
 525       break;
 526
 527     case BT_LOGICAL:
 528       result->representation.length =
 529         gfc_interpret_logical (result->ts.kind, buffer, buffer_size,
 530                                &result->value.logical);
 531       break;
 532
 533     case BT_CHARACTER:
 534       result->representation.length =
 535         gfc_interpret_character (buffer, buffer_size, result);
 536       break;
 537
 538     case BT_DERIVED:
 539       result->representation.length =
 540         gfc_interpret_derived (buffer, buffer_size, result);
 541       break;
 542
 543     default:
 544       gfc_internal_error ("Invalid expression in gfc_target_interpret_expr.");
 545       break;
 546     }
 547
 548   if (result->ts.type == BT_CHARACTER)
 549     result->representation.string
 550       = gfc_widechar_to_char (result->value.character.string,
 551                               result->value.character.length);
 552   else
 553     {
 554       result->representation.string =
 555         (char *) gfc_getmem (result->representation.length + 1);
 556       memcpy (result->representation.string, buffer,
 557               result->representation.length);
 558       result->representation.string[result->representation.length] = '\0';
 559     }
 560
 561   return result->representation.length;
 562 }
 563
 564
 565 /* --------------------------------------------------------------- */
 566 /* Two functions used by trans-common.c to write overlapping
 567    equivalence initializers to a buffer.  This is added to the union
 568    and the original initializers freed.  */
 569
 570
 571 /* Writes the values of a constant expression to a char buffer. If another
 572    unequal initializer has already been written to the buffer, this is an
 573    error.  */
 574
 575 static size_t
 576 expr_to_char (gfc_expr *e, unsigned char *data, unsigned char *chk, size_t len)
 577 {
 578   int i;
 579   int ptr;
 580   gfc_constructor *ctr;
 581   gfc_component *cmp;
 582   unsigned char *buffer;
 583
 584   if (e == NULL)
 585     return 0;
 586
 587   /* Take a derived type, one component at a time, using the offsets from the backend
 588      declaration.  */
 589   if (e->ts.type == BT_DERIVED)
 590     {
 591       ctr = e->value.constructor;
 592       cmp = e->ts.derived->components;
 593       for (;ctr; ctr = ctr->next, cmp = cmp->next)
 594         {
 595           gcc_assert (cmp && cmp->backend_decl);
 596           if (!ctr->expr)
 597             continue;
 598             ptr = TREE_INT_CST_LOW(DECL_FIELD_OFFSET(cmp->backend_decl))
 599                         + TREE_INT_CST_LOW(DECL_FIELD_BIT_OFFSET(cmp->backend_decl))/8;
 600           expr_to_char (ctr->expr, &data[ptr], &chk[ptr], len);
 601         }
 602       return len;
 603     }
 604
 605   /* Otherwise, use the target-memory machinery to write a bitwise image, appropriate
 606      to the target, in a buffer and check off the initialized part of the buffer.  */
 607   len = gfc_target_expr_size (e);
 608   buffer = (unsigned char*)alloca (len);
 609   len = gfc_target_encode_expr (e, buffer, len);
 610
 611     for (i = 0; i < (int)len; i++)
 612     {
 613       if (chk[i] && (buffer[i] != data[i]))
 614         {
 615           gfc_error ("Overlapping unequal initializers in EQUIVALENCE "
 616                      "at %L", &e->where);
 617           return 0;
 618         }
 619       chk[i] = 0xFF;
 620     }
 621
 622   memcpy (data, buffer, len);
 623   return len;
 624 }
 625
 626
 627 /* Writes the values from the equivalence initializers to a char* array
 628    that will be written to the constructor to make the initializer for
 629    the union declaration.  */
 630
 631 size_t
 632 gfc_merge_initializers (gfc_typespec ts, gfc_expr *e, unsigned char *data,
 633                         unsigned char *chk, size_t length)
 634 {
 635   size_t len = 0;
 636   gfc_constructor * c;
 637
 638   switch (e->expr_type)
 639     {
 640     case EXPR_CONSTANT:
 641     case EXPR_STRUCTURE:
 642       len = expr_to_char (e, &data[0], &chk[0], length);
 643
 644       break;
 645
 646     case EXPR_ARRAY:
 647       for (c = e->value.constructor; c; c = c->next)
 648         {
 649           size_t elt_size = gfc_target_expr_size (c->expr);
 650
 651           if (c->n.offset)
 652             len = elt_size * (size_t)mpz_get_si (c->n.offset);
 653
 654           len = len + gfc_merge_initializers (ts, c->expr, &data[len],
 655                                               &chk[len], length - len);
 656         }
 657       break;
 658
 659     default:
 660       return 0;
 661     }
 662
 663   return len;
 664 }
 665
 666
 667 /* Transfer the bitpattern of a (integer) BOZ to real or complex variables.
 668    When successful, no BOZ or nothing to do, true is returned.  */
 669
 670 bool
 671 gfc_convert_boz (gfc_expr *expr, gfc_typespec *ts)
 672 {
 673   size_t buffer_size, boz_bit_size, ts_bit_size;
 674   int index;
 675   unsigned char *buffer;
 676
 677   if (!expr->is_boz)
 678     return true;
 679
 680   gcc_assert (expr->expr_type == EXPR_CONSTANT
 681               && expr->ts.type == BT_INTEGER);
 682
 683   /* Don't convert BOZ to logical, character, derived etc.  */
 684   if (ts->type == BT_REAL)
 685     {
 686       buffer_size = size_float (ts->kind);
 687       ts_bit_size = buffer_size * 8;
 688     }
 689   else if (ts->type == BT_COMPLEX)
 690     {
 691       buffer_size = size_complex (ts->kind);
 692       ts_bit_size = buffer_size * 8 / 2;
 693     }
 694   else
 695     return true;
 696
 697   /* Convert BOZ to the smallest possible integer kind.  */
 698   boz_bit_size = mpz_sizeinbase (expr->value.integer, 2);
 699
 700   if (boz_bit_size > ts_bit_size)
 701     {
 702       gfc_error_now ("BOZ constant at %L is too large (%ld vs %ld bits)",
 703                      &expr->where, (long) boz_bit_size, (long) ts_bit_size);
 704       return false;
 705     }
 706
 707   for (index = 0; gfc_integer_kinds[index].kind != 0; ++index)
 708     if ((unsigned) gfc_integer_kinds[index].bit_size >= ts_bit_size)
 709       break;
 710
 711   expr->ts.kind = gfc_integer_kinds[index].kind;
 712   buffer_size = MAX (buffer_size, size_integer (expr->ts.kind));
 713
 714   buffer = (unsigned char*)alloca (buffer_size);
 715   encode_integer (expr->ts.kind, expr->value.integer, buffer, buffer_size);
 716   mpz_clear (expr->value.integer);
 717
 718   if (ts->type == BT_REAL)
 719     {
 720       mpfr_init (expr->value.real);
 721       gfc_interpret_float (ts->kind, buffer, buffer_size, expr->value.real);
 722     }
 723   else
 724     {
 725       mpfr_init (expr->value.complex.r);
 726       mpfr_init (expr->value.complex.i);
 727       gfc_interpret_complex (ts->kind, buffer, buffer_size,
 728                              expr->value.complex.r, expr->value.complex.i);
 729     }
 730   expr->is_boz = 0;
 731   expr->ts.type = ts->type;
 732   expr->ts.kind = ts->kind;
 733
 734   return true;
 735 }