1 /++ 2 Copyright: Copyright © 2016-, Ilya Yaroshenko. 3 License: $(HTTP boost.org/LICENSE_1_0.txt, Boost License 1.0). 4 Authors: Ilya Yaroshenko 5 +/ 6 module glas.precompiled.utility; 7 8 import glas.ndslice; 9 import glas.fortran; 10 import ldc.attributes: weak; 11 import ldc.intrinsics: llvm_expect; 12 import mir.ndslice.slice: Structure; 13 14 extern(C) @system nothrow @nogc pragma(inline, false): 15 16 17 __gshared string[] _errors = [ 18 "undefinded error", // 0 19 "unexpected flag", //1 20 "constraint: asl.length!1 == bsl.length!0",//2 21 "constraint: csl.length!0 == asl.length!0",//3 22 "constraint: csl.length!1 == bsl.length!1",//4 23 "constraint: abs(csl.stride!0) or abs(csl.stride!1) must be equal to 1",//5 24 "constraint: asl.length!0 == asl.length!1",//6 25 "constraint: abs(csl.stride!0) >= csl.length!0 || abs(csl.stride!1) >= csl.length!1",//7 26 ]; 27 28 string glas_error(int error_code) 29 { 30 if (error_code < _errors.length) 31 error_code = 0; 32 return _errors[error_code]; 33 } 34 35 int glas_validate_gemm_common(ref const Structure!2 as, ref const Structure!2 bs, ref const Structure!2 cs) 36 { 37 if (llvm_expect(as.lengths[1] != bs.lengths[0], false)) 38 return 2; 39 if (llvm_expect(cs.lengths[0] != as.lengths[0], false)) 40 return 3; 41 if (llvm_expect(cs.lengths[1] != bs.lengths[1], false)) 42 return 4; 43 auto s0 = cs.strides[0] >= 0 ? cs.strides[0] : -cs.strides[0]; 44 auto s1 = cs.strides[1] >= 0 ? cs.strides[1] : -cs.strides[1]; 45 if (llvm_expect(s0 != 1 && s1 != 1, false)) 46 return 5; 47 if (llvm_expect(s0 < cs.lengths[0] && s1 < cs.lengths[1], false)) 48 return 7; 49 return 0; 50 } 51 52 int glas_validate_gemm(Structure!2 as, Structure!2 bs, Structure!2 cs, ulong settings) 53 { 54 if (llvm_expect(settings & ~(ConjA | ConjB), false)) 55 return 1; 56 if (auto ret = glas_validate_gemm_common(as, bs, cs)) 57 return ret; 58 return 0; 59 } 60 61 int glas_validate_symm(Structure!2 as, Structure!2 bs, Structure!2 cs, ulong settings) 62 { 63 if (llvm_expect(settings & ~(ConjA | ConjB | Left | Right | Upper | Lower), false)) 64 return 1; 65 if (llvm_expect(as.lengths[0] != as.lengths[1], false)) 66 return 6; 67 if (auto ret = glas_validate_gemm_common(as, bs, cs)) 68 return ret; 69 return 0; 70 } 71 72 /* -- LAPACK auxiliary routine (preliminary version) -- */ 73 /* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., */ 74 /* Courant Institute, Argonne National Lab, and Rice University */ 75 /* February 29, 1992 */ 76 /* .. Scalar Arguments .. */ 77 /* .. */ 78 /* Purpose */ 79 /* ======= */ 80 /* XERBLA is an error handler for the LAPACK routines. */ 81 /* It is called by an LAPACK routine if an input parameter has an */ 82 /* invalid value. A message is printed and execution stops. */ 83 /* Installers may consider modifying the STOP statement in order to */ 84 /* call system-specific exception-handling facilities. */ 85 /* Arguments */ 86 /* ========= */ 87 /* SRNAME (input) CHARACTER*6 */ 88 /* The name of the routine which called XERBLA. */ 89 /* INFO (input) INTEGER */ 90 /* The position of the invalid parameter in the parameter list */ 91 /* of the calling routine. */ 92 @weak int xerbla_(in char* srname, ref FortranInt info) 93 { 94 import core.stdc.stdio; 95 static if (FortranInt.sizeof == 8) 96 enum fmt = " ** On entry to %6s parameter number %2ld had an illegal value\n"; 97 else 98 enum fmt = " ** On entry to %6s parameter number %2d had an illegal value\n"; 99 printf(fmt, srname, info); 100 return 0; 101 } 102 103 version(Posix) 104 @weak extern (C) void _d_dso_registry() {}