[RFH] ME optimizes variable assignment away / Fortran bind(C) descriptor conversion

Tobias Burnus tobias@codesourcery.com
Fri Aug 27 15:47:58 GMT 2021


Hi all,

Background: gfortran has its own array descriptor – and one which is defined in
F2018 and used/usable from C (#include <ISO_Fortran_binding.h>).
On mainline, the conversion is done via a void* pointer and calls to libgfortran,
which causes all kind of issues, including alias issues but also data type/bounds
issues etc.

The attached patch tries to do this inline - and defines in the FE a proper
type for the C descriptor.  ("CFI_cdesc_t" has a 'dim[]' as last member,
'CFI_cdesc_t01' has dim[1].)


But but I have a ME optimization issue, which removes an crucial
assignment - any help/suggestion is welcome!
(Additionally, there is room for improvement regarding the debugging
experience. Suggestions are welcome as well, but it is not as crucial.)


Do you have any suggestion or idea what goes wrong?


It looks really nice with "-O1 -fno-inline"   :-)
   The callee 'rank_p()' is mostly optimized and in the
   caller only those struct elements are set, which are used:

integer(kind=4) rank_p (struct CFI_cdesc_t & _this)
{
   _1 = _this_11(D)->base_addr;
   _2 = _this_11(D)->rank;
...
   rnk_13 = (integer(kind=4)) _2;
   return rnk_13;
}

void selr_p ()
{
...
   struct CFI_cdesc_t01 cfi.7;
...
   <bb 2> [local count: 537730764]:
   cfi.7.rank = 1;
   cfi.7.base_addr = 0B;
   irnk_45 = rank_p (&cfi.7);
   cfi.7 ={v} {CLOBBER};
   if (irnk_45 != 1)


BUT BAD RESULT with -O2 -fno-inline  :-(
   The assignments on the caller side are gone,
   which causes wrong code (run stops with 'stop 1'):

integer(kind=4) rank_p (struct CFI_cdesc_t & _this)
{
...
   <bb 2> [local count: 1073741824]:
   _1 = _this_3(D)->rank;
   rnk_4 = (integer(kind=4)) _1;
   return rnk_4;
}

void selr_p ()
{
...
   struct CFI_cdesc_t01 cfi.7;
...
   <bb 2> [local count: 537730764]:
   irnk_30 = rank_p (&cfi.7);   ! <<<< ERROR: cfi.7.rank assignment missing
   cfi.7 ={v} {CLOBBER};
   if (irnk_30 != 1)

  *  *  *

Any idea / suggestion?

  *  *  *

* trans-type.c defines the new type
* trans-decl.c handles the conversion from C descriptor to Fortran descriptor in the callee
* trans-expr.c handles the conversion to the C descriptor in the callee

Attached:
* Testcase 'test.f90'
   - original dump
   - -O1 -fno-inline optimized dump
   - -O2 -fno-inline optimized dump
* Full patch
   - Testcase is lightly modified gfortran.dg/PR93963.f90

Tobias

  *  *  *

PS: Current GCC (mainline w/o patch) generates the following.
[-> with patch, see a-test.f90.*.original.]

Namely, for the callee, casting the argument
   (in reality pointer to a CFI descriptor,
    but TREE_TYPE (PARM_DECL) is ptr to Fortran descriptor)
to 'void *', passing it to a library function, which creates
a new Fortran descriptor and pointer-assigning it to
the PARM_DECL pointer, which now points to a Fortran
descriptor:

integer(kind=4) rank_p (struct array15_integer(kind=4) & this)
{
    gfc_desc_ptr.1 = &gfc_desc.0;
    CFI_desc_ptr.2 = (void *) this;
    _gfortran_cfi_desc_to_gfc_desc (gfc_desc_ptr.1, &CFI_desc_ptr.2);
    this = (struct array15_integer(kind=4) &) gfc_desc_ptr.1;
    rnk = (integer(kind=4)) this->dtype.rank;
...
void selr_p ()
{
   struct array01_integer(kind=4) intp;
   integer(kind=4) irnk;
   static integer(kind=4) rnk = 1;

   intp.dtype = {.elem_len=4, .rank=1, .type=1};
   intp.span = 0;
...
     _gfortran_gfc_desc_to_cfi_desc (&cfi.3, &intp);
     intp.dtype.attribute = 0;
     irnk = rank_p (cfi.3);
     __builtin_free (cfi.3);

  *  *  *

-----------------
Siemens Electronic Design Automation GmbH; Anschrift: Arnulfstraße 201, 80634 München; Gesellschaft mit beschränkter Haftung; Geschäftsführer: Thomas Heurung, Frank Thürauf; Sitz der Gesellschaft: München; Registergericht München, HRB 106955
-------------- next part --------------
A non-text attachment was scrubbed...
Name: test.f90
Type: text/x-fortran
Size: 592 bytes
Desc: not available
URL: <https://gcc.gnu.org/pipermail/gcc-patches/attachments/20210827/f40d4c79/attachment-0002.bin>
-------------- next part --------------
__attribute__((fn spec (". . ")))
integer(kind=4) rank_p (struct array15_integer(kind=4) & this)
{
  struct array15_integer(kind=4) gfc_desc.0;
  struct array15_integer(kind=4) * gfc_desc_ptr.1;
  void * CFI_desc_ptr.2;
  integer(kind=4) rnk;

  if (this != 0)
    {
      gfc_desc_ptr.1 = &gfc_desc.0;
      CFI_desc_ptr.2 = (void *) this;
      _gfortran_cfi_desc_to_gfc_desc (gfc_desc_ptr.1, &CFI_desc_ptr.2);
      this = (struct array15_integer(kind=4) &) gfc_desc_ptr.1;
    }
  rnk = (integer(kind=4)) this->dtype.rank;
  return rnk;
}


__attribute__((fn spec (". ")))
void selr_p ()
{
  struct array01_integer(kind=4) intp;
  integer(kind=4) irnk;
  static integer(kind=4) rnk = 1;

  intp.dtype = {.elem_len=4, .rank=1, .type=1};
  intp.span = 0;
  intp.data = 0B;
  {
    void * cfi.3;

    if ((integer(kind=4)[0:] *) intp.data == 0B)
      {
        intp.dtype = {.elem_len=4, .rank=1, .type=1};
      }
    intp.span = (integer(kind=8)) intp.dtype.elem_len;
    intp.dtype.attribute = 0;
    cfi.3 = 0B;
    _gfortran_gfc_desc_to_cfi_desc (&cfi.3, &intp);
    intp.dtype.attribute = 0;
    irnk = rank_p (cfi.3);
    __builtin_free (cfi.3);
  }
  if (irnk != rnk)
    {
      _gfortran_stop_numeric (1, 0);
    }
  L.1:;
  if (irnk != 1)
    {
      _gfortran_stop_numeric (2, 0);
    }
  L.2:;
}


__attribute__((externally_visible))
integer(kind=4) main (integer(kind=4) argc, character(kind=1) * * argv)
{
  static integer(kind=4) options.4[7] = {2116, 4095, 0, 1, 1, 0, 31};

  _gfortran_set_args (argc, argv);
  _gfortran_set_options (7, &options.4[0]);
  selr_p ();
  return 0;
}


-------------- next part --------------

;; Function rank_p (rank_p, funcdef_no=0, decl_uid=3946, cgraph_uid=1, symbol_order=0)

Removing basic block 6
Removing basic block 7
Removing basic block 8
Removing basic block 9
Removing basic block 10
__attribute__((fn spec (". . ")))
integer(kind=4) rank_p (struct CFI_cdesc_t & _this)
{
  unsigned int ivtmp.17;
  integer(kind=4) rnk;
  void * _1;
  signed char _2;
  signed char _4;

  <bb 2> [local count: 168730857]:
  _1 = _this_11(D)->base_addr;
  _2 = _this_11(D)->rank;
  if (_1 != 0B)
    goto <bb 3>; [70.00%]
  else
    goto <bb 5>; [30.00%]

  <bb 3> [local count: 118111600]:
  if (_2 <= 0)
    goto <bb 5>; [11.00%]
  else
    goto <bb 4>; [89.00%]

  <bb 4> [local count: 955630226]:
  # ivtmp.17_9 = PHI <ivtmp.17_6(4), 0(3)>
  ivtmp.17_6 = ivtmp.17_9 + 1;
  _4 = (signed char) ivtmp.17_6;
  if (_2 <= _4)
    goto <bb 5>; [11.00%]
  else
    goto <bb 4>; [89.00%]

  <bb 5> [local count: 168730857]:
  rnk_13 = (integer(kind=4)) _2;
  return rnk_13;

}



;; Function selr_p (MAIN__, funcdef_no=1, decl_uid=3970, cgraph_uid=2, symbol_order=1) (executed once)

__attribute__((fn spec (". ")))
void selr_p ()
{
  struct CFI_cdesc_t01 cfi.2;
  integer(kind=4) irnk;

  <bb 2> [local count: 1073741824]:
  cfi.2.rank = 1;
  cfi.2.base_addr = 0B;
  irnk_6 = rank_p (&cfi.2);
  cfi.2 ={v} {CLOBBER};
  if (irnk_6 != 1)
    goto <bb 3>; [0.04%]
  else
    goto <bb 4>; [99.96%]

  <bb 3> [local count: 429496]:
  _gfortran_stop_numeric (1, 0);

  <bb 4> [local count: 1072883005]:
  return;

}



;; Function main (main, funcdef_no=2, decl_uid=4000, cgraph_uid=3, symbol_order=2) (executed once)

__attribute__((externally_visible))
integer(kind=4) main (integer(kind=4) argc, character(kind=1) * * argv)
{
  static integer(kind=4) options.4[7] = {2116, 4095, 0, 1, 1, 0, 31};

  <bb 2> [local count: 1073741824]:
  _gfortran_set_args (argc_2(D), argv_3(D));
  _gfortran_set_options (7, &options.4[0]);
  selr_p ();
  return 0;

}


-------------- next part --------------

;; Function rank_p (rank_p, funcdef_no=0, decl_uid=3946, cgraph_uid=1, symbol_order=0)

__attribute__((fn spec (". . ")))
integer(kind=4) rank_p (struct CFI_cdesc_t & _this)
{
  integer(kind=4) rnk;
  signed char _1;

  <bb 2> [local count: 1073741824]:
  _1 = _this_3(D)->rank;
  rnk_4 = (integer(kind=4)) _1;
  return rnk_4;

}



;; Function selr_p (MAIN__, funcdef_no=1, decl_uid=3970, cgraph_uid=2, symbol_order=1) (executed once)

__attribute__((fn spec (". ")))
void selr_p ()
{
  struct CFI_cdesc_t01 cfi.2;
  integer(kind=4) irnk;

  <bb 2> [local count: 1073741824]:
  irnk_3 = rank_p (&cfi.2);
  cfi.2 ={v} {CLOBBER};
  if (irnk_3 != 1)
    goto <bb 3>; [0.04%]
  else
    goto <bb 4>; [99.96%]

  <bb 3> [local count: 429496]:
  _gfortran_stop_numeric (1, 0);

  <bb 4> [local count: 1072883005]:
  return;

}



;; Function main (main, funcdef_no=2, decl_uid=4000, cgraph_uid=3, symbol_order=2) (executed once)

__attribute__((externally_visible))
integer(kind=4) main (integer(kind=4) argc, character(kind=1) * * argv)
{
  static integer(kind=4) options.4[7] = {2116, 4095, 0, 1, 1, 0, 31};

  <bb 2> [local count: 1073741824]:
  _gfortran_set_args (argc_2(D), argv_3(D));
  _gfortran_set_options (7, &options.4[0]);
  selr_p ();
  return 0;

}


-------------- next part --------------
A non-text attachment was scrubbed...
Name: cfi-fortran-descriptor.diff
Type: text/x-patch
Size: 90301 bytes
Desc: not available
URL: <https://gcc.gnu.org/pipermail/gcc-patches/attachments/20210827/f40d4c79/attachment-0003.bin>


More information about the Gcc-patches mailing list