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