procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

gfortran.h (gfc_generic_isym_id): Add GFC_ISYM_SIZEOF.

Browse source 
2007-05-28  Tobias Schlter  <tobi@gcc.gnu.org>
fortran/
* gfortran.h (gfc_generic_isym_id): Add GFC_ISYM_SIZEOF.
* intrinsic.c (add_functions): Add stuff for SIZEOF intrinsic.
* intrinsic.h (gfc_check_sizeof): Add prototype of ...
* check.c (gfc_check_sizeof): .. new function.
* trans-intrinsic.c (gfc_conv_intrinsic_sizeof): New function.
(gfc_conv_intrinsic_strcmp): Whitespace fix.
(gfc_conv_intrinsic_array_transfer): Remove double initialization,
use fold_build. where appropriate.
(gfc_conv_intrinsic_function): Add case for SIZEOF.
* intrinsic.texi: Add documentation for SIZEOF.
testsuite/
* gfortran.dg/sizeof.f90: New.

From-SVN: r125161
This commit is contained in:
Tobias Schlüter 2007-05-29 11:03:03 +02:00
parent 9bd196f0e3
commit fd2157ce09
9 changed files with 261 additions and 25 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

13
gcc/fortran/ChangeLog
View file

@ -1,3 +1,16 @@
2007-05-28 Tobias Schlüter <tobi@gcc.gnu.org>
* gfortran.h (gfc_generic_isym_id): Add GFC_ISYM_SIZEOF.
* intrinsic.c (add_functions): Add stuff for SIZEOF intrinsic.
* intrinsic.h (gfc_check_sizeof): Add prototype of ...
* check.c (gfc_check_sizeof): .. new function.
* trans-intrinsic.c (gfc_conv_intrinsic_sizeof): New function.
(gfc_conv_intrinsic_strcmp): Whitespace fix.
(gfc_conv_intrinsic_array_transfer): Remove double initialization,
use fold_build. where appropriate.
(gfc_conv_intrinsic_function): Add case for SIZEOF.
* intrinsic.texi: Add documentation for SIZEOF.
2007-05-28 Brooks Moses <brooks.moses@codesourcery.com>
* trans-array.c (gfc_conv_expr_descriptor): Edit comment.

7
gcc/fortran/check.c
View file

@ -2333,6 +2333,13 @@ gfc_check_size (gfc_expr *array, gfc_expr *dim)
}
try
gfc_check_sizeof (gfc_expr *arg __attribute__((unused)))
{
return SUCCESS;
}
try
gfc_check_sleep_sub (gfc_expr *seconds)
{

1
gcc/fortran/gfortran.h
View file

@ -446,6 +446,7 @@ enum gfc_generic_isym_id
GFC_ISYM_SIN,
GFC_ISYM_SINH,
GFC_ISYM_SIZE,
GFC_ISYM_SIZEOF,
GFC_ISYM_SPACING,
GFC_ISYM_SPREAD,
GFC_ISYM_SQRT,

6
gcc/fortran/intrinsic.c
View file

@ -2138,6 +2138,12 @@ add_functions (void)
make_generic ("size", GFC_ISYM_SIZE, GFC_STD_F95);
add_sym_1 ("sizeof", NOT_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di,
GFC_STD_GNU, gfc_check_sizeof, NULL, NULL,
i, BT_INTEGER, di, REQUIRED);
make_generic ("sizeof", GFC_ISYM_SIZEOF, GFC_STD_GNU);
add_sym_1 ("spacing", ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
gfc_check_x, gfc_simplify_spacing, gfc_resolve_spacing,
x, BT_REAL, dr, REQUIRED);

1
gcc/fortran/intrinsic.h
View file

@ -121,6 +121,7 @@ try gfc_check_shape (gfc_expr *);
try gfc_check_size (gfc_expr *, gfc_expr *);
try gfc_check_sign (gfc_expr *, gfc_expr *);
try gfc_check_signal (gfc_expr *, gfc_expr *);
try gfc_check_sizeof (gfc_expr *);
try gfc_check_spread (gfc_expr *, gfc_expr *, gfc_expr *);
try gfc_check_srand (gfc_expr *);
try gfc_check_stat (gfc_expr *, gfc_expr *);

44
gcc/fortran/intrinsic.texi
View file

@ -222,6 +222,7 @@ Some basic guidelines for editing this document:
* @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
@ -9012,6 +9013,49 @@ END PROGRAM
@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

128
gcc/fortran/trans-intrinsic.c
View file

@ -2745,9 +2745,83 @@ gfc_conv_intrinsic_size (gfc_se * se, gfc_expr * expr)
}
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;
@ -2850,7 +2924,6 @@ gfc_conv_intrinsic_array_transfer (gfc_se * se, gfc_expr * expr)
}
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);
@ -2898,13 +2971,13 @@ gfc_conv_intrinsic_array_transfer (gfc_se * se, gfc_expr * 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);
}
}
@ -2964,17 +3037,18 @@ gfc_conv_intrinsic_array_transfer (gfc_se * se, gfc_expr * expr)
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
@ -2985,23 +3059,23 @@ gfc_conv_intrinsic_array_transfer (gfc_se * se, gfc_expr * expr)
{
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;
}
@ -3866,6 +3940,10 @@ gfc_conv_intrinsic_function (gfc_se * se, gfc_expr * expr)
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;

4
gcc/testsuite/ChangeLog
View file

@ -1,3 +1,7 @@
2007-05-29 Tobias Schlüter <tobi@gcc.gnu.org>
* gfortran.dg/sizeof.f90: New.
2007-05-28 Andrew Pinski <andrew_pinski@playstation.sony.com>
PR c/31339

82
gcc/testsuite/gfortran.dg/sizeof.f90 Normal file
View file

@ -0,0 +1,82 @@
! { 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