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