* @code{SIN}: SIN, Sine function
* @code{SINH}: SINH, Hyperbolic sine function
* @code{SIZE}: SIZE, Function to determine the size of an array
+* @code{SIZEOF}: SIZEOF, Determine the size in bytes of an expression
* @code{SLEEP}: SLEEP, Sleep for the specified number of seconds
* @code{SNGL}: SNGL, Convert double precision real to default real
* @code{SPACING}: SPACING, Smallest distance between two numbers of a given type
@end table
+@node SIZEOF
+@section @code{SIZEOF} --- Size in bytes of an expression
+@fnindex SIZEOF
+@cindex expression size
+@cindex size of an expression
+
+@table @asis
+@item @emph{Description}:
+@code{SIZEOF(X)} calculates the number of bytes of storage the
+expression @code{X} occupies.
+
+@item @emph{Standard}:
+GNU extension
+
+@item @emph{Class}:
+Intrinsic function
+
+@item @emph{Syntax}:
+@code{N = SIZEOF(X)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{X} @tab The argument shall be of any type, rank or shape.
+@end multitable
+
+@item @emph{Return value}:
+The return value is of type integer. Its value is the number of bytes
+occupied by the argument. If the argument has the @code{POINTER}
+attribute, the number of bytes of the storage area pointed to is
+returned. If the argument is of a derived type with @code{POINTER} or
+@code{ALLOCATABLE} components, the return value doesn't account for
+the sizes of the data pointed to by these components.
+
+@item @emph{Example}:
+@smallexample
+ integer :: i
+ real :: r, s(5)
+ print *, (sizeof(s)/sizeof(r) == 5)
+ end
+@end smallexample
+The example will print @code{.TRUE.} unless you are using a platform
+where default @code{REAL} variables are unusually padded.
+@end table
@node SLEEP
@section @code{SLEEP} --- Sleep for the specified number of seconds
}
+static void
+gfc_conv_intrinsic_sizeof (gfc_se *se, gfc_expr *expr)
+{
+ gfc_expr *arg;
+ gfc_ss *ss;
+ gfc_se argse;
+ tree source;
+ tree source_bytes;
+ tree type;
+ tree tmp;
+ tree lower;
+ tree upper;
+ /*tree stride;*/
+ int n;
+
+ arg = expr->value.function.actual->expr;
+
+ gfc_init_se (&argse, NULL);
+ ss = gfc_walk_expr (arg);
+
+ source_bytes = gfc_create_var (gfc_array_index_type, "bytes");
+
+ if (ss == gfc_ss_terminator)
+ {
+ gfc_conv_expr_reference (&argse, arg);
+ source = argse.expr;
+
+ type = TREE_TYPE (build_fold_indirect_ref (argse.expr));
+
+ /* Obtain the source word length. */
+ if (arg->ts.type == BT_CHARACTER)
+ source_bytes = fold_convert (gfc_array_index_type,
+ argse.string_length);
+ else
+ source_bytes = fold_convert (gfc_array_index_type,
+ size_in_bytes (type));
+ }
+ else
+ {
+ argse.want_pointer = 0;
+ gfc_conv_expr_descriptor (&argse, arg, ss);
+ source = gfc_conv_descriptor_data_get (argse.expr);
+ type = gfc_get_element_type (TREE_TYPE (argse.expr));
+
+ /* Obtain the argument's word length. */
+ if (arg->ts.type == BT_CHARACTER)
+ tmp = fold_convert (gfc_array_index_type, argse.string_length);
+ else
+ tmp = fold_convert (gfc_array_index_type,
+ size_in_bytes (type));
+ gfc_add_modify_expr (&argse.pre, source_bytes, tmp);
+
+ /* Obtain the size of the array in bytes. */
+ for (n = 0; n < arg->rank; n++)
+ {
+ tree idx;
+ idx = gfc_rank_cst[n];
+ lower = gfc_conv_descriptor_lbound (argse.expr, idx);
+ upper = gfc_conv_descriptor_ubound (argse.expr, idx);
+ tmp = fold_build2 (MINUS_EXPR, gfc_array_index_type,
+ upper, lower);
+ tmp = fold_build2 (PLUS_EXPR, gfc_array_index_type,
+ tmp, gfc_index_one_node);
+ tmp = fold_build2 (MULT_EXPR, gfc_array_index_type,
+ tmp, source_bytes);
+ gfc_add_modify_expr (&argse.pre, source_bytes, tmp);
+ }
+ }
+
+ gfc_add_block_to_block (&se->pre, &argse.pre);
+ se->expr = source_bytes;
+}
+
+
/* Intrinsic string comparison functions. */
- static void
+static void
gfc_conv_intrinsic_strcmp (gfc_se * se, gfc_expr * expr, int op)
{
tree type;
}
else
{
- gfc_init_se (&argse, NULL);
argse.want_pointer = 0;
gfc_conv_expr_descriptor (&argse, arg->expr, ss);
source = gfc_conv_descriptor_data_get (argse.expr);
stride = gfc_conv_descriptor_stride (argse.expr, idx);
lower = gfc_conv_descriptor_lbound (argse.expr, idx);
upper = gfc_conv_descriptor_ubound (argse.expr, idx);
- tmp = build2 (MINUS_EXPR, gfc_array_index_type,
- upper, lower);
+ tmp = fold_build2 (MINUS_EXPR, gfc_array_index_type,
+ upper, lower);
gfc_add_modify_expr (&argse.pre, extent, tmp);
- tmp = build2 (PLUS_EXPR, gfc_array_index_type,
- extent, gfc_index_one_node);
- tmp = build2 (MULT_EXPR, gfc_array_index_type,
- tmp, source_bytes);
+ tmp = fold_build2 (PLUS_EXPR, gfc_array_index_type,
+ extent, gfc_index_one_node);
+ tmp = fold_build2 (MULT_EXPR, gfc_array_index_type,
+ tmp, source_bytes);
}
}
size_bytes = gfc_create_var (gfc_array_index_type, NULL);
if (tmp != NULL_TREE)
{
- tmp = build2 (MULT_EXPR, gfc_array_index_type,
- tmp, dest_word_len);
- tmp = build2 (MIN_EXPR, gfc_array_index_type, tmp, source_bytes);
+ tmp = fold_build2 (MULT_EXPR, gfc_array_index_type,
+ tmp, dest_word_len);
+ tmp = fold_build2 (MIN_EXPR, gfc_array_index_type,
+ tmp, source_bytes);
}
else
tmp = source_bytes;
gfc_add_modify_expr (&se->pre, size_bytes, tmp);
gfc_add_modify_expr (&se->pre, size_words,
- build2 (CEIL_DIV_EXPR, gfc_array_index_type,
- size_bytes, dest_word_len));
+ fold_build2 (CEIL_DIV_EXPR, gfc_array_index_type,
+ size_bytes, dest_word_len));
/* Evaluate the bounds of the result. If the loop range exists, we have
to check if it is too large. If so, we modify loop->to be consistent
{
tmp = fold_build2 (MINUS_EXPR, gfc_array_index_type,
se->loop->to[n], se->loop->from[n]);
- tmp = build2 (PLUS_EXPR, gfc_array_index_type,
- tmp, gfc_index_one_node);
- tmp = build2 (MIN_EXPR, gfc_array_index_type,
- tmp, size_words);
+ tmp = fold_build2 (PLUS_EXPR, gfc_array_index_type,
+ tmp, gfc_index_one_node);
+ tmp = fold_build2 (MIN_EXPR, gfc_array_index_type,
+ tmp, size_words);
gfc_add_modify_expr (&se->pre, size_words, tmp);
gfc_add_modify_expr (&se->pre, size_bytes,
- build2 (MULT_EXPR, gfc_array_index_type,
- size_words, dest_word_len));
- upper = build2 (PLUS_EXPR, gfc_array_index_type,
- size_words, se->loop->from[n]);
- upper = build2 (MINUS_EXPR, gfc_array_index_type,
- upper, gfc_index_one_node);
+ fold_build2 (MULT_EXPR, gfc_array_index_type,
+ size_words, dest_word_len));
+ upper = fold_build2 (PLUS_EXPR, gfc_array_index_type,
+ size_words, se->loop->from[n]);
+ upper = fold_build2 (MINUS_EXPR, gfc_array_index_type,
+ upper, gfc_index_one_node);
}
else
{
- upper = build2 (MINUS_EXPR, gfc_array_index_type,
- size_words, gfc_index_one_node);
+ upper = fold_build2 (MINUS_EXPR, gfc_array_index_type,
+ size_words, gfc_index_one_node);
se->loop->from[n] = gfc_index_zero_node;
}
gfc_conv_intrinsic_size (se, expr);
break;
+ case GFC_ISYM_SIZEOF:
+ gfc_conv_intrinsic_sizeof (se, expr);
+ break;
+
case GFC_ISYM_SUM:
gfc_conv_intrinsic_arith (se, expr, PLUS_EXPR);
break;
--- /dev/null
+! { dg-do run }
+! Verify that the sizeof intrinsic does as advertised
+subroutine check_int (j)
+ INTEGER(4) :: i, ia(5), ib(5,4), ip, ipa(:)
+ target :: ib
+ POINTER :: ip, ipa
+ logical :: l(6)
+ integer(8) :: jb(5,4)
+
+ if (sizeof (j) /= sizeof (i)) call abort
+ if (sizeof (jb) /= 2*sizeof (ib)) call abort
+
+ ipa=>ib(2:3,1)
+
+ l = (/ sizeof(i) == 4, sizeof(ia) == 20, sizeof(ib) == 80, &
+ sizeof(ip) == 4, sizeof(ipa) == 8, sizeof(ib(1:5:2,3)) == 12 /)
+
+ if (any(.not.l)) call abort
+ if (sizeof(l) /= 6*sizeof(l(1))) call abort
+end subroutine check_int
+
+subroutine check_real (x, y)
+ dimension y(5)
+ real(4) :: r(20,20,20), rp(:,:)
+ target :: r
+ pointer :: rp
+ double precision :: d(5,5)
+ complex :: c(5)
+
+ if (sizeof (y) /= 5*sizeof (x)) call abort
+
+ if (sizeof (r) /= 8000*4) call abort
+ rp => r(5,2:10,1:5)
+ if (sizeof (rp) /= 45*4) call abort
+ rp => r(1:5,1:5,1)
+ if (sizeof (d) /= 2*sizeof (rp)) call abort
+ if (sizeof (c(1)) /= 2*sizeof(r(1,1,1))) call abort
+end subroutine check_real
+
+subroutine check_derived ()
+ type dt
+ integer i
+ end type dt
+ type (dt) :: a
+ integer :: i
+ type foo
+ integer :: i(5000)
+ real :: j(5)
+ type(dt) :: d
+ end type foo
+ type bar
+ integer :: j(5000)
+ real :: k(5)
+ type(dt) :: d
+ end type bar
+ type (foo) :: oof
+ type (bar) :: rab
+ integer(8) :: size_500, size_200, sizev500, sizev200
+ type all
+ real, allocatable :: r(:)
+ end type all
+ real :: r(200), s(500)
+ type(all) :: v
+
+ if (sizeof(a) /= sizeof(i)) call abort
+ if (sizeof(oof) /= sizeof(rab)) call abort
+ allocate (v%r(500))
+ sizev500 = sizeof (v)
+ size_500 = sizeof (v%r)
+ deallocate (v%r)
+ allocate (v%r(200))
+ sizev200 = sizeof (v)
+ size_200 = sizeof (v%r)
+ deallocate (v%r)
+ if (size_500 - size_200 /= sizeof(s) - sizeof(r) .or. sizev500 /= sizev200) &
+ call abort
+end subroutine check_derived
+
+call check_int ()
+call check_real ()
+call check_derived ()
+end
projects / gcc.git / commitdiff