155 lines
5.7 KiB
Text
155 lines
5.7 KiB
Text
(setq *Sha512-K
|
|
(mapcar hex
|
|
'("428a2f98d728ae22" "7137449123ef65cd" "b5c0fbcfec4d3b2f"
|
|
"e9b5dba58189dbbc" "3956c25bf348b538" "59f111f1b605d019"
|
|
"923f82a4af194f9b" "ab1c5ed5da6d8118" "d807aa98a3030242"
|
|
"12835b0145706fbe" "243185be4ee4b28c" "550c7dc3d5ffb4e2"
|
|
"72be5d74f27b896f" "80deb1fe3b1696b1" "9bdc06a725c71235"
|
|
"c19bf174cf692694" "e49b69c19ef14ad2" "efbe4786384f25e3"
|
|
"0fc19dc68b8cd5b5" "240ca1cc77ac9c65" "2de92c6f592b0275"
|
|
"4a7484aa6ea6e483" "5cb0a9dcbd41fbd4" "76f988da831153b5"
|
|
"983e5152ee66dfab" "a831c66d2db43210" "b00327c898fb213f"
|
|
"bf597fc7beef0ee4" "c6e00bf33da88fc2" "d5a79147930aa725"
|
|
"06ca6351e003826f" "142929670a0e6e70" "27b70a8546d22ffc"
|
|
"2e1b21385c26c926" "4d2c6dfc5ac42aed" "53380d139d95b3df"
|
|
"650a73548baf63de" "766a0abb3c77b2a8" "81c2c92e47edaee6"
|
|
"92722c851482353b" "a2bfe8a14cf10364" "a81a664bbc423001"
|
|
"c24b8b70d0f89791" "c76c51a30654be30" "d192e819d6ef5218"
|
|
"d69906245565a910" "f40e35855771202a" "106aa07032bbd1b8"
|
|
"19a4c116b8d2d0c8" "1e376c085141ab53" "2748774cdf8eeb99"
|
|
"34b0bcb5e19b48a8" "391c0cb3c5c95a63" "4ed8aa4ae3418acb"
|
|
"5b9cca4f7763e373" "682e6ff3d6b2b8a3" "748f82ee5defb2fc"
|
|
"78a5636f43172f60" "84c87814a1f0ab72" "8cc702081a6439ec"
|
|
"90befffa23631e28" "a4506cebde82bde9" "bef9a3f7b2c67915"
|
|
"c67178f2e372532b" "ca273eceea26619c" "d186b8c721c0c207"
|
|
"eada7dd6cde0eb1e" "f57d4f7fee6ed178" "06f067aa72176fba"
|
|
"0a637dc5a2c898a6" "113f9804bef90dae" "1b710b35131c471b"
|
|
"28db77f523047d84" "32caab7b40c72493" "3c9ebe0a15c9bebc"
|
|
"431d67c49c100d4c" "4cc5d4becb3e42b6" "597f299cfc657e2a"
|
|
"5fcb6fab3ad6faec" "6c44198c4a475817" ) ) )
|
|
(de rightRotate64 (X C)
|
|
(| (>> C X) (mod64 (>> (- C 64) X))) )
|
|
(de mod64 (N)
|
|
(& N `(hex "FFFFFFFFFFFFFFFF")) )
|
|
(de not64 (N)
|
|
(x| N `(hex "FFFFFFFFFFFFFFFF")) )
|
|
(de add64 @
|
|
(mod64 (pass +)) )
|
|
(de sha512 (Lst)
|
|
(let (Len (length Lst) R NIL)
|
|
(setq Lst
|
|
(conc
|
|
(need
|
|
(-
|
|
16
|
|
(* 128 (/ (+ Len 1 16 127) 128)) )
|
|
(append Lst (cons `(hex "80")))
|
|
0 )
|
|
(prog
|
|
(setq Len (* 8 Len))
|
|
(do 16
|
|
(push 'R (& Len 255))
|
|
(setq Len (>> 8 Len)) )
|
|
R ) ) ) )
|
|
(let
|
|
(H0 `(hex "6a09e667f3bcc908")
|
|
H1 `(hex "bb67ae8584caa73b")
|
|
H2 `(hex "3c6ef372fe94f82b")
|
|
H3 `(hex "a54ff53a5f1d36f1")
|
|
H4 `(hex "510e527fade682d1")
|
|
H5 `(hex "9b05688c2b3e6c1f")
|
|
H6 `(hex "1f83d9abfb41bd6b")
|
|
H7 `(hex "5be0cd19137e2179") )
|
|
(while Lst
|
|
(let
|
|
(A H0
|
|
B H1
|
|
C H2
|
|
D H3
|
|
E H4
|
|
F H5
|
|
G H6
|
|
H H7
|
|
W
|
|
(conc
|
|
(make
|
|
(do 16
|
|
(link
|
|
(apply
|
|
|
|
|
(mapcar
|
|
>>
|
|
(-56 -48 -40 -32 -24 -16 -8 0)
|
|
(cut 8 'Lst) ) ) ) ) )
|
|
(need 64 0) ) )
|
|
(for (I 17 (>= 80 I) (inc I))
|
|
(let
|
|
(Wi15 (get W (- I 15))
|
|
Wi2 (get W (- I 2))
|
|
S0
|
|
(x|
|
|
(rightRotate64 Wi15 1)
|
|
(rightRotate64 Wi15 8)
|
|
(>> 7 Wi15) )
|
|
S1
|
|
(x|
|
|
(rightRotate64 Wi2 19)
|
|
(rightRotate64 Wi2 61)
|
|
(>> 6 Wi2) ) )
|
|
(set (nth W I)
|
|
(add64
|
|
(get W (- I 16))
|
|
S0
|
|
(get W (- I 7))
|
|
S1 ) ) ) )
|
|
(use (Tmp1 Tmp2)
|
|
(for I 80
|
|
(setq
|
|
Tmp1
|
|
(add64
|
|
H
|
|
(x|
|
|
(rightRotate64 E 14)
|
|
(rightRotate64 E 18)
|
|
(rightRotate64 E 41) )
|
|
(x| (& E F) (& (not64 E) G))
|
|
(get *Sha512-K I)
|
|
(get W I) )
|
|
Tmp2
|
|
(add64
|
|
(x|
|
|
(rightRotate64 A 28)
|
|
(rightRotate64 A 34)
|
|
(rightRotate64 A 39) )
|
|
(x|
|
|
(& A B)
|
|
(& A C)
|
|
(& B C) ) )
|
|
H G
|
|
G F
|
|
F E
|
|
E (add64 D Tmp1)
|
|
D C
|
|
C B
|
|
B A
|
|
A (add64 Tmp1 Tmp2) ) ) )
|
|
(setq
|
|
H0 (add64 H0 A)
|
|
H1 (add64 H1 B)
|
|
H2 (add64 H2 C)
|
|
H3 (add64 H3 D)
|
|
H4 (add64 H4 E)
|
|
H5 (add64 H5 F)
|
|
H6 (add64 H6 G)
|
|
H7 (add64 H7 H) ) ) )
|
|
(mapcan
|
|
'((N)
|
|
(let R NIL
|
|
(do 8
|
|
(push 'R (& 255 N))
|
|
(setq N (>> 8 N)) )
|
|
R ) )
|
|
(list H0 H1 H2 H3 H4 H5 H6 H7) ) ) )
|
|
|
|
(de d512 (Lst)
|
|
(sha512 (sha512 Lst)) )
|