external/ch-util/src/debug.cl

   1
   2
   3 (in-package :ch-util)
   4
   5 (defun hex-dump-word (address)
   6   #+sbcl
   7   (format nil "~8,'0X"
   8           (sb-alien:deref
   9            (sb-alien:sap-alien
  10             (sb-alien::int-sap address)
  11             (* (sb-alien:unsigned 32)))))
  12   #-sbcl
  13   (format "not yet implemented!"))
  14
  15 (defun hex-dump-byte (address)
  16   #+sbcl
  17   (format nil "~2,'0X"
  18           (sb-alien:deref
  19            (sb-alien:sap-alien
  20             (sb-alien::int-sap address)
  21             (* (sb-alien:unsigned 8)))))
  22   #-sbcl
  23   (format "not yet implemented!"))
  24
  25 (defun hex-dump-memory (start-address length)
  26   (loop for i from start-address below (+ start-address length)
  27      collect (format nil (hex-dump-byte i))))
  28
  29 (defun hex-dump-words (start-address length)
  30   (loop for i from start-address below (+ start-address length) by 4
  31      collect (format nil (hex-dump-word i))))
  32
  33 (defun hex-dump-long (address)
  34   (hex-dump-memory address 4))
  35
  36 (defun char-dump-byte (address)
  37   #+sbcl
  38   (format nil "~A"
  39           (code-char
  40            (sb-alien:deref
  41             (sb-alien:sap-alien
  42              (sb-alien::int-sap address)
  43              (* (sb-alien:unsigned 8))))))
  44   #-sbcl
  45   (format nil "not yet implemented"))
  46
  47 (defun char-dump-memory (start-address length)
  48   (loop for i from start-address below (+ start-address length)
  49      collect (format nil (char-dump-byte i))))
  50
  51 (defun double-at-address (address)
  52   (sb-alien:deref
  53    (sb-alien:sap-alien
  54     (sb-alien::int-sap address)
  55     (* (sb-alien:double-float)))))
  56
  57 (defun double-dump-memory (start-address length)
  58   (let ((size (sb-alien:alien-size sb-alien:double-float :bytes)))
  59     (loop for i from start-address
  60        below (+ start-address (*  length size))
  61        by size
  62        collect (cons (format nil "~X" i)
  63                      (double-at-address i)))))