Skip to content

Instantly share code, notes, and snippets.

@llibra
Created August 31, 2011 05:52
Show Gist options
  • Save llibra/1182900 to your computer and use it in GitHub Desktop.
Save llibra/1182900 to your computer and use it in GitHub Desktop.
hex dump
(defun hex-dump (seq &key (address-length 8) (address-offset 0))
(labels ((x->char (x)
(let ((c (code-char x)))
(if (and (standard-char-p c) (graphic-char-p c)) c #\.)))
(x->str (l)
(coerce (mapcar #'x->char l) 'string))
(print-header ()
(princ (make-string address-length :initial-element #\=))
(let ((l '#.(loop for n below 16 collect n)))
(format t "== ~{+~x ~}=================~%" l)))
(print-address (i)
(format t (format nil "~~~a,'0x : " address-length)
(+ address-offset i)))
(print-byte (b)
(format t "~2,'0x " b))
(print-text (l)
(format t "| ~a~%" (x->str l)))
(print-padding (n)
(princ (make-string (* n 3) :initial-element #\space)))
(reduce-fn (state byte)
(destructuring-bind (col row txt) state
(when (and (zerop col) (zerop (mod row 10)))
(print-header))
(when (zerop col)
(print-address (* row 16)))
(print-byte byte)
(when (= col 15)
(print-text (nreverse txt)))
(if (= col 15)
(list 0 (1+ row) nil)
(list (1+ col) row (cons byte txt))))))
(fresh-line)
(destructuring-bind (col row txt)
(reduce #'reduce-fn seq :initial-value (list 0 0 nil))
(declare (ignore row))
(unless (zerop col)
(print-padding (- 16 col))
(print-text (nreverse txt))))
(fresh-line)))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment