libgfortran/m4/matmul.m4

   1 `/* Implementation of the MATMUL intrinsic
   2    Copyright (C) 2002-2016 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 <stdlib.h>
  28 #include <string.h>
  29 #include <assert.h>'
  30
  31 include(iparm.m4)dnl
  32
  33 `#if defined (HAVE_'rtype_name`)
  34
  35 /* Prototype for the BLAS ?gemm subroutine, a pointer to which can be
  36    passed to us by the front-end, in which case we call it for large
  37    matrices.  */
  38
  39 typedef void (*blas_call)(const char *, const char *, const int *, const int *,
  40                           const int *, const 'rtype_name` *, const 'rtype_name` *,
  41                           const int *, const 'rtype_name` *, const int *,
  42                           const 'rtype_name` *, 'rtype_name` *, const int *,
  43                           int, int);
  44
  45 /* The order of loops is different in the case of plain matrix
  46    multiplication C=MATMUL(A,B), and in the frequent special case where
  47    the argument A is the temporary result of a TRANSPOSE intrinsic:
  48    C=MATMUL(TRANSPOSE(A),B).  Transposed temporaries are detected by
  49    looking at their strides.
  50
  51    The equivalent Fortran pseudo-code is:
  52
  53    DIMENSION A(M,COUNT), B(COUNT,N), C(M,N)
  54    IF (.NOT.IS_TRANSPOSED(A)) THEN
  55      C = 0
  56      DO J=1,N
  57        DO K=1,COUNT
  58          DO I=1,M
  59            C(I,J) = C(I,J)+A(I,K)*B(K,J)
  60    ELSE
  61      DO J=1,N
  62        DO I=1,M
  63          S = 0
  64          DO K=1,COUNT
  65            S = S+A(I,K)*B(K,J)
  66          C(I,J) = S
  67    ENDIF
  68 */
  69
  70 /* If try_blas is set to a nonzero value, then the matmul function will
  71    see if there is a way to perform the matrix multiplication by a call
  72    to the BLAS gemm function.  */
  73
  74 extern void matmul_'rtype_code` ('rtype` * const restrict retarray,
  75         'rtype` * const restrict a, 'rtype` * const restrict b, int try_blas,
  76         int blas_limit, blas_call gemm);
  77 export_proto(matmul_'rtype_code`);
  78
  79 'ifelse(rtype_letter,`r',dnl
  80 `#if defined(HAVE_AVX) && defined(HAVE_AVX2)
  81 /* REAL types generate identical code for AVX and AVX2.  Only generate
  82    an AVX2 function if we are dealing with integer.  */
  83 #undef HAVE_AVX2
  84 #endif')
  85 `
  86
  87 /* Put exhaustive list of possible architectures here here, ORed together.  */
  88
  89 #if defined(HAVE_AVX) || defined(HAVE_AVX2) || defined(HAVE_AVX512F)
  90
  91 #ifdef HAVE_AVX
  92 'define(`matmul_name',`matmul_'rtype_code`_avx')dnl
  93 `static void
  94 'matmul_name` ('rtype` * const restrict retarray,
  95         'rtype` * const restrict a, 'rtype` * const restrict b, int try_blas,
  96         int blas_limit, blas_call gemm) __attribute__((__target__("avx")));
  97 static' include(matmul_internal.m4)dnl
  98 `#endif /* HAVE_AVX */
  99
 100 #ifdef HAVE_AVX2
 101 'define(`matmul_name',`matmul_'rtype_code`_avx2')dnl
 102 `static void
 103 'matmul_name` ('rtype` * const restrict retarray,
 104         'rtype` * const restrict a, 'rtype` * const restrict b, int try_blas,
 105         int blas_limit, blas_call gemm) __attribute__((__target__("avx2")));
 106 static' include(matmul_internal.m4)dnl
 107 `#endif /* HAVE_AVX2 */
 108
 109 #ifdef HAVE_AVX512F
 110 'define(`matmul_name',`matmul_'rtype_code`_avx512f')dnl
 111 `static void
 112 'matmul_name` ('rtype` * const restrict retarray,
 113         'rtype` * const restrict a, 'rtype` * const restrict b, int try_blas,
 114         int blas_limit, blas_call gemm) __attribute__((__target__("avx512f")));
 115 static' include(matmul_internal.m4)dnl
 116 `#endif  /* HAVE_AVX512F */
 117
 118 /* Function to fall back to if there is no special processor-specific version.  */
 119 'define(`matmul_name',`matmul_'rtype_code`_vanilla')dnl
 120 `static' include(matmul_internal.m4)dnl
 121
 122 `/* Compiling main function, with selection code for the processor.  */
 123
 124 /* Currently, this is i386 only.  Adjust for other architectures.  */
 125
 126 #include <config/i386/cpuinfo.h>
 127 void matmul_'rtype_code` ('rtype` * const restrict retarray,
 128         'rtype` * const restrict a, 'rtype` * const restrict b, int try_blas,
 129         int blas_limit, blas_call gemm)
 130 {
 131   static void (*matmul_p) ('rtype` * const restrict retarray,
 132         'rtype` * const restrict a, 'rtype` * const restrict b, int try_blas,
 133         int blas_limit, blas_call gemm) = NULL;
 134
 135   if (matmul_p == NULL)
 136     {
 137       matmul_p = matmul_'rtype_code`_vanilla;
 138       if (__cpu_model.__cpu_vendor == VENDOR_INTEL)
 139         {
 140           /* Run down the available processors in order of preference.  */
 141 #ifdef HAVE_AVX512F
 142           if (__cpu_model.__cpu_features[0] & (1 << FEATURE_AVX512F))
 143             {
 144               matmul_p = matmul_'rtype_code`_avx512f;
 145               goto tailcall;
 146             }
 147
 148 #endif  /* HAVE_AVX512F */
 149
 150 #ifdef HAVE_AVX2
 151           if (__cpu_model.__cpu_features[0] & (1 << FEATURE_AVX2))
 152             {
 153               matmul_p = matmul_'rtype_code`_avx2;
 154               goto tailcall;
 155             }
 156
 157 #endif
 158
 159 #ifdef HAVE_AVX
 160           if (__cpu_model.__cpu_features[0] & (1 << FEATURE_AVX))
 161             {
 162               matmul_p = matmul_'rtype_code`_avx;
 163               goto tailcall;
 164             }
 165 #endif  /* HAVE_AVX */
 166         }
 167    }
 168
 169 tailcall:
 170    (*matmul_p) (retarray, a, b, try_blas, blas_limit, gemm);
 171 }
 172
 173 #else  /* Just the vanilla function.  */
 174
 175 'define(`matmul_name',`matmul_'rtype_code)dnl
 176 define(`target_attribute',`')dnl
 177 include(matmul_internal.m4)dnl
 178 `#endif
 179 #endif
 180 '