openmpi/ompi/mpi/f90/xml/chasm-mpi.i.f90.xsl

<!--
 ...........................................................................
 Copyright (c) 2004-2006 The Regents of the University of California.
                         All rights reserved.
 $COPYRIGHT$
 
 Additional copyrights may follow
 
 $HEADER$
 ...........................................................................
 -->

<!--
  - chasm-mpi.f90.xsl: creates F90 functions that call MPI equivalent
  -
  - Output should be directed to the file, Method_f90.f90
  -->

<xsl:stylesheet xmlns:xsl="http://www.w3.org/1999/XSL/Transform" version="1.0">

<xsl:import href="common.xsl"/>
<xsl:import href="common-C.xsl"/>
<xsl:import href="common-f90.xsl"/>

<xsl:output method="text"/>

<!-- global variables -->

<xsl:variable name="filename">
  <xsl:call-template name="lower-case">
    <xsl:with-param name="symbol" select="/library/scope/@name"/>
  </xsl:call-template>
  <xsl:text>_C.c</xsl:text>
</xsl:variable>

<xsl:variable name="header_file">
  <xsl:call-template name="lower-case">
    <xsl:with-param name="symbol" select="/library/scope/@name"/>
  </xsl:call-template>
  <xsl:text>_C.h</xsl:text>
</xsl:variable>


<!--
  - root level
  -->
<xsl:template match="/">
  <xsl:call-template name="openFile">
    <xsl:with-param name="filename" select="$filename"/>
  </xsl:call-template>

  <!-- output all include files -->

  <xsl:call-template name="include-files">
    <xsl:with-param name="filename" select="$filename"/>
  </xsl:call-template>

  <!-- define C bridging functions -->

  <xsl:for-each select="library/scope">
    <xsl:call-template name="defineFunctions"/>
  </xsl:for-each>

  <xsl:call-template name="closeFile">
    <xsl:with-param name="filename" select="$filename"/>
  </xsl:call-template>
</xsl:template>


<!--
  - defineFunctions: define functions to call Fortran procedures <scope>
  -->
<xsl:template name="defineFunctions">
  <xsl:param name="module" select="@name"/>
  <xsl:for-each select="method">

   <xsl:if test="@kind != 'No_F90'">

    <xsl:choose>
      <xsl:when test="@template = 'yes'">
        <xsl:call-template name="defineArrayFunctionBody"/>
      </xsl:when>
      <xsl:otherwise>
        <xsl:call-template name="defineFunctionBody"/>
      </xsl:otherwise>
    </xsl:choose>

   </xsl:if>
  </xsl:for-each>

</xsl:template>


<!--
  - defineFunctionBody
  -->
<xsl:template name="defineFunctionBody">

<xsl:text>
#------------------------------------------------------------------------

output_</xsl:text>  <xsl:number/>  <xsl:text>() {
    if test "$output" = "0"; then
        return 0
    fi

    procedure=$1
    cat &lt;&lt;EOF

</xsl:text>

    <xsl:text>subroutine ${procedure}(</xsl:text>
    <xsl:call-template name="arg-list"/> <xsl:text>)</xsl:text>
    <xsl:value-of select="$nl"/>
    <xsl:text>  include 'mpif.h'</xsl:text>
    <xsl:value-of select="$nl"/>
    <xsl:call-template name="decl-construct-list">
      <xsl:with-param name="ws" select="''"/>
      <xsl:with-param name="void_type" select="''"/>
      <xsl:with-param name="void_kind" select="''"/>
    </xsl:call-template>

    <xsl:for-each select="return[1]">
      <xsl:if test="@name = 'ierr'">
       <xsl:text>  integer, intent(out) :: ierr</xsl:text>
      </xsl:if>
    </xsl:for-each>

<xsl:text>
end subroutine ${procedure}

EOF
}

start </xsl:text>
    <xsl:choose>
      <xsl:when test="@interface != ''">
        <xsl:value-of select="@interface"/>
      </xsl:when>
      <xsl:otherwise>
        <xsl:value-of select="@name"/>
      </xsl:otherwise>
    </xsl:choose>
    <xsl:text> </xsl:text>
    <xsl:call-template name="interface-size"/>
<xsl:text>
output_</xsl:text>  <xsl:number/>  <xsl:text> </xsl:text>
<xsl:value-of select="@name"/>  <xsl:text>
end </xsl:text>
    <xsl:choose>
      <xsl:when test="@interface != ''">
        <xsl:value-of select="@interface"/>
      </xsl:when>
      <xsl:otherwise>
        <xsl:value-of select="@name"/>
      </xsl:otherwise>
    </xsl:choose>
    <xsl:value-of select="$nl"/>

</xsl:template>


<!--
  - defineArrayFunctionBody
  -->
<xsl:template name="defineArrayFunctionBody">

<xsl:text>
#------------------------------------------------------------------------

output_</xsl:text>  <xsl:number/>  <xsl:text>() {
    if test "$output" = "0"; then
        return 0
    fi

    procedure=$1
    rank=$2
    type=$4
    proc="$1$2D$3"
    cat &lt;&lt;EOF

</xsl:text>

    <xsl:text>subroutine ${proc}(</xsl:text>
    <xsl:call-template name="arg-list"/> <xsl:text>)</xsl:text>
    <xsl:value-of select="$nl"/>
    <xsl:text>  include 'mpif.h'</xsl:text>
    <xsl:value-of select="$nl"/>
    <xsl:call-template name="decl-construct-list">
      <xsl:with-param name="ws" select="''"/>
      <xsl:with-param name="void_type" select="'logical'"/>
      <xsl:with-param name="void_kind" select="'INTEGER'"/>
      <xsl:with-param name="has_dim" select="0"/>
    </xsl:call-template>

    <xsl:for-each select="return[1]">
      <xsl:if test="@name = 'ierr'">
       <xsl:text>  integer, intent(out) :: ierr</xsl:text>
      </xsl:if>
    </xsl:for-each>

<xsl:text>
end subroutine ${proc}

EOF
}

start </xsl:text>  <xsl:value-of select="@name"/>  <xsl:text> </xsl:text>
<xsl:call-template name="interface-size"/>
<xsl:value-of select="$nl"/>

<xsl:text>
for rank in $allranks
do
  case "$rank" in  0)  dim=''  ;  esac
  case "$rank" in  1)  dim=', dimension(:)'  ;  esac
  case "$rank" in  2)  dim=', dimension(:,:)'  ;  esac
  case "$rank" in  3)  dim=', dimension(:,:,:)'  ;  esac
  case "$rank" in  4)  dim=', dimension(:,:,:,:)'  ;  esac
  case "$rank" in  5)  dim=', dimension(:,:,:,:,:)'  ;  esac
  case "$rank" in  6)  dim=', dimension(:,:,:,:,:,:)'  ;  esac
  case "$rank" in  7)  dim=', dimension(:,:,:,:,:,:,:)'  ;  esac

  output_</xsl:text>  <xsl:number/>  <xsl:text> </xsl:text>
  <xsl:value-of select="@name"/>
  <xsl:text> ${rank} CH "character${dim}"
  output_</xsl:text>  <xsl:number/>  <xsl:text> </xsl:text>
  <xsl:value-of select="@name"/>
  <xsl:text> ${rank} L "logical${dim}"
  for kind in $ikinds
  do
    output_</xsl:text>  <xsl:number/>  <xsl:text> </xsl:text>
    <xsl:value-of select="@name"/>
  <xsl:text> ${rank} I${kind} "integer*${kind}${dim}"
  done
  for kind in $rkinds
  do
    output_</xsl:text>  <xsl:number/>  <xsl:text> </xsl:text>
    <xsl:value-of select="@name"/>
    <xsl:text> ${rank} R${kind} "real*${kind}${dim}"
  done
  for kind in $ckinds
  do
    output_</xsl:text>  <xsl:number/>  <xsl:text> </xsl:text>
    <xsl:value-of select="@name"/>
    <xsl:text> ${rank} C${kind} "complex*${kind}${dim}"
  done
done
end </xsl:text>
    <xsl:value-of select="@name"/>
    <xsl:value-of select="$nl"/>

</xsl:template>


<!--
  - interface-size <method>
  -->
<xsl:template name="interface-size">
  <xsl:variable name="count">
    <xsl:call-template name="choice-count"/>
  </xsl:variable>

  <xsl:choose>
    <!-- special cases-->
    <xsl:when test="@name = 'MPI_Alloc_mem'">
      <xsl:text>medium</xsl:text>
    </xsl:when>
    <xsl:when test="@name = 'MPI_SIZEOF'">
      <xsl:text>trivial</xsl:text>
    </xsl:when>
    <!-- end special cases-->
    <xsl:when test="$count = ''">
      <xsl:text>small</xsl:text>
    </xsl:when>
    <xsl:when test="$count = '1'">
      <xsl:text>medium</xsl:text>
    </xsl:when>
    <xsl:otherwise>
      <xsl:text>large</xsl:text>
    </xsl:otherwise>
  </xsl:choose>

</xsl:template>


<!--
  - choice-count <method>
  -->
<xsl:template name="choice-count">

  <xsl:for-each select="arg">
    <xsl:if test="type/@idl = 'choice'">
      <xsl:text>1</xsl:text>
    </xsl:if>
  </xsl:for-each>

</xsl:template>


<!--
  - arg-list <method>
  -->
<xsl:template name="arg-list">
  <xsl:for-each select="arg">
    <xsl:value-of select="@name"/>
    <xsl:if test="position() != last()">
      <xsl:text>, </xsl:text>
    </xsl:if>
    <xsl:if test="position() = 5">
      <xsl:text>&amp;</xsl:text>
      <xsl:value-of select="concat($nl, '        ')"/>
    </xsl:if>
  </xsl:for-each>
  <xsl:for-each select="return[1]">
    <xsl:if test="@name = 'ierr'">
      <xsl:if test="../arg[1]">
        <xsl:text>, </xsl:text>
      </xsl:if>
      <xsl:value-of select="@name"/>
    </xsl:if>
  </xsl:for-each>
</xsl:template>


<!--
  - decl-construct-list <method>
  -->
<xsl:template name="decl-construct-list">
  <xsl:param name="ws" select="'  '"/>
  <xsl:param name="void_type"/>
  <xsl:param name="void_kind"/>
  <xsl:param name="has_dim" select="1"/>
  <xsl:for-each select="arg">
    <xsl:call-template name="type-decl-stmt">
      <xsl:with-param name="ws" select="$ws"/>
      <xsl:with-param name="void_type" select="$void_type"/>
      <xsl:with-param name="void_kind" select="$void_kind"/>
      <xsl:with-param name="has_dim" select="$has_dim"/>
    </xsl:call-template>
  </xsl:for-each>
</xsl:template>


<!--
  - type-decl-stmt <arg>
  -->
<xsl:template name="type-decl-stmt">
  <xsl:param name="ws" select="'  '"/>
  <xsl:param name="void_type"/>
  <xsl:param name="void_kind"/>
  <xsl:param name="has_dim" select="1"/>

  <xsl:value-of select="$ws"/>
  <xsl:text>  </xsl:text>
  <xsl:for-each select="type[1]">
    <xsl:call-template name="decl-type-spec">
      <xsl:with-param name="void_type" select="$void_type"/>
      <xsl:with-param name="void_kind" select="$void_kind"/>
      <xsl:with-param name="has_dim" select="$has_dim"/>
    </xsl:call-template>
  </xsl:for-each>
  <xsl:for-each select="type[1]">
    <xsl:call-template name="decl-type-intent"/>
  </xsl:for-each>
  <xsl:value-of select="concat(' :: ', @name, $nl)"/>

</xsl:template>


<!--
  - decl-type-intent <type>
  -->
<xsl:template name="decl-type-intent">

  <xsl:choose>

    <!-- C++ types -->

    <xsl:when test="@kind = 'void'"/>
    <xsl:when test="@kind = 'ptr'">
      <xsl:choose>
        <xsl:when
             test="indirect/type/@usertype='MPI_Comm_errhandler_fn'"/>
        <xsl:when
             test="indirect/type/@usertype='MPI_Comm_copy_attr_function'"/>
        <xsl:when
             test="indirect/type/@usertype='MPI_Comm_delete_attr_function'"/>
        <xsl:when
             test="indirect/type/@usertype='MPI_Handler_function'"/>
        <xsl:when
             test="indirect/type/@usertype='MPI_File_errhandler_fn'"/>
        <xsl:when
             test="indirect/type/@usertype='MPI_Grequest_query_function'"/>
        <xsl:when
             test="indirect/type/@usertype='MPI_Grequest_free_function'"/>
        <xsl:when
             test="indirect/type/@usertype='MPI_Grequest_cancel_function'"/>
        <xsl:when
             test="indirect/type/@usertype='MPI_Copy_function'"/>
        <xsl:when
             test="indirect/type/@usertype='MPI_Delete_function'"/>
        <xsl:when
             test="indirect/type/@usertype='MPI_User_function'"/>
        <xsl:when
             test="indirect/type/@usertype='MPI_Datarep_conversion_function'"/>
        <xsl:when
             test="indirect/type/@usertype='MPI_Datarep_extent_function'"/>
        <xsl:when
             test="indirect/type/@usertype='MPI_Type_copy_attr_function'"/>
        <xsl:when
             test="indirect/type/@usertype='MPI_Type_delete_attr_function'"/>
        <xsl:when
             test="indirect/type/@usertype='MPI_Win_errhandler_fn'"/>
        <xsl:when
             test="indirect/type/@usertype='MPI_Win_copy_attr_function'"/>
        <xsl:when
             test="indirect/type/@usertype='MPI_Win_delete_attr_function'"/>
        <xsl:otherwise>
          <xsl:value-of select="concat(', intent(', ../@intent, ')')"/>
        </xsl:otherwise>
      </xsl:choose>
    </xsl:when>
    <xsl:otherwise>
      <xsl:value-of select="concat(', intent(', ../@intent, ')')"/>
    </xsl:otherwise>
  </xsl:choose>

</xsl:template>


<!--
  - decl-type-spec <type>
  -->
<xsl:template name="decl-type-spec">
  <xsl:param name="void_type"/>
  <xsl:param name="void_kind"/>
  <xsl:param name="has_dim" select="1"/>

  <xsl:choose>

    <!-- idl types (annotate xml to specify what this type is) -->

    <xsl:when test="@idl = 'MPI_ARGV'">
      <xsl:text>character(len=*), dimension(*)</xsl:text>
    </xsl:when>
    <xsl:when test="@idl = 'MPI_A_ARGV'">
      <xsl:text>character(len=*), dimension(</xsl:text>
      <xsl:value-of select="array/dimension[2]/@extent"/>
      <xsl:text>,*)</xsl:text>
    </xsl:when>
    <xsl:when test="@idl = 'MPI_Aint'">
      <xsl:text>integer(kind=MPI_ADDRESS_KIND)</xsl:text>
    </xsl:when>

    <!-- C++ types -->

    <xsl:when test="@kind = 'void'">
      <xsl:choose>
        <xsl:when test="../../../../@template = 'yes'">
          <xsl:text>${type}</xsl:text>
        </xsl:when>
        <xsl:otherwise>
          <xsl:text>integer</xsl:text>
        </xsl:otherwise>
      </xsl:choose>
    </xsl:when>
    <xsl:when test="@kind = 'bool'">
      <xsl:text>logical</xsl:text>
    </xsl:when>
    <xsl:when test="@kind = 'int'">
      <xsl:choose>
        <xsl:when test="@ikind = 'int'">
          <xsl:text>integer</xsl:text>
        </xsl:when>
        <xsl:when test="@ikind = 'char'">
          <xsl:text>character</xsl:text>
          <xsl:if test="../../@kind = 'ptr'">
            <xsl:text>(len=*)</xsl:text>
          </xsl:if>
        </xsl:when>
        <xsl:otherwise>
          <xsl:text>UNSUPPORTED</xsl:text>
        </xsl:otherwise>
      </xsl:choose>
    </xsl:when>
    <xsl:when test="@kind = 'float'">
      <xsl:text>UNSUPPORTED</xsl:text>
    </xsl:when>
    <xsl:when test="@kind = 'ptr'">
      <xsl:for-each select="indirect[1]/type[1]">
        <xsl:call-template name="decl-type-spec"/>
      </xsl:for-each>
    </xsl:when>
    <xsl:when test="@kind = 'array'">
      <xsl:for-each select="array[1]/type[1]">
        <xsl:call-template name="decl-type-spec"/>
      </xsl:for-each>
      <xsl:text>, dimension(</xsl:text>
      <xsl:for-each select="array[1]/dimension">
        <xsl:value-of select="@extent"/>
        <xsl:if test="position() != last()">
          <xsl:text>, </xsl:text>
        </xsl:if>
      </xsl:for-each>
      <xsl:text>)</xsl:text>
    </xsl:when>
    <xsl:when test="@kind = 'ref'">
      <xsl:for-each select="indirect/type">
        <xsl:call-template name="type-spec">
          <xsl:with-param name="depth" select="../@depth"/>
        </xsl:call-template>
      </xsl:for-each>
    </xsl:when>
    <xsl:when test="@kind = 'usertype'">
      <xsl:choose>
        <xsl:when test="@usertype = 'default_integer'">
          <xsl:text>integer</xsl:text>
        </xsl:when>
        <xsl:when test="@usertype = 'MPI_Aint'">
          <xsl:text>integer(kind=MPI_ADDRESS_KIND)</xsl:text>
        </xsl:when>
        <xsl:when test="@usertype = 'int64_t'">
          <xsl:text>integer(kind=MPI_OFFSET_KIND)</xsl:text>
        </xsl:when>
        <xsl:when test="@usertype = 'MPI_Status'">
          <xsl:text>integer, dimension(MPI_STATUS_SIZE)</xsl:text>
        </xsl:when>
        <xsl:when test="@usertype = 'MPI_Comm_errhandler_fn'">
          <xsl:text>external</xsl:text>
        </xsl:when>
        <xsl:when test="@usertype = 'MPI_Comm_copy_attr_function'">
          <xsl:text>external</xsl:text>
        </xsl:when>
        <xsl:when test="@usertype = 'MPI_Comm_delete_attr_function'">
          <xsl:text>external</xsl:text>
        </xsl:when>
        <xsl:when test="@usertype = 'MPI_Handler_function'">
          <xsl:text>external</xsl:text>
        </xsl:when>
        <xsl:when test="@usertype = 'MPI_File_errhandler_fn'">
          <xsl:text>external</xsl:text>
        </xsl:when>
        <xsl:when test="@usertype = 'MPI_Grequest_query_function'">
          <xsl:text>external</xsl:text>
        </xsl:when>
        <xsl:when test="@usertype = 'MPI_Grequest_free_function'">
          <xsl:text>external</xsl:text>
        </xsl:when>
        <xsl:when test="@usertype = 'MPI_Grequest_cancel_function'">
          <xsl:text>external</xsl:text>
        </xsl:when>
        <xsl:when test="@usertype = 'MPI_Copy_function'">
          <xsl:text>external</xsl:text>
        </xsl:when>
        <xsl:when test="@usertype = 'MPI_Delete_function'">
          <xsl:text>external</xsl:text>
        </xsl:when>
        <xsl:when test="@usertype = 'MPI_User_function'">
          <xsl:text>external</xsl:text>
        </xsl:when>
        <xsl:when test="@usertype = 'MPI_Datarep_conversion_function'">
          <xsl:text>external</xsl:text>
        </xsl:when>
        <xsl:when test="@usertype = 'MPI_Datarep_extent_function'">
          <xsl:text>external</xsl:text>
        </xsl:when>
        <xsl:when test="@usertype = 'MPI_Type_copy_attr_function'">
          <xsl:text>external</xsl:text>
        </xsl:when>
        <xsl:when test="@usertype = 'MPI_Type_delete_attr_function'">
          <xsl:text>external</xsl:text>
        </xsl:when>
        <xsl:when test="@usertype = 'MPI_Win_errhandler_fn'">
          <xsl:text>external</xsl:text>
        </xsl:when>
        <xsl:when test="@usertype = 'MPI_Win_copy_attr_function'">
          <xsl:text>external</xsl:text>
        </xsl:when>
        <xsl:when test="@usertype = 'MPI_Win_delete_attr_function'">
          <xsl:text>external</xsl:text>
        </xsl:when>
        <xsl:otherwise>
          <xsl:param name="prefix" select="substring-before(@usertype, '_')"/>
          <xsl:if test="$prefix = 'MPI'">
            <xsl:text>integer</xsl:text>
          </xsl:if>
          <xsl:if test="$prefix != 'MPI'">
            <xsl:text>UNSUPPORTED</xsl:text>
          </xsl:if>
        </xsl:otherwise>
      </xsl:choose>
    </xsl:when>
    <xsl:otherwise>
      <xsl:text>UNSUPPORTED</xsl:text>
    </xsl:otherwise>
  </xsl:choose>
</xsl:template>


<!--
  - copyright: print copyright
  -->
<xsl:template name="copyright">


<xsl:text>
#
# Copyright (c) 2004-2006 The Trustees of Indiana University and Indiana
#                         University Research and Technology
#                         Corporation.  All rights reserved.
# Copyright (c) 2004-2006 The Regents of the University of California.
#                         All rights reserved.
# Copyright (c) 2006      Cisco Systems, Inc.  All rights reserved.
# $COPYRIGHT$
# 
# Additional copyrights may follow
# 
# $HEADER$
#
</xsl:text>

</xsl:template>


<!--
  - info: print information about file
  -->
<xsl:template name="info">

<xsl:text>
# Do a little error checking

if test ! -f fortran_kinds.sh; then
    echo "ERROR: Cannot find fortran_kinds.sh" >&amp;2
    exit 1
elif test -z fortran_kinds.sh; then
    echo "ERROR: fortran_kinds.sh appears to be empty!" >&amp;2
    exit 1
fi

# Read in the KIND information

. fortran_kinds.sh

# Setup

output=1
allranks="0 $ranks"

#------------------------------------------------------------------------

# Helper functions

start() {
    check_size $2
    if test "$output" = "1"; then        
        echo "interface $1"
    fi
}

end() {
    if test "$output" = "1"; then
        cat &lt;&lt;EOF
end interface $1


EOF
    fi
}
</xsl:text>

</xsl:template>


<!--
  - openFile: print file header information
  -->
<xsl:template name="openFile">
  <xsl:param name="filename" select="''"/>
  <xsl:text>#! /bin/sh</xsl:text>
  <xsl:call-template name="copyright"/>
  <xsl:call-template name="info"/>
</xsl:template>


<!--
  - closeFile: finish up
  -->
<xsl:template name="closeFile">
  <xsl:param name="filename" select="''"/>
</xsl:template>


</xsl:stylesheet>