commit fb4e6ce8f35ee25f8299f5aeae71906a312cedc4
parent 8148385e2efc89e73e3a242a0b8373b190ada831
Author: Jared Tobin <jared@jtobin.io>
Date: Sat, 31 Oct 2026 13:56:25 +0400
Merge branch 'impl/x86'
Adds hardware-accelerated SHA-512 on x86_64 via the x86 SHA512
extension, alongside the existing ARM SHA512 path.
* The internal Crypto.Hash.SHA512.Arm module and cbits/sha512_arm.c
are renamed to Crypto.Hash.SHA512.Native and cbits/sha512_native.c,
exporting the architecture-neutral sha512_block_native and
sha512_native_available. The Haskell driver is unchanged.
* On x86_64, the block function uses vsha512rnds2, vsha512msg1 and
vsha512msg2 with AVX2, rearranging the state into the
(a,b,e,f)/(c,d,g,h) layout the instructions expect. Availability
of SHA512 and AVX2, and OS support for the YMM registers, is checked
via CPUID and XGETBV, so CPUs lacking them fall back to the pure
Haskell implementation. The kernel is only compiled when the
compiler provides <sha512intrin.h> (GCC 14, Clang 18 and later).
The K table is shared between the two kernels.
* Documentation and README note the x86_64 support.
Tested with the LLVM backend on aarch64-darwin (ARM path) and on an
x86_64-linux AMD EPYC 7642 host, which lacks the SHA512 extension:
natively (pure fallback), and under Intel SDE 10.13.1 emulating Arrow
Lake (x86 kernel) and Ice Lake (fallback). Under Arrow Lake, SDE's
instruction mix confirms the dispatch-vs-pure tests ran the kernel
over ~49k blocks. CPUID detection reports support only under SDE's
Arrow Lake and Lunar Lake models, and a GCC 13 build falls back to
the stubs. No hardware with the extension was available, so there
are no benchmark figures.
Diffstat:
8 files changed, 1038 insertions(+), 782 deletions(-)
diff --git a/README.md b/README.md
@@ -6,7 +6,7 @@
A pure Haskell implementation of SHA-512 and HMAC-SHA512 on strict and
lazy ByteStrings, as specified by RFC's [6234][r6234] and [2104][r2104],
-that uses ARM SHA2 intrinsics when available.
+that uses ARM SHA2 or x86 SHA512 intrinsics when available.
## Usage
@@ -56,10 +56,11 @@ Haddocks (API documentation, etc.) are hosted at
## Performance
-The aim is best-in-class performance. Current benchmark figures on an
-M4 Silicon MacBook Air, where we avail of hardware acceleration via
-ARM cryptography extensions, look like (use `cabal bench` to run the
-benchmark suite):
+The aim is best-in-class performance. We avail of hardware
+acceleration via the ARM SHA512 extensions on aarch64, and the x86
+SHA512 extensions on x86_64, whenever the CPU supports them. Current
+benchmark figures on an M4 Silicon MacBook Air look like (use `cabal
+bench` to run the benchmark suite):
```
benchmarking ppad-sha512/SHA512 (32B input)/hash
diff --git a/cbits/sha512_arm.c b/cbits/sha512_arm.c
@@ -1,500 +0,0 @@
-#include <stdint.h>
-#include <string.h>
-
-#if defined(__aarch64__)
-
-#include <arm_neon.h>
-
-#if defined(__APPLE__)
-#include <sys/sysctl.h>
-#elif defined(__linux__)
-#include <sys/auxv.h>
-#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
@@ -0,0 +1,754 @@
+#include <stdint.h>
+#include <string.h>
+
+/*
+ * 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(<sha512intrin.h>)
+#define HAVE_X86_SHA512
+#endif
+#endif
+
+#if defined(__aarch64__)
+
+#include <arm_neon.h>
+
+#if defined(__APPLE__)
+#include <sys/sysctl.h>
+#elif defined(__linux__)
+#include <sys/auxv.h>
+#ifndef HWCAP_SHA512
+#define HWCAP_SHA512 (1UL << 21)
+#endif
+#endif
+
+#elif defined(HAVE_X86_SHA512)
+
+#include <cpuid.h>
+#include <immintrin.h>
+
+#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
@@ -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 @@ module Crypto.Hash.SHA512 (
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 @@ import qualified Crypto.Hash.SHA512.Pure as Pure
-- "<strict 512-bit message digest>"
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 @@ hash m
-- "<strict 512-bit MAC>"
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 @@ _hmac_rr
-> 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 @@ _hmac_rsb
-> 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
@@ -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 <jared@ppad.tech>
---
--- 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
@@ -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 <jared@ppad.tech>
+--
+-- 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
@@ -10,7 +10,7 @@
-- Maintainer: Jared Tobin <jared@ppad.tech>
--
-- 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
@@ -41,13 +41,13 @@ library
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
