day-4.l

(setq *Scl 16)
(load "@lib/math.l")

# precompute the 64-element constant table
# take the integer part of 2^32 * abs(sin(i)) for i = 1 to 64
# (where i is in radians)
(setq Table
   (make (for I 64
            (let K (* (** 2 32) (abs (sin (* 1.0 I))))
               (link (format (head -16 (chop K))))))))

(setq Shift
   '(7 12 17 22  7 12 17 22  7 12 17 22  7 12 17 22
     5  9 14 20  5  9 14 20  5  9 14 20  5  9 14 20
     4 11 16 23  4 11 16 23  4 11 16 23  4 11 16 23
     6 10 15 21  6 10 15 21  6 10 15 21  6 10 15 21))

# turn N into a binary string of 32-bit words
# low-order word first
(de BinString (N)
   (make
      # turn number into a 64-digit binary string
      (let BS (reverse (chop (pad 64 (bin N))))
         (while BS
            (chain (make
                      # for each 32-bit word
                      (let W (reverse (cut 32 'BS))
                         # un-binary each byte in little-endian order
                         (for I 4 (yoke (bin (cut 8 'W)))))))))))

# pad a transient symbol M to 448 (mod 512) bits,
# or 56 (mod 64) bytes, then add the 64-bit length
(de Pad (M)
   (let (LM (chop M) # chop transient into list
         # get the lowest 64 bits of message length
         Len (% (* (length LM) 8) (** 2 64)))
      (make (made (mapcar char LM)) # message is verbatim
         (link (>> -7 1)) # single 1 bit, then 0s
         # pad the rest with zeros
         (let PadLen (- 56 (% (length (made)) 64))
            (chain (need (if (lt0 PadLen)
                            (+ 64 PadLen) PadLen)
                      0)))
         # append the 64-bit length
         (chain (BinString Len)))))

# 32-bit bitwise NOT
(de Not (N) (x| N (dec (** 2 32))))

# 4-element byte list to 32-bit word
(de ToWord (L) (sum '((N S) (>> (- S) N)) L '(0 8 16 24)))

# turn byte list into list of 32-bit words
(de Wordify (L)
   (make (while L
            (link (ToWord (cut 4 'L))))))

# 32-bit left rotation by C
(de LeftRot (N C)
   (% (| (>> (- C) N) (>> (- 32 C) N)) (** 2 32)))

# 32-bit modular addition
(de ModAdd @
   (% (apply + (rest))
      (** 2 32)))

# flip the endianness of a number (for formatting the hash)
(de FlipEndian (N)
   (| (& (>> 24     N) (hex "000000FF"))   # byte 3 -> byte 0
      (& (>> (- 8)  N) (hex "00FF0000"))   # byte 1 -> byte 2
      (& (>> 8      N) (hex "0000FF00"))   # byte 2 -> byte 1
      (& (>> (- 24) N) (hex "FF000000")))) # byte 0 -> byte 3

# perform an MD5 sum on a multiple of 512-bit input, in
# 32-bit words
(de MD5 (M)
   (let (AA (hex "67452301")
         BB (hex "efcdab89")
         CC (hex "98badcfe")
         DD (hex "10325476"))
         (while M
            (let (A AA
                  B BB
                  C CC
                  D DD
                  F NIL
                  G NIL
                  X (cut 16 'M))
               (for I 64
                  (let I (dec I)
                     (cond
                        ((< I 16)
                         (setq F (| (& B C) (& (Not B) D))
                            G I ))
                        ((< I 32)
                         (setq F (| (& D B) (& (Not D) C))
                            G (% (+ (* I 5) 1) 16)))
                        ((< I 48)
                         (setq F (x| B C D)
                            G (% (+ (* I 3) 5) 16)))
                        (T
                           (setq F (x| C (| B (Not D)))
                              G (% (* I 7) 16))))
                     (let Tmp D
                        (setq D C
                           C B
                           B (ModAdd B (LeftRot (ModAdd A F (car (nth Table (inc I))) (car (nth X (inc G))))
                                          (car (nth Shift (inc I)))))
                           A Tmp))))
               (setq AA (ModAdd AA A)
                  BB (ModAdd BB B)
                  CC (ModAdd CC C)
                  DD (ModAdd DD D))))
         (list AA BB CC DD)))

(de Digest (M)
   (mapcar '((X) (hex (FlipEndian X)))
      (MD5 (Wordify (Pad M)))))

(de main ()
   (let (S "bgvyzdsv@1"
         I 1)
      (while (> (length (car (Digest (text S I)))) 2)
         (inc 'I))
      (println I (Digest (text S I))))
   (bye))