(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)) )