SBCL pointer distances

distances.lisp

(defun distance-histogram ()
  (let ((hist (make-array 128
                          :element-type '(unsigned-byte 64)
                          :initial-element 0)))
    (flet ((measure (object referenced)
             (when (typep referenced '(or cons array standard-object))
               (let* ((object (sb-kernel:get-lisp-obj-address object))
                      (referenced (sb-kernel:get-lisp-obj-address referenced))
                      (delta (ash (- object referenced) -3))
                      (size (* (signum delta) (integer-length (abs delta)))))
                 (incf (aref hist (+ 64 size)))))))
      (declare (inline measure))
      (sb-vm:map-allocated-objects
       (lambda (object code size)
         (declare (ignore code size))
         (typecase object
           (cons
            (measure object (car object))
            (measure object (cdr object)))
           (simple-vector
            (loop for x across object
                  do (measure object x)))))
       :all))
    hist))

(defun draw-histogram ()
  (vgplot:new-plot)
  (vgplot:plot (alexandria:iota 128 :start -64)
               (distance-histogram)
               "k;")
  (vgplot:axis '(-64 64))
  (vgplot:xlabel "Bits apart")
  (vgplot:ylabel "Pointers"))