diff --git a/CHANGELOG b/CHANGELOG --- a/CHANGELOG +++ b/CHANGELOG @@ -1,5 +1,11 @@ # Changelog +- 0.2.6 (2026-10-31) + * Uses the x86 SHA512 extensions on x86_64 CPUs that support them, + detected at runtime, falling back to the pure Haskell + implementation elsewhere. The x86 kernel requires GCC 14 or Clang + 18 or later to build; older compilers always use the fallback. + - 0.2.5 (2026-10-10) * Further defends MAC comparison timing against "helpful" LLVM optimizations. diff --git a/cbits/sha512_arm.c b/cbits/sha512_arm.c deleted file mode 100644 --- a/cbits/sha512_arm.c +++ /dev/null @@ -1,500 +0,0 @@ -#include -#include - -#if defined(__aarch64__) - -#include - -#if defined(__APPLE__) -#include -#elif defined(__linux__) -#include -#ifndef HWCAP_SHA512 -#define HWCAP_SHA512 (1UL << 21) -#endif -#endif - -static const uint64_t K[80] = { - 0x428a2f98d728ae22ULL, 0x7137449123ef65cdULL, - 0xb5c0fbcfec4d3b2fULL, 0xe9b5dba58189dbbcULL, - 0x3956c25bf348b538ULL, 0x59f111f1b605d019ULL, - 0x923f82a4af194f9bULL, 0xab1c5ed5da6d8118ULL, - 0xd807aa98a3030242ULL, 0x12835b0145706fbeULL, - 0x243185be4ee4b28cULL, 0x550c7dc3d5ffb4e2ULL, - 0x72be5d74f27b896fULL, 0x80deb1fe3b1696b1ULL, - 0x9bdc06a725c71235ULL, 0xc19bf174cf692694ULL, - 0xe49b69c19ef14ad2ULL, 0xefbe4786384f25e3ULL, - 0x0fc19dc68b8cd5b5ULL, 0x240ca1cc77ac9c65ULL, - 0x2de92c6f592b0275ULL, 0x4a7484aa6ea6e483ULL, - 0x5cb0a9dcbd41fbd4ULL, 0x76f988da831153b5ULL, - 0x983e5152ee66dfabULL, 0xa831c66d2db43210ULL, - 0xb00327c898fb213fULL, 0xbf597fc7beef0ee4ULL, - 0xc6e00bf33da88fc2ULL, 0xd5a79147930aa725ULL, - 0x06ca6351e003826fULL, 0x142929670a0e6e70ULL, - 0x27b70a8546d22ffcULL, 0x2e1b21385c26c926ULL, - 0x4d2c6dfc5ac42aedULL, 0x53380d139d95b3dfULL, - 0x650a73548baf63deULL, 0x766a0abb3c77b2a8ULL, - 0x81c2c92e47edaee6ULL, 0x92722c851482353bULL, - 0xa2bfe8a14cf10364ULL, 0xa81a664bbc423001ULL, - 0xc24b8b70d0f89791ULL, 0xc76c51a30654be30ULL, - 0xd192e819d6ef5218ULL, 0xd69906245565a910ULL, - 0xf40e35855771202aULL, 0x106aa07032bbd1b8ULL, - 0x19a4c116b8d2d0c8ULL, 0x1e376c085141ab53ULL, - 0x2748774cdf8eeb99ULL, 0x34b0bcb5e19b48a8ULL, - 0x391c0cb3c5c95a63ULL, 0x4ed8aa4ae3418acbULL, - 0x5b9cca4f7763e373ULL, 0x682e6ff3d6b2b8a3ULL, - 0x748f82ee5defb2fcULL, 0x78a5636f43172f60ULL, - 0x84c87814a1f0ab72ULL, 0x8cc702081a6439ecULL, - 0x90befffa23631e28ULL, 0xa4506cebde82bde9ULL, - 0xbef9a3f7b2c67915ULL, 0xc67178f2e372532bULL, - 0xca273eceea26619cULL, 0xd186b8c721c0c207ULL, - 0xeada7dd6cde0eb1eULL, 0xf57d4f7fee6ed178ULL, - 0x06f067aa72176fbaULL, 0x0a637dc5a2c898a6ULL, - 0x113f9804bef90daeULL, 0x1b710b35131c471bULL, - 0x28db77f523047d84ULL, 0x32caab7b40c72493ULL, - 0x3c9ebe0a15c9bebcULL, 0x431d67c49c100d4cULL, - 0x4cc5d4becb3e42b6ULL, 0x597f299cfc657e2aULL, - 0x5fcb6fab3ad6faecULL, 0x6c44198c4a475817ULL -}; - -/* - * Process one 128-byte block using ARM SHA512 crypto instructions. - * - * state: pointer to 8 uint64_t words (a,b,c,d,e,f,g,h) - * block: pointer to 16 uint64_t words (already native endian) - * - * The state is updated in place. - * - * Compiled for the SHA512 extension only; callers must first check - * 'sha512_arm_available'. - */ -__attribute__((target("+sha3"))) -void sha512_block_arm(uint64_t *state, const uint64_t *block) { - /* Load current hash state */ - uint64x2_t ab = vld1q_u64(&state[0]); - uint64x2_t cd = vld1q_u64(&state[2]); - uint64x2_t ef = vld1q_u64(&state[4]); - uint64x2_t gh = vld1q_u64(&state[6]); - - /* Save original for final addition */ - uint64x2_t ab_orig = ab; - uint64x2_t cd_orig = cd; - uint64x2_t ef_orig = ef; - uint64x2_t gh_orig = gh; - - /* Load message (already native endian) */ - uint64x2_t m0 = vld1q_u64(&block[0]); - uint64x2_t m1 = vld1q_u64(&block[2]); - uint64x2_t m2 = vld1q_u64(&block[4]); - uint64x2_t m3 = vld1q_u64(&block[6]); - uint64x2_t m4 = vld1q_u64(&block[8]); - uint64x2_t m5 = vld1q_u64(&block[10]); - uint64x2_t m6 = vld1q_u64(&block[12]); - uint64x2_t m7 = vld1q_u64(&block[14]); - - uint64x2_t tmp; - - /* Rounds 0-1 */ - tmp = vaddq_u64(m0, vld1q_u64(&K[0])); - tmp = vextq_u64(tmp, tmp, 1); - tmp = vaddq_u64(gh, tmp); - tmp = vsha512hq_u64(tmp, vextq_u64(ef, gh, 1), vextq_u64(cd, ef, 1)); - gh = vsha512h2q_u64(tmp, cd, ab); - cd = vaddq_u64(cd, tmp); - m0 = vsha512su1q_u64(vsha512su0q_u64(m0, m1), m7, vextq_u64(m4, m5, 1)); - - /* Rounds 2-3 */ - tmp = vaddq_u64(m1, vld1q_u64(&K[2])); - tmp = vextq_u64(tmp, tmp, 1); - tmp = vaddq_u64(ef, tmp); - tmp = vsha512hq_u64(tmp, vextq_u64(cd, ef, 1), vextq_u64(ab, cd, 1)); - ef = vsha512h2q_u64(tmp, ab, gh); - ab = vaddq_u64(ab, tmp); - m1 = vsha512su1q_u64(vsha512su0q_u64(m1, m2), m0, vextq_u64(m5, m6, 1)); - - /* Rounds 4-5 */ - tmp = vaddq_u64(m2, vld1q_u64(&K[4])); - tmp = vextq_u64(tmp, tmp, 1); - tmp = vaddq_u64(cd, tmp); - tmp = vsha512hq_u64(tmp, vextq_u64(ab, cd, 1), vextq_u64(gh, ab, 1)); - cd = vsha512h2q_u64(tmp, gh, ef); - gh = vaddq_u64(gh, tmp); - m2 = vsha512su1q_u64(vsha512su0q_u64(m2, m3), m1, vextq_u64(m6, m7, 1)); - - /* Rounds 6-7 */ - tmp = vaddq_u64(m3, vld1q_u64(&K[6])); - tmp = vextq_u64(tmp, tmp, 1); - tmp = vaddq_u64(ab, tmp); - tmp = vsha512hq_u64(tmp, vextq_u64(gh, ab, 1), vextq_u64(ef, gh, 1)); - ab = vsha512h2q_u64(tmp, ef, cd); - ef = vaddq_u64(ef, tmp); - m3 = vsha512su1q_u64(vsha512su0q_u64(m3, m4), m2, vextq_u64(m7, m0, 1)); - - /* Rounds 8-9 */ - tmp = vaddq_u64(m4, vld1q_u64(&K[8])); - tmp = vextq_u64(tmp, tmp, 1); - tmp = vaddq_u64(gh, tmp); - tmp = vsha512hq_u64(tmp, vextq_u64(ef, gh, 1), vextq_u64(cd, ef, 1)); - gh = vsha512h2q_u64(tmp, cd, ab); - cd = vaddq_u64(cd, tmp); - m4 = vsha512su1q_u64(vsha512su0q_u64(m4, m5), m3, vextq_u64(m0, m1, 1)); - - /* Rounds 10-11 */ - tmp = vaddq_u64(m5, vld1q_u64(&K[10])); - tmp = vextq_u64(tmp, tmp, 1); - tmp = vaddq_u64(ef, tmp); - tmp = vsha512hq_u64(tmp, vextq_u64(cd, ef, 1), vextq_u64(ab, cd, 1)); - ef = vsha512h2q_u64(tmp, ab, gh); - ab = vaddq_u64(ab, tmp); - m5 = vsha512su1q_u64(vsha512su0q_u64(m5, m6), m4, vextq_u64(m1, m2, 1)); - - /* Rounds 12-13 */ - tmp = vaddq_u64(m6, vld1q_u64(&K[12])); - tmp = vextq_u64(tmp, tmp, 1); - tmp = vaddq_u64(cd, tmp); - tmp = vsha512hq_u64(tmp, vextq_u64(ab, cd, 1), vextq_u64(gh, ab, 1)); - cd = vsha512h2q_u64(tmp, gh, ef); - gh = vaddq_u64(gh, tmp); - m6 = vsha512su1q_u64(vsha512su0q_u64(m6, m7), m5, vextq_u64(m2, m3, 1)); - - /* Rounds 14-15 */ - tmp = vaddq_u64(m7, vld1q_u64(&K[14])); - tmp = vextq_u64(tmp, tmp, 1); - tmp = vaddq_u64(ab, tmp); - tmp = vsha512hq_u64(tmp, vextq_u64(gh, ab, 1), vextq_u64(ef, gh, 1)); - ab = vsha512h2q_u64(tmp, ef, cd); - ef = vaddq_u64(ef, tmp); - m7 = vsha512su1q_u64(vsha512su0q_u64(m7, m0), m6, vextq_u64(m3, m4, 1)); - - /* Rounds 16-17 */ - tmp = vaddq_u64(m0, vld1q_u64(&K[16])); - tmp = vextq_u64(tmp, tmp, 1); - tmp = vaddq_u64(gh, tmp); - tmp = vsha512hq_u64(tmp, vextq_u64(ef, gh, 1), vextq_u64(cd, ef, 1)); - gh = vsha512h2q_u64(tmp, cd, ab); - cd = vaddq_u64(cd, tmp); - m0 = vsha512su1q_u64(vsha512su0q_u64(m0, m1), m7, vextq_u64(m4, m5, 1)); - - /* Rounds 18-19 */ - tmp = vaddq_u64(m1, vld1q_u64(&K[18])); - tmp = vextq_u64(tmp, tmp, 1); - tmp = vaddq_u64(ef, tmp); - tmp = vsha512hq_u64(tmp, vextq_u64(cd, ef, 1), vextq_u64(ab, cd, 1)); - ef = vsha512h2q_u64(tmp, ab, gh); - ab = vaddq_u64(ab, tmp); - m1 = vsha512su1q_u64(vsha512su0q_u64(m1, m2), m0, vextq_u64(m5, m6, 1)); - - /* Rounds 20-21 */ - tmp = vaddq_u64(m2, vld1q_u64(&K[20])); - tmp = vextq_u64(tmp, tmp, 1); - tmp = vaddq_u64(cd, tmp); - tmp = vsha512hq_u64(tmp, vextq_u64(ab, cd, 1), vextq_u64(gh, ab, 1)); - cd = vsha512h2q_u64(tmp, gh, ef); - gh = vaddq_u64(gh, tmp); - m2 = vsha512su1q_u64(vsha512su0q_u64(m2, m3), m1, vextq_u64(m6, m7, 1)); - - /* Rounds 22-23 */ - tmp = vaddq_u64(m3, vld1q_u64(&K[22])); - tmp = vextq_u64(tmp, tmp, 1); - tmp = vaddq_u64(ab, tmp); - tmp = vsha512hq_u64(tmp, vextq_u64(gh, ab, 1), vextq_u64(ef, gh, 1)); - ab = vsha512h2q_u64(tmp, ef, cd); - ef = vaddq_u64(ef, tmp); - m3 = vsha512su1q_u64(vsha512su0q_u64(m3, m4), m2, vextq_u64(m7, m0, 1)); - - /* Rounds 24-25 */ - tmp = vaddq_u64(m4, vld1q_u64(&K[24])); - tmp = vextq_u64(tmp, tmp, 1); - tmp = vaddq_u64(gh, tmp); - tmp = vsha512hq_u64(tmp, vextq_u64(ef, gh, 1), vextq_u64(cd, ef, 1)); - gh = vsha512h2q_u64(tmp, cd, ab); - cd = vaddq_u64(cd, tmp); - m4 = vsha512su1q_u64(vsha512su0q_u64(m4, m5), m3, vextq_u64(m0, m1, 1)); - - /* Rounds 26-27 */ - tmp = vaddq_u64(m5, vld1q_u64(&K[26])); - tmp = vextq_u64(tmp, tmp, 1); - tmp = vaddq_u64(ef, tmp); - tmp = vsha512hq_u64(tmp, vextq_u64(cd, ef, 1), vextq_u64(ab, cd, 1)); - ef = vsha512h2q_u64(tmp, ab, gh); - ab = vaddq_u64(ab, tmp); - m5 = vsha512su1q_u64(vsha512su0q_u64(m5, m6), m4, vextq_u64(m1, m2, 1)); - - /* Rounds 28-29 */ - tmp = vaddq_u64(m6, vld1q_u64(&K[28])); - tmp = vextq_u64(tmp, tmp, 1); - tmp = vaddq_u64(cd, tmp); - tmp = vsha512hq_u64(tmp, vextq_u64(ab, cd, 1), vextq_u64(gh, ab, 1)); - cd = vsha512h2q_u64(tmp, gh, ef); - gh = vaddq_u64(gh, tmp); - m6 = vsha512su1q_u64(vsha512su0q_u64(m6, m7), m5, vextq_u64(m2, m3, 1)); - - /* Rounds 30-31 */ - tmp = vaddq_u64(m7, vld1q_u64(&K[30])); - tmp = vextq_u64(tmp, tmp, 1); - tmp = vaddq_u64(ab, tmp); - tmp = vsha512hq_u64(tmp, vextq_u64(gh, ab, 1), vextq_u64(ef, gh, 1)); - ab = vsha512h2q_u64(tmp, ef, cd); - ef = vaddq_u64(ef, tmp); - m7 = vsha512su1q_u64(vsha512su0q_u64(m7, m0), m6, vextq_u64(m3, m4, 1)); - - /* Rounds 32-33 */ - tmp = vaddq_u64(m0, vld1q_u64(&K[32])); - tmp = vextq_u64(tmp, tmp, 1); - tmp = vaddq_u64(gh, tmp); - tmp = vsha512hq_u64(tmp, vextq_u64(ef, gh, 1), vextq_u64(cd, ef, 1)); - gh = vsha512h2q_u64(tmp, cd, ab); - cd = vaddq_u64(cd, tmp); - m0 = vsha512su1q_u64(vsha512su0q_u64(m0, m1), m7, vextq_u64(m4, m5, 1)); - - /* Rounds 34-35 */ - tmp = vaddq_u64(m1, vld1q_u64(&K[34])); - tmp = vextq_u64(tmp, tmp, 1); - tmp = vaddq_u64(ef, tmp); - tmp = vsha512hq_u64(tmp, vextq_u64(cd, ef, 1), vextq_u64(ab, cd, 1)); - ef = vsha512h2q_u64(tmp, ab, gh); - ab = vaddq_u64(ab, tmp); - m1 = vsha512su1q_u64(vsha512su0q_u64(m1, m2), m0, vextq_u64(m5, m6, 1)); - - /* Rounds 36-37 */ - tmp = vaddq_u64(m2, vld1q_u64(&K[36])); - tmp = vextq_u64(tmp, tmp, 1); - tmp = vaddq_u64(cd, tmp); - tmp = vsha512hq_u64(tmp, vextq_u64(ab, cd, 1), vextq_u64(gh, ab, 1)); - cd = vsha512h2q_u64(tmp, gh, ef); - gh = vaddq_u64(gh, tmp); - m2 = vsha512su1q_u64(vsha512su0q_u64(m2, m3), m1, vextq_u64(m6, m7, 1)); - - /* Rounds 38-39 */ - tmp = vaddq_u64(m3, vld1q_u64(&K[38])); - tmp = vextq_u64(tmp, tmp, 1); - tmp = vaddq_u64(ab, tmp); - tmp = vsha512hq_u64(tmp, vextq_u64(gh, ab, 1), vextq_u64(ef, gh, 1)); - ab = vsha512h2q_u64(tmp, ef, cd); - ef = vaddq_u64(ef, tmp); - m3 = vsha512su1q_u64(vsha512su0q_u64(m3, m4), m2, vextq_u64(m7, m0, 1)); - - /* Rounds 40-41 */ - tmp = vaddq_u64(m4, vld1q_u64(&K[40])); - tmp = vextq_u64(tmp, tmp, 1); - tmp = vaddq_u64(gh, tmp); - tmp = vsha512hq_u64(tmp, vextq_u64(ef, gh, 1), vextq_u64(cd, ef, 1)); - gh = vsha512h2q_u64(tmp, cd, ab); - cd = vaddq_u64(cd, tmp); - m4 = vsha512su1q_u64(vsha512su0q_u64(m4, m5), m3, vextq_u64(m0, m1, 1)); - - /* Rounds 42-43 */ - tmp = vaddq_u64(m5, vld1q_u64(&K[42])); - tmp = vextq_u64(tmp, tmp, 1); - tmp = vaddq_u64(ef, tmp); - tmp = vsha512hq_u64(tmp, vextq_u64(cd, ef, 1), vextq_u64(ab, cd, 1)); - ef = vsha512h2q_u64(tmp, ab, gh); - ab = vaddq_u64(ab, tmp); - m5 = vsha512su1q_u64(vsha512su0q_u64(m5, m6), m4, vextq_u64(m1, m2, 1)); - - /* Rounds 44-45 */ - tmp = vaddq_u64(m6, vld1q_u64(&K[44])); - tmp = vextq_u64(tmp, tmp, 1); - tmp = vaddq_u64(cd, tmp); - tmp = vsha512hq_u64(tmp, vextq_u64(ab, cd, 1), vextq_u64(gh, ab, 1)); - cd = vsha512h2q_u64(tmp, gh, ef); - gh = vaddq_u64(gh, tmp); - m6 = vsha512su1q_u64(vsha512su0q_u64(m6, m7), m5, vextq_u64(m2, m3, 1)); - - /* Rounds 46-47 */ - tmp = vaddq_u64(m7, vld1q_u64(&K[46])); - tmp = vextq_u64(tmp, tmp, 1); - tmp = vaddq_u64(ab, tmp); - tmp = vsha512hq_u64(tmp, vextq_u64(gh, ab, 1), vextq_u64(ef, gh, 1)); - ab = vsha512h2q_u64(tmp, ef, cd); - ef = vaddq_u64(ef, tmp); - m7 = vsha512su1q_u64(vsha512su0q_u64(m7, m0), m6, vextq_u64(m3, m4, 1)); - - /* Rounds 48-49 */ - tmp = vaddq_u64(m0, vld1q_u64(&K[48])); - tmp = vextq_u64(tmp, tmp, 1); - tmp = vaddq_u64(gh, tmp); - tmp = vsha512hq_u64(tmp, vextq_u64(ef, gh, 1), vextq_u64(cd, ef, 1)); - gh = vsha512h2q_u64(tmp, cd, ab); - cd = vaddq_u64(cd, tmp); - m0 = vsha512su1q_u64(vsha512su0q_u64(m0, m1), m7, vextq_u64(m4, m5, 1)); - - /* Rounds 50-51 */ - tmp = vaddq_u64(m1, vld1q_u64(&K[50])); - tmp = vextq_u64(tmp, tmp, 1); - tmp = vaddq_u64(ef, tmp); - tmp = vsha512hq_u64(tmp, vextq_u64(cd, ef, 1), vextq_u64(ab, cd, 1)); - ef = vsha512h2q_u64(tmp, ab, gh); - ab = vaddq_u64(ab, tmp); - m1 = vsha512su1q_u64(vsha512su0q_u64(m1, m2), m0, vextq_u64(m5, m6, 1)); - - /* Rounds 52-53 */ - tmp = vaddq_u64(m2, vld1q_u64(&K[52])); - tmp = vextq_u64(tmp, tmp, 1); - tmp = vaddq_u64(cd, tmp); - tmp = vsha512hq_u64(tmp, vextq_u64(ab, cd, 1), vextq_u64(gh, ab, 1)); - cd = vsha512h2q_u64(tmp, gh, ef); - gh = vaddq_u64(gh, tmp); - m2 = vsha512su1q_u64(vsha512su0q_u64(m2, m3), m1, vextq_u64(m6, m7, 1)); - - /* Rounds 54-55 */ - tmp = vaddq_u64(m3, vld1q_u64(&K[54])); - tmp = vextq_u64(tmp, tmp, 1); - tmp = vaddq_u64(ab, tmp); - tmp = vsha512hq_u64(tmp, vextq_u64(gh, ab, 1), vextq_u64(ef, gh, 1)); - ab = vsha512h2q_u64(tmp, ef, cd); - ef = vaddq_u64(ef, tmp); - m3 = vsha512su1q_u64(vsha512su0q_u64(m3, m4), m2, vextq_u64(m7, m0, 1)); - - /* Rounds 56-57 */ - tmp = vaddq_u64(m4, vld1q_u64(&K[56])); - tmp = vextq_u64(tmp, tmp, 1); - tmp = vaddq_u64(gh, tmp); - tmp = vsha512hq_u64(tmp, vextq_u64(ef, gh, 1), vextq_u64(cd, ef, 1)); - gh = vsha512h2q_u64(tmp, cd, ab); - cd = vaddq_u64(cd, tmp); - m4 = vsha512su1q_u64(vsha512su0q_u64(m4, m5), m3, vextq_u64(m0, m1, 1)); - - /* Rounds 58-59 */ - tmp = vaddq_u64(m5, vld1q_u64(&K[58])); - tmp = vextq_u64(tmp, tmp, 1); - tmp = vaddq_u64(ef, tmp); - tmp = vsha512hq_u64(tmp, vextq_u64(cd, ef, 1), vextq_u64(ab, cd, 1)); - ef = vsha512h2q_u64(tmp, ab, gh); - ab = vaddq_u64(ab, tmp); - m5 = vsha512su1q_u64(vsha512su0q_u64(m5, m6), m4, vextq_u64(m1, m2, 1)); - - /* Rounds 60-61 */ - tmp = vaddq_u64(m6, vld1q_u64(&K[60])); - tmp = vextq_u64(tmp, tmp, 1); - tmp = vaddq_u64(cd, tmp); - tmp = vsha512hq_u64(tmp, vextq_u64(ab, cd, 1), vextq_u64(gh, ab, 1)); - cd = vsha512h2q_u64(tmp, gh, ef); - gh = vaddq_u64(gh, tmp); - m6 = vsha512su1q_u64(vsha512su0q_u64(m6, m7), m5, vextq_u64(m2, m3, 1)); - - /* Rounds 62-63 */ - tmp = vaddq_u64(m7, vld1q_u64(&K[62])); - tmp = vextq_u64(tmp, tmp, 1); - tmp = vaddq_u64(ab, tmp); - tmp = vsha512hq_u64(tmp, vextq_u64(gh, ab, 1), vextq_u64(ef, gh, 1)); - ab = vsha512h2q_u64(tmp, ef, cd); - ef = vaddq_u64(ef, tmp); - m7 = vsha512su1q_u64(vsha512su0q_u64(m7, m0), m6, vextq_u64(m3, m4, 1)); - - /* Rounds 64-65 */ - tmp = vaddq_u64(m0, vld1q_u64(&K[64])); - tmp = vextq_u64(tmp, tmp, 1); - tmp = vaddq_u64(gh, tmp); - tmp = vsha512hq_u64(tmp, vextq_u64(ef, gh, 1), vextq_u64(cd, ef, 1)); - gh = vsha512h2q_u64(tmp, cd, ab); - cd = vaddq_u64(cd, tmp); - - /* Rounds 66-67 */ - tmp = vaddq_u64(m1, vld1q_u64(&K[66])); - tmp = vextq_u64(tmp, tmp, 1); - tmp = vaddq_u64(ef, tmp); - tmp = vsha512hq_u64(tmp, vextq_u64(cd, ef, 1), vextq_u64(ab, cd, 1)); - ef = vsha512h2q_u64(tmp, ab, gh); - ab = vaddq_u64(ab, tmp); - - /* Rounds 68-69 */ - tmp = vaddq_u64(m2, vld1q_u64(&K[68])); - tmp = vextq_u64(tmp, tmp, 1); - tmp = vaddq_u64(cd, tmp); - tmp = vsha512hq_u64(tmp, vextq_u64(ab, cd, 1), vextq_u64(gh, ab, 1)); - cd = vsha512h2q_u64(tmp, gh, ef); - gh = vaddq_u64(gh, tmp); - - /* Rounds 70-71 */ - tmp = vaddq_u64(m3, vld1q_u64(&K[70])); - tmp = vextq_u64(tmp, tmp, 1); - tmp = vaddq_u64(ab, tmp); - tmp = vsha512hq_u64(tmp, vextq_u64(gh, ab, 1), vextq_u64(ef, gh, 1)); - ab = vsha512h2q_u64(tmp, ef, cd); - ef = vaddq_u64(ef, tmp); - - /* Rounds 72-73 */ - tmp = vaddq_u64(m4, vld1q_u64(&K[72])); - tmp = vextq_u64(tmp, tmp, 1); - tmp = vaddq_u64(gh, tmp); - tmp = vsha512hq_u64(tmp, vextq_u64(ef, gh, 1), vextq_u64(cd, ef, 1)); - gh = vsha512h2q_u64(tmp, cd, ab); - cd = vaddq_u64(cd, tmp); - - /* Rounds 74-75 */ - tmp = vaddq_u64(m5, vld1q_u64(&K[74])); - tmp = vextq_u64(tmp, tmp, 1); - tmp = vaddq_u64(ef, tmp); - tmp = vsha512hq_u64(tmp, vextq_u64(cd, ef, 1), vextq_u64(ab, cd, 1)); - ef = vsha512h2q_u64(tmp, ab, gh); - ab = vaddq_u64(ab, tmp); - - /* Rounds 76-77 */ - tmp = vaddq_u64(m6, vld1q_u64(&K[76])); - tmp = vextq_u64(tmp, tmp, 1); - tmp = vaddq_u64(cd, tmp); - tmp = vsha512hq_u64(tmp, vextq_u64(ab, cd, 1), vextq_u64(gh, ab, 1)); - cd = vsha512h2q_u64(tmp, gh, ef); - gh = vaddq_u64(gh, tmp); - - /* Rounds 78-79 */ - tmp = vaddq_u64(m7, vld1q_u64(&K[78])); - tmp = vextq_u64(tmp, tmp, 1); - tmp = vaddq_u64(ab, tmp); - tmp = vsha512hq_u64(tmp, vextq_u64(gh, ab, 1), vextq_u64(ef, gh, 1)); - ab = vsha512h2q_u64(tmp, ef, cd); - ef = vaddq_u64(ef, tmp); - - /* Add original state back */ - ab = vaddq_u64(ab, ab_orig); - cd = vaddq_u64(cd, cd_orig); - ef = vaddq_u64(ef, ef_orig); - gh = vaddq_u64(gh, gh_orig); - - /* Store result */ - vst1q_u64(&state[0], ab); - vst1q_u64(&state[2], cd); - vst1q_u64(&state[4], ef); - vst1q_u64(&state[6], gh); -} - -#if defined(__APPLE__) -static int sysctl_flag(const char *name) { - int val = 0; - size_t len = sizeof(val); - if (sysctlbyname(name, &val, &len, NULL, 0) != 0) return 0; - return val != 0; -} -#endif - -/* - * Return 1 if the CPU implements the ARM SHA512 extension, 0 - * otherwise. We only know how to ask Darwin and Linux, and report 0 - * (selecting the pure Haskell fallback) on any other OS. - */ -int sha512_arm_available(void) { -#if defined(__APPLE__) - return sysctl_flag("hw.optional.arm.FEAT_SHA512") - || sysctl_flag("hw.optional.armv8_2_sha512"); -#elif defined(__linux__) - return (getauxval(AT_HWCAP) & HWCAP_SHA512) != 0; -#else - return 0; -#endif -} - -#else - -/* Stub implementations for non-aarch64 builds */ -void sha512_block_arm(uint64_t *state, const uint64_t *block) { - (void)state; - (void)block; - /* Should never be called - use pure Haskell fallback */ -} - -int sha512_arm_available(void) { - return 0; -} - -#endif diff --git a/cbits/sha512_native.c b/cbits/sha512_native.c new file mode 100644 --- /dev/null +++ b/cbits/sha512_native.c @@ -0,0 +1,754 @@ +#include +#include + +/* + * The x86 SHA512 intrinsics arrived in GCC 14 and Clang 18; older + * compilers get the stubs below. + */ +#if defined(__x86_64__) && defined(__has_include) +#if __has_include() +#define HAVE_X86_SHA512 +#endif +#endif + +#if defined(__aarch64__) + +#include + +#if defined(__APPLE__) +#include +#elif defined(__linux__) +#include +#ifndef HWCAP_SHA512 +#define HWCAP_SHA512 (1UL << 21) +#endif +#endif + +#elif defined(HAVE_X86_SHA512) + +#include +#include + +#ifndef bit_SHA512 +#define bit_SHA512 (1 << 0) +#endif + +#endif + +#if defined(__aarch64__) || defined(HAVE_X86_SHA512) + +static const uint64_t K[80] = { + 0x428a2f98d728ae22ULL, 0x7137449123ef65cdULL, + 0xb5c0fbcfec4d3b2fULL, 0xe9b5dba58189dbbcULL, + 0x3956c25bf348b538ULL, 0x59f111f1b605d019ULL, + 0x923f82a4af194f9bULL, 0xab1c5ed5da6d8118ULL, + 0xd807aa98a3030242ULL, 0x12835b0145706fbeULL, + 0x243185be4ee4b28cULL, 0x550c7dc3d5ffb4e2ULL, + 0x72be5d74f27b896fULL, 0x80deb1fe3b1696b1ULL, + 0x9bdc06a725c71235ULL, 0xc19bf174cf692694ULL, + 0xe49b69c19ef14ad2ULL, 0xefbe4786384f25e3ULL, + 0x0fc19dc68b8cd5b5ULL, 0x240ca1cc77ac9c65ULL, + 0x2de92c6f592b0275ULL, 0x4a7484aa6ea6e483ULL, + 0x5cb0a9dcbd41fbd4ULL, 0x76f988da831153b5ULL, + 0x983e5152ee66dfabULL, 0xa831c66d2db43210ULL, + 0xb00327c898fb213fULL, 0xbf597fc7beef0ee4ULL, + 0xc6e00bf33da88fc2ULL, 0xd5a79147930aa725ULL, + 0x06ca6351e003826fULL, 0x142929670a0e6e70ULL, + 0x27b70a8546d22ffcULL, 0x2e1b21385c26c926ULL, + 0x4d2c6dfc5ac42aedULL, 0x53380d139d95b3dfULL, + 0x650a73548baf63deULL, 0x766a0abb3c77b2a8ULL, + 0x81c2c92e47edaee6ULL, 0x92722c851482353bULL, + 0xa2bfe8a14cf10364ULL, 0xa81a664bbc423001ULL, + 0xc24b8b70d0f89791ULL, 0xc76c51a30654be30ULL, + 0xd192e819d6ef5218ULL, 0xd69906245565a910ULL, + 0xf40e35855771202aULL, 0x106aa07032bbd1b8ULL, + 0x19a4c116b8d2d0c8ULL, 0x1e376c085141ab53ULL, + 0x2748774cdf8eeb99ULL, 0x34b0bcb5e19b48a8ULL, + 0x391c0cb3c5c95a63ULL, 0x4ed8aa4ae3418acbULL, + 0x5b9cca4f7763e373ULL, 0x682e6ff3d6b2b8a3ULL, + 0x748f82ee5defb2fcULL, 0x78a5636f43172f60ULL, + 0x84c87814a1f0ab72ULL, 0x8cc702081a6439ecULL, + 0x90befffa23631e28ULL, 0xa4506cebde82bde9ULL, + 0xbef9a3f7b2c67915ULL, 0xc67178f2e372532bULL, + 0xca273eceea26619cULL, 0xd186b8c721c0c207ULL, + 0xeada7dd6cde0eb1eULL, 0xf57d4f7fee6ed178ULL, + 0x06f067aa72176fbaULL, 0x0a637dc5a2c898a6ULL, + 0x113f9804bef90daeULL, 0x1b710b35131c471bULL, + 0x28db77f523047d84ULL, 0x32caab7b40c72493ULL, + 0x3c9ebe0a15c9bebcULL, 0x431d67c49c100d4cULL, + 0x4cc5d4becb3e42b6ULL, 0x597f299cfc657e2aULL, + 0x5fcb6fab3ad6faecULL, 0x6c44198c4a475817ULL +}; + +#endif + +#if defined(__aarch64__) + +/* + * Process one 128-byte block using ARM SHA512 crypto instructions. + * + * state: pointer to 8 uint64_t words (a,b,c,d,e,f,g,h) + * block: pointer to 16 uint64_t words (already native endian) + * + * The state is updated in place. + * + * Compiled for the SHA512 extension only; callers must first check + * 'sha512_native_available'. + */ +__attribute__((target("+sha3"))) +void sha512_block_native(uint64_t *state, const uint64_t *block) { + /* Load current hash state */ + uint64x2_t ab = vld1q_u64(&state[0]); + uint64x2_t cd = vld1q_u64(&state[2]); + uint64x2_t ef = vld1q_u64(&state[4]); + uint64x2_t gh = vld1q_u64(&state[6]); + + /* Save original for final addition */ + uint64x2_t ab_orig = ab; + uint64x2_t cd_orig = cd; + uint64x2_t ef_orig = ef; + uint64x2_t gh_orig = gh; + + /* Load message (already native endian) */ + uint64x2_t m0 = vld1q_u64(&block[0]); + uint64x2_t m1 = vld1q_u64(&block[2]); + uint64x2_t m2 = vld1q_u64(&block[4]); + uint64x2_t m3 = vld1q_u64(&block[6]); + uint64x2_t m4 = vld1q_u64(&block[8]); + uint64x2_t m5 = vld1q_u64(&block[10]); + uint64x2_t m6 = vld1q_u64(&block[12]); + uint64x2_t m7 = vld1q_u64(&block[14]); + + uint64x2_t tmp; + + /* Rounds 0-1 */ + tmp = vaddq_u64(m0, vld1q_u64(&K[0])); + tmp = vextq_u64(tmp, tmp, 1); + tmp = vaddq_u64(gh, tmp); + tmp = vsha512hq_u64(tmp, vextq_u64(ef, gh, 1), vextq_u64(cd, ef, 1)); + gh = vsha512h2q_u64(tmp, cd, ab); + cd = vaddq_u64(cd, tmp); + m0 = vsha512su1q_u64(vsha512su0q_u64(m0, m1), m7, vextq_u64(m4, m5, 1)); + + /* Rounds 2-3 */ + tmp = vaddq_u64(m1, vld1q_u64(&K[2])); + tmp = vextq_u64(tmp, tmp, 1); + tmp = vaddq_u64(ef, tmp); + tmp = vsha512hq_u64(tmp, vextq_u64(cd, ef, 1), vextq_u64(ab, cd, 1)); + ef = vsha512h2q_u64(tmp, ab, gh); + ab = vaddq_u64(ab, tmp); + m1 = vsha512su1q_u64(vsha512su0q_u64(m1, m2), m0, vextq_u64(m5, m6, 1)); + + /* Rounds 4-5 */ + tmp = vaddq_u64(m2, vld1q_u64(&K[4])); + tmp = vextq_u64(tmp, tmp, 1); + tmp = vaddq_u64(cd, tmp); + tmp = vsha512hq_u64(tmp, vextq_u64(ab, cd, 1), vextq_u64(gh, ab, 1)); + cd = vsha512h2q_u64(tmp, gh, ef); + gh = vaddq_u64(gh, tmp); + m2 = vsha512su1q_u64(vsha512su0q_u64(m2, m3), m1, vextq_u64(m6, m7, 1)); + + /* Rounds 6-7 */ + tmp = vaddq_u64(m3, vld1q_u64(&K[6])); + tmp = vextq_u64(tmp, tmp, 1); + tmp = vaddq_u64(ab, tmp); + tmp = vsha512hq_u64(tmp, vextq_u64(gh, ab, 1), vextq_u64(ef, gh, 1)); + ab = vsha512h2q_u64(tmp, ef, cd); + ef = vaddq_u64(ef, tmp); + m3 = vsha512su1q_u64(vsha512su0q_u64(m3, m4), m2, vextq_u64(m7, m0, 1)); + + /* Rounds 8-9 */ + tmp = vaddq_u64(m4, vld1q_u64(&K[8])); + tmp = vextq_u64(tmp, tmp, 1); + tmp = vaddq_u64(gh, tmp); + tmp = vsha512hq_u64(tmp, vextq_u64(ef, gh, 1), vextq_u64(cd, ef, 1)); + gh = vsha512h2q_u64(tmp, cd, ab); + cd = vaddq_u64(cd, tmp); + m4 = vsha512su1q_u64(vsha512su0q_u64(m4, m5), m3, vextq_u64(m0, m1, 1)); + + /* Rounds 10-11 */ + tmp = vaddq_u64(m5, vld1q_u64(&K[10])); + tmp = vextq_u64(tmp, tmp, 1); + tmp = vaddq_u64(ef, tmp); + tmp = vsha512hq_u64(tmp, vextq_u64(cd, ef, 1), vextq_u64(ab, cd, 1)); + ef = vsha512h2q_u64(tmp, ab, gh); + ab = vaddq_u64(ab, tmp); + m5 = vsha512su1q_u64(vsha512su0q_u64(m5, m6), m4, vextq_u64(m1, m2, 1)); + + /* Rounds 12-13 */ + tmp = vaddq_u64(m6, vld1q_u64(&K[12])); + tmp = vextq_u64(tmp, tmp, 1); + tmp = vaddq_u64(cd, tmp); + tmp = vsha512hq_u64(tmp, vextq_u64(ab, cd, 1), vextq_u64(gh, ab, 1)); + cd = vsha512h2q_u64(tmp, gh, ef); + gh = vaddq_u64(gh, tmp); + m6 = vsha512su1q_u64(vsha512su0q_u64(m6, m7), m5, vextq_u64(m2, m3, 1)); + + /* Rounds 14-15 */ + tmp = vaddq_u64(m7, vld1q_u64(&K[14])); + tmp = vextq_u64(tmp, tmp, 1); + tmp = vaddq_u64(ab, tmp); + tmp = vsha512hq_u64(tmp, vextq_u64(gh, ab, 1), vextq_u64(ef, gh, 1)); + ab = vsha512h2q_u64(tmp, ef, cd); + ef = vaddq_u64(ef, tmp); + m7 = vsha512su1q_u64(vsha512su0q_u64(m7, m0), m6, vextq_u64(m3, m4, 1)); + + /* Rounds 16-17 */ + tmp = vaddq_u64(m0, vld1q_u64(&K[16])); + tmp = vextq_u64(tmp, tmp, 1); + tmp = vaddq_u64(gh, tmp); + tmp = vsha512hq_u64(tmp, vextq_u64(ef, gh, 1), vextq_u64(cd, ef, 1)); + gh = vsha512h2q_u64(tmp, cd, ab); + cd = vaddq_u64(cd, tmp); + m0 = vsha512su1q_u64(vsha512su0q_u64(m0, m1), m7, vextq_u64(m4, m5, 1)); + + /* Rounds 18-19 */ + tmp = vaddq_u64(m1, vld1q_u64(&K[18])); + tmp = vextq_u64(tmp, tmp, 1); + tmp = vaddq_u64(ef, tmp); + tmp = vsha512hq_u64(tmp, vextq_u64(cd, ef, 1), vextq_u64(ab, cd, 1)); + ef = vsha512h2q_u64(tmp, ab, gh); + ab = vaddq_u64(ab, tmp); + m1 = vsha512su1q_u64(vsha512su0q_u64(m1, m2), m0, vextq_u64(m5, m6, 1)); + + /* Rounds 20-21 */ + tmp = vaddq_u64(m2, vld1q_u64(&K[20])); + tmp = vextq_u64(tmp, tmp, 1); + tmp = vaddq_u64(cd, tmp); + tmp = vsha512hq_u64(tmp, vextq_u64(ab, cd, 1), vextq_u64(gh, ab, 1)); + cd = vsha512h2q_u64(tmp, gh, ef); + gh = vaddq_u64(gh, tmp); + m2 = vsha512su1q_u64(vsha512su0q_u64(m2, m3), m1, vextq_u64(m6, m7, 1)); + + /* Rounds 22-23 */ + tmp = vaddq_u64(m3, vld1q_u64(&K[22])); + tmp = vextq_u64(tmp, tmp, 1); + tmp = vaddq_u64(ab, tmp); + tmp = vsha512hq_u64(tmp, vextq_u64(gh, ab, 1), vextq_u64(ef, gh, 1)); + ab = vsha512h2q_u64(tmp, ef, cd); + ef = vaddq_u64(ef, tmp); + m3 = vsha512su1q_u64(vsha512su0q_u64(m3, m4), m2, vextq_u64(m7, m0, 1)); + + /* Rounds 24-25 */ + tmp = vaddq_u64(m4, vld1q_u64(&K[24])); + tmp = vextq_u64(tmp, tmp, 1); + tmp = vaddq_u64(gh, tmp); + tmp = vsha512hq_u64(tmp, vextq_u64(ef, gh, 1), vextq_u64(cd, ef, 1)); + gh = vsha512h2q_u64(tmp, cd, ab); + cd = vaddq_u64(cd, tmp); + m4 = vsha512su1q_u64(vsha512su0q_u64(m4, m5), m3, vextq_u64(m0, m1, 1)); + + /* Rounds 26-27 */ + tmp = vaddq_u64(m5, vld1q_u64(&K[26])); + tmp = vextq_u64(tmp, tmp, 1); + tmp = vaddq_u64(ef, tmp); + tmp = vsha512hq_u64(tmp, vextq_u64(cd, ef, 1), vextq_u64(ab, cd, 1)); + ef = vsha512h2q_u64(tmp, ab, gh); + ab = vaddq_u64(ab, tmp); + m5 = vsha512su1q_u64(vsha512su0q_u64(m5, m6), m4, vextq_u64(m1, m2, 1)); + + /* Rounds 28-29 */ + tmp = vaddq_u64(m6, vld1q_u64(&K[28])); + tmp = vextq_u64(tmp, tmp, 1); + tmp = vaddq_u64(cd, tmp); + tmp = vsha512hq_u64(tmp, vextq_u64(ab, cd, 1), vextq_u64(gh, ab, 1)); + cd = vsha512h2q_u64(tmp, gh, ef); + gh = vaddq_u64(gh, tmp); + m6 = vsha512su1q_u64(vsha512su0q_u64(m6, m7), m5, vextq_u64(m2, m3, 1)); + + /* Rounds 30-31 */ + tmp = vaddq_u64(m7, vld1q_u64(&K[30])); + tmp = vextq_u64(tmp, tmp, 1); + tmp = vaddq_u64(ab, tmp); + tmp = vsha512hq_u64(tmp, vextq_u64(gh, ab, 1), vextq_u64(ef, gh, 1)); + ab = vsha512h2q_u64(tmp, ef, cd); + ef = vaddq_u64(ef, tmp); + m7 = vsha512su1q_u64(vsha512su0q_u64(m7, m0), m6, vextq_u64(m3, m4, 1)); + + /* Rounds 32-33 */ + tmp = vaddq_u64(m0, vld1q_u64(&K[32])); + tmp = vextq_u64(tmp, tmp, 1); + tmp = vaddq_u64(gh, tmp); + tmp = vsha512hq_u64(tmp, vextq_u64(ef, gh, 1), vextq_u64(cd, ef, 1)); + gh = vsha512h2q_u64(tmp, cd, ab); + cd = vaddq_u64(cd, tmp); + m0 = vsha512su1q_u64(vsha512su0q_u64(m0, m1), m7, vextq_u64(m4, m5, 1)); + + /* Rounds 34-35 */ + tmp = vaddq_u64(m1, vld1q_u64(&K[34])); + tmp = vextq_u64(tmp, tmp, 1); + tmp = vaddq_u64(ef, tmp); + tmp = vsha512hq_u64(tmp, vextq_u64(cd, ef, 1), vextq_u64(ab, cd, 1)); + ef = vsha512h2q_u64(tmp, ab, gh); + ab = vaddq_u64(ab, tmp); + m1 = vsha512su1q_u64(vsha512su0q_u64(m1, m2), m0, vextq_u64(m5, m6, 1)); + + /* Rounds 36-37 */ + tmp = vaddq_u64(m2, vld1q_u64(&K[36])); + tmp = vextq_u64(tmp, tmp, 1); + tmp = vaddq_u64(cd, tmp); + tmp = vsha512hq_u64(tmp, vextq_u64(ab, cd, 1), vextq_u64(gh, ab, 1)); + cd = vsha512h2q_u64(tmp, gh, ef); + gh = vaddq_u64(gh, tmp); + m2 = vsha512su1q_u64(vsha512su0q_u64(m2, m3), m1, vextq_u64(m6, m7, 1)); + + /* Rounds 38-39 */ + tmp = vaddq_u64(m3, vld1q_u64(&K[38])); + tmp = vextq_u64(tmp, tmp, 1); + tmp = vaddq_u64(ab, tmp); + tmp = vsha512hq_u64(tmp, vextq_u64(gh, ab, 1), vextq_u64(ef, gh, 1)); + ab = vsha512h2q_u64(tmp, ef, cd); + ef = vaddq_u64(ef, tmp); + m3 = vsha512su1q_u64(vsha512su0q_u64(m3, m4), m2, vextq_u64(m7, m0, 1)); + + /* Rounds 40-41 */ + tmp = vaddq_u64(m4, vld1q_u64(&K[40])); + tmp = vextq_u64(tmp, tmp, 1); + tmp = vaddq_u64(gh, tmp); + tmp = vsha512hq_u64(tmp, vextq_u64(ef, gh, 1), vextq_u64(cd, ef, 1)); + gh = vsha512h2q_u64(tmp, cd, ab); + cd = vaddq_u64(cd, tmp); + m4 = vsha512su1q_u64(vsha512su0q_u64(m4, m5), m3, vextq_u64(m0, m1, 1)); + + /* Rounds 42-43 */ + tmp = vaddq_u64(m5, vld1q_u64(&K[42])); + tmp = vextq_u64(tmp, tmp, 1); + tmp = vaddq_u64(ef, tmp); + tmp = vsha512hq_u64(tmp, vextq_u64(cd, ef, 1), vextq_u64(ab, cd, 1)); + ef = vsha512h2q_u64(tmp, ab, gh); + ab = vaddq_u64(ab, tmp); + m5 = vsha512su1q_u64(vsha512su0q_u64(m5, m6), m4, vextq_u64(m1, m2, 1)); + + /* Rounds 44-45 */ + tmp = vaddq_u64(m6, vld1q_u64(&K[44])); + tmp = vextq_u64(tmp, tmp, 1); + tmp = vaddq_u64(cd, tmp); + tmp = vsha512hq_u64(tmp, vextq_u64(ab, cd, 1), vextq_u64(gh, ab, 1)); + cd = vsha512h2q_u64(tmp, gh, ef); + gh = vaddq_u64(gh, tmp); + m6 = vsha512su1q_u64(vsha512su0q_u64(m6, m7), m5, vextq_u64(m2, m3, 1)); + + /* Rounds 46-47 */ + tmp = vaddq_u64(m7, vld1q_u64(&K[46])); + tmp = vextq_u64(tmp, tmp, 1); + tmp = vaddq_u64(ab, tmp); + tmp = vsha512hq_u64(tmp, vextq_u64(gh, ab, 1), vextq_u64(ef, gh, 1)); + ab = vsha512h2q_u64(tmp, ef, cd); + ef = vaddq_u64(ef, tmp); + m7 = vsha512su1q_u64(vsha512su0q_u64(m7, m0), m6, vextq_u64(m3, m4, 1)); + + /* Rounds 48-49 */ + tmp = vaddq_u64(m0, vld1q_u64(&K[48])); + tmp = vextq_u64(tmp, tmp, 1); + tmp = vaddq_u64(gh, tmp); + tmp = vsha512hq_u64(tmp, vextq_u64(ef, gh, 1), vextq_u64(cd, ef, 1)); + gh = vsha512h2q_u64(tmp, cd, ab); + cd = vaddq_u64(cd, tmp); + m0 = vsha512su1q_u64(vsha512su0q_u64(m0, m1), m7, vextq_u64(m4, m5, 1)); + + /* Rounds 50-51 */ + tmp = vaddq_u64(m1, vld1q_u64(&K[50])); + tmp = vextq_u64(tmp, tmp, 1); + tmp = vaddq_u64(ef, tmp); + tmp = vsha512hq_u64(tmp, vextq_u64(cd, ef, 1), vextq_u64(ab, cd, 1)); + ef = vsha512h2q_u64(tmp, ab, gh); + ab = vaddq_u64(ab, tmp); + m1 = vsha512su1q_u64(vsha512su0q_u64(m1, m2), m0, vextq_u64(m5, m6, 1)); + + /* Rounds 52-53 */ + tmp = vaddq_u64(m2, vld1q_u64(&K[52])); + tmp = vextq_u64(tmp, tmp, 1); + tmp = vaddq_u64(cd, tmp); + tmp = vsha512hq_u64(tmp, vextq_u64(ab, cd, 1), vextq_u64(gh, ab, 1)); + cd = vsha512h2q_u64(tmp, gh, ef); + gh = vaddq_u64(gh, tmp); + m2 = vsha512su1q_u64(vsha512su0q_u64(m2, m3), m1, vextq_u64(m6, m7, 1)); + + /* Rounds 54-55 */ + tmp = vaddq_u64(m3, vld1q_u64(&K[54])); + tmp = vextq_u64(tmp, tmp, 1); + tmp = vaddq_u64(ab, tmp); + tmp = vsha512hq_u64(tmp, vextq_u64(gh, ab, 1), vextq_u64(ef, gh, 1)); + ab = vsha512h2q_u64(tmp, ef, cd); + ef = vaddq_u64(ef, tmp); + m3 = vsha512su1q_u64(vsha512su0q_u64(m3, m4), m2, vextq_u64(m7, m0, 1)); + + /* Rounds 56-57 */ + tmp = vaddq_u64(m4, vld1q_u64(&K[56])); + tmp = vextq_u64(tmp, tmp, 1); + tmp = vaddq_u64(gh, tmp); + tmp = vsha512hq_u64(tmp, vextq_u64(ef, gh, 1), vextq_u64(cd, ef, 1)); + gh = vsha512h2q_u64(tmp, cd, ab); + cd = vaddq_u64(cd, tmp); + m4 = vsha512su1q_u64(vsha512su0q_u64(m4, m5), m3, vextq_u64(m0, m1, 1)); + + /* Rounds 58-59 */ + tmp = vaddq_u64(m5, vld1q_u64(&K[58])); + tmp = vextq_u64(tmp, tmp, 1); + tmp = vaddq_u64(ef, tmp); + tmp = vsha512hq_u64(tmp, vextq_u64(cd, ef, 1), vextq_u64(ab, cd, 1)); + ef = vsha512h2q_u64(tmp, ab, gh); + ab = vaddq_u64(ab, tmp); + m5 = vsha512su1q_u64(vsha512su0q_u64(m5, m6), m4, vextq_u64(m1, m2, 1)); + + /* Rounds 60-61 */ + tmp = vaddq_u64(m6, vld1q_u64(&K[60])); + tmp = vextq_u64(tmp, tmp, 1); + tmp = vaddq_u64(cd, tmp); + tmp = vsha512hq_u64(tmp, vextq_u64(ab, cd, 1), vextq_u64(gh, ab, 1)); + cd = vsha512h2q_u64(tmp, gh, ef); + gh = vaddq_u64(gh, tmp); + m6 = vsha512su1q_u64(vsha512su0q_u64(m6, m7), m5, vextq_u64(m2, m3, 1)); + + /* Rounds 62-63 */ + tmp = vaddq_u64(m7, vld1q_u64(&K[62])); + tmp = vextq_u64(tmp, tmp, 1); + tmp = vaddq_u64(ab, tmp); + tmp = vsha512hq_u64(tmp, vextq_u64(gh, ab, 1), vextq_u64(ef, gh, 1)); + ab = vsha512h2q_u64(tmp, ef, cd); + ef = vaddq_u64(ef, tmp); + m7 = vsha512su1q_u64(vsha512su0q_u64(m7, m0), m6, vextq_u64(m3, m4, 1)); + + /* Rounds 64-65 */ + tmp = vaddq_u64(m0, vld1q_u64(&K[64])); + tmp = vextq_u64(tmp, tmp, 1); + tmp = vaddq_u64(gh, tmp); + tmp = vsha512hq_u64(tmp, vextq_u64(ef, gh, 1), vextq_u64(cd, ef, 1)); + gh = vsha512h2q_u64(tmp, cd, ab); + cd = vaddq_u64(cd, tmp); + + /* Rounds 66-67 */ + tmp = vaddq_u64(m1, vld1q_u64(&K[66])); + tmp = vextq_u64(tmp, tmp, 1); + tmp = vaddq_u64(ef, tmp); + tmp = vsha512hq_u64(tmp, vextq_u64(cd, ef, 1), vextq_u64(ab, cd, 1)); + ef = vsha512h2q_u64(tmp, ab, gh); + ab = vaddq_u64(ab, tmp); + + /* Rounds 68-69 */ + tmp = vaddq_u64(m2, vld1q_u64(&K[68])); + tmp = vextq_u64(tmp, tmp, 1); + tmp = vaddq_u64(cd, tmp); + tmp = vsha512hq_u64(tmp, vextq_u64(ab, cd, 1), vextq_u64(gh, ab, 1)); + cd = vsha512h2q_u64(tmp, gh, ef); + gh = vaddq_u64(gh, tmp); + + /* Rounds 70-71 */ + tmp = vaddq_u64(m3, vld1q_u64(&K[70])); + tmp = vextq_u64(tmp, tmp, 1); + tmp = vaddq_u64(ab, tmp); + tmp = vsha512hq_u64(tmp, vextq_u64(gh, ab, 1), vextq_u64(ef, gh, 1)); + ab = vsha512h2q_u64(tmp, ef, cd); + ef = vaddq_u64(ef, tmp); + + /* Rounds 72-73 */ + tmp = vaddq_u64(m4, vld1q_u64(&K[72])); + tmp = vextq_u64(tmp, tmp, 1); + tmp = vaddq_u64(gh, tmp); + tmp = vsha512hq_u64(tmp, vextq_u64(ef, gh, 1), vextq_u64(cd, ef, 1)); + gh = vsha512h2q_u64(tmp, cd, ab); + cd = vaddq_u64(cd, tmp); + + /* Rounds 74-75 */ + tmp = vaddq_u64(m5, vld1q_u64(&K[74])); + tmp = vextq_u64(tmp, tmp, 1); + tmp = vaddq_u64(ef, tmp); + tmp = vsha512hq_u64(tmp, vextq_u64(cd, ef, 1), vextq_u64(ab, cd, 1)); + ef = vsha512h2q_u64(tmp, ab, gh); + ab = vaddq_u64(ab, tmp); + + /* Rounds 76-77 */ + tmp = vaddq_u64(m6, vld1q_u64(&K[76])); + tmp = vextq_u64(tmp, tmp, 1); + tmp = vaddq_u64(cd, tmp); + tmp = vsha512hq_u64(tmp, vextq_u64(ab, cd, 1), vextq_u64(gh, ab, 1)); + cd = vsha512h2q_u64(tmp, gh, ef); + gh = vaddq_u64(gh, tmp); + + /* Rounds 78-79 */ + tmp = vaddq_u64(m7, vld1q_u64(&K[78])); + tmp = vextq_u64(tmp, tmp, 1); + tmp = vaddq_u64(ab, tmp); + tmp = vsha512hq_u64(tmp, vextq_u64(gh, ab, 1), vextq_u64(ef, gh, 1)); + ab = vsha512h2q_u64(tmp, ef, cd); + ef = vaddq_u64(ef, tmp); + + /* Add original state back */ + ab = vaddq_u64(ab, ab_orig); + cd = vaddq_u64(cd, cd_orig); + ef = vaddq_u64(ef, ef_orig); + gh = vaddq_u64(gh, gh_orig); + + /* Store result */ + vst1q_u64(&state[0], ab); + vst1q_u64(&state[2], cd); + vst1q_u64(&state[4], ef); + vst1q_u64(&state[6], gh); +} + +#if defined(__APPLE__) +static int sysctl_flag(const char *name) { + int val = 0; + size_t len = sizeof(val); + if (sysctlbyname(name, &val, &len, NULL, 0) != 0) return 0; + return val != 0; +} +#endif + +/* + * Return 1 if the CPU implements the ARM SHA512 extension, 0 + * otherwise. We only know how to ask Darwin and Linux, and report 0 + * (selecting the pure Haskell fallback) on any other OS. + */ +int sha512_native_available(void) { +#if defined(__APPLE__) + return sysctl_flag("hw.optional.arm.FEAT_SHA512") + || sysctl_flag("hw.optional.armv8_2_sha512"); +#elif defined(__linux__) + return (getauxval(AT_HWCAP) & HWCAP_SHA512) != 0; +#else + return 0; +#endif +} + +#elif defined(HAVE_X86_SHA512) + +/* + * Four rounds. 'sha512rnds2' does two: it takes the (c,d,g,h) and + * (a,b,e,f) halves of the state, and two message-plus-constant words + * in its third argument, and returns the new (a,b,e,f). The old + * (a,b,e,f) is then the new (c,d,g,h), so a second call with the + * halves swapped, on the upper two words, does the next two. + */ +#define ROUNDS4(abef, cdgh, msg) \ + do { \ + cdgh = _mm256_sha512rnds2_epi64(cdgh, abef, \ + _mm256_castsi256_si128(msg)); \ + abef = _mm256_sha512rnds2_epi64(abef, cdgh, \ + _mm256_extracti128_si256(msg, 1)); \ + } while (0) + +/* + * The four words following prev[0], i.e. (prev[1], prev[2], prev[3], + * cur[0]) from lowest lane to highest. + */ +#define ALIGNR1(cur, prev) \ + _mm256_permute4x64_epi64(_mm256_blend_epi32(prev, cur, 0x03), 0x39) + +/* + * Process one 128-byte block using x86 SHA512 instructions. + * + * state: pointer to 8 uint64_t words (a,b,c,d,e,f,g,h) + * block: pointer to 16 uint64_t words (already native endian) + * + * The state is updated in place. + * + * Compiled for the SHA512 and AVX2 extensions only; callers must first + * check 'sha512_native_available'. + * + * Lane orders in comments are written from highest lane to lowest. + */ +__attribute__((target("avx2,sha512"))) +void sha512_block_native(uint64_t *state, const uint64_t *block) { + __m256i abcd, efgh, abef, cdgh, abef_orig, cdgh_orig; + __m256i m0, m1, m2, m3, msg; + + /* Load current hash state, rearranging it for the SHA instructions */ + abcd = _mm256_loadu_si256((const __m256i *)&state[0]); /* d c b a */ + efgh = _mm256_loadu_si256((const __m256i *)&state[4]); /* h g f e */ + abef = _mm256_permute4x64_epi64( + _mm256_permute2x128_si256(abcd, efgh, 0x20), 0x1b); + /* a b e f */ + cdgh = _mm256_permute4x64_epi64( + _mm256_permute2x128_si256(abcd, efgh, 0x31), 0x1b); + /* c d g h */ + + /* Save original for final addition */ + abef_orig = abef; + cdgh_orig = cdgh; + + /* Load message (already native endian) */ + m0 = _mm256_loadu_si256((const __m256i *)&block[0]); + m1 = _mm256_loadu_si256((const __m256i *)&block[4]); + m2 = _mm256_loadu_si256((const __m256i *)&block[8]); + m3 = _mm256_loadu_si256((const __m256i *)&block[12]); + + /* Rounds 0-3 */ + msg = _mm256_add_epi64(m0, _mm256_loadu_si256((const __m256i *)&K[0])); + ROUNDS4(abef, cdgh, msg); + + /* Rounds 4-7 */ + msg = _mm256_add_epi64(m1, _mm256_loadu_si256((const __m256i *)&K[4])); + ROUNDS4(abef, cdgh, msg); + m0 = _mm256_sha512msg1_epi64(m0, _mm256_castsi256_si128(m1)); + + /* Rounds 8-11 */ + msg = _mm256_add_epi64(m2, _mm256_loadu_si256((const __m256i *)&K[8])); + ROUNDS4(abef, cdgh, msg); + m1 = _mm256_sha512msg1_epi64(m1, _mm256_castsi256_si128(m2)); + + /* Rounds 12-15 */ + msg = _mm256_add_epi64(m3, _mm256_loadu_si256((const __m256i *)&K[12])); + ROUNDS4(abef, cdgh, msg); + m0 = _mm256_add_epi64(m0, ALIGNR1(m3, m2)); + m0 = _mm256_sha512msg2_epi64(m0, m3); + m2 = _mm256_sha512msg1_epi64(m2, _mm256_castsi256_si128(m3)); + + /* Rounds 16-19 */ + msg = _mm256_add_epi64(m0, _mm256_loadu_si256((const __m256i *)&K[16])); + ROUNDS4(abef, cdgh, msg); + m1 = _mm256_add_epi64(m1, ALIGNR1(m0, m3)); + m1 = _mm256_sha512msg2_epi64(m1, m0); + m3 = _mm256_sha512msg1_epi64(m3, _mm256_castsi256_si128(m0)); + + /* Rounds 20-23 */ + msg = _mm256_add_epi64(m1, _mm256_loadu_si256((const __m256i *)&K[20])); + ROUNDS4(abef, cdgh, msg); + m2 = _mm256_add_epi64(m2, ALIGNR1(m1, m0)); + m2 = _mm256_sha512msg2_epi64(m2, m1); + m0 = _mm256_sha512msg1_epi64(m0, _mm256_castsi256_si128(m1)); + + /* Rounds 24-27 */ + msg = _mm256_add_epi64(m2, _mm256_loadu_si256((const __m256i *)&K[24])); + ROUNDS4(abef, cdgh, msg); + m3 = _mm256_add_epi64(m3, ALIGNR1(m2, m1)); + m3 = _mm256_sha512msg2_epi64(m3, m2); + m1 = _mm256_sha512msg1_epi64(m1, _mm256_castsi256_si128(m2)); + + /* Rounds 28-31 */ + msg = _mm256_add_epi64(m3, _mm256_loadu_si256((const __m256i *)&K[28])); + ROUNDS4(abef, cdgh, msg); + m0 = _mm256_add_epi64(m0, ALIGNR1(m3, m2)); + m0 = _mm256_sha512msg2_epi64(m0, m3); + m2 = _mm256_sha512msg1_epi64(m2, _mm256_castsi256_si128(m3)); + + /* Rounds 32-35 */ + msg = _mm256_add_epi64(m0, _mm256_loadu_si256((const __m256i *)&K[32])); + ROUNDS4(abef, cdgh, msg); + m1 = _mm256_add_epi64(m1, ALIGNR1(m0, m3)); + m1 = _mm256_sha512msg2_epi64(m1, m0); + m3 = _mm256_sha512msg1_epi64(m3, _mm256_castsi256_si128(m0)); + + /* Rounds 36-39 */ + msg = _mm256_add_epi64(m1, _mm256_loadu_si256((const __m256i *)&K[36])); + ROUNDS4(abef, cdgh, msg); + m2 = _mm256_add_epi64(m2, ALIGNR1(m1, m0)); + m2 = _mm256_sha512msg2_epi64(m2, m1); + m0 = _mm256_sha512msg1_epi64(m0, _mm256_castsi256_si128(m1)); + + /* Rounds 40-43 */ + msg = _mm256_add_epi64(m2, _mm256_loadu_si256((const __m256i *)&K[40])); + ROUNDS4(abef, cdgh, msg); + m3 = _mm256_add_epi64(m3, ALIGNR1(m2, m1)); + m3 = _mm256_sha512msg2_epi64(m3, m2); + m1 = _mm256_sha512msg1_epi64(m1, _mm256_castsi256_si128(m2)); + + /* Rounds 44-47 */ + msg = _mm256_add_epi64(m3, _mm256_loadu_si256((const __m256i *)&K[44])); + ROUNDS4(abef, cdgh, msg); + m0 = _mm256_add_epi64(m0, ALIGNR1(m3, m2)); + m0 = _mm256_sha512msg2_epi64(m0, m3); + m2 = _mm256_sha512msg1_epi64(m2, _mm256_castsi256_si128(m3)); + + /* Rounds 48-51 */ + msg = _mm256_add_epi64(m0, _mm256_loadu_si256((const __m256i *)&K[48])); + ROUNDS4(abef, cdgh, msg); + m1 = _mm256_add_epi64(m1, ALIGNR1(m0, m3)); + m1 = _mm256_sha512msg2_epi64(m1, m0); + m3 = _mm256_sha512msg1_epi64(m3, _mm256_castsi256_si128(m0)); + + /* Rounds 52-55 */ + msg = _mm256_add_epi64(m1, _mm256_loadu_si256((const __m256i *)&K[52])); + ROUNDS4(abef, cdgh, msg); + m2 = _mm256_add_epi64(m2, ALIGNR1(m1, m0)); + m2 = _mm256_sha512msg2_epi64(m2, m1); + m0 = _mm256_sha512msg1_epi64(m0, _mm256_castsi256_si128(m1)); + + /* Rounds 56-59 */ + msg = _mm256_add_epi64(m2, _mm256_loadu_si256((const __m256i *)&K[56])); + ROUNDS4(abef, cdgh, msg); + m3 = _mm256_add_epi64(m3, ALIGNR1(m2, m1)); + m3 = _mm256_sha512msg2_epi64(m3, m2); + m1 = _mm256_sha512msg1_epi64(m1, _mm256_castsi256_si128(m2)); + + /* Rounds 60-63 */ + msg = _mm256_add_epi64(m3, _mm256_loadu_si256((const __m256i *)&K[60])); + ROUNDS4(abef, cdgh, msg); + m0 = _mm256_add_epi64(m0, ALIGNR1(m3, m2)); + m0 = _mm256_sha512msg2_epi64(m0, m3); + m2 = _mm256_sha512msg1_epi64(m2, _mm256_castsi256_si128(m3)); + + /* Rounds 64-67 */ + msg = _mm256_add_epi64(m0, _mm256_loadu_si256((const __m256i *)&K[64])); + ROUNDS4(abef, cdgh, msg); + m1 = _mm256_add_epi64(m1, ALIGNR1(m0, m3)); + m1 = _mm256_sha512msg2_epi64(m1, m0); + m3 = _mm256_sha512msg1_epi64(m3, _mm256_castsi256_si128(m0)); + + /* Rounds 68-71 */ + msg = _mm256_add_epi64(m1, _mm256_loadu_si256((const __m256i *)&K[68])); + ROUNDS4(abef, cdgh, msg); + m2 = _mm256_add_epi64(m2, ALIGNR1(m1, m0)); + m2 = _mm256_sha512msg2_epi64(m2, m1); + + /* Rounds 72-75 */ + msg = _mm256_add_epi64(m2, _mm256_loadu_si256((const __m256i *)&K[72])); + ROUNDS4(abef, cdgh, msg); + m3 = _mm256_add_epi64(m3, ALIGNR1(m2, m1)); + m3 = _mm256_sha512msg2_epi64(m3, m2); + + /* Rounds 76-79 */ + msg = _mm256_add_epi64(m3, _mm256_loadu_si256((const __m256i *)&K[76])); + ROUNDS4(abef, cdgh, msg); + + /* Add original state back */ + abef = _mm256_add_epi64(abef, abef_orig); + cdgh = _mm256_add_epi64(cdgh, cdgh_orig); + + /* Restore the state's original order and store result */ + abef = _mm256_permute4x64_epi64(abef, 0x1b); /* f e b a */ + cdgh = _mm256_permute4x64_epi64(cdgh, 0x1b); /* h g d c */ + _mm256_storeu_si256((__m256i *)&state[0], + _mm256_permute2x128_si256(abef, cdgh, 0x20)); /* d c b a */ + _mm256_storeu_si256((__m256i *)&state[4], + _mm256_permute2x128_si256(abef, cdgh, 0x31)); /* h g f e */ +} + +/* + * Return 1 if the CPU implements the x86 SHA512 extension and the AVX2 + * instructions used alongside it, and the OS saves the YMM registers, + * 0 otherwise. + */ +int sha512_native_available(void) { + unsigned int eax, ebx, ecx, edx, xcr0; + + if (!__get_cpuid(1, &eax, &ebx, &ecx, &edx)) + return 0; + if (!(ecx & bit_OSXSAVE) || !(ecx & bit_AVX)) + return 0; + /* XCR0 bits 1 and 2: the OS saves the XMM and YMM registers */ + __asm__ ("xgetbv" : "=a"(xcr0), "=d"(edx) : "c"(0)); + if ((xcr0 & 0x6) != 0x6) + return 0; + if (!__get_cpuid_count(7, 0, &eax, &ebx, &ecx, &edx)) + return 0; + if (eax < 1 || !(ebx & bit_AVX2)) + return 0; + __get_cpuid_count(7, 1, &eax, &ebx, &ecx, &edx); + return (eax & bit_SHA512) != 0; +} + +#else + +/* Stub implementations for builds without hardware support */ +void sha512_block_native(uint64_t *state, const uint64_t *block) { + (void)state; + (void)block; + /* Should never be called - use pure Haskell fallback */ +} + +int sha512_native_available(void) { + return 0; +} + +#endif diff --git a/lib/Crypto/Hash/SHA512.hs b/lib/Crypto/Hash/SHA512.hs --- a/lib/Crypto/Hash/SHA512.hs +++ b/lib/Crypto/Hash/SHA512.hs @@ -12,7 +12,7 @@ -- [2104](https://datatracker.ietf.org/doc/html/rfc2104). -- -- The 'hash' and 'hmac' functions will use primitive instructions from --- the ARM cryptographic extensions via FFI if they're available, and +-- the ARM or x86 SHA512 extensions via FFI if they're available, and -- will otherwise use a pure Haskell implementation. module Crypto.Hash.SHA512 ( @@ -33,7 +33,7 @@ import qualified Data.ByteString as BS import Data.Word (Word8, Word64) import Foreign.Ptr (Ptr) -import qualified Crypto.Hash.SHA512.Arm as Arm +import qualified Crypto.Hash.SHA512.Native as Native import Crypto.Hash.SHA512.Internal (MAC(..), Registers) import qualified Crypto.Hash.SHA512.Lazy as Lazy import qualified Crypto.Hash.SHA512.Pure as Pure @@ -49,7 +49,7 @@ -- "" hash :: BS.ByteString -> BS.ByteString hash m - | Arm.sha512_arm_available = Arm.hash m + | Native.sha512_native_available = Native.hash m | otherwise = Pure.hash m {-# INLINABLE hash #-} @@ -67,7 +67,7 @@ -- "" hmac :: BS.ByteString -> BS.ByteString -> MAC hmac k m - | Arm.sha512_arm_available = MAC (Arm.hmac k m) + | Native.sha512_native_available = MAC (Native.hmac k m) | otherwise = MAC (Pure.hmac k m) {-# INLINABLE hmac #-} @@ -84,7 +84,7 @@ -> Registers -- ^ message -> IO () _hmac_rr rp bp k m - | Arm.sha512_arm_available = Arm._hmac_rr rp bp k m + | Native.sha512_native_available = Native._hmac_rr rp bp k m | otherwise = Pure._hmac_rr rp bp k m {-# INLINABLE _hmac_rr #-} @@ -102,6 +102,6 @@ -> BS.ByteString -- ^ data -> IO () _hmac_rsb rp bp k v sep dat - | Arm.sha512_arm_available = Arm._hmac_rsb rp bp k v sep dat + | Native.sha512_native_available = Native._hmac_rsb rp bp k v sep dat | otherwise = Pure._hmac_rsb rp bp k v sep dat {-# INLINABLE _hmac_rsb #-} diff --git a/lib/Crypto/Hash/SHA512/Arm.hs b/lib/Crypto/Hash/SHA512/Arm.hs deleted file mode 100644 --- a/lib/Crypto/Hash/SHA512/Arm.hs +++ /dev/null @@ -1,268 +0,0 @@ -{-# OPTIONS_HADDOCK hide #-} -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE MagicHash #-} -{-# LANGUAGE PatternSynonyms #-} -{-# LANGUAGE UnboxedTuples #-} - --- | --- Module: Crypto.Hash.SHA512.Arm --- Copyright: (c) 2024 Jared Tobin --- License: MIT --- Maintainer: Jared Tobin --- --- ARM crypto extension support for SHA-512. - -module Crypto.Hash.SHA512.Arm ( - sha512_arm_available - , hash - , hmac - , _hmac_rr - , _hmac_rsb - ) where - -import qualified Data.ByteString as BS -import qualified Data.ByteString.Internal as BI -import qualified Data.ByteString.Unsafe as BU -import Data.Word (Word8, Word64) -import Foreign.C.Types (CInt(..)) -import Foreign.Marshal.Alloc (allocaBytes) -import Foreign.Ptr (Ptr) -import qualified GHC.Exts as Exts -import qualified GHC.IO (IO(..)) -import qualified GHC.Ptr -import Crypto.Hash.SHA512.Internal hiding (update) -import System.IO.Unsafe (unsafeDupablePerformIO) - --- ffi ------------------------------------------------------------------------ - -foreign import ccall unsafe "sha512_block_arm" - c_sha512_block :: Ptr Word64 -> Ptr Word64 -> IO () - -foreign import ccall unsafe "sha512_arm_available" - c_sha512_arm_available :: IO CInt - --- utilities ------------------------------------------------------------------ - -fi :: (Integral a, Num b) => a -> b -fi = fromIntegral -{-# INLINE fi #-} - -peek_registers - :: Ptr Word64 - -> Registers -peek_registers (GHC.Ptr.Ptr addr) = R - (Exts.indexWord64OffAddr# addr 0#) - (Exts.indexWord64OffAddr# addr 1#) - (Exts.indexWord64OffAddr# addr 2#) - (Exts.indexWord64OffAddr# addr 3#) - (Exts.indexWord64OffAddr# addr 4#) - (Exts.indexWord64OffAddr# addr 5#) - (Exts.indexWord64OffAddr# addr 6#) - (Exts.indexWord64OffAddr# addr 7#) -{-# INLINE peek_registers #-} - -poke_block :: Ptr Word64 -> Block -> IO () -poke_block - (GHC.Ptr.Ptr addr) - (B w00 w01 w02 w03 w04 w05 w06 w07 w08 w09 w10 w11 w12 w13 w14 w15) - = GHC.IO.IO $ \s00 -> - case Exts.writeWord64OffAddr# addr 00# w00 s00 of { s01 -> - case Exts.writeWord64OffAddr# addr 01# w01 s01 of { s02 -> - case Exts.writeWord64OffAddr# addr 02# w02 s02 of { s03 -> - case Exts.writeWord64OffAddr# addr 03# w03 s03 of { s04 -> - case Exts.writeWord64OffAddr# addr 04# w04 s04 of { s05 -> - case Exts.writeWord64OffAddr# addr 05# w05 s05 of { s06 -> - case Exts.writeWord64OffAddr# addr 06# w06 s06 of { s07 -> - case Exts.writeWord64OffAddr# addr 07# w07 s07 of { s08 -> - case Exts.writeWord64OffAddr# addr 08# w08 s08 of { s09 -> - case Exts.writeWord64OffAddr# addr 09# w09 s09 of { s10 -> - case Exts.writeWord64OffAddr# addr 10# w10 s10 of { s11 -> - case Exts.writeWord64OffAddr# addr 11# w11 s11 of { s12 -> - case Exts.writeWord64OffAddr# addr 12# w12 s12 of { s13 -> - case Exts.writeWord64OffAddr# addr 13# w13 s13 of { s14 -> - case Exts.writeWord64OffAddr# addr 14# w14 s14 of { s15 -> - case Exts.writeWord64OffAddr# addr 15# w15 s15 of { s16 -> - (# s16, () #) }}}}}}}}}}}}}}}} -{-# INLINE poke_block #-} - --- update --------------------------------------------------------------------- - -update :: Ptr Word64 -> Ptr Word64 -> Block -> IO () -update rp bp block = do - poke_block bp block - c_sha512_block rp bp -{-# INLINE update #-} - --- api ----------------------------------------------------------------------- - --- | Are ARM +sha512 extensions available? -sha512_arm_available :: Bool -sha512_arm_available = unsafeDupablePerformIO c_sha512_arm_available /= 0 -{-# NOINLINE sha512_arm_available #-} - -hash - :: BS.ByteString - -> BS.ByteString -hash m = unsafeDupablePerformIO $ - allocaBytes 64 $ \rp -> - allocaBytes 128 $ \bp -> do - poke_registers rp (iv ()) - _hash rp bp 0 m - let !rs = peek_registers rp - pure (cat rs) - -_hash - :: Ptr Word64 -- ^ register state - -> Ptr Word64 -- ^ block state - -> Word64 -- ^ extra prefix length, for padding calculation - -> BS.ByteString -- ^ input - -> IO () -_hash rp bp el m@(BI.PS _ _ l) = do - hash_blocks rp bp m - let !fin@(BI.PS _ _ ll) = BU.unsafeDrop (l - l `rem` 128) m - !total = el + fi l - if ll < 112 - then do - let !ult = parse_pad1 fin total - update rp bp ult - else do - let !(# pen, ult #) = parse_pad2 fin total - update rp bp pen - update rp bp ult -{-# INLINABLE _hash #-} - -hash_blocks - :: Ptr Word64 -- ^ register state - -> Ptr Word64 -- ^ block state - -> BS.ByteString -- ^ input - -> IO () -hash_blocks rp bp m@(BI.PS _ _ l) = loop 0 where - loop !j - | j + 128 > l = pure () - | otherwise = do - let !block = parse m j - update rp bp block - loop (j + 128) -{-# INLINE hash_blocks #-} - --- hmac ----------------------------------------------------------------------- - -hmac :: BS.ByteString -> BS.ByteString -> BS.ByteString -hmac k m = unsafeDupablePerformIO $ - allocaBytes 64 $ \rp -> - allocaBytes 128 $ \bp -> do - _hmac rp bp (prep_key k) m - pure (cat (peek_registers rp)) - -prep_key :: BS.ByteString -> Block -prep_key k@(BI.PS _ _ l) - | l > 128 = parse_key (hash k) - | otherwise = parse_key k -{-# INLINABLE prep_key #-} - --- assume padded key as block. -_hmac - :: Ptr Word64 -- ^ register state - -> Ptr Word64 -- ^ block state - -> Block -- ^ padded key - -> BS.ByteString -- ^ message - -> IO () -_hmac rp bp k m = do - poke_registers rp (iv ()) - update rp bp (xor k (Exts.wordToWord64# 0x3636363636363636##)) - _hash rp bp 128 m - let !block = pad_registers_with_length (peek_registers rp) - poke_registers rp (iv ()) - update rp bp (xor k (Exts.wordToWord64# 0x5C5C5C5C5C5C5C5C##)) - update rp bp block -{-# NOINLINE _hmac #-} - -_hmac_rr - :: Ptr Word64 -- ^ register state - -> Ptr Word64 -- ^ block state - -> Registers -- ^ key - -> Registers -- ^ message - -> IO () -_hmac_rr rp bp k m = do - let !key = pad_registers k - !block = pad_registers_with_length m - _hmac_bb rp bp key block -{-# INLINABLE _hmac_rr #-} - -_hmac_bb - :: Ptr Word64 -- ^ register state - -> Ptr Word64 -- ^ block state - -> Block -- ^ padded key - -> Block -- ^ padded message - -> IO () -_hmac_bb rp bp k m = do - poke_registers rp (iv ()) - update rp bp (xor k (Exts.wordToWord64# 0x3636363636363636##)) - update rp bp m - let !inner = pad_registers_with_length (peek_registers rp) - poke_registers rp (iv ()) - update rp bp (xor k (Exts.wordToWord64# 0x5C5C5C5C5C5C5C5C##)) - update rp bp inner -{-# INLINABLE _hmac_bb #-} - --- | HMAC(key, v || sep || data) using ARM crypto extensions. --- Writes result to destination pointer. -_hmac_rsb - :: Ptr Word64 -- ^ destination (8 Word64s) - -> Ptr Word64 -- ^ scratch block buffer (16 Word64s) - -> Registers -- ^ key - -> Registers -- ^ v - -> Word8 -- ^ separator byte - -> BS.ByteString -- ^ data - -> IO () -_hmac_rsb rp bp k v sep dat = do - poke_registers rp (iv ()) - let !key = pad_registers k - update rp bp (xor key (Exts.wordToWord64# 0x3636363636363636##)) - _hash_vsb rp bp 128 v sep dat - let !inner = pad_registers_with_length (peek_registers rp) - poke_registers rp (iv ()) - update rp bp (xor key (Exts.wordToWord64# 0x5C5C5C5C5C5C5C5C##)) - update rp bp inner -{-# INLINABLE _hmac_rsb #-} - --- | Hash (v || sep || dat) with ARM crypto extensions. --- Assumes register state already initialized at rp. -_hash_vsb - :: Ptr Word64 -- ^ register state - -> Ptr Word64 -- ^ block buffer - -> Word64 -- ^ extra prefix length - -> Registers -- ^ v - -> Word8 -- ^ sep - -> BS.ByteString -- ^ dat - -> IO () -_hash_vsb rp bp el v sep dat@(BI.PS _ _ l) - | l >= 63 = do - -- first block is complete: v || sep || dat[0:63] - let !b0 = parse_vsb v sep dat - update rp bp b0 - -- hash remaining complete blocks from dat[63:] - let !rest = BU.unsafeDrop 63 dat - !restLen = l - 63 - hash_blocks rp bp rest - -- handle final padding - let !finLen = restLen `rem` 128 - !fin = BU.unsafeDrop (restLen - finLen) rest - !total = el + 65 + fi l - if finLen < 112 - then update rp bp (parse_pad1 fin total) - else do - let !(# pen, ult #) = parse_pad2 fin total - update rp bp pen - update rp bp ult - | otherwise = do - -- message < 128 bytes total, straight to padding - let !total = el + 65 + fi l - if 65 + l < 112 - then update rp bp (parse_pad1_vsb v sep dat total) - else do - let !(# pen, ult #) = parse_pad2_vsb v sep dat total - update rp bp pen - update rp bp ult -{-# INLINABLE _hash_vsb #-} - diff --git a/lib/Crypto/Hash/SHA512/Native.hs b/lib/Crypto/Hash/SHA512/Native.hs new file mode 100644 --- /dev/null +++ b/lib/Crypto/Hash/SHA512/Native.hs @@ -0,0 +1,269 @@ +{-# OPTIONS_HADDOCK hide #-} +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE UnboxedTuples #-} + +-- | +-- Module: Crypto.Hash.SHA512.Native +-- Copyright: (c) 2024 Jared Tobin +-- License: MIT +-- Maintainer: Jared Tobin +-- +-- Hardware-accelerated SHA-512, via the ARM or x86 SHA512 +-- extensions. + +module Crypto.Hash.SHA512.Native ( + sha512_native_available + , hash + , hmac + , _hmac_rr + , _hmac_rsb + ) where + +import qualified Data.ByteString as BS +import qualified Data.ByteString.Internal as BI +import qualified Data.ByteString.Unsafe as BU +import Data.Word (Word8, Word64) +import Foreign.C.Types (CInt(..)) +import Foreign.Marshal.Alloc (allocaBytes) +import Foreign.Ptr (Ptr) +import qualified GHC.Exts as Exts +import qualified GHC.IO (IO(..)) +import qualified GHC.Ptr +import Crypto.Hash.SHA512.Internal hiding (update) +import System.IO.Unsafe (unsafeDupablePerformIO) + +-- ffi ------------------------------------------------------------------------ + +foreign import ccall unsafe "sha512_block_native" + c_sha512_block :: Ptr Word64 -> Ptr Word64 -> IO () + +foreign import ccall unsafe "sha512_native_available" + c_sha512_native_available :: IO CInt + +-- utilities ------------------------------------------------------------------ + +fi :: (Integral a, Num b) => a -> b +fi = fromIntegral +{-# INLINE fi #-} + +peek_registers + :: Ptr Word64 + -> Registers +peek_registers (GHC.Ptr.Ptr addr) = R + (Exts.indexWord64OffAddr# addr 0#) + (Exts.indexWord64OffAddr# addr 1#) + (Exts.indexWord64OffAddr# addr 2#) + (Exts.indexWord64OffAddr# addr 3#) + (Exts.indexWord64OffAddr# addr 4#) + (Exts.indexWord64OffAddr# addr 5#) + (Exts.indexWord64OffAddr# addr 6#) + (Exts.indexWord64OffAddr# addr 7#) +{-# INLINE peek_registers #-} + +poke_block :: Ptr Word64 -> Block -> IO () +poke_block + (GHC.Ptr.Ptr addr) + (B w00 w01 w02 w03 w04 w05 w06 w07 w08 w09 w10 w11 w12 w13 w14 w15) + = GHC.IO.IO $ \s00 -> + case Exts.writeWord64OffAddr# addr 00# w00 s00 of { s01 -> + case Exts.writeWord64OffAddr# addr 01# w01 s01 of { s02 -> + case Exts.writeWord64OffAddr# addr 02# w02 s02 of { s03 -> + case Exts.writeWord64OffAddr# addr 03# w03 s03 of { s04 -> + case Exts.writeWord64OffAddr# addr 04# w04 s04 of { s05 -> + case Exts.writeWord64OffAddr# addr 05# w05 s05 of { s06 -> + case Exts.writeWord64OffAddr# addr 06# w06 s06 of { s07 -> + case Exts.writeWord64OffAddr# addr 07# w07 s07 of { s08 -> + case Exts.writeWord64OffAddr# addr 08# w08 s08 of { s09 -> + case Exts.writeWord64OffAddr# addr 09# w09 s09 of { s10 -> + case Exts.writeWord64OffAddr# addr 10# w10 s10 of { s11 -> + case Exts.writeWord64OffAddr# addr 11# w11 s11 of { s12 -> + case Exts.writeWord64OffAddr# addr 12# w12 s12 of { s13 -> + case Exts.writeWord64OffAddr# addr 13# w13 s13 of { s14 -> + case Exts.writeWord64OffAddr# addr 14# w14 s14 of { s15 -> + case Exts.writeWord64OffAddr# addr 15# w15 s15 of { s16 -> + (# s16, () #) }}}}}}}}}}}}}}}} +{-# INLINE poke_block #-} + +-- update --------------------------------------------------------------------- + +update :: Ptr Word64 -> Ptr Word64 -> Block -> IO () +update rp bp block = do + poke_block bp block + c_sha512_block rp bp +{-# INLINE update #-} + +-- api ----------------------------------------------------------------------- + +-- | Are hardware SHA-512 instructions available? +sha512_native_available :: Bool +sha512_native_available = unsafeDupablePerformIO c_sha512_native_available /= 0 +{-# NOINLINE sha512_native_available #-} + +hash + :: BS.ByteString + -> BS.ByteString +hash m = unsafeDupablePerformIO $ + allocaBytes 64 $ \rp -> + allocaBytes 128 $ \bp -> do + poke_registers rp (iv ()) + _hash rp bp 0 m + let !rs = peek_registers rp + pure (cat rs) + +_hash + :: Ptr Word64 -- ^ register state + -> Ptr Word64 -- ^ block state + -> Word64 -- ^ extra prefix length, for padding calculation + -> BS.ByteString -- ^ input + -> IO () +_hash rp bp el m@(BI.PS _ _ l) = do + hash_blocks rp bp m + let !fin@(BI.PS _ _ ll) = BU.unsafeDrop (l - l `rem` 128) m + !total = el + fi l + if ll < 112 + then do + let !ult = parse_pad1 fin total + update rp bp ult + else do + let !(# pen, ult #) = parse_pad2 fin total + update rp bp pen + update rp bp ult +{-# INLINABLE _hash #-} + +hash_blocks + :: Ptr Word64 -- ^ register state + -> Ptr Word64 -- ^ block state + -> BS.ByteString -- ^ input + -> IO () +hash_blocks rp bp m@(BI.PS _ _ l) = loop 0 where + loop !j + | j + 128 > l = pure () + | otherwise = do + let !block = parse m j + update rp bp block + loop (j + 128) +{-# INLINE hash_blocks #-} + +-- hmac ----------------------------------------------------------------------- + +hmac :: BS.ByteString -> BS.ByteString -> BS.ByteString +hmac k m = unsafeDupablePerformIO $ + allocaBytes 64 $ \rp -> + allocaBytes 128 $ \bp -> do + _hmac rp bp (prep_key k) m + pure (cat (peek_registers rp)) + +prep_key :: BS.ByteString -> Block +prep_key k@(BI.PS _ _ l) + | l > 128 = parse_key (hash k) + | otherwise = parse_key k +{-# INLINABLE prep_key #-} + +-- assume padded key as block. +_hmac + :: Ptr Word64 -- ^ register state + -> Ptr Word64 -- ^ block state + -> Block -- ^ padded key + -> BS.ByteString -- ^ message + -> IO () +_hmac rp bp k m = do + poke_registers rp (iv ()) + update rp bp (xor k (Exts.wordToWord64# 0x3636363636363636##)) + _hash rp bp 128 m + let !block = pad_registers_with_length (peek_registers rp) + poke_registers rp (iv ()) + update rp bp (xor k (Exts.wordToWord64# 0x5C5C5C5C5C5C5C5C##)) + update rp bp block +{-# NOINLINE _hmac #-} + +_hmac_rr + :: Ptr Word64 -- ^ register state + -> Ptr Word64 -- ^ block state + -> Registers -- ^ key + -> Registers -- ^ message + -> IO () +_hmac_rr rp bp k m = do + let !key = pad_registers k + !block = pad_registers_with_length m + _hmac_bb rp bp key block +{-# INLINABLE _hmac_rr #-} + +_hmac_bb + :: Ptr Word64 -- ^ register state + -> Ptr Word64 -- ^ block state + -> Block -- ^ padded key + -> Block -- ^ padded message + -> IO () +_hmac_bb rp bp k m = do + poke_registers rp (iv ()) + update rp bp (xor k (Exts.wordToWord64# 0x3636363636363636##)) + update rp bp m + let !inner = pad_registers_with_length (peek_registers rp) + poke_registers rp (iv ()) + update rp bp (xor k (Exts.wordToWord64# 0x5C5C5C5C5C5C5C5C##)) + update rp bp inner +{-# INLINABLE _hmac_bb #-} + +-- | HMAC(key, v || sep || data) using hardware SHA-512 instructions. +-- Writes result to destination pointer. +_hmac_rsb + :: Ptr Word64 -- ^ destination (8 Word64s) + -> Ptr Word64 -- ^ scratch block buffer (16 Word64s) + -> Registers -- ^ key + -> Registers -- ^ v + -> Word8 -- ^ separator byte + -> BS.ByteString -- ^ data + -> IO () +_hmac_rsb rp bp k v sep dat = do + poke_registers rp (iv ()) + let !key = pad_registers k + update rp bp (xor key (Exts.wordToWord64# 0x3636363636363636##)) + _hash_vsb rp bp 128 v sep dat + let !inner = pad_registers_with_length (peek_registers rp) + poke_registers rp (iv ()) + update rp bp (xor key (Exts.wordToWord64# 0x5C5C5C5C5C5C5C5C##)) + update rp bp inner +{-# INLINABLE _hmac_rsb #-} + +-- | Hash (v || sep || dat) with hardware SHA-512 instructions. +-- Assumes register state already initialized at rp. +_hash_vsb + :: Ptr Word64 -- ^ register state + -> Ptr Word64 -- ^ block buffer + -> Word64 -- ^ extra prefix length + -> Registers -- ^ v + -> Word8 -- ^ sep + -> BS.ByteString -- ^ dat + -> IO () +_hash_vsb rp bp el v sep dat@(BI.PS _ _ l) + | l >= 63 = do + -- first block is complete: v || sep || dat[0:63] + let !b0 = parse_vsb v sep dat + update rp bp b0 + -- hash remaining complete blocks from dat[63:] + let !rest = BU.unsafeDrop 63 dat + !restLen = l - 63 + hash_blocks rp bp rest + -- handle final padding + let !finLen = restLen `rem` 128 + !fin = BU.unsafeDrop (restLen - finLen) rest + !total = el + 65 + fi l + if finLen < 112 + then update rp bp (parse_pad1 fin total) + else do + let !(# pen, ult #) = parse_pad2 fin total + update rp bp pen + update rp bp ult + | otherwise = do + -- message < 128 bytes total, straight to padding + let !total = el + 65 + fi l + if 65 + l < 112 + then update rp bp (parse_pad1_vsb v sep dat total) + else do + let !(# pen, ult #) = parse_pad2_vsb v sep dat total + update rp bp pen + update rp bp ult +{-# INLINABLE _hash_vsb #-} + diff --git a/lib/Crypto/Hash/SHA512/Pure.hs b/lib/Crypto/Hash/SHA512/Pure.hs --- a/lib/Crypto/Hash/SHA512/Pure.hs +++ b/lib/Crypto/Hash/SHA512/Pure.hs @@ -10,7 +10,7 @@ -- Maintainer: Jared Tobin -- -- Pure Haskell SHA-512 and HMAC-SHA512 implementations for strict --- ByteStrings, used when the ARM cryptographic extensions are +-- ByteStrings, used when hardware SHA-512 instructions are -- unavailable. module Crypto.Hash.SHA512.Pure ( diff --git a/ppad-sha512.cabal b/ppad-sha512.cabal --- a/ppad-sha512.cabal +++ b/ppad-sha512.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: ppad-sha512 -version: 0.2.5 +version: 0.2.6 synopsis: The SHA-512 and HMAC-SHA512 algorithms license: MIT license-file: LICENSE @@ -41,13 +41,13 @@ Crypto.Hash.SHA512.Lazy Crypto.Hash.SHA512.Pure other-modules: - Crypto.Hash.SHA512.Arm + Crypto.Hash.SHA512.Native Data.Barrier build-depends: base >= 4.9 && < 5 , bytestring >= 0.9 && < 0.13 c-sources: - cbits/sha512_arm.c + cbits/sha512_native.c if flag(sanitize) cc-options: -fsanitize=address,undefined -fno-omit-frame-pointer ghc-options: -optl=-fsanitize=address,undefined