OSDN Git Service

2007-05-28 Tobias Schlter <tobi@gcc.gnu.org>
authortobi <tobi@138bc75d-0d04-0410-961f-82ee72b054a4>
Tue, 29 May 2007 09:03:03 +0000 (09:03 +0000)
committertobi <tobi@138bc75d-0d04-0410-961f-82ee72b054a4>
Tue, 29 May 2007 09:03:03 +0000 (09:03 +0000)
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.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@125161 138bc75d-0d04-0410-961f-82ee72b054a4

gcc/fortran/ChangeLog
gcc/fortran/check.c
gcc/fortran/gfortran.h
gcc/fortran/intrinsic.c
gcc/fortran/intrinsic.h
gcc/fortran/intrinsic.texi
gcc/fortran/trans-intrinsic.c
gcc/testsuite/ChangeLog
gcc/testsuite/gfortran.dg/sizeof.f90 [new file with mode: 0644]

index 8f0422e..65dfa5f 100644 (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.
index e229002..a196635 100644 (file)
@@ -2334,6 +2334,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)
 {
   if (type_check (seconds, 0, BT_INTEGER) == FAILURE)
index c7fa5f8..e64a995 100644 (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,
index d3392b0..3a72fc5 100644 (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);
index d4a4fc5..5bc4a85 100644 (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 *);
index 892fda5..aea18b1 100644 (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
index d814b28..4745a78 100644 (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;
index 6697e0d..696a478 100644 (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
diff --git a/gcc/testsuite/gfortran.dg/sizeof.f90 b/gcc/testsuite/gfortran.dg/sizeof.f90
new file mode 100644 (file)
index 0000000..35ea527
--- /dev/null
@@ -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