libgfortran/m4/matmul.m4

   1 `/* Implementation of the MATMUL intrinsic
   2    Copyright (C) 2002-2017 Free Software Foundation, Inc.
   3    Contributed by Paul Brook <paul@nowt.org>
   4
   5 This file is part of the GNU Fortran runtime library (libgfortran).
   6
   7 Libgfortran is free software; you can redistribute it and/or
   8 modify it under the terms of the GNU General Public
   9 License as published by the Free Software Foundation; either
  10 version 3 of the License, or (at your option) any later version.
  11
  12 Libgfortran is distributed in the hope that it will be useful,
  13 but WITHOUT ANY WARRANTY; without even the implied warranty of
  14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 GNU General Public License for more details.
  16
  17 Under Section 7 of GPL version 3, you are granted additional
  18 permissions described in the GCC Runtime Library Exception, version
  19 3.1, as published by the Free Software Foundation.
  20
  21 You should have received a copy of the GNU General Public License and
  22 a copy of the GCC Runtime Library Exception along with this program;
  23 see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
  24 <http://www.gnu.org/licenses/>.  */
  25
  26 #include "libgfortran.h"
  27 #include <string.h>
  28 #include <assert.h>'
  29
  30 include(iparm.m4)dnl
  31
  32 `#if defined (HAVE_'rtype_name`)
  33
  34 /* Prototype for the BLAS ?gemm subroutine, a pointer to which can be
  35    passed to us by the front-end, in which case we call it for large
  36    matrices.  */
  37
  38 typedef void (*blas_call)(const char *, const char *, const int *, const int *,
  39                           const int *, const 'rtype_name` *, const 'rtype_name` *,
  40                           const int *, const 'rtype_name` *, const int *,
  41                           const 'rtype_name` *, 'rtype_name` *, const int *,
  42                           int, int);
  43
  44 /* The order of loops is different in the case of plain matrix
  45    multiplication C=MATMUL(A,B), and in the frequent special case where
  46    the argument A is the temporary result of a TRANSPOSE intrinsic:
  47    C=MATMUL(TRANSPOSE(A),B).  Transposed temporaries are detected by
  48    looking at their strides.
  49
  50    The equivalent Fortran pseudo-code is:
  51
  52    DIMENSION A(M,COUNT), B(COUNT,N), C(M,N)
  53    IF (.NOT.IS_TRANSPOSED(A)) THEN
  54      C = 0
  55      DO J=1,N
  56        DO K=1,COUNT
  57          DO I=1,M
  58            C(I,J) = C(I,J)+A(I,K)*B(K,J)
  59    ELSE
  60      DO J=1,N
  61        DO I=1,M
  62          S = 0
  63          DO K=1,COUNT
  64            S = S+A(I,K)*B(K,J)
  65          C(I,J) = S
  66    ENDIF
  67 */
  68
  69 /* If try_blas is set to a nonzero value, then the matmul function will
  70    see if there is a way to perform the matrix multiplication by a call
  71    to the BLAS gemm function.  */
  72
  73 extern void matmul_'rtype_code` ('rtype` * const restrict retarray,
  74         'rtype` * const restrict a, 'rtype` * const restrict b, int try_blas,
  75         int blas_limit, blas_call gemm);
  76 export_proto(matmul_'rtype_code`);
  77
  78 'ifelse(rtype_letter,`r',dnl
  79 `#if defined(HAVE_AVX) && defined(HAVE_AVX2)
  80 /* REAL types generate identical code for AVX and AVX2.  Only generate
  81    an AVX2 function if we are dealing with integer.  */
  82 #undef HAVE_AVX2
  83 #endif')
  84 `
  85
  86 /* Put exhaustive list of possible architectures here here, ORed together.  */
  87
  88 #if defined(HAVE_AVX) || defined(HAVE_AVX2) || defined(HAVE_AVX512F)
  89
  90 #ifdef HAVE_AVX
  91 'define(`matmul_name',`matmul_'rtype_code`_avx')dnl
  92 `static void
  93 'matmul_name` ('rtype` * const restrict retarray,
  94         'rtype` * const restrict a, 'rtype` * const restrict b, int try_blas,
  95         int blas_limit, blas_call gemm) __attribute__((__target__("avx")));
  96 static' include(matmul_internal.m4)dnl
  97 `#endif /* HAVE_AVX */
  98
  99 #ifdef HAVE_AVX2
 100 'define(`matmul_name',`matmul_'rtype_code`_avx2')dnl
 101 `static void
 102 'matmul_name` ('rtype` * const restrict retarray,
 103         'rtype` * const restrict a, 'rtype` * const restrict b, int try_blas,
 104         int blas_limit, blas_call gemm) __attribute__((__target__("avx2")));
 105 static' include(matmul_internal.m4)dnl
 106 `#endif /* HAVE_AVX2 */
 107
 108 #ifdef HAVE_AVX512F
 109 'define(`matmul_name',`matmul_'rtype_code`_avx512f')dnl
 110 `static void
 111 'matmul_name` ('rtype` * const restrict retarray,
 112         'rtype` * const restrict a, 'rtype` * const restrict b, int try_blas,
 113         int blas_limit, blas_call gemm) __attribute__((__target__("avx512f")));
 114 static' include(matmul_internal.m4)dnl
 115 `#endif  /* HAVE_AVX512F */
 116
 117 /* Function to fall back to if there is no special processor-specific version.  */
 118 'define(`matmul_name',`matmul_'rtype_code`_vanilla')dnl
 119 `static' include(matmul_internal.m4)dnl
 120
 121 `/* Compiling main function, with selection code for the processor.  */
 122
 123 /* Currently, this is i386 only.  Adjust for other architectures.  */
 124
 125 #include <config/i386/cpuinfo.h>
 126 void matmul_'rtype_code` ('rtype` * const restrict retarray,
 127         'rtype` * const restrict a, 'rtype` * const restrict b, int try_blas,
 128         int blas_limit, blas_call gemm)
 129 {
 130   static void (*matmul_p) ('rtype` * const restrict retarray,
 131         'rtype` * const restrict a, 'rtype` * const restrict b, int try_blas,
 132         int blas_limit, blas_call gemm) = NULL;
 133
 134   if (matmul_p == NULL)
 135     {
 136       matmul_p = matmul_'rtype_code`_vanilla;
 137       if (__cpu_model.__cpu_vendor == VENDOR_INTEL)
 138         {
 139           /* Run down the available processors in order of preference.  */
 140 #ifdef HAVE_AVX512F
 141           if (__cpu_model.__cpu_features[0] & (1 << FEATURE_AVX512F))
 142             {
 143               matmul_p = matmul_'rtype_code`_avx512f;
 144               goto tailcall;
 145             }
 146
 147 #endif  /* HAVE_AVX512F */
 148
 149 #ifdef HAVE_AVX2
 150           if (__cpu_model.__cpu_features[0] & (1 << FEATURE_AVX2))
 151             {
 152               matmul_p = matmul_'rtype_code`_avx2;
 153               goto tailcall;
 154             }
 155
 156 #endif
 157
 158 #ifdef HAVE_AVX
 159           if (__cpu_model.__cpu_features[0] & (1 << FEATURE_AVX))
 160             {
 161               matmul_p = matmul_'rtype_code`_avx;
 162               goto tailcall;
 163             }
 164 #endif  /* HAVE_AVX */
 165         }
 166    }
 167
 168 tailcall:
 169    (*matmul_p) (retarray, a, b, try_blas, blas_limit, gemm);
 170 }
 171
 172 #else  /* Just the vanilla function.  */
 173
 174 'define(`matmul_name',`matmul_'rtype_code)dnl
 175 define(`target_attribute',`')dnl
 176 include(matmul_internal.m4)dnl
 177 `#endif
 178 #endif
 179 '