/[cmucl]/src/code/debug-info.lisp
ViewVC logotype

Contents of /src/code/debug-info.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.30 - (show annotations)
Fri Mar 19 15:18:58 2010 UTC (4 years, 1 month ago) by rtoy
Branch: MAIN
CVS Tags: sparc-tramp-assem-base, post-merge-intl-branch, release-20b-pre1, release-20b-pre2, sparc-tramp-assem-2010-07-19, GIT-CONVERSION, cross-sol-x86-merged, RELEASE_20b, cross-sol-x86-base, snapshot-2010-12, snapshot-2010-11, snapshot-2011-09, snapshot-2011-06, snapshot-2011-07, snapshot-2011-04, snapshot-2011-02, snapshot-2011-03, snapshot-2011-01, snapshot-2010-05, snapshot-2010-04, snapshot-2010-07, snapshot-2010-06, snapshot-2010-08, cross-sol-x86-2010-12-20, cross-sparc-branch-base, HEAD
Branch point for: cross-sparc-branch, RELEASE-20B-BRANCH, sparc-tramp-assem-branch, cross-sol-x86-branch
Changes since 1.29: +3 -1 lines
Merge intl-branch 2010-03-18 to HEAD.  To build, you need to use
boot-2010-02-1 as the bootstrap file.  You should probably also use
the new -P option for build.sh to generate and update the po files
while building.
1 ;;; -*- Log: code.log; Package: C -*-
2 ;;;
3 ;;; **********************************************************************
4 ;;; This code was written as part of the CMU Common Lisp project at
5 ;;; Carnegie Mellon University, and has been placed in the public domain.
6 ;;;
7 (ext:file-comment
8 "$Header: /tiger/var/lib/cvsroots/cmucl/src/code/debug-info.lisp,v 1.30 2010/03/19 15:18:58 rtoy Rel $")
9 ;;;
10 ;;; **********************************************************************
11 ;;;
12 ;;; This file contains structures used for recording debugger information.
13 ;;;
14 (in-package "C")
15
16 (intl:textdomain "cmucl")
17
18 (export '(make-sc-offset sc-offset-scn sc-offset-offset
19 read-var-integer write-var-integer
20 read-var-string write-var-string
21 read-packed-bit-vector write-packed-bit-vector))
22
23
24 ;;;; SC-Offsets:
25 ;;;
26 ;;; We represent the place where some value is stored with a SC-OFFSET,
27 ;;; which is the SC number and offset encoded as an integer.
28
29 (defconstant sc-offset-scn-byte (byte 5 0))
30 (defconstant sc-offset-offset-byte (byte 22 5))
31 (deftype sc-offset () '(unsigned-byte 27))
32
33 (defmacro make-sc-offset (scn offset)
34 `(dpb ,scn sc-offset-scn-byte
35 (dpb ,offset sc-offset-offset-byte 0)))
36
37 (defmacro sc-offset-scn (sco) `(ldb sc-offset-scn-byte ,sco))
38 (defmacro sc-offset-offset (sco) `(ldb sc-offset-offset-byte ,sco))
39
40
41 ;;;; Variable length integers:
42 ;;;
43 ;;; The debug info representation makes extensive use of integers encoded in
44 ;;; a byte vector using a variable number of bytes:
45 ;;; 0..253 => the integer
46 ;;; 254 => read next two bytes for integer
47 ;;; 255 => read next four bytes for integer
48
49 ;;; READ-VAR-INTEGER -- Interface
50 ;;;
51 ;;; Given a byte vector Vec and an index variable Index, read a variable
52 ;;; length integer and advance index.
53 ;;;
54 (defmacro read-var-integer (vec index)
55 (once-only ((val `(aref ,vec ,index)))
56 `(cond ((<= ,val 253)
57 (incf ,index)
58 ,val)
59 ((= ,val 254)
60 (prog1
61 (logior (aref ,vec (+ ,index 1))
62 (ash (aref ,vec (+ ,index 2)) 8))
63 (incf ,index 3)))
64 (t
65 (prog1
66 (logior (aref ,vec (+ ,index 1))
67 (ash (aref ,vec (+ ,index 2)) 8)
68 (ash (aref ,vec (+ ,index 3)) 16)
69 (ash (aref ,vec (+ ,index 4)) 24))
70 (incf ,index 5))))))
71
72
73 ;;; WRITE-VAR-INTEGER -- Interface
74 ;;;
75 ;;; Takes an adjustable vector Vec with a fill pointer and pushes the
76 ;;; variable length representation of Int on the end.
77 ;;;
78 (defun write-var-integer (int vec)
79 (declare (type (unsigned-byte 32) int))
80 (cond ((<= int 253)
81 (vector-push-extend int vec))
82 (t
83 (let ((32-p (> int #xFFFF)))
84 (vector-push-extend (if 32-p 255 254) vec)
85 (vector-push-extend (ldb (byte 8 0) int) vec)
86 (vector-push-extend (ldb (byte 8 8) int) vec)
87 (when 32-p
88 (vector-push-extend (ldb (byte 8 16) int) vec)
89 (vector-push-extend (ldb (byte 8 24) int) vec)))))
90 (undefined-value))
91
92
93
94 ;;;; Packed strings:
95 ;;;
96 ;;; A packed string is a variable length integer length followed by the
97 ;;; character codes.
98
99
100 ;;; READ-VAR-STRING -- Interface
101 ;;;
102 ;;; Read a packed string from Vec starting at Index, leaving advancing
103 ;;; Index.
104 ;;;
105 #-unicode
106 (defmacro read-var-string (vec index)
107 (once-only ((len `(read-var-integer ,vec ,index)))
108 (once-only ((res `(make-string ,len)))
109 `(progn
110 (%primitive byte-blt ,vec ,index ,res 0 ,len)
111 (incf ,index ,len)
112 ,res))))
113
114 #+unicode
115 (defmacro read-var-string (vec index)
116 (once-only ((len `(read-var-integer ,vec ,index)))
117 (once-only ((res `(make-string ,len))
118 (k 0))
119 `(progn
120 (dotimes (,k ,len)
121 (let ((lo (aref ,vec (+ ,index (* 2 ,k))))
122 (hi (aref ,vec (+ ,index (+ (* 2 ,k) 1)))))
123 (setf (aref ,res ,k)
124 (code-char (+ lo (ash hi 8))))))
125 (incf ,index (* 2 ,len))
126 ,res))))
127
128
129 ;;; WRITE-VAR-STRING -- Interface
130 ;;;
131 ;;; Write String into Vec (adjustable, fill-pointer) represented as the
132 ;;; length (in a var-length integer) followed by the codes of the characters.
133 ;;;
134 (defun write-var-string (string vec)
135 (declare (simple-string string))
136 (let ((len (length string)))
137 (write-var-integer len vec)
138 (dotimes (i len)
139 (vector-push-extend (ldb (byte 8 0) (char-code (schar string i))) vec)
140 #+unicode
141 (vector-push-extend (ldb (byte 8 8) (char-code (schar string i))) vec)))
142 (undefined-value))
143
144
145 ;;;; Packed bit vectors:
146 ;;;
147
148 ;;; READ-PACKED-BIT-VECTOR -- Interface
149 ;;;
150 ;;; Read the specified number of Bytes out of Vec at Index and convert them
151 ;;; to a bit-vector. Index is incremented.
152 ;;;
153 (defmacro read-packed-bit-vector (bytes vec index)
154 (once-only ((n-bytes bytes))
155 (once-only ((n-res `(make-array (* ,n-bytes 8) :element-type 'bit)))
156 `(progn
157 (%primitive byte-blt ,vec ,index ,n-res 0 ,n-bytes)
158 (incf ,index ,n-bytes)
159 ,n-res))))
160
161
162 ;;; WRITE-PACKED-BIT-VECTOR -- Interface
163 ;;;
164 ;;; Write Bits out to Vec. Bits must be an eight-bit multiple.
165 ;;;
166 (defun write-packed-bit-vector (bits vec)
167 (declare (type simple-bit-vector bits))
168 (let ((len (length bits))
169 (start (fill-pointer vec)))
170 (cond ((eq (backend-byte-order *backend*)
171 (backend-byte-order *native-backend*))
172 (let ((bytes (ash len -3)))
173 (dotimes (i bytes)
174 (vector-push-extend 0 vec))
175 (lisp::with-array-data ((data vec) (ig1) (ig2))
176 (declare (ignore ig1 ig2))
177 (%primitive byte-blt bits 0 data start (+ start bytes)))))
178 (t
179 (macrolet ((frob (initial step done)
180 `(let ((shift ,initial)
181 (byte 0))
182 (dotimes (i len)
183 (let ((int (aref bits i)))
184 (setq byte (logior byte (ash int shift)))
185 (,step shift))
186 (when ,done
187 (vector-push-extend byte vec)
188 (setq shift ,initial byte 0)))
189 (unless (= shift ,initial)
190 (vector-push-extend byte vec)))))
191 (ecase (backend-byte-order *backend*)
192 (:little-endian
193 (frob 0 incf (= shift 8)))
194 (:big-endian
195 (frob 7 decf (minusp shift))))))))
196
197 (undefined-value))
198
199
200 ;;;; Compiled debug variables:
201 ;;;
202 ;;; Compiled debug variables are in a packed binary representation in the
203 ;;; DEBUG-FUNCTION-VARIABLES:
204 ;;; single byte of boolean flags:
205 ;;; uninterned name
206 ;;; packaged name
207 ;;; environment-live
208 ;;; has distinct save location
209 ;;; has ID (name not unique in this fun)
210 ;;; minimal debug-info argument (name generated as ARG-0, ...)
211 ;;; deleted: placeholder for unused minimal argument
212 ;;; [name length in bytes (as var-length integer), if not minimal]
213 ;;; [...name bytes..., if not minimal]
214 ;;; [if packaged, var-length integer that is package name length]
215 ;;; ...package name bytes...]
216 ;;; [If has ID, ID as var-length integer]
217 ;;; SC-Offset of primary location (as var-length integer)
218 ;;; [If has save SC, SC-Offset of save location (as var-length integer)]
219
220 (defconstant compiled-debug-variable-uninterned #b00000001)
221 (defconstant compiled-debug-variable-packaged #b00000010)
222 (defconstant compiled-debug-variable-environment-live #b00000100)
223 (defconstant compiled-debug-variable-save-loc-p #b00001000)
224 (defconstant compiled-debug-variable-id-p #b00010000)
225 (defconstant compiled-debug-variable-minimal-p #b00100000)
226 (defconstant compiled-debug-variable-deleted-p #b01000000)
227
228
229 ;;;; Compiled debug blocks:
230 ;;;
231 ;;; Compiled debug blocks are in a packed binary representation in the
232 ;;; DEBUG-FUNCTION-BLOCKS:
233 ;;; number of successors + bit flags (single byte)
234 ;;; elsewhere-p
235 ;;; ...ordinal number of each successor in the function's blocks vector...
236 ;;; number of locations in this block
237 ;;; kind of first location (single byte)
238 ;;; delta from previous PC (or from 0 if first location in function.)
239 ;;; [offset of first top-level form, if no function TLF-NUMBER]
240 ;;; form number of first source form
241 ;;; first live mask (length in bytes determined by number of VARIABLES)
242 ;;; ...more <kind, delta, top-level form offset, form-number, live-set>
243 ;;; tuples...
244
245
246 (defconstant compiled-debug-block-nsucc-byte (byte 2 0))
247 (defconstant compiled-debug-block-elsewhere-p #b00000100)
248
249 (defconstant compiled-code-location-kind-byte (byte 3 0))
250 (defconstant compiled-code-location-kinds
251 '#(:unknown-return :known-return :internal-error :non-local-exit
252 :block-start :call-site :single-value-return :non-local-entry))
253
254
255
256 ;;;; Debug function:
257
258 (defstruct debug-function)
259
260 (defstruct (compiled-debug-function
261 (:include debug-function)
262 (:pure t))
263 ;;
264 ;; The name of this function. If from a DEFUN, etc., then this is the
265 ;; function name, otherwise it is a descriptive string.
266 (name (required-argument) :type (or simple-string cons symbol))
267 ;;
268 ;; The kind of function (same as FUNCTIONAL-KIND):
269 (kind nil :type (member nil :optional :external :top-level :cleanup))
270 ;;
271 ;; A vector of the packed binary representation of variable locations in this
272 ;; function. These are in alphabetical order by name. This ordering is used
273 ;; in lifetime info to refer to variables: the first entry is 0, the second
274 ;; entry is 1, etc. Variable numbers are *not* the byte index at which the
275 ;; representation of the location starts. This slot may be NIL to save
276 ;; space.
277 (variables nil :type (or (simple-array (unsigned-byte 8) (*)) null))
278 ;;
279 ;; A vector of the packed binary representation of the COMPILED-DEBUG-BLOCKS
280 ;; in this function, in the order that the blocks were emitted. The first
281 ;; block is the start of the function. This slot may be NIL to save space.
282 (blocks nil :type (or (simple-array (unsigned-byte 8) (*)) null))
283 ;;
284 ;; If all code locations in this function are in the same top-level form,
285 ;; then this is the number of that form, otherwise NIL. If NIL, then each
286 ;; code location represented in the BLOCKS specifies the TLF number.
287 (tlf-number nil :type (or index null))
288 ;;
289 ;; A vector describing the variables that the argument values are stored in
290 ;; within this function. The locations are represented by the ordinal number
291 ;; of the entry in the VARIABLES. The locations are in the order that the
292 ;; arguments are actually passed in, but special marker symbols can be
293 ;; interspersed to indicate the orignal call syntax:
294 ;;
295 ;; DELETED
296 ;; There was an argument to the function in this position, but it was
297 ;; deleted due to lack of references. The value cannot be recovered.
298 ;;
299 ;; SUPPLIED-P
300 ;; The following location is the supplied-p value for the preceding
301 ;; keyword or optional.
302 ;;
303 ;; OPTIONAL-ARGS
304 ;; Indicates that following unqualified args are optionals, not required.
305 ;;
306 ;; REST-ARG
307 ;; The following location holds the list of rest args.
308 ;;
309 ;; MORE-ARG
310 ;; The following two locations are the more arg context and count.
311 ;;
312 ;; <any other symbol>
313 ;; The following location is the value of the keyword argument with the
314 ;; specified name.
315 ;;
316 ;; This may be NIL to save space. If no symbols are present, then this will
317 ;; be represented with an I-vector with sufficiently large element type. If
318 ;; this is :MINIMAL, then this means that the VARIABLES are all required
319 ;; arguments, and are in the order they appear in the VARIABLES vector. In
320 ;; other words, :MINIMAL stands in for a vector where every element holds its
321 ;; index.
322 (arguments nil :type (or (simple-array * (*)) (member :minimal nil)))
323 ;;
324 ;; There are three alternatives for this slot:
325 ;;
326 ;; A vector
327 ;; A vector of SC-OFFSETS describing the return locations. The
328 ;; vector element type is chosen to hold the largest element.
329 ;;
330 ;; :Standard
331 ;; The function returns using the standard unknown-values convention.
332 ;;
333 ;; :Fixed
334 ;; The function returns using the a fixed-values convention, but we
335 ;; elected not to store a vector to save space.
336 (returns :fixed :type (or (simple-array * (*)) (member :standard :fixed)))
337 ;;
338 ;; SC-Offsets describing where the return PC and return FP are kept.
339 (return-pc (required-argument) :type sc-offset)
340 (old-fp (required-argument) :type sc-offset)
341 ;;
342 ;; SC-Offset for the number stack FP in this function, or NIL if no NFP
343 ;; allocated.
344 (nfp nil :type (or sc-offset null))
345 ;;
346 ;; The earliest PC in this function at which the environment is properly
347 ;; initialized (arguments moved from passing locations, etc.)
348 (start-pc (required-argument) :type index)
349 ;;
350 ;; The start of elsewhere code for this function (if any.)
351 (elsewhere-pc (required-argument) :type index))
352
353
354 ;;;; Minimal debug function:
355
356 ;;; The minimal debug info format compactly represents debug-info for some
357 ;;; cases where the other debug info (variables, blocks) is small enough
358 ;;; that the per-function overhead becomes relatively large. The minimal
359 ;;; debug-info format can represent any function at level 0, and any fixed-arg
360 ;;; function at level 1.
361 ;;;
362 ;;; In the minimal format, the debug functions and function map are packed into
363 ;;; a single byte-vector which is placed in the
364 ;;; COMPILED-DEBUG-INFO-FUNCTION-MAP. Because of this, all functions in a
365 ;;; component must be representable in minimal format for any function to
366 ;;; actually be dumped in minimal format. The vector is a sequence of records
367 ;;; in this format:
368 ;;; name representation + kind + return convention (single byte)
369 ;;; bit flags (single byte)
370 ;;; setf, nfp, variables
371 ;;; [package name length (as var-length int), if name is packaged]
372 ;;; [...package name bytes, if name is packaged]
373 ;;; [name length (as var-length int), if there is a name]
374 ;;; [...name bytes, if there is a name]
375 ;;; [variables length (as var-length int), if variables flag]
376 ;;; [...bytes holding variable descriptions]
377 ;;; If variables are dumped (level 1), then the variables are all
378 ;;; arguments (in order) with the minimal-arg bit set.
379 ;;; [If returns is specified, then the number of return values]
380 ;;; [...sequence of var-length ints holding sc-offsets of the return
381 ;;; value locations, if fixed return values are specified.]
382 ;;; return-pc location sc-offset (as var-length int)
383 ;;; old-fp location sc-offset (as var-length int)
384 ;;; [nfp location sc-offset (as var-length int), if nfp flag]
385 ;;; code-start-pc (as a var-length int)
386 ;;; This field implicitly encodes start of this function's code in the
387 ;;; function map, as a delta from the previous function's code start.
388 ;;; If the first function in the component, then this is the delta from
389 ;;; 0 (i.e. the absolute offset).
390 ;;; start-pc (as a var-length int)
391 ;;; This encodes the environment start PC as an offset from the
392 ;;; code-start PC.
393 ;;; elsewhere-pc
394 ;;; This encodes the elsewhere code start for this function, as a delta
395 ;;; from the previous function's elsewhere code start. (i.e. the
396 ;;; encoding is the same as for code-start-pc).
397 ;;;
398 ;;;
399
400 #|
401 ### For functions with XEPs, name could be represented more simply and
402 compactly as some sort of info about how to find the function-entry that
403 this is a function for. Actually, you really hardly need any info. You can
404 just chain through the functions in the component until you find the right one.
405 Well, I guess you need to at least know which function is an XEP for the real
406 function (which would be useful info anyway).
407 |#
408
409 ;;; Following are definitions of bit-fields in the first byte of the minimal
410 ;;; debug function:
411 ;;;
412 (defconstant minimal-debug-function-name-symbol 0)
413 (defconstant minimal-debug-function-name-packaged 1)
414 (defconstant minimal-debug-function-name-uninterned 2)
415 (defconstant minimal-debug-function-name-component 3)
416 (defconstant minimal-debug-function-name-style-byte (byte 2 0))
417 (defconstant minimal-debug-function-kind-byte (byte 3 2))
418 (defconstant minimal-debug-function-kinds
419 '#(nil :optional :external :top-level :cleanup))
420 (defconstant minimal-debug-function-returns-standard 0)
421 (defconstant minimal-debug-function-returns-specified 1)
422 (defconstant minimal-debug-function-returns-fixed 2)
423 (defconstant minimal-debug-function-returns-byte (byte 2 5))
424
425 ;;; The following are bit-flags in the second byte of the minimal debug
426 ;;; function:
427
428 ;;; If true, wrap (SETF ...) around the name.
429 (defconstant minimal-debug-function-setf-bit (ash 1 0))
430
431 ;;; If true, there is a NFP.
432 (defconstant minimal-debug-function-nfp-bit (ash 1 1))
433
434 ;;; If true, variables (hence arguments) have been dumped.
435 (defconstant minimal-debug-function-variables-bit (ash 1 2))
436
437
438 ;;;; Debug source:
439
440 (defstruct (debug-source (:pure t))
441 ;;
442 ;; This slot indicates where the definition came from:
443 ;; :File - from a file (Compile-File)
444 ;; :Lisp - from Lisp (Compile)
445 ;; :Stream - from a non-file stream (Compile-From-Stream)
446 (from (required-argument) :type (member :file :stream :lisp))
447 ;;
448 ;; If :File, the file name, if :Lisp or :Stream, then a vector of the
449 ;; top-level forms. When from COMPILE, form 0 is #'(LAMBDA ...).
450 (name nil)
451 ;;
452 ;; File comment for this file, if any.
453 (comment nil :type (or simple-string null))
454 ;;
455 ;; The universal time that the source was written, or NIL if unavailable.
456 (created nil :type (or unsigned-byte null))
457 ;;
458 ;; The universal time that the source was compiled.
459 (compiled (required-argument) :type unsigned-byte)
460 ;;
461 ;; The source path root number of the first form read from this source (i.e.
462 ;; the total number of forms converted previously in this compilation).
463 (source-root 0 :type index)
464 ;;
465 ;; The file-positions of each truly top-level form read from this file (if
466 ;; applicable). The vector element type will be chosen to hold the largest
467 ;; element. May be null to save space.
468 (start-positions nil :type (or (simple-array * (*)) null))
469 ;;
470 ;; If from :LISP, this is the function whose source is form 0.
471 ;; If from :STREAM, this is whatever was the :SOURCE-INFO argument to
472 ;; COMPILE-FROM-STREAM.
473 ;; If from :FILE, this is the external format used to read from the
474 ;; file while compiling
475 (info nil))
476
477
478 ;;;; The DEBUG-INFO structure:
479
480 (defstruct debug-info
481 ;;
482 ;; Some string describing something about the code in this component.
483 (name (required-argument) :type simple-string)
484 ;;
485 ;; A list of DEBUG-SOURCE structures describing where the code for this
486 ;; component came from, in the order that they were read.
487 ;;
488 ;; *** NOTE: the offset of this slot is wired into the fasl dumper so that it
489 ;; *** can backpatch the source info when compilation is complete.
490 (source nil :type list))
491
492
493 (defstruct (compiled-debug-info
494 (:include debug-info)
495 (:pure t))
496 ;;
497 ;; The name of the package that DEBUG-FUNCTION-VARIABLES were dumped relative
498 ;; to. Locations that aren't packaged are in this package.
499 (package (required-argument) :type simple-string)
500 ;;
501 ;; Either a simple-vector or a byte-vector holding the debug functions for
502 ;; this component. This is used to map PCs to functions, so that we can
503 ;; figure out what function we were running in. If a byte-vector, then it is
504 ;; a sequence of minimal debug functions in a packed binary representation.
505 ;;
506 ;; If a simple-vector, then it alternates Debug-Function structures and
507 ;; fixnum PCs. The function is valid between the PC before it (inclusive)
508 ;; and the PC after it (exclusive). The PCs are in sorted order, so we can
509 ;; binary-search. We omit the first and last PC, since their values are 0
510 ;; and the length of the code vector. Null only temporarily.
511 (function-map nil :type (or simple-vector
512 (simple-array (unsigned-byte 8) (*))
513 null)))

  ViewVC Help
Powered by ViewVC 1.1.5