0.7.13.3
[sbcl.git] / 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))))