commit adc0406051a470836d2e0bc2edb4b1fc2ca06c43
parent 8148385e2efc89e73e3a242a0b8373b190ada831
Author: Jared Tobin <jared@jtobin.io>
Date: Sat, 31 Oct 2026 13:47:59 +0400
lib: rename the Arm module and kernel to Native
Crypto.Hash.SHA512.Arm becomes Crypto.Hash.SHA512.Native, and
cbits/sha512_arm.c becomes cbits/sha512_native.c, exporting
sha512_block_native and sha512_native_available. Nothing in the
Haskell module is specific to ARM beyond the FFI symbol it binds, so
the same driver can sit over a block function for another
architecture.
Diffstat:
6 files changed, 775 insertions(+), 775 deletions(-)
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,500 @@
+#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_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
+}
+
+#else
+
+/* Stub implementations for non-aarch64 builds */
+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
@@ -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,268 @@
+{-# 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>
+--
+-- ARM crypto extension support for SHA-512.
+
+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/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
