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
  14 (file-comment
  15  "$Header$")
  16 \f
  17 ;;;; reading variable length integers
  18 ;;;;
  19 ;;;; The debug info representation makes extensive use of integers
  20 ;;;; encoded in a byte vector using a variable number of bytes:
  21 ;;;;    0..253 => the integer
  22 ;;;;    254 => read next two bytes for integer
  23 ;;;;    255 => read next four bytes for integer
  24
  25 ;;; Given a byte vector VEC and an index variable INDEX, read a
  26 ;;; variable length integer and advance index.
  27 ;;;
  28 ;;; FIXME: This is called O(20) times. It should be reimplemented
  29 ;;; with much of its logic in a single service function which can
  30 ;;; be called by the macro expansion:
  31 ;;;   `(SETF ,INDEX (%READ-VAR-INTEGER ,VEC ,INDEX)).
  32 (defmacro read-var-integer (vec index)
  33   (once-only ((val `(aref ,vec ,index)))
  34     `(cond ((<= ,val 253)
  35             (incf ,index)
  36             ,val)
  37            ((= ,val 254)
  38             (prog1
  39                 (logior (aref ,vec (+ ,index 1))
  40                         (ash (aref ,vec (+ ,index 2)) 8))
  41               (incf ,index 3)))
  42            (t
  43             (prog1
  44                 (logior (aref ,vec (+ ,index 1))
  45                         (ash (aref ,vec (+ ,index 2)) 8)
  46                         (ash (aref ,vec (+ ,index 3)) 16)
  47                         (ash (aref ,vec (+ ,index 4)) 24))
  48               (incf ,index 5))))))
  49
  50 ;;; Takes an adjustable vector Vec with a fill pointer and pushes the
  51 ;;; variable length representation of Int on the end.
  52 (defun write-var-integer (int vec)
  53   (declare (type (unsigned-byte 32) int))
  54   (cond ((<= int 253)
  55          (vector-push-extend int vec))
  56         (t
  57          (let ((32-p (> int #xFFFF)))
  58            (vector-push-extend (if 32-p 255 254) vec)
  59            (vector-push-extend (ldb (byte 8 0) int) vec)
  60            (vector-push-extend (ldb (byte 8 8) int) vec)
  61            (when 32-p
  62              (vector-push-extend (ldb (byte 8 16) int) vec)
  63              (vector-push-extend (ldb (byte 8 24) int) vec)))))
  64   (values))
  65 \f
  66 ;;;; packed strings
  67 ;;;;
  68 ;;;;    A packed string is a variable length integer length followed by the
  69 ;;;; character codes.
  70
  71 ;;; Read a packed string from Vec starting at Index, advancing Index.
  72 (defmacro read-var-string (vec index)
  73   (once-only ((len `(read-var-integer ,vec ,index)))
  74     (once-only ((res `(make-string ,len)))
  75       `(progn
  76          (%primitive byte-blt ,vec ,index ,res 0 ,len)
  77          (incf ,index ,len)
  78          ,res))))
  79
  80 ;;; Write String into Vec (adjustable, fill-pointer) represented as the
  81 ;;; length (in a var-length integer) followed by the codes of the characters.
  82 (defun write-var-string (string vec)
  83   (declare (simple-string string))
  84   (let ((len (length string)))
  85     (write-var-integer len vec)
  86     (dotimes (i len)
  87       (vector-push-extend (char-code (schar string i)) vec)))
  88   (values))
  89 \f
  90 ;;;; packed bit vectors
  91
  92 ;;; Read the specified number of Bytes out of Vec at Index and convert them
  93 ;;; to a bit-vector. Index is incremented.
  94 (defmacro read-packed-bit-vector (bytes vec index)
  95   (once-only ((n-bytes bytes))
  96     (once-only ((n-res `(make-array (* ,n-bytes 8) :element-type 'bit)))
  97       `(progn
  98          (%primitive byte-blt ,vec ,index ,n-res 0 ,n-bytes)
  99          (incf ,index ,n-bytes)
 100          ,n-res))))