Commit | Line | Data |
---|---|---|
5e390de6 AW |
1 | # -*- GDB-Script -*- |
2 | ||
a6f15a1e AW |
3 | handle SIGPWR noprint nostop |
4 | handle SIGXCPU noprint nostop | |
5 | ||
ff1592a1 AW |
6 | define newline |
7 | call (void)scm_newline (scm_current_error_port ()) | |
8 | end | |
9 | ||
5e390de6 AW |
10 | define pp |
11 | call (void)scm_call_1 (scm_variable_ref (scm_c_module_lookup (scm_c_resolve_module ("ice-9 pretty-print"), "pretty-print")), $arg0) | |
12 | end | |
13 | ||
ff1592a1 AW |
14 | define gdisplay |
15 | call (void)scm_display ($arg0, scm_current_error_port ()) | |
16 | newline | |
17 | end | |
18 | ||
19 | define gwrite | |
20 | call (void)scm_write ($arg0, scm_current_error_port ()) | |
21 | newline | |
22 | end | |
23 | ||
24 | define sputs | |
25 | call (void)scm_puts ($arg0, scm_current_error_port ()) | |
26 | end | |
27 | ||
28 | define gslot | |
29 | print ((SCM**)$arg0)[1][$arg1] | |
30 | end | |
31 | ||
32 | define pslot | |
33 | gslot $arg0 $arg1 | |
34 | gwrite $ | |
35 | end | |
36 | ||
37 | define lforeach | |
38 | set $l=$arg0 | |
39 | while $l != 0x404 | |
40 | set $x=scm_car($l) | |
41 | $arg1 $x | |
42 | set $l = scm_cdr($l) | |
43 | end | |
44 | end | |
45 | ||
46 | define modsum | |
47 | modname $arg0 | |
48 | gslot $arg0 1 | |
49 | set $uses=$ | |
50 | output "uses:\n" | |
51 | lforeach $uses modname | |
52 | end | |
53 | ||
54 | define moduses | |
55 | pslot $arg0 1 | |
56 | end | |
57 | ||
58 | define modname | |
59 | pslot $arg0 5 | |
60 | end | |
61 | ||
62 | define modkind | |
63 | pslot $arg0 6 | |
64 | end | |
65 | ||
66 | define car | |
67 | call scm_car ($arg0) | |
68 | end | |
69 | ||
70 | define cdr | |
71 | call scm_cdr ($arg0) | |
72 | end | |
73 | ||
74 | define smobwordtox | |
75 | set $x=((SCM*)$arg0)[$arg1] | |
76 | end | |
77 | ||
78 | define smobdatatox | |
79 | smobwordtox $arg0 1 | |
80 | end | |
81 | ||
53e28ed9 | 82 | define program_objcode |
ff1592a1 | 83 | smobdatatox $arg0 |
53e28ed9 AW |
84 | set $objcode=$x |
85 | smobdatatox $objcode | |
86 | p *(struct scm_objcode*)$x | |
ff1592a1 AW |
87 | end |
88 | ||
89 | define proglocals | |
90 | set $i=bp->nlocs | |
91 | while $i > 0 | |
92 | set $i=$i-1 | |
93 | gwrite fp[bp->nargs+$i] | |
94 | end | |
95 | end | |
96 | ||
97 | define progstack | |
98 | set $x=sp | |
99 | while $x > stack_base | |
100 | gwrite *$x | |
101 | set $x=$x-1 | |
102 | end | |
103 | end | |
104 | ||
105 | define tc16 | |
106 | p ((scm_t_bits)$arg0) & 0xffff | |
107 | end | |
108 | ||
109 | define smobdescriptor | |
110 | p scm_smobs[0xff & (((scm_t_bits)$arg0) >> 8)] | |
111 | end | |
112 | ||
887ce75a | 113 | define vmstackinit |
ff1592a1 AW |
114 | set $vmsp=sp |
115 | set $vmstack_base=stack_base | |
116 | set $vmfp=fp | |
117 | set $vmbp=bp | |
118 | set $vmframe=0 | |
887ce75a AW |
119 | end |
120 | ||
121 | define nextframe | |
122 | set $orig_vmsp=$vmsp | |
123 | while $vmsp > $vmstack_base | |
124 | output $orig_vmsp - $vmsp | |
ff1592a1 | 125 | sputs "\t" |
ff1592a1 AW |
126 | output $vmsp |
127 | sputs "\t" | |
128 | gwrite *$vmsp | |
129 | set $vmsp=$vmsp-1 | |
887ce75a AW |
130 | end |
131 | newline | |
132 | sputs "Frame " | |
133 | output $vmframe | |
134 | newline | |
135 | sputs "ra:\t" | |
136 | output $vmsp | |
137 | sputs "\t" | |
138 | output (SCM*)*$vmsp | |
139 | set $vmsp=$vmsp-1 | |
140 | newline | |
141 | sputs "mvra:\t" | |
142 | output $vmsp | |
143 | sputs "\t" | |
144 | output (SCM*)*$vmsp | |
145 | set $vmsp=$vmsp-1 | |
146 | newline | |
147 | sputs "dl:\t" | |
148 | output $vmsp | |
149 | sputs "\t" | |
150 | set $vmdl=(SCM*)(*$vmsp) | |
151 | output $vmdl | |
152 | newline | |
153 | set $vmsp=$vmsp-1 | |
887ce75a AW |
154 | set $vmnlocs=(int)$vmbp->nlocs |
155 | while $vmnlocs > 0 | |
156 | sputs "loc #" | |
157 | output $vmnlocs | |
158 | sputs ":\t" | |
ff1592a1 AW |
159 | output $vmsp |
160 | sputs "\t" | |
161 | gwrite *$vmsp | |
162 | set $vmsp=$vmsp-1 | |
887ce75a AW |
163 | set $vmnlocs=$vmnlocs-1 |
164 | end | |
165 | set $vmnargs=(int)$vmbp->nargs | |
166 | while $vmnargs > 0 | |
167 | sputs "arg #" | |
168 | output $vmnargs | |
169 | sputs ":\t" | |
ff1592a1 AW |
170 | output $vmsp |
171 | sputs "\t" | |
172 | gwrite *$vmsp | |
173 | set $vmsp=$vmsp-1 | |
887ce75a AW |
174 | set $vmnargs=$vmnargs-1 |
175 | end | |
176 | sputs "prog:\t" | |
177 | output $vmsp | |
178 | sputs "\t" | |
179 | gwrite *$vmsp | |
180 | set $vmsp=$vmsp-1 | |
181 | newline | |
b1b942b7 AW |
182 | if $vmdl |
183 | set $vmfp=$vmdl | |
53e28ed9 | 184 | set $vmbp=(struct scm_objcode*)((SCM*)(((SCM*)($vmfp[-1]))[1])[1]) |
b1b942b7 AW |
185 | set $vmstack_base=$vmfp+$vmbp->nargs+$vmbp->nlocs+4 |
186 | set $vmframe=$vmframe+1 | |
187 | newline | |
887ce75a | 188 | end |
887ce75a AW |
189 | end |
190 | ||
191 | define vmstack | |
192 | vmstackinit | |
193 | while $vmsp > vp->stack_base | |
194 | nextframe | |
ff1592a1 AW |
195 | end |
196 | end | |
5e390de6 AW |
197 | |
198 | define inst | |
199 | p scm_instruction_table[$arg0] | |
200 | end | |
08d7492c AW |
201 | |
202 | define gbt | |
203 | call scm_display_backtrace (scm_make_stack(0x404,0x304), scm_current_error_port (), 0x704, 0x704, 0x704) | |
204 | end |