packing three u16s into a 42bit morton code

play-with-morton-codes.lisp

(defun u! (x y z)
  (check-type x (unsigned-byte 16))
  (check-type y (unsigned-byte 16))
  (check-type z (unsigned-byte 16))
  (make-array 3 :element-type '(unsigned-byte 16)
	      :initial-contents (list x y z)))

(defun u3-to-morton (u3)
  (let ((x (aref u3 0))
	(y (aref u3 1))
	(z (aref u3 2)))
    (+ (ash (part-1-by-2 z) 2)
       (ash (part-1-by-2 y) 1)
       (part-1-by-2 x))))

(defun morton-to-u3 (code)
  (let ((z (compact-1-by-2 code))
	(y (compact-1-by-2 (ash code -1)))
	(x (compact-1-by-2 (ash code -2))))
    (u! x y z)))

(defun part-1-by-2 (x)
  (let* ((v (logand x #xffff))
	 (v (logand (logxor v (ash v 16)) #xff0000ff0000ff))
	 (v (logand (logxor v (ash v 8)) #xf00f00f00f00f))
	 (v (logand (logxor v (ash v 4)) #xc30c30c30c30c3))
	 (v (logand (logxor v (ash v 2)) #x49249249249249)))
    v))

(defun compact-1-by-2 (x)
  (let* ((v (logand x #x49249249249249))
	 (v (logand (logxor v (ash v -2)) #xc30c30c30c30c3))
	 (v (logand (logxor v (ash v -4)) #xf00f00f00f00f))
	 (v (logand (logxor v (ash v -8)) #xff0000ff0000ff))
	 (v (logand (logxor v (ash v -16)) #xffff)))
    v))


(defun test ()
  (loop
     :for i :below 10000000
     :for x := (random 65000)
     :for y := (random 65000)
     :for z := (random 65000)
     :for ou := (u! x y z)
     :for m := (u3-to-morton ou)
     :for nu := (morton-to-u3 m)
     :unless (and (= (aref ou 0) (aref nu 0))
		  (= (aref ou 1) (aref nu 1))
		  (= (aref ou 2) (aref nu 2)))
     :collect ou))