Name: Anonymous 2013-12-14 17:42
How would you implement it without breaking homoiconicity?
(declaim (ftype (function ((unsigned-byte 64)) (values (unsigned-byte 64) &optional))
shuffle))
(defun shuffle (x)
(flet ((one-round (x mask shift)
(ldb (byte 64 0)
(logior (ash (logand x mask) shift)
(logand (ash x (- shift)) mask)
(logandc2 x (logior mask (ash mask shift)))))))
(declare (inline one-round))
(let* ((k1 (one-round x #x00000000FFFF0000 16))
(k2 (one-round k1 #x0000FF000000FF00 8))
(k3 (one-round k2 #x00F000F000F000F0 4))
(k4 (one-round k3 #x0C0C0C0C0C0C0C0C 2))
(k5 (one-round k4 #x2222222222222222 1)))
k5)))
CL-USER> (format t "~2r~%" (shuffle #x00000000FFFFFFFF))
101010101010101010101010101010101010101010101010101010101010101
CL-USER> (disassemble 'shuffle)
; disassembly for SHUFFLE
; Size: 424 bytes
; 05772DB0: 488D0409 LEA RAX, [RCX+RCX] ; no-arg-parsing entry point
; DB4: 4823054D010000 AND RAX, [RIP+333] ; #x1FFFE0000
; DBB: 488BD0 MOV RDX, RAX
; DBE: 48C1E210 SHL RDX, 16
; DC2: 488BC1 MOV RAX, RCX
; DC5: 48C1E810 SHR RAX, 16
; DC9: 48D1E0 SHL RAX, 1
; DCC: 48230535010000 AND RAX, [RIP+309] ; #x1FFFE0000
; DD3: 4809C2 OR RDX, RAX
; DD6: 488BD9 MOV RBX, RCX
; DD9: 48231D30010000 AND RBX, [RIP+304] ; #xFFFF00000000FFFF
; DE0: 488BC2 MOV RAX, RDX
; DE3: 48D1F8 SAR RAX, 1
; DE6: 4809D8 OR RAX, RBX
; DE9: 488D1400 LEA RDX, [RAX+RAX]
; DED: 48231524010000 AND RDX, [RIP+292] ; #x1FE000001FE00
; DF4: 488BDA MOV RBX, RDX
; DF7: 48C1E308 SHL RBX, 8
; DFB: 488BD0 MOV RDX, RAX
; DFE: 48C1EA08 SHR RDX, 8
; E02: 48D1E2 SHL RDX, 1
; E05: 4823150C010000 AND RDX, [RIP+268] ; #x1FE000001FE00
; E0C: 4809D3 OR RBX, RDX
; E0F: 488BD0 MOV RDX, RAX
; E12: 48231507010000 AND RDX, [RIP+263] ; #xFF0000FFFF0000FF
; E19: 488BC3 MOV RAX, RBX
; E1C: 48D1F8 SAR RAX, 1
; E1F: 4809D0 OR RAX, RDX
; E22: 488D1400 LEA RDX, [RAX+RAX]
; E26: 482315FB000000 AND RDX, [RIP+251] ; #x1E001E001E001E0
; E2D: 488BDA MOV RBX, RDX
; E30: 48C1E304 SHL RBX, 4
; E34: 488BD0 MOV RDX, RAX
; E37: 48C1EA04 SHR RDX, 4
; E3B: 48D1E2 SHL RDX, 1
; E3E: 482315E3000000 AND RDX, [RIP+227] ; #x1E001E001E001E0
; E45: 4809D3 OR RBX, RDX
; E48: 488BD0 MOV RDX, RAX
; E4B: 482315DE000000 AND RDX, [RIP+222] ; #xF00FF00FF00FF00F
; E52: 488BC3 MOV RAX, RBX
; E55: 48D1F8 SAR RAX, 1
; E58: 4809D0 OR RAX, RDX
; E5B: 488D1400 LEA RDX, [RAX+RAX]
; E5F: 482315D2000000 AND RDX, [RIP+210] ; #x1818181818181818
; E66: 488D1C9500000000 LEA RBX, [RDX*4]
; E6E: 488BD0 MOV RDX, RAX
; E71: 48C1EA02 SHR RDX, 2
; E75: 48D1E2 SHL RDX, 1
; E78: 482315B9000000 AND RDX, [RIP+185] ; #x1818181818181818
; E7F: 4809D3 OR RBX, RDX
; E82: 488BD0 MOV RDX, RAX
; E85: 482315B4000000 AND RDX, [RIP+180] ; #xC3C3C3C3C3C3C3C3
; E8C: 488BC3 MOV RAX, RBX
; E8F: 48D1F8 SAR RAX, 1
; E92: 4809D0 OR RAX, RDX
; E95: 488D1400 LEA RDX, [RAX+RAX]
; E99: 482315A8000000 AND RDX, [RIP+168] ; #x4444444444444444
; EA0: 48D1FA SAR RDX, 1
; EA3: 48D1E2 SHL RDX, 1
; EA6: 488BDA MOV RBX, RDX
; EA9: 488BD0 MOV RDX, RAX
; EAC: 48D1EA SHR RDX, 1
; EAF: 48D1E2 SHL RDX, 1
; EB2: 4823158F000000 AND RDX, [RIP+143] ; #x4444444444444444
; EB9: 48D1FA SAR RDX, 1
; EBC: 4809D3 OR RBX, RDX
; EBF: 4823058A000000 AND RAX, [RIP+138] ; #x9999999999999999
; EC6: 4809C3 OR RBX, RAX
; EC9: 48BA00000000000000C0 MOV RDX, -4611686018427387904
; ED3: 4885DA TEST RBX, RDX
; ED6: 488D141B LEA RDX, [RBX+RBX]
; EDA: 740E JEQ L0
; EDC: 488BD3 MOV RDX, RBX
; EDF: 4C8D1C256B090020 LEA R11, [#x2000096B] ; ALLOC-UNSIGNED-BIGNUM-IN-RDX
; EE7: 41FFD3 CALL R11
; EEA: L0: 488BE5 MOV RSP, RBP
; EED: F8 CLC
; EEE: 5D POP RBP
; EEF: C3 RET