1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
|
; Part of Scheme 48 1.9. See file COPYING for notices and license.
; Authors: Richard Kelsey, Jonathan Rees
; Stuff moved from segment.scm 6/5/93
; Some of that stuff moved to state.scm 4/28/95
; Debug-data records are for communicating information from the
; compiler to various debugging tools.
; An environment map has the form
; #(pc-before pc-after #(name+ ...) offset (env-map ...))
; where the two pc's delimit the region of code that executes in this
; environment. The names indicate variables bound at from that stack
; offset up. A name+ is either a name or a vector of names indicating
; that the stack holds a vector of values at that point. The list of
; env-maps is for inferior (deeper) environments.
; Source is in the form of an a-list mapping pc's used in continuations
; to pairs of the form (i . expression), indicating that the continuation
; is returning the value of i'th subexpression in the source expression.
(define-record-type debug-data :debug-data
(make-debug-data uid name parent env-maps jump-back-dests source)
debug-data?
(uid debug-data-uid)
(name debug-data-name)
(parent debug-data-parent)
(env-maps debug-data-env-maps set-debug-data-env-maps!)
(jump-back-dests debug-data-jump-back-dests set-debug-data-jump-back-dests!)
(source debug-data-source set-debug-data-source!))
(define-record-discloser :debug-data
(lambda (dd)
(list 'debug-data (debug-data-uid dd) (debug-data-name dd))))
; Returns a list of proper lists describing the environment in effect
; at the given pc with the given template's code vector.
;
; Entries in the environment-maps table (one per template) have the form
; #(#(pc-before pc-after #(var ...) offset (env-map ...)) ...)
;
; A PC of #F indicates that the caller wants the environment map for
; the closure itself, which will be the last thing in the outermost
; environment map (because that matches where the environment is pushed
; onto the stack).
;
; Cf. procedure (note-environment vars segment) in segment.scm.
(define (debug-data-env-shape dd pc)
(cond ((not (debug-data? dd))
'())
(pc
(let loop ((emaps (debug-data-env-maps dd))
(shape '()))
(if (null? emaps)
shape
(let ((pc-before (vector-ref (car emaps) 0))
(pc-after (vector-ref (car emaps) 1))
(offset (vector-ref (car emaps) 2))
(vars (vector-ref (car emaps) 3))
(more-maps (vector-ref (car emaps) 4)))
(if (and (>= pc pc-before)
(< pc pc-after))
(loop more-maps
(cons (cons offset
(vector->list vars))
shape))
(loop (cdr emaps) shape))))))
((not (null? (debug-data-env-maps dd)))
(let ((names (vector-ref (car (debug-data-env-maps dd))
3)))
(if (and names
(< 0 (vector-length names))
(pair? (vector-ref names (- (vector-length names) 1))))
(list (vector-ref names (- (vector-length names) 1)))
'())))
(else
'())))
|
