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
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
|
# -*- GDB-Script -*-
handle SIGPWR noprint nostop
handle SIGXCPU noprint nostop
define newline
call (void)scm_newline (scm_current_error_port ())
end
define pp
call (void)scm_call_1 (scm_variable_ref (scm_c_module_lookup (scm_c_resolve_module ("ice-9 pretty-print"), "pretty-print")), $arg0)
end
define gdisplay
call (void)scm_display ($arg0, scm_current_error_port ())
newline
end
define gwrite
call (void)scm_write ($arg0, scm_current_error_port ())
newline
end
define sputs
call (void)scm_puts ($arg0, scm_current_error_port ())
end
define gslot
print ((SCM**)$arg0)[1][$arg1]
end
define pslot
gslot $arg0 $arg1
gwrite $
end
define lforeach
set $l=$arg0
while $l != 0x404
set $x=scm_car($l)
$arg1 $x
set $l = scm_cdr($l)
end
end
define modsum
modname $arg0
gslot $arg0 1
set $uses=$
output "uses:\n"
lforeach $uses modname
end
define moduses
pslot $arg0 1
end
define modname
pslot $arg0 5
end
define modkind
pslot $arg0 6
end
define car
call scm_car ($arg0)
end
define cdr
call scm_cdr ($arg0)
end
define smobwordtox
set $x=((SCM*)$arg0)[$arg1]
end
define smobdatatox
smobwordtox $arg0 1
end
define program_objcode
smobdatatox $arg0
set $objcode=$x
smobdatatox $objcode
p *(struct scm_objcode*)$x
end
define proglocals
set $i=bp->nlocs
while $i > 0
set $i=$i-1
gwrite fp[bp->nargs+$i]
end
end
define progstack
set $x=sp
while $x > stack_base
gwrite *$x
set $x=$x-1
end
end
define tc16
p ((scm_t_bits)$arg0) & 0xffff
end
define smobdescriptor
p scm_smobs[0xff & (((scm_t_bits)$arg0) >> 8)]
end
define vmstackinit
set $vmsp=sp
set $vmstack_base=stack_base
set $vmfp=fp
set $vmbp=bp
set $vmframe=0
end
define nextframe
set $orig_vmsp=$vmsp
while $vmsp > $vmstack_base
output $orig_vmsp - $vmsp
sputs "\t"
output $vmsp
sputs "\t"
gwrite *$vmsp
set $vmsp=$vmsp-1
end
newline
sputs "Frame "
output $vmframe
newline
sputs "ra:\t"
output $vmsp
sputs "\t"
output (SCM*)*$vmsp
set $vmsp=$vmsp-1
newline
sputs "mvra:\t"
output $vmsp
sputs "\t"
output (SCM*)*$vmsp
set $vmsp=$vmsp-1
newline
sputs "dl:\t"
output $vmsp
sputs "\t"
set $vmdl=(SCM*)(*$vmsp)
output $vmdl
newline
set $vmsp=$vmsp-1
set $vmnlocs=(int)$vmbp->nlocs
while $vmnlocs > 0
sputs "loc #"
output $vmnlocs
sputs ":\t"
output $vmsp
sputs "\t"
gwrite *$vmsp
set $vmsp=$vmsp-1
set $vmnlocs=$vmnlocs-1
end
set $vmnargs=(int)$vmbp->nargs
while $vmnargs > 0
sputs "arg #"
output $vmnargs
sputs ":\t"
output $vmsp
sputs "\t"
gwrite *$vmsp
set $vmsp=$vmsp-1
set $vmnargs=$vmnargs-1
end
sputs "prog:\t"
output $vmsp
sputs "\t"
gwrite *$vmsp
set $vmsp=$vmsp-1
newline
if $vmdl
set $vmfp=$vmdl
set $vmbp=(struct scm_objcode*)((SCM*)(((SCM*)($vmfp[-1]))[1])[1])
set $vmstack_base=$vmfp+$vmbp->nargs+$vmbp->nlocs+4
set $vmframe=$vmframe+1
newline
end
end
define vmstack
vmstackinit
while $vmsp > vp->stack_base
nextframe
end
end
define inst
p scm_instruction_table[$arg0]
end
define gbt
call scm_display_backtrace (scm_make_stack(0x404,0x304), scm_current_error_port (), 0x704, 0x704, 0x704)
end
|
