1 /* Simulate storage of variables into target memory.
3 Free Software Foundation, Inc.
4 Contributed by Paul Thomas and Brooks Moses
6 This file is part of GCC.
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
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
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/>. */
30 #include "trans-const.h"
31 #include "trans-types.h"
32 #include "target-memory.h"
34 /* --------------------------------------------------------------- */
35 /* Calculate the size of an expression. */
38 size_array (gfc_expr *e)
41 size_t elt_size = gfc_target_expr_size (e->value.constructor->expr);
43 gfc_array_size (e, &array_size);
44 return (size_t)mpz_get_ui (array_size) * elt_size;
48 size_integer (int kind)
50 return GET_MODE_SIZE (TYPE_MODE (gfc_get_int_type (kind)));;
57 return GET_MODE_SIZE (TYPE_MODE (gfc_get_real_type (kind)));;
62 size_complex (int kind)
64 return 2 * size_float (kind);
69 size_logical (int kind)
71 return GET_MODE_SIZE (TYPE_MODE (gfc_get_logical_type (kind)));;
76 size_character (int length)
83 gfc_target_expr_size (gfc_expr *e)
87 gcc_assert (e != NULL);
89 if (e->expr_type == EXPR_ARRAY)
90 return size_array (e);
95 return size_integer (e->ts.kind);
97 return size_float (e->ts.kind);
99 return size_complex (e->ts.kind);
101 return size_logical (e->ts.kind);
103 return size_character (e->value.character.length);
105 return e->representation.length;
107 type = gfc_typenode_for_spec (&e->ts);
108 return int_size_in_bytes (type);
110 gfc_internal_error ("Invalid expression in gfc_target_expr_size.");
116 /* The encode_* functions export a value into a buffer, and
117 return the number of bytes of the buffer that have been
121 encode_array (gfc_expr *expr, unsigned char *buffer, size_t buffer_size)
127 gfc_array_size (expr, &array_size);
128 for (i = 0; i < (int)mpz_get_ui (array_size); i++)
130 ptr += gfc_target_encode_expr (gfc_get_array_element (expr, i),
131 &buffer[ptr], buffer_size - ptr);
134 mpz_clear (array_size);
140 encode_integer (int kind, mpz_t integer, unsigned char *buffer,
143 return native_encode_expr (gfc_conv_mpz_to_tree (integer, kind),
144 buffer, buffer_size);
149 encode_float (int kind, mpfr_t real, unsigned char *buffer, size_t buffer_size)
151 return native_encode_expr (gfc_conv_mpfr_to_tree (real, kind), buffer,
157 encode_complex (int kind, mpfr_t real, mpfr_t imaginary, unsigned char *buffer,
161 size = encode_float (kind, real, &buffer[0], buffer_size);
162 size += encode_float (kind, imaginary, &buffer[size], buffer_size - size);
168 encode_logical (int kind, int logical, unsigned char *buffer, size_t buffer_size)
170 return native_encode_expr (build_int_cst (gfc_get_logical_type (kind),
172 buffer, buffer_size);
177 encode_character (int length, char *string, unsigned char *buffer,
180 gcc_assert (buffer_size >= size_character (length));
181 memcpy (buffer, string, length);
187 encode_derived (gfc_expr *source, unsigned char *buffer, size_t buffer_size)
189 gfc_constructor *ctr;
194 type = gfc_typenode_for_spec (&source->ts);
196 ctr = source->value.constructor;
197 cmp = source->ts.derived->components;
198 for (;ctr; ctr = ctr->next, cmp = cmp->next)
203 ptr = TREE_INT_CST_LOW(DECL_FIELD_OFFSET(cmp->backend_decl))
204 + TREE_INT_CST_LOW(DECL_FIELD_BIT_OFFSET(cmp->backend_decl))/8;
205 gfc_target_encode_expr (ctr->expr, &buffer[ptr],
209 return int_size_in_bytes (type);
213 /* Write a constant expression in binary form to a buffer. */
215 gfc_target_encode_expr (gfc_expr *source, unsigned char *buffer,
221 if (source->expr_type == EXPR_ARRAY)
222 return encode_array (source, buffer, buffer_size);
224 gcc_assert (source->expr_type == EXPR_CONSTANT
225 || source->expr_type == EXPR_STRUCTURE);
227 /* If we already have a target-memory representation, we use that rather
228 than recreating one. */
229 if (source->representation.string)
231 memcpy (buffer, source->representation.string,
232 source->representation.length);
233 return source->representation.length;
236 switch (source->ts.type)
239 return encode_integer (source->ts.kind, source->value.integer, buffer,
242 return encode_float (source->ts.kind, source->value.real, buffer,
245 return encode_complex (source->ts.kind, source->value.complex.r,
246 source->value.complex.i, buffer, buffer_size);
248 return encode_logical (source->ts.kind, source->value.logical, buffer,
251 return encode_character (source->value.character.length,
252 source->value.character.string, buffer,
255 return encode_derived (source, buffer, buffer_size);
257 gfc_internal_error ("Invalid expression in gfc_target_encode_expr.");
264 interpret_array (unsigned char *buffer, size_t buffer_size, gfc_expr *result)
269 gfc_constructor *head = NULL, *tail = NULL;
271 /* Calculate array size from its shape and rank. */
272 gcc_assert (result->rank > 0 && result->shape);
274 for (i = 0; i < result->rank; i++)
275 array_size *= (int)mpz_get_ui (result->shape[i]);
277 /* Iterate over array elements, producing constructors. */
278 for (i = 0; i < array_size; i++)
281 head = tail = gfc_get_constructor ();
284 tail->next = gfc_get_constructor ();
288 tail->where = result->where;
289 tail->expr = gfc_constant_result (result->ts.type,
290 result->ts.kind, &result->where);
291 tail->expr->ts = result->ts;
293 if (tail->expr->ts.type == BT_CHARACTER)
294 tail->expr->value.character.length = result->value.character.length;
296 ptr += gfc_target_interpret_expr (&buffer[ptr], buffer_size - ptr,
299 result->value.constructor = head;
306 gfc_interpret_integer (int kind, unsigned char *buffer, size_t buffer_size,
310 gfc_conv_tree_to_mpz (integer,
311 native_interpret_expr (gfc_get_int_type (kind),
312 buffer, buffer_size));
313 return size_integer (kind);
318 gfc_interpret_float (int kind, unsigned char *buffer, size_t buffer_size,
322 gfc_conv_tree_to_mpfr (real,
323 native_interpret_expr (gfc_get_real_type (kind),
324 buffer, buffer_size));
326 return size_float (kind);
331 gfc_interpret_complex (int kind, unsigned char *buffer, size_t buffer_size,
332 mpfr_t real, mpfr_t imaginary)
335 size = gfc_interpret_float (kind, &buffer[0], buffer_size, real);
336 size += gfc_interpret_float (kind, &buffer[size], buffer_size - size, imaginary);
342 gfc_interpret_logical (int kind, unsigned char *buffer, size_t buffer_size,
345 tree t = native_interpret_expr (gfc_get_logical_type (kind), buffer,
347 *logical = double_int_zero_p (tree_to_double_int (t))
349 return size_logical (kind);
354 gfc_interpret_character (unsigned char *buffer, size_t buffer_size, gfc_expr *result)
356 if (result->ts.cl && result->ts.cl->length)
357 result->value.character.length =
358 (int)mpz_get_ui (result->ts.cl->length->value.integer);
360 gcc_assert (buffer_size >= size_character (result->value.character.length));
361 result->value.character.string =
362 gfc_getmem (result->value.character.length + 1);
363 memcpy (result->value.character.string, buffer,
364 result->value.character.length);
365 result->value.character.string [result->value.character.length] = '\0';
367 return result->value.character.length;
372 gfc_interpret_derived (unsigned char *buffer, size_t buffer_size, gfc_expr *result)
375 gfc_constructor *head = NULL, *tail = NULL;
379 /* The attributes of the derived type need to be bolted to the floor. */
380 result->expr_type = EXPR_STRUCTURE;
382 type = gfc_typenode_for_spec (&result->ts);
383 cmp = result->ts.derived->components;
385 /* Run through the derived type components. */
386 for (;cmp; cmp = cmp->next)
389 head = tail = gfc_get_constructor ();
392 tail->next = gfc_get_constructor ();
396 /* The constructor points to the component. */
397 tail->n.component = cmp;
399 tail->expr = gfc_constant_result (cmp->ts.type, cmp->ts.kind,
401 tail->expr->ts = cmp->ts;
403 /* Copy shape, if needed. */
404 if (cmp->as && cmp->as->rank)
408 tail->expr->expr_type = EXPR_ARRAY;
409 tail->expr->rank = cmp->as->rank;
411 tail->expr->shape = gfc_get_shape (tail->expr->rank);
412 for (n = 0; n < tail->expr->rank; n++)
414 mpz_init_set_ui (tail->expr->shape[n], 1);
415 mpz_add (tail->expr->shape[n], tail->expr->shape[n],
416 cmp->as->upper[n]->value.integer);
417 mpz_sub (tail->expr->shape[n], tail->expr->shape[n],
418 cmp->as->lower[n]->value.integer);
422 ptr = TREE_INT_CST_LOW (DECL_FIELD_OFFSET (cmp->backend_decl));
423 gfc_target_interpret_expr (&buffer[ptr], buffer_size - ptr,
426 result->value.constructor = head;
429 return int_size_in_bytes (type);
433 /* Read a binary buffer to a constant expression. */
435 gfc_target_interpret_expr (unsigned char *buffer, size_t buffer_size,
438 if (result->expr_type == EXPR_ARRAY)
439 return interpret_array (buffer, buffer_size, result);
441 switch (result->ts.type)
444 result->representation.length =
445 gfc_interpret_integer (result->ts.kind, buffer, buffer_size,
446 result->value.integer);
450 result->representation.length =
451 gfc_interpret_float (result->ts.kind, buffer, buffer_size,
456 result->representation.length =
457 gfc_interpret_complex (result->ts.kind, buffer, buffer_size,
458 result->value.complex.r,
459 result->value.complex.i);
463 result->representation.length =
464 gfc_interpret_logical (result->ts.kind, buffer, buffer_size,
465 &result->value.logical);
469 result->representation.length =
470 gfc_interpret_character (buffer, buffer_size, result);
474 result->representation.length =
475 gfc_interpret_derived (buffer, buffer_size, result);
479 gfc_internal_error ("Invalid expression in gfc_target_interpret_expr.");
483 if (result->ts.type == BT_CHARACTER)
484 result->representation.string = result->value.character.string;
487 result->representation.string =
488 gfc_getmem (result->representation.length + 1);
489 memcpy (result->representation.string, buffer,
490 result->representation.length);
491 result->representation.string[result->representation.length] = '\0';
494 return result->representation.length;
498 /* --------------------------------------------------------------- */
499 /* Two functions used by trans-common.c to write overlapping
500 equivalence initializers to a buffer. This is added to the union
501 and the original initializers freed. */
504 /* Writes the values of a constant expression to a char buffer. If another
505 unequal initializer has already been written to the buffer, this is an
509 expr_to_char (gfc_expr *e, unsigned char *data, unsigned char *chk, size_t len)
513 gfc_constructor *ctr;
515 unsigned char *buffer;
520 /* Take a derived type, one component at a time, using the offsets from the backend
522 if (e->ts.type == BT_DERIVED)
524 ctr = e->value.constructor;
525 cmp = e->ts.derived->components;
526 for (;ctr; ctr = ctr->next, cmp = cmp->next)
528 gcc_assert (cmp && cmp->backend_decl);
531 ptr = TREE_INT_CST_LOW(DECL_FIELD_OFFSET(cmp->backend_decl))
532 + TREE_INT_CST_LOW(DECL_FIELD_BIT_OFFSET(cmp->backend_decl))/8;
533 expr_to_char (ctr->expr, &data[ptr], &chk[ptr], len);
538 /* Otherwise, use the target-memory machinery to write a bitwise image, appropriate
539 to the target, in a buffer and check off the initialized part of the buffer. */
540 len = gfc_target_expr_size (e);
541 buffer = (unsigned char*)alloca (len);
542 len = gfc_target_encode_expr (e, buffer, len);
544 for (i = 0; i < (int)len; i++)
546 if (chk[i] && (buffer[i] != data[i]))
548 gfc_error ("Overlapping unequal initializers in EQUIVALENCE "
555 memcpy (data, buffer, len);
560 /* Writes the values from the equivalence initializers to a char* array
561 that will be written to the constructor to make the initializer for
562 the union declaration. */
565 gfc_merge_initializers (gfc_typespec ts, gfc_expr *e, unsigned char *data,
566 unsigned char *chk, size_t length)
571 switch (e->expr_type)
575 len = expr_to_char (e, &data[0], &chk[0], length);
580 for (c = e->value.constructor; c; c = c->next)
582 size_t elt_size = gfc_target_expr_size (c->expr);
585 len = elt_size * (size_t)mpz_get_si (c->n.offset);
587 len = len + gfc_merge_initializers (ts, c->expr, &data[len],
588 &chk[len], length - len);