src/code/debug-var-io.lisp

   1 ;;;; variable-length encoding and other i/o tricks for the debugger
   2
   3 ;;;; This software is part of the SBCL system. See the README file for
   4 ;;;; more information.
   5 ;;;;
   6 ;;;; This software is derived from the CMU CL system, which was
   7 ;;;; written at Carnegie Mellon University and released into the
   8 ;;;; public domain. The software is in the public domain and is
   9 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
  10 ;;;; files for more information.
  11
  12 (in-package "SB!C")
  13 \f
  14 ;;;; reading variable length integers
  15 ;;;;
  16 ;;;; The debug info representation makes extensive use of integers
  17 ;;;; encoded in a byte vector using a variable number of bytes:
  18 ;;;;    0..253 => the integer
  19 ;;;;    254 => read next two bytes for integer
  20 ;;;;    255 => read next four bytes for integer
  21
  22 ;;; Given a byte vector VEC and an index variable INDEX, read a
  23 ;;; variable length integer and advance index.
  24 ;;;
  25 ;;; FIXME: This is called O(20) times. It should be reimplemented
  26 ;;; with much of its logic in a single service function which can
  27 ;;; be called by the macro expansion:
  28 ;;;   `(SETF ,INDEX (%READ-VAR-INTEGER ,VEC ,INDEX)).
  29 (defmacro read-var-integer (vec index)
  30   (once-only ((val `(aref ,vec ,index)))
  31     `(cond ((<= ,val 253)
  32             (incf ,index)
  33             ,val)
  34            ((= ,val 254)
  35             (prog1
  36                 (logior (aref ,vec (+ ,index 1))
  37                         (ash (aref ,vec (+ ,index 2)) 8))
  38               (incf ,index 3)))
  39            (t
  40             (prog1
  41                 (logior (aref ,vec (+ ,index 1))
  42                         (ash (aref ,vec (+ ,index 2)) 8)
  43                         (ash (aref ,vec (+ ,index 3)) 16)
  44                         (ash (aref ,vec (+ ,index 4)) 24))
  45               (incf ,index 5))))))
  46
  47 ;;; Take an adjustable vector VEC with a fill pointer and push the
  48 ;;; variable length representation of INT on the end.
  49 (defun write-var-integer (int vec)
  50   (declare (type (unsigned-byte 32) int))
  51   (cond ((<= int 253)
  52          (vector-push-extend int vec))
  53         (t
  54          (let ((32-p (> int #xFFFF)))
  55            (vector-push-extend (if 32-p 255 254) vec)
  56            (vector-push-extend (ldb (byte 8 0) int) vec)
  57            (vector-push-extend (ldb (byte 8 8) int) vec)
  58            (when 32-p
  59              (vector-push-extend (ldb (byte 8 16) int) vec)
  60              (vector-push-extend (ldb (byte 8 24) int) vec)))))
  61   (values))
  62 \f
  63 ;;;; packed strings
  64 ;;;;
  65 ;;;; A packed string is a variable length integer length followed by
  66 ;;;; the character codes.
  67
  68 ;;; Read a packed string from VEC starting at INDEX, advancing INDEX.
  69 (defmacro read-var-string (vec index)
  70   (once-only ((len `(read-var-integer ,vec ,index)))
  71     (once-only ((res `(make-string ,len)))
  72       `(progn
  73          (%byte-blt ,vec ,index ,res 0 ,len)
  74          (incf ,index ,len)
  75          ,res))))
  76
  77 ;;; Write STRING into VEC (adjustable, with fill-pointer) represented
  78 ;;; as the length (in a var-length integer) followed by the codes of
  79 ;;; the characters.
  80 (defun write-var-string (string vec)
  81   (declare (simple-string string))
  82   (let ((len (length string)))
  83     (write-var-integer len vec)
  84     (dotimes (i len)
  85       (vector-push-extend (char-code (schar string i)) vec)))
  86   (values))
  87 \f
  88 ;;;; packed bit vectors
  89
  90 ;;; Read the specified number of BYTES out of VEC at INDEX and convert
  91 ;;; them to a BIT-VECTOR. INDEX is incremented.
  92 (defmacro read-packed-bit-vector (bytes vec index)
  93   (once-only ((n-bytes bytes))
  94     (once-only ((n-res `(make-array (* ,n-bytes 8) :element-type 'bit)))
  95       `(progn
  96          (%byte-blt ,vec ,index ,n-res 0 ,n-bytes)
  97          (incf ,index ,n-bytes)
  98          ,n-res))))