[patch] Implement sizeof intrinsic, a minor cleanups to trans-intrinsic.c

[patch] Implement sizeof intrinsic, a minor cleanups to trans-intrinsic.c

[Tobias Schlüter]

[-- Attachment #1: Type: text/plain, Size: 870 bytes --]


Hi,

the attached patch implements the SIZEOF intrinsic.  Since the code for 
determining the length is copied from the code for TRANSFER, I had a 
chance to look at that as well and noticed the complete lack of 
constant-folding in it as well as a redundant initialization, which I 
chose to fix.  The code could also be somewhat simplified, as I did in 
the version for SIZEOF, but for fear of introducing bugs, I didn't touch 
it.  I tried to avoid the redundancy between the two size-determination 
codes by merging them, but failed at doing so: I would have had to walk 
the expression twice in gfc_conv_intrinsic_array_transfer, which 
wouldn't have left me with much saved code.

The patch comes with a new testcase which exercises the stuff that 
should be platform independent.  Built and tested on i386-darwin.  I 
also checked make pdf.  Ok?

Cheers,
- Tobi

[-- Attachment #2: sizeof_final.diff.txt --]
[-- Type: text/plain, Size: 13362 bytes --]

2007-05-28  Tobias Schlüter  <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.

Index: fortran/gfortran.h
===================================================================
--- fortran/gfortran.h	(revision 125133)
+++ fortran/gfortran.h	(working copy)
@@ -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: fortran/intrinsic.c
===================================================================
--- fortran/intrinsic.c	(revision 125133)
+++ fortran/intrinsic.c	(working copy)
@@ -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: fortran/intrinsic.h
===================================================================
--- fortran/intrinsic.h	(revision 125133)
+++ fortran/intrinsic.h	(working copy)
@@ -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: fortran/check.c
===================================================================
--- fortran/check.c	(revision 125133)
+++ fortran/check.c	(working copy)
@@ -2334,6 +2334,13 @@ gfc_check_size (gfc_expr *array, gfc_exp
 
 
 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: fortran/trans-intrinsic.c
===================================================================
--- fortran/trans-intrinsic.c	(revision 125133)
+++ fortran/trans-intrinsic.c	(working copy)
@@ -2745,9 +2745,83 @@ gfc_conv_intrinsic_size (gfc_se * se, gf
 }
 
 
+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_s
     }
   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_s
 	  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_s
   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_s
     {
       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_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: fortran/intrinsic.texi
===================================================================
--- fortran/intrinsic.texi	(revision 125133)
+++ fortran/intrinsic.texi	(working copy)
@@ -222,6 +222,7 @@ Some basic guidelines for editing this d
 * @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: testsuite/gfortran.dg/sizeof.f90
===================================================================
--- testsuite/gfortran.dg/sizeof.f90	(revision 0)
+++ testsuite/gfortran.dg/sizeof.f90	(revision 0)
@@ -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

Re: [patch] Implement sizeof intrinsic, a minor cleanups to trans-intrinsic.c

[Tobias Schlüter]

Tobias Schlüter wrote:
> the attached patch implements the SIZEOF intrinsic.  Since the code for 
> determining the length is copied from the code for TRANSFER, I had a 
> chance to look at that as well and noticed the complete lack of 
> constant-folding in it as well as a redundant initialization, which I 
> chose to fix.  The code could also be somewhat simplified, as I did in 
> the version for SIZEOF, but for fear of introducing bugs, I didn't touch 
> it.  I tried to avoid the redundancy between the two size-determination 
> codes by merging them, but failed at doing so: I would have had to walk 
> the expression twice in gfc_conv_intrinsic_array_transfer, which 
> wouldn't have left me with much saved code.

I had this cooking for so long, that I forgot to mention that I didn't 
use the new frontend-stuff for sizing expressions because that only 
works for initialization expressions, not for general expressions (maybe 
this should be asserted in the code).  I should have also pointed out 
that this patch implements sizeof for all expressions as its argument, 
which seems to be what ifc does, even though its documentation sounds as 
if it only worked if the size could be determined at compile-time.

- Tobi

Re: [patch] Implement sizeof intrinsic, a minor cleanups to trans-intrinsic.c

[Paul Thomas]

Tobi,
>
>
> the attached patch implements the SIZEOF intrinsic.  Since the code 
> for determining the length is copied from the code for TRANSFER, I had 
> a chance to look at that as well and noticed the complete lack of 
> constant-folding in it as well as a redundant initialization, which I 
> chose to fix.  The code could also be
Ooops to the initialization.  OK for the constant folding.
> somewhat simplified, as I did in the version for SIZEOF, but for fear 
> of introducing bugs, I didn't touch it.  I tried to avoid the 
> redundancy between the two size-determination codes by merging them, 
> but failed at doing so: I would have had to walk the expression twice 
> in gfc_conv_intrinsic_array_transfer, which wouldn't have left me with 
> much saved code.
:-(
>
> The patch comes with a new testcase which exercises the stuff that 
> should be platform independent.  Built and tested on i386-darwin.  I 
> also checked make pdf.  Ok?
>
OK for trunk.

Thanks

Paul