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 | ||
79 | define program | |
80 | smobdatatox $arg0 | |
81 | p *(struct scm_program*)$x | |
82 | end | |
83 | ||
84 | define proglocals | |
85 | set $i=bp->nlocs | |
86 | while $i > 0 | |
87 | set $i=$i-1 | |
88 | gwrite fp[bp->nargs+$i] | |
89 | end | |
90 | end | |
91 | ||
92 | define progstack | |
93 | set $x=sp | |
94 | while $x > stack_base | |
95 | gwrite *$x | |
96 | set $x=$x-1 | |
97 | end | |
98 | end | |
99 | ||
100 | define tc16 | |
101 | p ((scm_t_bits)$arg0) & 0xffff | |
102 | end | |
103 | ||
104 | define smobdescriptor | |
105 | p scm_smobs[0xff & (((scm_t_bits)$arg0) >> 8)] | |
106 | end | |
107 | ||
887ce75a | 108 | define vmstackinit |
ff1592a1 AW |
109 | set $vmsp=sp |
110 | set $vmstack_base=stack_base | |
111 | set $vmfp=fp | |
112 | set $vmbp=bp | |
113 | set $vmframe=0 | |
887ce75a AW |
114 | end |
115 | ||
116 | define nextframe | |
117 | set $orig_vmsp=$vmsp | |
118 | while $vmsp > $vmstack_base | |
119 | output $orig_vmsp - $vmsp | |
ff1592a1 | 120 | sputs "\t" |
ff1592a1 AW |
121 | output $vmsp |
122 | sputs "\t" | |
123 | gwrite *$vmsp | |
124 | set $vmsp=$vmsp-1 | |
887ce75a AW |
125 | end |
126 | newline | |
127 | sputs "Frame " | |
128 | output $vmframe | |
129 | newline | |
130 | sputs "ra:\t" | |
131 | output $vmsp | |
132 | sputs "\t" | |
133 | output (SCM*)*$vmsp | |
134 | set $vmsp=$vmsp-1 | |
135 | newline | |
136 | sputs "mvra:\t" | |
137 | output $vmsp | |
138 | sputs "\t" | |
139 | output (SCM*)*$vmsp | |
140 | set $vmsp=$vmsp-1 | |
141 | newline | |
142 | sputs "dl:\t" | |
143 | output $vmsp | |
144 | sputs "\t" | |
145 | set $vmdl=(SCM*)(*$vmsp) | |
146 | output $vmdl | |
147 | newline | |
148 | set $vmsp=$vmsp-1 | |
887ce75a AW |
149 | sputs "el:\t" |
150 | output $vmsp | |
151 | sputs "\t" | |
152 | gwrite *$vmsp | |
153 | set $vmsp=$vmsp-1 | |
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 | |
184 | set $vmbp=(struct scm_program*)(((SCM*)($vmfp[-1]))[1]) | |
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 |