blob: 2725c6e781f84e5eb47f186670c1a54297c70a61 [file] [log] [blame]
Greg Claytone51dc6f2011-05-20 02:00:47 +00001#!/usr/bin/perl
2
3use strict;
4
5#----------------------------------------------------------------------
6# Globals
7#----------------------------------------------------------------------
Greg Clayton86729962011-06-02 22:21:38 +00008our $unimplemented_str = "UNIMPLEMENTED";
Greg Claytone51dc6f2011-05-20 02:00:47 +00009our $success_str = "OK";
10our $swap = 1;
11our $addr_size = 4;
12our $thread_suffix_supported = 0;
13our $max_bytes_per_line = 32;
14our $addr_format = sprintf("0x%%%u.%ux", $addr_size*2, $addr_size*2);
15our $pid_format = "%04.4x";
16our $tid_format = "%04.4x";
17our $reg8_href = { extract => \&get8, format => "0x%2.2x" };
18our $reg16_href = { extract => \&get16, format => "0x%4.4x" };
19our $reg32_href = { extract => \&get32, format => "0x%8.8x" };
20our $reg64_href = { extract => \&get64, format => "0x%s" };
21our $reg80_href = { extract => \&get80, format => "0x%s" };
22our $reg128_href = { extract => \&get128, format => "0x%s" };
Greg Clayton9163c392011-09-17 05:45:35 +000023our $reg256_href = { extract => \&get256, format => "0x%s" };
Greg Claytone51dc6f2011-05-20 02:00:47 +000024our $float32_href = { extract => \&get32, format => "0x%8.8x" };
25our $float64_href = { extract => \&get64, format => "0x%s" };
26our $float96_href = { extract => \&get96, format => "0x%s" };
27our $curr_cmd = undef;
Greg Clayton5c3de152012-01-25 21:52:15 +000028our $curr_full_cmd = undef;
29our %packet_times;
30our $curr_time = 0.0;
31our $last_time = 0.0;
32our $base_time = 0.0;
33our $packet_start_time = 0.0;
Greg Claytone51dc6f2011-05-20 02:00:47 +000034our $reg_cmd_reg;
35our %reg_map = (
36 'i386-gdb' => [
37 { name => 'eax', info => $reg32_href },
38 { name => 'ecx', info => $reg32_href },
39 { name => 'edx', info => $reg32_href },
40 { name => 'ebx', info => $reg32_href },
41 { name => 'esp', info => $reg32_href },
42 { name => 'ebp', info => $reg32_href },
43 { name => 'esi', info => $reg32_href },
44 { name => 'edi', info => $reg32_href },
45 { name => 'eip', info => $reg32_href },
46 { name => 'eflags', info => $reg32_href },
47 { name => 'cs', info => $reg32_href },
48 { name => 'ss', info => $reg32_href },
49 { name => 'ds', info => $reg32_href },
50 { name => 'es', info => $reg32_href },
51 { name => 'fs', info => $reg32_href },
52 { name => 'gs', info => $reg32_href },
53 { name => 'st0', info => $reg80_href },
54 { name => 'st1', info => $reg80_href },
55 { name => 'st2', info => $reg80_href },
56 { name => 'st3', info => $reg80_href },
57 { name => 'st4', info => $reg80_href },
58 { name => 'st5', info => $reg80_href },
59 { name => 'st6', info => $reg80_href },
60 { name => 'st7', info => $reg80_href },
61 { name => 'fctrl', info => $reg32_href },
62 { name => 'fstat', info => $reg32_href },
63 { name => 'ftag', info => $reg32_href },
64 { name => 'fiseg', info => $reg32_href },
65 { name => 'fioff', info => $reg32_href },
66 { name => 'foseg', info => $reg32_href },
67 { name => 'fooff', info => $reg32_href },
68 { name => 'fop', info => $reg32_href },
69 { name => 'xmm0', info => $reg128_href },
70 { name => 'xmm1', info => $reg128_href },
71 { name => 'xmm2', info => $reg128_href },
72 { name => 'xmm3', info => $reg128_href },
73 { name => 'xmm4', info => $reg128_href },
74 { name => 'xmm5', info => $reg128_href },
75 { name => 'xmm6', info => $reg128_href },
76 { name => 'xmm7', info => $reg128_href },
77 { name => 'mxcsr', info => $reg32_href },
78 { name => 'mm0', info => $reg64_href },
79 { name => 'mm1', info => $reg64_href },
80 { name => 'mm2', info => $reg64_href },
81 { name => 'mm3', info => $reg64_href },
82 { name => 'mm4', info => $reg64_href },
83 { name => 'mm5', info => $reg64_href },
84 { name => 'mm6', info => $reg64_href },
85 { name => 'mm7', info => $reg64_href },
86 ],
87
88 'i386-lldb' => [
89 { name => 'eax', info => $reg32_href },
90 { name => 'ebx', info => $reg32_href },
91 { name => 'ecx', info => $reg32_href },
92 { name => 'edx', info => $reg32_href },
93 { name => 'edi', info => $reg32_href },
94 { name => 'esi', info => $reg32_href },
95 { name => 'ebp', info => $reg32_href },
96 { name => 'esp', info => $reg32_href },
97 { name => 'ss', info => $reg32_href },
98 { name => 'eflags', info => $reg32_href },
99 { name => 'eip', info => $reg32_href },
100 { name => 'cs', info => $reg32_href },
101 { name => 'ds', info => $reg32_href },
102 { name => 'es', info => $reg32_href },
103 { name => 'fs', info => $reg32_href },
104 { name => 'gs', info => $reg32_href },
105 { name => 'fctrl', info => $reg16_href },
106 { name => 'fstat', info => $reg16_href },
107 { name => 'ftag', info => $reg8_href },
108 { name => 'fop', info => $reg16_href },
109 { name => 'fioff', info => $reg32_href },
110 { name => 'fiseg', info => $reg16_href },
111 { name => 'fooff', info => $reg32_href },
112 { name => 'foseg', info => $reg16_href },
113 { name => 'mxcsr', info => $reg32_href },
114 { name => 'mxcsrmask', info => $reg32_href },
115 { name => 'stmm0', info => $reg80_href },
116 { name => 'stmm1', info => $reg80_href },
117 { name => 'stmm2', info => $reg80_href },
118 { name => 'stmm3', info => $reg80_href },
119 { name => 'stmm4', info => $reg80_href },
120 { name => 'stmm5', info => $reg80_href },
121 { name => 'stmm6', info => $reg80_href },
122 { name => 'stmm7', info => $reg80_href },
123 { name => 'xmm0', info => $reg128_href },
124 { name => 'xmm1', info => $reg128_href },
125 { name => 'xmm2', info => $reg128_href },
126 { name => 'xmm3', info => $reg128_href },
127 { name => 'xmm4', info => $reg128_href },
128 { name => 'xmm5', info => $reg128_href },
129 { name => 'xmm6', info => $reg128_href },
130 { name => 'xmm7', info => $reg128_href },
131 { name => 'trapno', info => $reg32_href },
132 { name => 'err', info => $reg32_href },
133 { name => 'faultvaddr', info => $reg32_href },
134 ],
135
136 'arm-gdb' => [
137 { name => 'r0' , info => $reg32_href },
138 { name => 'r1' , info => $reg32_href },
139 { name => 'r2' , info => $reg32_href },
140 { name => 'r3' , info => $reg32_href },
141 { name => 'r4' , info => $reg32_href },
142 { name => 'r5' , info => $reg32_href },
143 { name => 'r6' , info => $reg32_href },
144 { name => 'r7' , info => $reg32_href },
145 { name => 'r8' , info => $reg32_href },
146 { name => 'r9' , info => $reg32_href },
147 { name => 'r10' , info => $reg32_href },
148 { name => 'r11' , info => $reg32_href },
149 { name => 'r12' , info => $reg32_href },
150 { name => 'sp' , info => $reg32_href },
151 { name => 'lr' , info => $reg32_href },
152 { name => 'pc' , info => $reg32_href },
153 { name => 'f0' , info => $float96_href },
154 { name => 'f1' , info => $float96_href },
155 { name => 'f2' , info => $float96_href },
156 { name => 'f3' , info => $float96_href },
157 { name => 'f4' , info => $float96_href },
158 { name => 'f5' , info => $float96_href },
159 { name => 'f6' , info => $float96_href },
160 { name => 'f7' , info => $float96_href },
161 { name => 'fps' , info => $reg32_href },
162 { name => 'cpsr' , info => $reg32_href },
163 { name => 's0' , info => $float32_href },
164 { name => 's1' , info => $float32_href },
165 { name => 's2' , info => $float32_href },
166 { name => 's3' , info => $float32_href },
167 { name => 's4' , info => $float32_href },
168 { name => 's5' , info => $float32_href },
169 { name => 's6' , info => $float32_href },
170 { name => 's7' , info => $float32_href },
171 { name => 's8' , info => $float32_href },
172 { name => 's9' , info => $float32_href },
173 { name => 's10' , info => $float32_href },
174 { name => 's11' , info => $float32_href },
175 { name => 's12' , info => $float32_href },
176 { name => 's13' , info => $float32_href },
177 { name => 's14' , info => $float32_href },
178 { name => 's15' , info => $float32_href },
179 { name => 's16' , info => $float32_href },
180 { name => 's17' , info => $float32_href },
181 { name => 's18' , info => $float32_href },
182 { name => 's19' , info => $float32_href },
183 { name => 's20' , info => $float32_href },
184 { name => 's21' , info => $float32_href },
185 { name => 's22' , info => $float32_href },
186 { name => 's23' , info => $float32_href },
187 { name => 's24' , info => $float32_href },
188 { name => 's25' , info => $float32_href },
189 { name => 's26' , info => $float32_href },
190 { name => 's27' , info => $float32_href },
191 { name => 's28' , info => $float32_href },
192 { name => 's29' , info => $float32_href },
193 { name => 's30' , info => $float32_href },
194 { name => 's31' , info => $float32_href },
195 { name => 'fpscr' , info => $reg32_href },
196 { name => 'd16' , info => $float64_href },
197 { name => 'd17' , info => $float64_href },
198 { name => 'd18' , info => $float64_href },
199 { name => 'd19' , info => $float64_href },
200 { name => 'd20' , info => $float64_href },
201 { name => 'd21' , info => $float64_href },
202 { name => 'd22' , info => $float64_href },
203 { name => 'd23' , info => $float64_href },
204 { name => 'd24' , info => $float64_href },
205 { name => 'd25' , info => $float64_href },
206 { name => 'd26' , info => $float64_href },
207 { name => 'd27' , info => $float64_href },
208 { name => 'd28' , info => $float64_href },
209 { name => 'd29' , info => $float64_href },
210 { name => 'd30' , info => $float64_href },
211 { name => 'd31' , info => $float64_href },
212 ],
213
Greg Clayton5fe15d22011-05-20 03:15:54 +0000214
215 'arm-lldb' => [
216 { name => 'r0' , info => $reg32_href },
217 { name => 'r1' , info => $reg32_href },
218 { name => 'r2' , info => $reg32_href },
219 { name => 'r3' , info => $reg32_href },
220 { name => 'r4' , info => $reg32_href },
221 { name => 'r5' , info => $reg32_href },
222 { name => 'r6' , info => $reg32_href },
223 { name => 'r7' , info => $reg32_href },
224 { name => 'r8' , info => $reg32_href },
225 { name => 'r9' , info => $reg32_href },
226 { name => 'r10' , info => $reg32_href },
227 { name => 'r11' , info => $reg32_href },
228 { name => 'r12' , info => $reg32_href },
229 { name => 'sp' , info => $reg32_href },
230 { name => 'lr' , info => $reg32_href },
231 { name => 'pc' , info => $reg32_href },
232 { name => 'cpsr' , info => $reg32_href },
233 { name => 's0' , info => $float32_href },
234 { name => 's1' , info => $float32_href },
235 { name => 's2' , info => $float32_href },
236 { name => 's3' , info => $float32_href },
237 { name => 's4' , info => $float32_href },
238 { name => 's5' , info => $float32_href },
239 { name => 's6' , info => $float32_href },
240 { name => 's7' , info => $float32_href },
241 { name => 's8' , info => $float32_href },
242 { name => 's9' , info => $float32_href },
243 { name => 's10' , info => $float32_href },
244 { name => 's11' , info => $float32_href },
245 { name => 's12' , info => $float32_href },
246 { name => 's13' , info => $float32_href },
247 { name => 's14' , info => $float32_href },
248 { name => 's15' , info => $float32_href },
249 { name => 's16' , info => $float32_href },
250 { name => 's17' , info => $float32_href },
251 { name => 's18' , info => $float32_href },
252 { name => 's19' , info => $float32_href },
253 { name => 's20' , info => $float32_href },
254 { name => 's21' , info => $float32_href },
255 { name => 's22' , info => $float32_href },
256 { name => 's23' , info => $float32_href },
257 { name => 's24' , info => $float32_href },
258 { name => 's25' , info => $float32_href },
259 { name => 's26' , info => $float32_href },
260 { name => 's27' , info => $float32_href },
261 { name => 's28' , info => $float32_href },
262 { name => 's29' , info => $float32_href },
263 { name => 's30' , info => $float32_href },
264 { name => 's31' , info => $float32_href },
265 { name => 'd0' , info => $float64_href },
266 { name => 'd1' , info => $float64_href },
267 { name => 'd2' , info => $float64_href },
268 { name => 'd3' , info => $float64_href },
269 { name => 'd4' , info => $float64_href },
270 { name => 'd5' , info => $float64_href },
271 { name => 'd6' , info => $float64_href },
272 { name => 'd7' , info => $float64_href },
273 { name => 'd8' , info => $float64_href },
274 { name => 'd9' , info => $float64_href },
275 { name => 'd10' , info => $float64_href },
276 { name => 'd11' , info => $float64_href },
277 { name => 'd12' , info => $float64_href },
278 { name => 'd13' , info => $float64_href },
279 { name => 'd14' , info => $float64_href },
280 { name => 'd15' , info => $float64_href },
281 { name => 'd16' , info => $float64_href },
282 { name => 'd17' , info => $float64_href },
283 { name => 'd18' , info => $float64_href },
284 { name => 'd19' , info => $float64_href },
285 { name => 'd20' , info => $float64_href },
286 { name => 'd21' , info => $float64_href },
287 { name => 'd22' , info => $float64_href },
288 { name => 'd23' , info => $float64_href },
289 { name => 'd24' , info => $float64_href },
290 { name => 'd25' , info => $float64_href },
291 { name => 'd26' , info => $float64_href },
292 { name => 'd27' , info => $float64_href },
293 { name => 'd28' , info => $float64_href },
294 { name => 'd29' , info => $float64_href },
295 { name => 'd30' , info => $float64_href },
296 { name => 'd31' , info => $float64_href },
297 { name => 'fpscr' , info => $reg32_href },
298 { name => 'exc' , info => $reg32_href },
299 { name => 'fsr' , info => $reg32_href },
300 { name => 'far' , info => $reg32_href },
301 ],
302
Greg Claytone51dc6f2011-05-20 02:00:47 +0000303 'x86_64-gdb' => [
304 { name => 'rax' , info => $reg64_href },
305 { name => 'rbx' , info => $reg64_href },
306 { name => 'rcx' , info => $reg64_href },
307 { name => 'rdx' , info => $reg64_href },
308 { name => 'rsi' , info => $reg64_href },
309 { name => 'rdi' , info => $reg64_href },
310 { name => 'rbp' , info => $reg64_href },
311 { name => 'rsp' , info => $reg64_href },
312 { name => 'r8' , info => $reg64_href },
313 { name => 'r9' , info => $reg64_href },
314 { name => 'r10' , info => $reg64_href },
315 { name => 'r11' , info => $reg64_href },
316 { name => 'r12' , info => $reg64_href },
317 { name => 'r13' , info => $reg64_href },
318 { name => 'r14' , info => $reg64_href },
319 { name => 'r15' , info => $reg64_href },
320 { name => 'rip' , info => $reg64_href },
321 { name => 'eflags' , info => $reg32_href },
322 { name => 'cs' , info => $reg32_href },
323 { name => 'ss' , info => $reg32_href },
324 { name => 'ds' , info => $reg32_href },
325 { name => 'es' , info => $reg32_href },
326 { name => 'fs' , info => $reg32_href },
327 { name => 'gs' , info => $reg32_href },
328 { name => 'stmm0' , info => $reg80_href },
329 { name => 'stmm1' , info => $reg80_href },
330 { name => 'stmm2' , info => $reg80_href },
331 { name => 'stmm3' , info => $reg80_href },
332 { name => 'stmm4' , info => $reg80_href },
333 { name => 'stmm5' , info => $reg80_href },
334 { name => 'stmm6' , info => $reg80_href },
335 { name => 'stmm7' , info => $reg80_href },
336 { name => 'fctrl' , info => $reg32_href },
337 { name => 'fstat' , info => $reg32_href },
338 { name => 'ftag' , info => $reg32_href },
339 { name => 'fiseg' , info => $reg32_href },
340 { name => 'fioff' , info => $reg32_href },
341 { name => 'foseg' , info => $reg32_href },
342 { name => 'fooff' , info => $reg32_href },
343 { name => 'fop' , info => $reg32_href },
344 { name => 'xmm0' , info => $reg128_href },
345 { name => 'xmm1' , info => $reg128_href },
346 { name => 'xmm2' , info => $reg128_href },
347 { name => 'xmm3' , info => $reg128_href },
348 { name => 'xmm4' , info => $reg128_href },
349 { name => 'xmm5' , info => $reg128_href },
350 { name => 'xmm6' , info => $reg128_href },
351 { name => 'xmm7' , info => $reg128_href },
352 { name => 'xmm8' , info => $reg128_href },
353 { name => 'xmm9' , info => $reg128_href },
354 { name => 'xmm10' , info => $reg128_href },
355 { name => 'xmm11' , info => $reg128_href },
356 { name => 'xmm12' , info => $reg128_href },
357 { name => 'xmm13' , info => $reg128_href },
358 { name => 'xmm14' , info => $reg128_href },
359 { name => 'xmm15' , info => $reg128_href },
360 { name => 'mxcsr' , info => $reg32_href },
361 ],
362
363 'x86_64-lldb' => [
364 { name => 'rax' , info => $reg64_href },
365 { name => 'rbx' , info => $reg64_href },
366 { name => 'rcx' , info => $reg64_href },
367 { name => 'rdx' , info => $reg64_href },
368 { name => 'rdi' , info => $reg64_href },
369 { name => 'rsi' , info => $reg64_href },
370 { name => 'rbp' , info => $reg64_href },
371 { name => 'rsp' , info => $reg64_href },
372 { name => 'r8 ' , info => $reg64_href },
373 { name => 'r9 ' , info => $reg64_href },
374 { name => 'r10' , info => $reg64_href },
375 { name => 'r11' , info => $reg64_href },
376 { name => 'r12' , info => $reg64_href },
377 { name => 'r13' , info => $reg64_href },
378 { name => 'r14' , info => $reg64_href },
379 { name => 'r15' , info => $reg64_href },
380 { name => 'rip' , info => $reg64_href },
381 { name => 'rflags' , info => $reg64_href },
382 { name => 'cs' , info => $reg64_href },
383 { name => 'fs' , info => $reg64_href },
384 { name => 'gs' , info => $reg64_href },
385 { name => 'fctrl' , info => $reg16_href },
386 { name => 'fstat' , info => $reg16_href },
387 { name => 'ftag' , info => $reg8_href },
388 { name => 'fop' , info => $reg16_href },
389 { name => 'fioff' , info => $reg32_href },
390 { name => 'fiseg' , info => $reg16_href },
391 { name => 'fooff' , info => $reg32_href },
392 { name => 'foseg' , info => $reg16_href },
393 { name => 'mxcsr' , info => $reg32_href },
394 { name => 'mxcsrmask' , info => $reg32_href },
395 { name => 'stmm0' , info => $reg80_href },
396 { name => 'stmm1' , info => $reg80_href },
397 { name => 'stmm2' , info => $reg80_href },
398 { name => 'stmm3' , info => $reg80_href },
399 { name => 'stmm4' , info => $reg80_href },
400 { name => 'stmm5' , info => $reg80_href },
401 { name => 'stmm6' , info => $reg80_href },
402 { name => 'stmm7' , info => $reg80_href },
403 { name => 'xmm0' , info => $reg128_href },
404 { name => 'xmm1' , info => $reg128_href },
405 { name => 'xmm2' , info => $reg128_href },
406 { name => 'xmm3' , info => $reg128_href },
407 { name => 'xmm4' , info => $reg128_href },
408 { name => 'xmm5' , info => $reg128_href },
409 { name => 'xmm6' , info => $reg128_href },
410 { name => 'xmm7' , info => $reg128_href },
411 { name => 'xmm8' , info => $reg128_href },
412 { name => 'xmm9' , info => $reg128_href },
413 { name => 'xmm10' , info => $reg128_href },
414 { name => 'xmm11' , info => $reg128_href },
415 { name => 'xmm12' , info => $reg128_href },
416 { name => 'xmm13' , info => $reg128_href },
417 { name => 'xmm14' , info => $reg128_href },
418 { name => 'xmm15' , info => $reg128_href },
419 { name => 'trapno' , info => $reg32_href },
420 { name => 'err' , info => $reg32_href },
421 { name => 'faultvaddr' , info => $reg64_href },
422 ]
423);
424
425our $max_register_name_len = 0;
426calculate_max_register_name_length();
427our @point_types = ( "software_bp", "hardware_bp", "write_wp", "read_wp", "access_wp" );
428our $opt_v = 0; # verbose
429our $opt_g = 0; # debug
430our $opt_q = 0; # quiet
431our $opt_r = undef;
432use Getopt::Std;
433getopts('gvqr:');
434
435our $registers_aref = undef;
436
437if (length($opt_r))
438{
Greg Clayton86729962011-06-02 22:21:38 +0000439 if (exists $reg_map{$opt_r})
440 {
441 $registers_aref = $reg_map{$opt_r};
442 }
443 else
444 {
445 die "Can't get registers group for '$opt_r'\n";
446 }
Greg Claytone51dc6f2011-05-20 02:00:47 +0000447}
448
449sub extract_key_value_pairs
450{
451 my $kv_href = {};
452 my $arrayref = shift;
453 my $str = join('',@$arrayref);
454 my @kv_strs = split(/;/, $str);
455 foreach my $kv_str (@kv_strs)
456 {
457 my ($key, $value) = split(/:/, $kv_str);
458 $kv_href->{$key} = $value;
459 }
460 return $kv_href;
461}
462
463sub get_thread_from_thread_suffix
464{
465 if ($thread_suffix_supported)
466 {
467 my $arrayref = shift;
468 # Skip leading semi-colon if needed
469 $$arrayref[0] == ';' and shift @$arrayref;
470 my $thread_href = extract_key_value_pairs ($arrayref);
471 if (exists $thread_href->{thread})
472 {
473 return $thread_href->{thread};
474 }
475 }
476 return undef;
477}
478
479sub calculate_max_register_name_length
480{
481 $max_register_name_len = 7;
482 foreach my $reg_href (@$registers_aref)
483 {
484 my $name_len = length($reg_href->{name});
485 if ($max_register_name_len < $name_len)
486 {
487 $max_register_name_len = $name_len;
488 }
489 }
490}
491#----------------------------------------------------------------------
492# Hash that maps command characters to the appropriate functions using
493# the command character as the key and the value being a reference to
494# the dump function for dumping the command itself.
495#----------------------------------------------------------------------
496our %cmd_callbacks =
497(
498 '?' => \&dump_last_signal_cmd,
499 'H' => \&dump_set_thread_cmd,
500 'T' => \&dump_thread_is_alive_cmd,
501 'q' => \&dump_general_query_cmd,
502 'Q' => \&dump_general_set_cmd,
503 'g' => \&dump_read_regs_cmd,
504 'G' => \&dump_write_regs_cmd,
505 'p' => \&dump_read_single_register_cmd,
506 'P' => \&dump_write_single_register_cmd,
507 'm' => \&dump_read_mem_cmd,
508 'M' => \&dump_write_mem_cmd,
509 'X' => \&dump_write_mem_binary_cmd,
510 'Z' => \&dump_bp_wp_command,
511 'z' => \&dump_bp_wp_command,
512 'k' => \&dump_kill_cmd,
513 'A' => \&dump_A_command,
514 'c' => \&dump_continue_cmd,
Greg Clayton9431f012012-01-25 03:20:34 +0000515 's' => \&dump_continue_cmd,
Greg Claytone51dc6f2011-05-20 02:00:47 +0000516 'C' => \&dump_continue_with_signal_cmd,
Greg Clayton9431f012012-01-25 03:20:34 +0000517 'S' => \&dump_continue_with_signal_cmd,
Greg Claytone51dc6f2011-05-20 02:00:47 +0000518 '_M' => \&dump_allocate_memory_cmd,
519 '_m' => \&dump_deallocate_memory_cmd,
520 # extended commands
521 'v' => \&dump_extended_cmd
522);
523
524#----------------------------------------------------------------------
525# Hash that maps command characters to the appropriate functions using
526# the command character as the key and the value being a reference to
527# the dump function for the response to the command.
528#----------------------------------------------------------------------
529our %rsp_callbacks =
530(
531 'c' => \&dump_stop_reply_packet,
Greg Clayton9431f012012-01-25 03:20:34 +0000532 's' => \&dump_stop_reply_packet,
Greg Claytone51dc6f2011-05-20 02:00:47 +0000533 'C' => \&dump_stop_reply_packet,
534 '?' => \&dump_stop_reply_packet,
535 'T' => \&dump_thread_is_alive_rsp,
536 'H' => \&dump_set_thread_rsp,
537 'q' => \&dump_general_query_rsp,
538 'g' => \&dump_read_regs_rsp,
539 'p' => \&dump_read_single_register_rsp,
540 'm' => \&dump_read_mem_rsp,
541 '_M' => \&dump_allocate_memory_rsp,
542
543 # extended commands
544 'v' => \&dump_extended_rsp,
545);
546
547
548sub dump_register_value
549{
550 my $indent = shift;
551 my $arrayref = shift;
552 my $reg_num = shift;
553
554 if ($reg_num >= @$registers_aref)
555 {
556 printf("\tinvalid register index %d\n", $reg_num);
557 }
558
559 my $reg_href = $$registers_aref[$reg_num];
560 my $reg_name = $reg_href->{name};
561 if ($$arrayref[0] eq '#')
562 {
563 printf("\t%*s: error: EOS reached when trying to read register %d\n", $max_register_name_len, $reg_name, $reg_num);
564 }
565
566 my $reg_info = $reg_href->{info};
567 my $reg_extract = $reg_info->{extract};
568 my $reg_format = $reg_info->{format};
569 my $reg_val = &$reg_extract($arrayref);
570 if ($indent) {
571 printf("\t%*s = $reg_format", $max_register_name_len, $reg_name, $reg_val);
572 } else {
573 printf("%s = $reg_format", $reg_name, $reg_val);
574 }
575}
576
577#----------------------------------------------------------------------
578# Extract the command into an array of ASCII char strings for easy
579# processing
580#----------------------------------------------------------------------
581sub extract_command
582{
583 my $cmd_str = shift;
584 my @cmd_chars = split(/ */, $cmd_str);
585 if ($cmd_chars[0] ne '$')
586 {
587 # only set the current command if it isn't a reply
588 $curr_cmd = $cmd_chars[0];
589 }
590 return @cmd_chars;
591}
592
593#----------------------------------------------------------------------
594# Strip the 3 checksum array entries after we don't need them anymore
595#----------------------------------------------------------------------
596sub strip_checksum
597{
598 my $arrayref = shift;
599 splice(@$arrayref, -3);
600}
601
602#----------------------------------------------------------------------
603# Dump all strings in array by joining them together with no space
604# between them
605#----------------------------------------------------------------------
606sub dump_chars
607{
608 print join('',@_);
609}
610
611#----------------------------------------------------------------------
612# Check if the response is an error 'EXX'
613#----------------------------------------------------------------------
614sub is_error_response
615{
616 if ($_[0] eq 'E')
617 {
618 shift;
619 print "ERROR = " . join('',@_) . "\n";
620 return 1;
621 }
622 return 0;
623}
624
625#----------------------------------------------------------------------
626# 'H' command
627#----------------------------------------------------------------------
628sub dump_set_thread_cmd
629{
630 my $cmd = shift;
631 my $mod = shift;
632 print "set_thread ( $mod, " . join('',@_) . " )\n";
633}
634
635#----------------------------------------------------------------------
636# 'T' command
637#----------------------------------------------------------------------
638our $T_cmd_tid = -1;
639sub dump_thread_is_alive_cmd
640{
641 my $cmd = shift;
642 $T_cmd_tid = get_hex(\@_);
643 printf("thread_is_alive ( $tid_format )\n", $T_cmd_tid);
644}
645
646sub dump_thread_is_alive_rsp
647{
648 my $rsp = join('',@_);
649
650 printf("thread_is_alive ( $tid_format ) =>", $T_cmd_tid);
651 if ($rsp eq 'OK')
652 {
653 print " alive.\n";
654 }
655 else
656 {
657 print " dead.\n";
658 }
659}
660
661#----------------------------------------------------------------------
662# 'H' response
663#----------------------------------------------------------------------
664sub dump_set_thread_rsp
665{
666 if (!is_error_response(@_))
667 {
668 print join('',@_) . "\n";
669 }
670}
671
672#----------------------------------------------------------------------
673# 'q' command
674#----------------------------------------------------------------------
675our $gen_query_cmd;
Greg Clayton86729962011-06-02 22:21:38 +0000676our $qRegisterInfo_reg_num = -1;
Greg Claytone51dc6f2011-05-20 02:00:47 +0000677sub dump_general_query_cmd
678{
679 $gen_query_cmd = join('',@_);
680 if ($gen_query_cmd eq 'qC')
681 {
682 print 'get_current_pid ()';
683 }
684 elsif ($gen_query_cmd eq 'qfThreadInfo')
685 {
686 print 'get_first_active_threads ()';
687 }
688 elsif ($gen_query_cmd eq 'qsThreadInfo')
689 {
690 print 'get_subsequent_active_threads ()';
691 }
692 elsif (index($gen_query_cmd, 'qThreadExtraInfo') == 0)
693 {
694 # qThreadExtraInfo,id
695 print 'get_thread_extra_info ()';
696 }
697 elsif (index($gen_query_cmd, 'qThreadStopInfo') == 0)
698 {
699 # qThreadStopInfoXXXX
700 @_ = splice(@_, length('qThreadStopInfo'));
701 my $tid = get_addr(\@_);
702 printf('get_thread_stop_info ( thread = 0x%4.4x )', $tid);
703 }
704 elsif (index($gen_query_cmd, 'qSymbol:') == 0)
705 {
706 # qCRC:addr,length
707 print 'gdb_ready_to_serve_symbol_lookups ()';
708 }
709 elsif (index($gen_query_cmd, 'qCRC:') == 0)
710 {
711 # qCRC:addr,length
712 @_ = splice(@_, length('qCRC:'));
713 my $address = get_addr(\@_);
714 shift @_;
715 my $length = join('', @_);
716 printf("compute_crc (addr = $addr_format, length = $length)", $address);
717 }
718 elsif (index($gen_query_cmd, 'qGetTLSAddr:') == 0)
719 {
720 # qGetTLSAddr:thread-id,offset,lm
721 @_ = splice(@_, length('qGetTLSAddr:'));
722 my ($tid, $offset, $lm) = split (/,/, join('', @_));
723 print "get_thread_local_storage_addr (thread-id = $tid, offset = $offset, lm = $lm)";
724 }
725 elsif ($gen_query_cmd eq 'qOffsets')
726 {
727 print 'get_section_offsets ()';
728 }
729 elsif (index($gen_query_cmd, 'qRegisterInfo') == 0)
730 {
731 @_ = splice(@_, length('qRegisterInfo'));
Greg Clayton86729962011-06-02 22:21:38 +0000732 $qRegisterInfo_reg_num = get_hex(\@_);
733
734 printf "get_dynamic_register_info ($qRegisterInfo_reg_num)";
Greg Claytone51dc6f2011-05-20 02:00:47 +0000735 }
736 else
737 {
738 print $gen_query_cmd;
739 }
740 print "\n";
741}
742
743#----------------------------------------------------------------------
744# 'q' response
745#----------------------------------------------------------------------
746sub dump_general_query_rsp
747{
748 my $gen_query_rsp = join('',@_);
Greg Clayton86729962011-06-02 22:21:38 +0000749 my $gen_query_rsp_len = length ($gen_query_rsp);
Greg Claytone51dc6f2011-05-20 02:00:47 +0000750 if ($gen_query_cmd eq 'qC' and index($gen_query_rsp, 'QC') == 0)
751 {
752 shift @_; shift @_;
753 my $pid = get_hex(\@_);
Greg Clayton86729962011-06-02 22:21:38 +0000754 printf("pid = $pid_format\n", $pid);
Greg Claytone51dc6f2011-05-20 02:00:47 +0000755 return;
756 }
757 elsif (index($gen_query_cmd, 'qRegisterInfo') == 0)
758 {
Greg Clayton86729962011-06-02 22:21:38 +0000759 if ($gen_query_rsp_len == 0)
Greg Claytone51dc6f2011-05-20 02:00:47 +0000760 {
Greg Clayton86729962011-06-02 22:21:38 +0000761 print "$unimplemented_str\n";
Greg Claytone51dc6f2011-05-20 02:00:47 +0000762 }
763 else
764 {
Greg Clayton86729962011-06-02 22:21:38 +0000765 if (index($gen_query_rsp, 'name') == 0)
766 {
767 $qRegisterInfo_reg_num == 0 and $registers_aref = [];
768
769 my @name_and_values = split (/;/, $gen_query_rsp);
770
771 my $reg_name = undef;
772 my $byte_size = 0;
773 foreach (@name_and_values)
774 {
775 my ($name, $value) = split /:/;
776 if ($name eq "name") { $reg_name = $value; }
777 elsif ($name eq "bitsize") { $byte_size = $value / 8; last; }
778 }
779 if (defined $reg_name and $byte_size > 0)
780 {
781 if ($byte_size == 4) {push @$registers_aref, { name => $reg_name, info => $reg32_href };}
782 elsif ($byte_size == 8) {push @$registers_aref, { name => $reg_name, info => $reg64_href };}
Greg Clayton9163c392011-09-17 05:45:35 +0000783 elsif ($byte_size == 1) {push @$registers_aref, { name => $reg_name, info => $reg8_href };}
784 elsif ($byte_size == 2) {push @$registers_aref, { name => $reg_name, info => $reg16_href };}
Greg Clayton86729962011-06-02 22:21:38 +0000785 elsif ($byte_size == 10) {push @$registers_aref, { name => $reg_name, info => $reg80_href };}
786 elsif ($byte_size == 12) {push @$registers_aref, { name => $reg_name, info => $float96_href };}
787 elsif ($byte_size == 16) {push @$registers_aref, { name => $reg_name, info => $reg128_href };}
Greg Clayton9163c392011-09-17 05:45:35 +0000788 elsif ($byte_size == 32) {push @$registers_aref, { name => $reg_name, info => $reg256_href };}
Greg Clayton86729962011-06-02 22:21:38 +0000789 }
790 }
791 elsif ($gen_query_rsp_len == 3 and index($gen_query_rsp, 'E') == 0)
792 {
793 calculate_max_register_name_length();
794 }
Greg Claytone51dc6f2011-05-20 02:00:47 +0000795 }
796 }
797 elsif ($gen_query_cmd =~ 'qThreadStopInfo')
798 {
799 dump_stop_reply_packet (@_);
800 }
801 if (dump_standard_response(\@_))
802 {
803 # Do nothing...
804 }
805 else
806 {
807 print join('',@_) . "\n";
808 }
809}
810
811#----------------------------------------------------------------------
812# 'Q' command
813#----------------------------------------------------------------------
814our $gen_set_cmd;
815sub dump_general_set_cmd
816{
817 $gen_query_cmd = join('',@_);
818 if ($gen_query_cmd eq 'QStartNoAckMode')
819 {
820 print "StartNoAckMode ()"
821 }
822 elsif ($gen_query_cmd eq 'QThreadSuffixSupported')
823 {
824 $thread_suffix_supported = 1;
825 print "ThreadSuffixSupported ()"
826 }
827 elsif (index($gen_query_cmd, 'QSetMaxPayloadSize:') == 0)
828 {
829 @_ = splice(@_, length('QSetMaxPayloadSize:'));
830 my $max_payload_size = get_hex(\@_);
831 # QSetMaxPayloadSize:XXXX where XXXX is a hex length of the max
832 # packet payload size supported by gdb
833 printf("SetMaxPayloadSize ( 0x%x (%u))", $max_payload_size, $max_payload_size);
834 }
Greg Clayton86729962011-06-02 22:21:38 +0000835 elsif (index ($gen_query_cmd, 'QSetSTDIN:') == 0)
836 {
837 @_ = splice(@_, length('QSetSTDIN:'));
838 printf ("SetSTDIN (path ='%s')\n", get_hex_string (\@_));
839 }
840 elsif (index ($gen_query_cmd, 'QSetSTDOUT:') == 0)
841 {
842 @_ = splice(@_, length('QSetSTDOUT:'));
843 printf ("SetSTDOUT (path ='%s')\n", get_hex_string (\@_));
844 }
845 elsif (index ($gen_query_cmd, 'QSetSTDERR:') == 0)
846 {
847 @_ = splice(@_, length('QSetSTDERR:'));
848 printf ("SetSTDERR (path ='%s')\n", get_hex_string (\@_));
849 }
Greg Claytone51dc6f2011-05-20 02:00:47 +0000850 else
851 {
852 print $gen_query_cmd;
853 }
854 print "\n";
855}
856
857#----------------------------------------------------------------------
858# 'k' command
859#----------------------------------------------------------------------
860sub dump_kill_cmd
861{
862 my $cmd = shift;
863 print "kill (" . join('',@_) . ")\n";
864}
865
866#----------------------------------------------------------------------
867# 'g' command
868#----------------------------------------------------------------------
869sub dump_read_regs_cmd
870{
871 my $cmd = shift;
872 print "read_registers ()\n";
873}
874
875#----------------------------------------------------------------------
876# 'G' command
877#----------------------------------------------------------------------
878sub dump_write_regs_cmd
879{
880 print "write_registers:\n";
881 my $cmd = shift;
882 foreach my $reg_href (@$registers_aref)
883 {
884 last if ($_[0] eq '#');
885 my $reg_info_href = $reg_href->{info};
886 my $reg_name = $reg_href->{name};
887 my $reg_extract = $reg_info_href->{extract};
888 my $reg_format = $reg_info_href->{format};
889 my $reg_val = &$reg_extract(\@_);
890 printf("\t%*s = $reg_format\n", $max_register_name_len, $reg_name, $reg_val);
891 }
892}
893
894sub dump_read_regs_rsp
895{
896 print "read_registers () =>\n";
897 if (!is_error_response(@_))
898 {
899 # print join('',@_) . "\n";
900 foreach my $reg_href (@$registers_aref)
901 {
902 last if ($_[0] eq '#');
903 my $reg_info_href = $reg_href->{info};
904 my $reg_name = $reg_href->{name};
905 my $reg_extract = $reg_info_href->{extract};
906 my $reg_format = $reg_info_href->{format};
907 my $reg_val = &$reg_extract(\@_);
908 printf("\t%*s = $reg_format\n", $max_register_name_len, $reg_name, $reg_val);
909 }
910 }
911}
912
913sub dump_read_single_register_rsp
914{
915 dump_register_value(0, \@_, $reg_cmd_reg);
916 print "\n";
917}
918
919#----------------------------------------------------------------------
920# '_M' - allocate memory command (LLDB extension)
921#
922# Command: '_M'
923# Arg1: Hex byte size as big endian hex string
924# Separator: ','
925# Arg2: permissions as string that must be a string that contains any
926# combination of 'r' (readable) 'w' (writable) or 'x' (executable)
927#
928# Returns: The address that was allocated as a big endian hex string
929# on success, else an error "EXX" where XX are hex bytes
930# that indicate an error code.
931#
932# Examples:
933# _M10,rw # allocate 16 bytes with read + write permissions
934# _M100,rx # allocate 256 bytes with read + execute permissions
935#----------------------------------------------------------------------
936sub dump_allocate_memory_cmd
937{
938 shift; shift; # shift off the '_' and the 'M'
939 my $byte_size = get_addr(\@_);
940 shift; # Skip ','
941 printf("allocate_memory ( byte_size = %u (0x%x), permissions = %s)\n", $byte_size, $byte_size, join('',@_));
942}
943
944sub dump_allocate_memory_rsp
945{
946 if (@_ == 3 and $_[0] == 'E')
947 {
948 printf("allocated memory addr = ERROR (%s))\n", join('',@_));
949 }
950 else
951 {
952 printf("allocated memory addr = 0x%s\n", join('',@_));
953 }
954}
955
Greg Claytone51dc6f2011-05-20 02:00:47 +0000956#----------------------------------------------------------------------
957# '_m' - deallocate memory command (LLDB extension)
958#
959# Command: '_m'
960# Arg1: Hex address as big endian hex string
961#
962# Returns: "OK" on success "EXX" on error
963#
964# Examples:
965# _m201000 # Free previously allocated memory at address 0x201000
966#----------------------------------------------------------------------
967sub dump_deallocate_memory_cmd
968{
969 shift; shift; # shift off the '_' and the 'm'
970 printf("deallocate_memory ( addr = 0x%s)\n", join('',@_));
971}
972
973
974#----------------------------------------------------------------------
975# 'p' command
976#----------------------------------------------------------------------
977sub dump_read_single_register_cmd
978{
979 my $cmd = shift;
Greg Clayton9163c392011-09-17 05:45:35 +0000980 $reg_cmd_reg = get_hex(\@_);
Greg Claytone51dc6f2011-05-20 02:00:47 +0000981 my $thread = get_thread_from_thread_suffix (\@_);
Greg Clayton9163c392011-09-17 05:45:35 +0000982 my $reg_href = $$registers_aref[$reg_cmd_reg];
Greg Clayton86729962011-06-02 22:21:38 +0000983
Greg Claytone51dc6f2011-05-20 02:00:47 +0000984 if (defined $thread)
985 {
Greg Clayton86729962011-06-02 22:21:38 +0000986 print "read_register ( reg = \"$reg_href->{name}\", thread = $thread )\n";
Greg Claytone51dc6f2011-05-20 02:00:47 +0000987 }
988 else
989 {
Greg Clayton86729962011-06-02 22:21:38 +0000990 print "read_register ( reg = \"$reg_href->{name}\" )\n";
Greg Claytone51dc6f2011-05-20 02:00:47 +0000991 }
992}
993
994
995#----------------------------------------------------------------------
996# 'P' command
997#----------------------------------------------------------------------
998sub dump_write_single_register_cmd
999{
1000 my $cmd = shift;
1001 my $reg_num = get_hex(\@_);
1002 shift (@_); # Discard the '='
1003
1004 print "write_register ( ";
1005 dump_register_value(0, \@_, $reg_num);
1006 my $thread = get_thread_from_thread_suffix (\@_);
1007 if (defined $thread)
1008 {
1009 print ", thread = $thread";
1010 }
1011 print " )\n";
1012}
1013
1014#----------------------------------------------------------------------
1015# 'm' command
1016#----------------------------------------------------------------------
1017our $read_mem_address = 0;
1018sub dump_read_mem_cmd
1019{
1020 my $cmd = shift;
1021 $read_mem_address = get_addr(\@_);
1022 shift; # Skip ','
1023 printf("read_mem ( $addr_format, %s )\n", $read_mem_address, join('',@_));
1024}
1025
1026#----------------------------------------------------------------------
1027# 'm' response
1028#----------------------------------------------------------------------
1029sub dump_read_mem_rsp
1030{
1031 # If the memory read was 2 or 4 bytes, print it out in native format
1032 # instead of just as bytes.
1033 my $num_nibbles = @_;
1034 if ($num_nibbles == 2)
1035 {
1036 printf(" 0x%2.2x", get8(\@_));
1037 }
1038 elsif ($num_nibbles == 4)
1039 {
1040 printf(" 0x%4.4x", get16(\@_));
1041 }
1042 elsif ($num_nibbles == 8)
1043 {
1044 printf(" 0x%8.8x", get32(\@_));
1045 }
1046 elsif ($num_nibbles == 16)
1047 {
1048 printf(" 0x%s", get64(\@_));
1049 }
1050 else
1051 {
1052 my $curr_address = $read_mem_address;
1053 my $nibble;
1054 my $nibble_offset = 0;
1055 my $max_nibbles_per_line = 2 * $max_bytes_per_line;
1056 foreach $nibble (@_)
1057 {
1058 if (($nibble_offset % $max_nibbles_per_line) == 0)
1059 {
1060 ($nibble_offset > 0) and print "\n ";
1061 printf("$addr_format: ", $curr_address + $nibble_offset/2);
1062 }
1063 (($nibble_offset % 2) == 0) and print ' ';
1064 print $nibble;
1065 $nibble_offset++;
1066 }
1067 }
1068 print "\n";
1069}
1070
1071#----------------------------------------------------------------------
Greg Clayton9431f012012-01-25 03:20:34 +00001072# 'c' or 's' command
Greg Claytone51dc6f2011-05-20 02:00:47 +00001073#----------------------------------------------------------------------
1074sub dump_continue_cmd
1075{
1076 my $cmd = shift;
Greg Clayton9431f012012-01-25 03:20:34 +00001077 my $cmd_str;
1078 $cmd eq 'c' and $cmd_str = 'continue';
1079 $cmd eq 's' and $cmd_str = 'step';
Greg Claytone51dc6f2011-05-20 02:00:47 +00001080 my $address = -1;
1081 if (@_)
1082 {
1083 my $address = get_addr(\@_);
Greg Clayton9431f012012-01-25 03:20:34 +00001084 printf("%s ($addr_format)\n", $cmd_str, $address);
Greg Claytone51dc6f2011-05-20 02:00:47 +00001085 }
1086 else
1087 {
Greg Clayton9431f012012-01-25 03:20:34 +00001088 printf("%s ()\n", $cmd_str);
Greg Claytone51dc6f2011-05-20 02:00:47 +00001089 }
1090}
1091
1092#----------------------------------------------------------------------
1093# 'Css' continue (C) with signal (ss where 'ss' is two hex digits)
Greg Clayton9431f012012-01-25 03:20:34 +00001094# 'Sss' step (S) with signal (ss where 'ss' is two hex digits)
Greg Claytone51dc6f2011-05-20 02:00:47 +00001095#----------------------------------------------------------------------
1096sub dump_continue_with_signal_cmd
1097{
1098 my $cmd = shift;
1099 my $address = -1;
Greg Clayton9431f012012-01-25 03:20:34 +00001100 my $cmd_str;
1101 $cmd eq 'c' and $cmd_str = 'continue';
1102 $cmd eq 's' and $cmd_str = 'step';
Greg Claytone51dc6f2011-05-20 02:00:47 +00001103 my $signal = get_hex(\@_);
1104 if (@_)
1105 {
1106 my $address = 0;
1107 if (@_ && $_[0] == ';')
1108 {
1109 shift;
1110 $address = get_addr(\@_);
1111 }
1112 }
1113
1114 if ($address != -1)
1115 {
Greg Clayton9431f012012-01-25 03:20:34 +00001116 printf("%s_with_signal (signal = 0x%2.2x, address = $addr_format)\n", $cmd_str, $signal, $address);
Greg Claytone51dc6f2011-05-20 02:00:47 +00001117 }
1118 else
1119 {
Greg Clayton9431f012012-01-25 03:20:34 +00001120 printf("%s_with_signal (signal = 0x%2.2x)\n", $cmd_str, $signal);
Greg Claytone51dc6f2011-05-20 02:00:47 +00001121 }
1122}
1123
1124#----------------------------------------------------------------------
1125# 'A' command
1126#----------------------------------------------------------------------
1127sub dump_A_command
1128{
1129 my $cmd = get_exptected_char(\@_, 'A') or print "error: incorrect command letter for argument packet, exptected 'A'\n";
1130 printf("set_program_arguments (\n");
1131 do
1132 {
1133 my $arg_len = get_uint(\@_);
1134 get_exptected_char(\@_, ',') or die "error: missing comma after argument length...?\n";
1135 my $arg_idx = get_uint(\@_);
1136 get_exptected_char(\@_, ',') or die "error: missing comma after argument number...?\n";
1137
1138 my $arg = '';
1139 my $num_hex8_bytes = $arg_len/2;
1140 for (1 .. $num_hex8_bytes)
1141 {
1142 $arg .= sprintf("%c", get8(\@_))
1143 }
1144 printf(" <%3u> argv[%u] = '%s'\n", $arg_len, $arg_idx, $arg);
1145 if (@_ > 0)
1146 {
1147 get_exptected_char(\@_, ',') or die "error: missing comma after argument argument ASCII hex bytes...?\n";
1148 }
1149 } while (@_ > 0);
1150 printf(" )\n");
1151}
1152
1153
1154#----------------------------------------------------------------------
1155# 'z' and 'Z' command
1156#----------------------------------------------------------------------
1157sub dump_bp_wp_command
1158{
1159 my $cmd = shift;
1160 my $type = shift;
1161 shift; # Skip ','
1162 my $address = get_addr(\@_);
1163 shift; # Skip ','
1164 my $length = join('',@_);
1165 if ($cmd eq 'z')
1166 {
1167 printf("remove $point_types[$type]($addr_format, %d)\n", $address, $length);
1168 }
1169 else
1170 {
1171 printf("insert $point_types[$type]($addr_format, %d)\n", $address, $length);
1172 }
1173}
1174
1175
1176#----------------------------------------------------------------------
1177# 'X' command
1178#----------------------------------------------------------------------
1179sub dump_write_mem_binary_cmd
1180{
1181 my $cmd = shift;
1182 my $address = get_addr(\@_);
1183 shift; # Skip ','
1184
1185 my ($length, $binary) = split(/:/, join('',@_));
1186 printf("write_mem_binary ( $addr_format, %d, %s)\n", $address, $length, $binary);
1187
1188}
1189
1190#----------------------------------------------------------------------
1191# 'M' command
1192#----------------------------------------------------------------------
1193sub dump_write_mem_cmd
1194{
1195 my $cmd = shift;
1196 my $address = get_addr(\@_);
1197 shift; # Skip ','
1198 my ($length, $hex_bytes) = split(/:/, join('',@_));
1199# printf("write_mem ( $addr_format, %d, %s)\n", $address, $length, $hex_bytes);
1200 printf("write_mem ( addr = $addr_format, len = %d (0x%x), bytes = ", $address, $length, $length);
1201 splice(@_, 0, length($length)+1);
1202
1203 my $curr_address = $address;
1204 my $nibble;
1205 my $nibble_count = 0;
1206 my $max_nibbles_per_line = 2 * $max_bytes_per_line;
1207 foreach $nibble (@_)
1208 {
1209 (($nibble_count % 2) == 0) and print ' ';
1210 print $nibble;
1211 $nibble_count++;
1212 }
1213
1214 # If the memory to write is 2 or 4 bytes, print it out in native format
1215 # instead of just as bytes.
1216 if (@_ == 4)
1217 {
1218 printf(" ( 0x%4.4x )", get16(\@_));
1219 }
1220 elsif (@_ == 8)
1221 {
1222 printf(" ( 0x%8.8x )", get32(\@_));
1223 }
1224 print " )\n";
1225
1226}
1227
1228#----------------------------------------------------------------------
1229# 'v' command
1230#----------------------------------------------------------------------
1231our $extended_rsp_callback = 0;
1232sub dump_extended_cmd
1233{
1234 $extended_rsp_callback = 0;
1235 if (join('', @_[0..4]) eq "vCont")
1236 {
1237 dump_extended_continue_cmd(splice(@_,5));
1238 }
1239 elsif (join('', @_[0..11]) eq 'vAttachWait;')
1240 {
1241 dump_attach_wait_command (splice(@_,12));
1242 }
1243}
1244
1245#----------------------------------------------------------------------
1246# 'v' response
1247#----------------------------------------------------------------------
1248sub dump_extended_rsp
1249{
1250 if ($extended_rsp_callback)
1251 {
1252 &$extended_rsp_callback(@_);
1253 }
1254 $extended_rsp_callback = 0;
1255}
1256
1257#----------------------------------------------------------------------
1258# 'vAttachWait' command
1259#----------------------------------------------------------------------
1260sub dump_attach_wait_command
1261{
Greg Claytone51dc6f2011-05-20 02:00:47 +00001262 print "attach_wait ( ";
1263 while (@_)
1264 {
1265 printf("%c", get8(\@_))
1266 }
1267 printf " )\n";
1268
1269}
1270
1271#----------------------------------------------------------------------
1272# 'vCont' command
1273#----------------------------------------------------------------------
1274sub dump_extended_continue_cmd
1275{
Greg Claytone51dc6f2011-05-20 02:00:47 +00001276 print "extended_continue ( ";
1277 my $cmd = shift;
1278 if ($cmd eq '?')
1279 {
1280 print "list supported modes )\n";
1281 $extended_rsp_callback = \&dump_extended_continue_rsp;
1282 }
1283 elsif ($cmd eq ';')
1284 {
1285 $extended_rsp_callback = \&dump_stop_reply_packet;
1286 my $i = 0;
1287 while ($#_ >= 0)
1288 {
1289 if ($i > 0)
1290 {
1291 print ", ";
1292 }
1293 my $continue_cmd = shift;
1294 my $tmp;
1295 if ($continue_cmd eq 'c')
1296 {
1297 print "continue";
1298 }
1299 elsif ($continue_cmd eq 'C')
1300 {
1301 print "continue with signal ";
1302 print shift;
1303 print shift;
1304 }
1305 elsif ($continue_cmd eq 's')
1306 {
1307 print "step";
1308 }
1309 elsif ($continue_cmd eq 'S')
1310 {
1311 print "step with signal ";
1312 print shift;
1313 print shift;
1314 }
1315
1316 if ($_[0] eq ':')
1317 {
1318 shift; # Skip ':'
1319 print " for thread ";
1320 while ($#_ >= 0)
1321 {
1322 $tmp = shift;
1323 if (length($tmp) > 0 && $tmp ne ';') {
1324 print $tmp;
1325 } else {
1326 last;
1327 }
1328 }
1329 }
1330 $i++;
1331 }
1332
1333 printf " )\n";
1334 }
1335}
1336
1337#----------------------------------------------------------------------
1338# 'vCont' response
1339#----------------------------------------------------------------------
1340sub dump_extended_continue_rsp
1341{
Greg Clayton86729962011-06-02 22:21:38 +00001342 if (scalar(@_) == 0)
1343 {
1344 print "$unimplemented_str\n";
1345 }
1346 else
1347 {
1348 print "extended_continue supports " . join('',@_) . "\n";
1349 }
Greg Claytone51dc6f2011-05-20 02:00:47 +00001350}
1351
1352#----------------------------------------------------------------------
1353# Dump the command ascii for any unknown commands
1354#----------------------------------------------------------------------
1355sub dump_other_cmd
1356{
1357 print "other = " . join('',@_) . "\n";
1358}
1359
1360#----------------------------------------------------------------------
1361# Check to see if the response was unsupported with appropriate checksum
1362#----------------------------------------------------------------------
1363sub rsp_is_unsupported
1364{
1365 return join('',@_) eq "#00";
1366}
1367
1368#----------------------------------------------------------------------
1369# Check to see if the response was "OK" with appropriate checksum
1370#----------------------------------------------------------------------
1371sub rsp_is_OK
1372{
1373 return join('',@_) eq "OK#9a";
1374}
1375
1376#----------------------------------------------------------------------
1377# Dump a response for an unknown command
1378#----------------------------------------------------------------------
1379sub dump_other_rsp
1380{
1381 print "other = " . join('',@_) . "\n";
1382}
1383
1384#----------------------------------------------------------------------
1385# Get a byte from the ascii string assuming that the 2 nibble ascii
1386# characters are in hex.
1387#
1388# The argument for this function needs to be a reference to an array
1389# that contains single character strings and the array will get
1390# updated by shifting characters off the front of it (no leading # "0x")
1391#----------------------------------------------------------------------
1392sub get8
1393{
1394 my $arrayref = shift;
1395 my $val = hex(shift(@$arrayref) . shift(@$arrayref));
1396 return $val;
1397}
1398
1399#----------------------------------------------------------------------
1400# Get a 16 bit integer and swap if $swap global is set to a non-zero
1401# value.
1402#
1403# The argument for this function needs to be a reference to an array
1404# that contains single character strings and the array will get
1405# updated by shifting characters off the front of it (no leading # "0x")
1406#----------------------------------------------------------------------
1407sub get16
1408{
1409 my $arrayref = shift;
1410 my $val = 0;
1411 if ($swap)
1412 {
1413 $val = get8($arrayref) |
1414 get8($arrayref) << 8;
1415 }
1416 else
1417 {
1418 $val = get8($arrayref) << 8 |
1419 get8($arrayref) ;
1420 }
1421 return $val;
1422}
1423
1424#----------------------------------------------------------------------
1425# Get a 32 bit integer and swap if $swap global is set to a non-zero
1426# value.
1427#
1428# The argument for this function needs to be a reference to an array
1429# that contains single character strings and the array will get
1430# updated by shifting characters off the front of it (no leading # "0x")
1431#----------------------------------------------------------------------
1432sub get32
1433{
1434 my $arrayref = shift;
1435 my $val = 0;
1436 if ($swap)
1437 {
1438 $val = get8($arrayref) |
1439 get8($arrayref) << 8 |
1440 get8($arrayref) << 16 |
1441 get8($arrayref) << 24 ;
1442 }
1443 else
1444 {
1445 $val = get8($arrayref) << 24 |
1446 get8($arrayref) << 16 |
1447 get8($arrayref) << 8 |
1448 get8($arrayref) ;
1449 }
1450 return $val;
1451}
1452
1453#----------------------------------------------------------------------
1454# Get a 64 bit hex value as a string
1455#
1456# The argument for this function needs to be a reference to an array
1457# that contains single character strings and the array will get
1458# updated by shifting characters off the front of it (no leading # "0x")
1459#----------------------------------------------------------------------
1460sub get64
1461{
1462 my $arrayref = shift;
1463 my $val = '';
1464 my @nibbles;
1465 if ($swap)
1466 {
1467 push @nibbles, splice(@$arrayref, 14, 2);
1468 push @nibbles, splice(@$arrayref, 12, 2);
1469 push @nibbles, splice(@$arrayref, 10, 2);
1470 push @nibbles, splice(@$arrayref, 8, 2);
1471 push @nibbles, splice(@$arrayref, 6, 2);
1472 push @nibbles, splice(@$arrayref, 4, 2);
1473 push @nibbles, splice(@$arrayref, 2, 2);
1474 push @nibbles, splice(@$arrayref, 0, 2);
1475 }
1476 else
1477 {
Greg Clayton9163c392011-09-17 05:45:35 +00001478 (@nibbles) = splice(@$arrayref, 0, ((64/8) * 2));
Greg Claytone51dc6f2011-05-20 02:00:47 +00001479 }
1480 $val = join('', @nibbles);
1481 return $val;
1482}
1483
1484#----------------------------------------------------------------------
1485# Get a 80 bit hex value as a string
1486#
1487# The argument for this function needs to be a reference to an array
1488# that contains single character strings and the array will get
1489# updated by shifting characters off the front of it (no leading # "0x")
1490#----------------------------------------------------------------------
1491sub get80
1492{
1493 my $arrayref = shift;
1494 my $val = '';
1495 my @nibbles;
1496 if ($swap)
1497 {
1498 push @nibbles, splice(@$arrayref, 18, 2);
1499 push @nibbles, splice(@$arrayref, 16, 2);
1500 push @nibbles, splice(@$arrayref, 14, 2);
1501 push @nibbles, splice(@$arrayref, 12, 2);
1502 push @nibbles, splice(@$arrayref, 10, 2);
1503 push @nibbles, splice(@$arrayref, 8, 2);
1504 push @nibbles, splice(@$arrayref, 6, 2);
1505 push @nibbles, splice(@$arrayref, 4, 2);
1506 push @nibbles, splice(@$arrayref, 2, 2);
1507 push @nibbles, splice(@$arrayref, 0, 2);
1508 }
1509 else
1510 {
Greg Clayton9163c392011-09-17 05:45:35 +00001511 (@nibbles) = splice(@$arrayref, 0, ((80/8) * 2));
Greg Claytone51dc6f2011-05-20 02:00:47 +00001512 }
1513 $val = join('', @nibbles);
1514 return $val;
1515}
1516
1517#----------------------------------------------------------------------
1518# Get a 96 bit hex value as a string
1519#
1520# The argument for this function needs to be a reference to an array
1521# that contains single character strings and the array will get
1522# updated by shifting characters off the front of it (no leading # "0x")
1523#----------------------------------------------------------------------
1524sub get96
1525{
1526 my $arrayref = shift;
1527 my $val = '';
1528 my @nibbles;
1529 if ($swap)
1530 {
1531 push @nibbles, splice(@$arrayref, 22, 2);
1532 push @nibbles, splice(@$arrayref, 20, 2);
1533 push @nibbles, splice(@$arrayref, 18, 2);
1534 push @nibbles, splice(@$arrayref, 16, 2);
1535 push @nibbles, splice(@$arrayref, 14, 2);
1536 push @nibbles, splice(@$arrayref, 12, 2);
1537 push @nibbles, splice(@$arrayref, 10, 2);
1538 push @nibbles, splice(@$arrayref, 8, 2);
1539 push @nibbles, splice(@$arrayref, 6, 2);
1540 push @nibbles, splice(@$arrayref, 4, 2);
1541 push @nibbles, splice(@$arrayref, 2, 2);
1542 push @nibbles, splice(@$arrayref, 0, 2);
1543 }
1544 else
1545 {
Greg Clayton9163c392011-09-17 05:45:35 +00001546 (@nibbles) = splice(@$arrayref, 0, ((96/8) * 2));
Greg Claytone51dc6f2011-05-20 02:00:47 +00001547 }
1548 $val = join('', @nibbles);
1549 return $val;
1550}
1551
1552#----------------------------------------------------------------------
1553# Get a 128 bit hex value as a string
1554#
1555# The argument for this function needs to be a reference to an array
1556# that contains single character strings and the array will get
1557# updated by shifting characters off the front of it (no leading # "0x")
1558#----------------------------------------------------------------------
1559sub get128
1560{
1561 my $arrayref = shift;
1562 my $val = '';
1563 my @nibbles;
1564 if ($swap)
1565 {
1566 push @nibbles, splice(@$arrayref, 30, 2);
1567 push @nibbles, splice(@$arrayref, 28, 2);
1568 push @nibbles, splice(@$arrayref, 26, 2);
1569 push @nibbles, splice(@$arrayref, 24, 2);
1570 push @nibbles, splice(@$arrayref, 22, 2);
1571 push @nibbles, splice(@$arrayref, 20, 2);
1572 push @nibbles, splice(@$arrayref, 18, 2);
1573 push @nibbles, splice(@$arrayref, 16, 2);
1574 push @nibbles, splice(@$arrayref, 14, 2);
1575 push @nibbles, splice(@$arrayref, 12, 2);
1576 push @nibbles, splice(@$arrayref, 10, 2);
1577 push @nibbles, splice(@$arrayref, 8, 2);
1578 push @nibbles, splice(@$arrayref, 6, 2);
1579 push @nibbles, splice(@$arrayref, 4, 2);
1580 push @nibbles, splice(@$arrayref, 2, 2);
1581 push @nibbles, splice(@$arrayref, 0, 2);
1582 }
1583 else
1584 {
Greg Clayton9163c392011-09-17 05:45:35 +00001585 (@nibbles) = splice(@$arrayref, 0, ((128/8) * 2));
1586 }
1587 $val = join('', @nibbles);
1588 return $val;
1589}
1590
1591#----------------------------------------------------------------------
1592# Get a 256 bit hex value as a string
1593#
1594# The argument for this function needs to be a reference to an array
1595# that contains single character strings and the array will get
1596# updated by shifting characters off the front of it (no leading # "0x")
1597#----------------------------------------------------------------------
1598sub get256
1599{
1600 my $arrayref = shift;
1601 my $val = '';
1602 my @nibbles;
1603 if ($swap)
1604 {
1605 push @nibbles, splice(@$arrayref, 62, 2);
1606 push @nibbles, splice(@$arrayref, 60, 2);
1607 push @nibbles, splice(@$arrayref, 58, 2);
1608 push @nibbles, splice(@$arrayref, 56, 2);
1609 push @nibbles, splice(@$arrayref, 54, 2);
1610 push @nibbles, splice(@$arrayref, 52, 2);
1611 push @nibbles, splice(@$arrayref, 50, 2);
1612 push @nibbles, splice(@$arrayref, 48, 2);
1613 push @nibbles, splice(@$arrayref, 46, 2);
1614 push @nibbles, splice(@$arrayref, 44, 2);
1615 push @nibbles, splice(@$arrayref, 42, 2);
1616 push @nibbles, splice(@$arrayref, 40, 2);
1617 push @nibbles, splice(@$arrayref, 38, 2);
1618 push @nibbles, splice(@$arrayref, 36, 2);
1619 push @nibbles, splice(@$arrayref, 34, 2);
1620 push @nibbles, splice(@$arrayref, 32, 2);
1621 push @nibbles, splice(@$arrayref, 30, 2);
1622 push @nibbles, splice(@$arrayref, 28, 2);
1623 push @nibbles, splice(@$arrayref, 26, 2);
1624 push @nibbles, splice(@$arrayref, 24, 2);
1625 push @nibbles, splice(@$arrayref, 22, 2);
1626 push @nibbles, splice(@$arrayref, 20, 2);
1627 push @nibbles, splice(@$arrayref, 18, 2);
1628 push @nibbles, splice(@$arrayref, 16, 2);
1629 push @nibbles, splice(@$arrayref, 14, 2);
1630 push @nibbles, splice(@$arrayref, 12, 2);
1631 push @nibbles, splice(@$arrayref, 10, 2);
1632 push @nibbles, splice(@$arrayref, 8, 2);
1633 push @nibbles, splice(@$arrayref, 6, 2);
1634 push @nibbles, splice(@$arrayref, 4, 2);
1635 push @nibbles, splice(@$arrayref, 2, 2);
1636 push @nibbles, splice(@$arrayref, 0, 2);
1637 }
1638 else
1639 {
1640 (@nibbles) = splice(@$arrayref, 0, ((256/8) * 2));
Greg Claytone51dc6f2011-05-20 02:00:47 +00001641 }
1642 $val = join('', @nibbles);
1643 return $val;
1644}
1645
1646#----------------------------------------------------------------------
1647# Get a an unsigned integer value by grabbing items off the front of
1648# the array stopping when a non-digit char string is encountered.
1649#
1650# The argument for this function needs to be a reference to an array
1651# that contains single character strings and the array will get
1652# updated by shifting characters off the front of it
1653#----------------------------------------------------------------------
1654sub get_uint
1655{
1656 my $arrayref = shift;
1657 @$arrayref == 0 and return 0;
1658 my $val = 0;
1659 while ($$arrayref[0] =~ /[0-9]/)
1660 {
1661 $val = $val * 10 + int(shift(@$arrayref));
1662 }
1663 return $val;
1664}
1665
1666#----------------------------------------------------------------------
1667# Check the first character in the array and if it matches the expected
1668# character, return that character, else return undef;
1669#
1670# The argument for this function needs to be a reference to an array
1671# that contains single character strings and the array will get
1672# updated by shifting characters off the front of it. If the expected
1673# character doesn't match, it won't touch the array. If the first
1674# character does match, it will shift it off and return it.
1675#----------------------------------------------------------------------
1676sub get_exptected_char
1677{
1678 my $arrayref = shift;
1679 my $expected_char = shift;
1680 if ($expected_char eq $$arrayref[0])
1681 {
1682 return shift(@$arrayref);
1683 }
1684 return undef;
1685}
1686#----------------------------------------------------------------------
1687# Get a hex value by grabbing items off the front of the array and
1688# stopping when a non-hex char string is encountered.
1689#
1690# The argument for this function needs to be a reference to an array
1691# that contains single character strings and the array will get
1692# updated by shifting characters off the front of it (no leading # "0x")
1693#----------------------------------------------------------------------
1694sub get_hex
1695{
1696 my $arrayref = shift;
1697 my $my_swap = @_ ? shift : 0;
1698 my $shift = 0;
1699 my $val = 0;
1700 while ($$arrayref[0] =~ /[0-9a-fA-F]/)
1701 {
1702 if ($my_swap)
1703 {
1704 my $byte = hex(shift(@$arrayref)) << 4 | hex(shift(@$arrayref));
1705 $val |= $byte << $shift;
1706 $shift += 8;
1707 }
1708 else
1709 {
1710 $val <<= 4;
1711 $val |= hex(shift(@$arrayref));
1712 }
1713 }
1714 return $val;
1715}
1716
1717#----------------------------------------------------------------------
1718# Get an address value by grabbing items off the front of the array.
1719#
1720# The argument for this function needs to be a reference to an array
1721# that contains single character strings and the array will get
1722# updated by shifting characters off the front of it (no leading # "0x")
1723#----------------------------------------------------------------------
1724sub get_addr
1725{
1726 get_hex(shift);
1727}
1728
Greg Clayton86729962011-06-02 22:21:38 +00001729sub get_hex_string
1730{
1731 my $arrayref = shift;
1732 my $str = '';
1733 while ($$arrayref[0] =~ /[0-9a-fA-F]/ and $$arrayref[1] =~ /[0-9a-fA-F]/)
1734 {
1735 my $hi_nibble = hex(shift(@$arrayref));
1736 my $lo_nibble = hex(shift(@$arrayref));
1737 my $byte = ($hi_nibble << 4) | $lo_nibble;
1738 $str .= chr($byte);
1739 }
1740 return $str;
1741}
1742
Greg Claytone51dc6f2011-05-20 02:00:47 +00001743sub dump_stop_reply_data
1744{
1745 while ($#_ >= 0)
1746 {
1747 last unless ($_[0] ne '#');
1748
1749
1750 my $key = '';
1751 my $value = '';
Greg Clayton73dfcbb2012-05-16 20:49:54 +00001752 my $comment = '';
Greg Claytone51dc6f2011-05-20 02:00:47 +00001753 if ($_[0] =~ /[0-9a-fA-F]/ && $_[1] =~ /[0-9a-fA-F]/)
1754 {
1755 my $reg_num = get8(\@_);
1756 shift(@_); # Skip ':'
1757 if (defined ($registers_aref) && $reg_num < @$registers_aref)
1758 {
1759 dump_register_value(1, \@_, $reg_num);
1760 print "\n";
1761 shift(@_); # Skip ';'
1762 next;
1763 }
1764 $key = sprintf("reg %u", $reg_num);
1765 }
1766 my $char;
1767
1768 if (length($key) == 0)
1769 {
1770 while (1)
1771 {
1772 $char = shift(@_);
1773 if (length($char) == 0 or $char eq ':' or $char eq '#') { last; }
1774 $key .= $char;
1775 }
1776 }
1777
1778 while (1)
1779 {
1780 $char = shift(@_);
1781 if (length($char) == 0 or $char eq ';' or $char eq '#') { last; }
1782 $value .= $char;
1783 }
Greg Clayton73dfcbb2012-05-16 20:49:54 +00001784 if ($key eq 'metype')
1785 {
1786 our %metype_to_name = (
1787 '1' => ' (EXC_BAD_ACCESS)',
1788 '2' => ' (EXC_BAD_INSTRUCTION)',
1789 '3' => ' (EXC_ARITHMETIC)',
1790 '4' => ' (EXC_EMULATION)',
1791 '5' => ' (EXC_SOFTWARE)',
1792 '6' => ' (EXC_BREAKPOINT)',
1793 '7' => ' (EXC_SYSCALL)',
1794 '8' => ' (EXC_MACH_SYSCALL)',
1795 '9' => ' (EXC_RPC_ALERT)',
1796 '10' => ' (EXC_CRASH)'
1797 );
1798 if (exists $metype_to_name{$value})
1799 {
1800 $comment = $metype_to_name{$value};
1801 }
1802 }
1803 printf("\t%*s = %s$comment\n", $max_register_name_len, $key, $value);
Greg Claytone51dc6f2011-05-20 02:00:47 +00001804 }
1805}
1806
1807#----------------------------------------------------------------------
1808# Dumps a Stop Reply Packet which happens in response to a step,
1809# continue, last signal, and probably a few other commands.
1810#----------------------------------------------------------------------
1811sub dump_stop_reply_packet
1812{
1813 my $what = shift(@_);
Greg Clayton73dfcbb2012-05-16 20:49:54 +00001814 if ($what eq 'S' or $what eq 'T')
Greg Claytone51dc6f2011-05-20 02:00:47 +00001815 {
Greg Clayton73dfcbb2012-05-16 20:49:54 +00001816 my $signo = get8(\@_);
1817
1818 our %signo_to_name = (
1819 '1' => ' SIGHUP',
1820 '2' => ' SIGINT',
1821 '3' => ' SIGQUIT',
1822 '4' => ' SIGILL',
1823 '5' => ' SIGTRAP',
1824 '6' => ' SIGABRT',
1825 '7' => ' SIGPOLL/SIGEMT',
1826 '8' => ' SIGFPE',
1827 '9' => ' SIGKILL',
1828 '10' => ' SIGBUS',
1829 '11' => ' SIGSEGV',
1830 '12' => ' SIGSYS',
1831 '13' => ' SIGPIPE',
1832 '14' => ' SIGALRM',
1833 '15' => ' SIGTERM',
1834 '16' => ' SIGURG',
1835 '17' => ' SIGSTOP',
1836 '18' => ' SIGTSTP',
1837 '19' => ' SIGCONT',
1838 '20' => ' SIGCHLD',
1839 '21' => ' SIGTTIN',
1840 '22' => ' SIGTTOU',
1841 '23' => ' SIGIO',
1842 '24' => ' SIGXCPU',
1843 '25' => ' SIGXFSZ',
1844 '26' => ' SIGVTALRM',
1845 '27' => ' SIGPROF',
1846 '28' => ' SIGWINCH',
1847 '29' => ' SIGINFO',
1848 '30' => ' SIGUSR1',
1849 '31' => ' SIGUSR2',
1850 '145' => ' TARGET_EXC_BAD_ACCESS', # 0x91
1851 '146' => ' TARGET_EXC_BAD_INSTRUCTION', # 0x92
1852 '147' => ' TARGET_EXC_ARITHMETIC', # 0x93
1853 '148' => ' TARGET_EXC_EMULATION', # 0x94
1854 '149' => ' TARGET_EXC_SOFTWARE', # 0x95
1855 '150' => ' TARGET_EXC_BREAKPOINT' # 0x96
1856 );
1857 my $signo_str = sprintf("%i", $signo);
1858 my $signo_name = '';
1859 if (exists $signo_to_name{$signo_str})
1860 {
1861 $signo_name = $signo_to_name{$signo_str};
1862 }
1863 printf ("signal (signo=%u$signo_name)\n", $signo);
Greg Claytone51dc6f2011-05-20 02:00:47 +00001864 dump_stop_reply_data (@_);
1865 }
1866 elsif ($what eq 'W')
1867 {
1868 print 'process_exited( ' . shift(@_) . shift(@_) . " )\n";
1869 }
1870 elsif ($what eq 'X')
1871 {
1872 print 'process_terminated( ' . shift(@_) . shift(@_) . " )\n";
1873 }
1874 elsif ($what eq 'O')
1875 {
1876 my $console_output = '';
1877 my $num_hex8_bytes = @_/2;
1878 for (1 .. $num_hex8_bytes)
1879 {
1880 $console_output .= sprintf("%c", get8(\@_))
1881 }
1882
1883 print "program_console_output('$console_output')\n";
1884 }
1885}
1886
1887#----------------------------------------------------------------------
1888# '?' command
1889#----------------------------------------------------------------------
1890sub dump_last_signal_cmd
1891{
1892 my $cmd = shift;
1893 print 'last_signal (' . join('',@_) . ")\n";
1894}
1895
1896sub dump_raw_command
1897{
1898 my $cmd_aref = shift;
1899 my $callback_ref;
1900 $curr_cmd = $$cmd_aref[0];
Greg Clayton5c3de152012-01-25 21:52:15 +00001901
1902 if ($curr_cmd eq 'q' or $curr_cmd eq 'Q' or $curr_cmd eq '_')
1903 {
1904 $curr_full_cmd = '';
1905 foreach my $ch (@$cmd_aref)
1906 {
1907 $ch !~ /[A-Za-z_]/ and last;
1908 $curr_full_cmd .= $ch;
1909 }
1910 }
1911 else
1912 {
1913 $curr_full_cmd = $curr_cmd;
1914 }
1915
1916 $curr_cmd eq '_' and $curr_cmd .= $$cmd_aref[1];
Greg Claytone51dc6f2011-05-20 02:00:47 +00001917 $callback_ref = $cmd_callbacks{$curr_cmd};
1918 if ($callback_ref)
1919 {
1920 &$callback_ref(@$cmd_aref);
1921 }
1922 else
1923 {
1924 # Strip the command byte for responses since we injected that above
1925 dump_other_cmd(@$cmd_aref);
1926 }
1927}
1928
1929sub dump_standard_response
1930{
1931 my $cmd_aref = shift;
1932
Greg Clayton86729962011-06-02 22:21:38 +00001933 my $cmd_len = scalar(@$cmd_aref);
1934 if ($cmd_len == 0)
Greg Claytone51dc6f2011-05-20 02:00:47 +00001935 {
Greg Clayton86729962011-06-02 22:21:38 +00001936 print "$unimplemented_str\n";
Greg Claytone51dc6f2011-05-20 02:00:47 +00001937 return 1;
1938 }
1939
1940 my $response = join('', @$cmd_aref);
1941 if ($response eq 'OK')
1942 {
1943 print "$success_str\n";
1944 return 1;
1945 }
1946
Greg Clayton86729962011-06-02 22:21:38 +00001947 if ($cmd_len == 3 and index($response, 'E') == 0)
Greg Claytone51dc6f2011-05-20 02:00:47 +00001948 {
1949 print "ERROR: " . substr($response, 1) . "\n";
1950 return 1;
1951 }
1952
1953 return 0;
1954}
1955sub dump_raw_response
1956{
1957 my $cmd_aref = shift;
1958 my $callback_ref;
1959
Greg Clayton5c3de152012-01-25 21:52:15 +00001960 if ($packet_start_time != 0.0)
1961 {
1962 if (length($curr_full_cmd) > 0)
1963 {
1964 $packet_times{$curr_full_cmd} += $curr_time - $packet_start_time;
1965 }
1966 else
1967 {
1968 $packet_times{$curr_cmd} += $curr_time - $packet_start_time;
1969 }
1970 $packet_start_time = 0.0;
1971 }
1972
Greg Claytone51dc6f2011-05-20 02:00:47 +00001973 $callback_ref = $rsp_callbacks{$curr_cmd};
1974
1975 if ($callback_ref)
1976 {
1977 &$callback_ref(@$cmd_aref);
1978 }
1979 else
1980 {
1981 dump_standard_response($cmd_aref) or dump_other_rsp(@$cmd_aref);
1982 }
1983
1984}
1985#----------------------------------------------------------------------
1986# Dumps any command and handles simple error checking on the responses
1987# for commands that are unsupported or OK.
1988#----------------------------------------------------------------------
1989sub dump_command
1990{
1991 my $cmd_str = shift;
1992
1993 # Dump the original command string if verbose is on
1994 if ($opt_v)
1995 {
1996 print "dump_command($cmd_str)\n ";
1997 }
1998
1999 my @cmd_chars = extract_command($cmd_str);
2000 my $is_cmd = 1;
2001
2002 my $cmd = $cmd_chars[0];
2003 if ($cmd eq '$')
2004 {
2005 $is_cmd = 0; # Note that this is a reply
2006 $cmd = $curr_cmd; # set the command byte appropriately
2007 shift @cmd_chars; # remove the '$' from the cmd bytes
2008 }
2009
2010 # Check for common responses across all commands and handle them
2011 # if we can
2012 if ( $is_cmd == 0 )
2013 {
2014 if (rsp_is_unsupported(@cmd_chars))
2015 {
Greg Clayton86729962011-06-02 22:21:38 +00002016 print "$unimplemented_str\n";
Greg Claytone51dc6f2011-05-20 02:00:47 +00002017 return;
2018 }
2019 elsif (rsp_is_OK(@cmd_chars))
2020 {
2021 print "$success_str\n";
2022 return;
2023 }
2024 # Strip the checksum information for responses
2025 strip_checksum(\@cmd_chars);
2026 }
2027
2028 my $callback_ref;
2029 if ($is_cmd) {
2030 $callback_ref = $cmd_callbacks{$cmd};
2031 } else {
2032 $callback_ref = $rsp_callbacks{$cmd};
2033 }
2034
2035 if ($callback_ref)
2036 {
2037 &$callback_ref(@cmd_chars);
2038 }
2039 else
2040 {
2041 # Strip the command byte for responses since we injected that above
2042 if ($is_cmd) {
2043 dump_other_cmd(@cmd_chars);
2044 } else {
2045 dump_other_rsp(@cmd_chars);
2046 }
2047
2048 }
2049}
2050
2051
2052#----------------------------------------------------------------------
2053# Process a gdbserver log line by looking for getpkt and putkpt and
2054# tossing any other lines.
Greg Clayton5c3de152012-01-25 21:52:15 +00002055
Greg Claytone51dc6f2011-05-20 02:00:47 +00002056#----------------------------------------------------------------------
2057sub process_log_line
2058{
2059 my $line = shift;
2060 #($opt_v and $opt_g) and print "# $line";
Greg Clayton5c3de152012-01-25 21:52:15 +00002061
Greg Claytone51dc6f2011-05-20 02:00:47 +00002062 my $extract_cmd = 0;
Greg Clayton5c3de152012-01-25 21:52:15 +00002063 my $delta_time = 0.0;
2064 if ($line =~ /^(\s*)([1-9][0-9]+\.[0-9]+)([^0-9].*)$/)
2065 {
2066 my $leading_space = $1;
2067 $curr_time = $2;
2068 $line = $3;
2069 if ($base_time == 0.0)
2070 {
2071 $base_time = $curr_time;
2072 }
2073 else
2074 {
2075 $delta_time = $curr_time - $last_time;
2076 }
2077 printf ("(%.6f, %+.6f): ", $curr_time - $base_time, $delta_time);
2078 $last_time = $curr_time;
2079 }
2080 else
2081 {
2082 $curr_time = 0.0
2083 }
2084
Greg Claytone51dc6f2011-05-20 02:00:47 +00002085 if ($line =~ /getpkt /)
2086 {
2087 $extract_cmd = 1;
2088 print "\n--> ";
Greg Clayton5c3de152012-01-25 21:52:15 +00002089 $packet_start_time = $curr_time;
Greg Claytone51dc6f2011-05-20 02:00:47 +00002090 }
2091 elsif ($line =~ /putpkt /)
2092 {
2093 $extract_cmd = 1;
2094 print "<-- ";
2095 }
2096 elsif ($line =~ /.*Sent: \[[0-9]+\.[0-9]+[:0-9]*\] (.*)/)
2097 {
2098 $opt_g and print "maintenance dump-packets command: $1\n";
2099 my @raw_cmd_bytes = split(/ */, $1);
Greg Clayton5c3de152012-01-25 21:52:15 +00002100 $packet_start_time = $curr_time;
Greg Claytone51dc6f2011-05-20 02:00:47 +00002101 print "\n--> ";
2102 dump_raw_command(\@raw_cmd_bytes);
2103 process_log_line($2);
2104 }
2105 elsif ($line =~ /.*Recvd: \[[0-9]+\.[0-9]+[:0-9]*\] (.*)/)
2106 {
2107 $opt_g and print "maintenance dump-packets reply: $1\n";
2108 my @raw_rsp_bytes = split(/ */, $1);
2109 print "<-- ";
2110 dump_raw_response(\@raw_rsp_bytes);
2111 print "\n";
2112 }
2113 elsif ($line =~ /getpkt: (.*)/)
2114 {
2115 if ($1 =~ /\$([^#]+)#[0-9a-fA-F]{2}/)
2116 {
2117 $opt_g and print "command: $1\n";
2118 my @raw_cmd_bytes = split(/ */, $1);
2119 print "--> ";
Greg Clayton5c3de152012-01-25 21:52:15 +00002120 $packet_start_time = $curr_time;
Greg Claytone51dc6f2011-05-20 02:00:47 +00002121 dump_raw_command(\@raw_cmd_bytes);
2122 }
2123 elsif ($1 =~ /\+/)
2124 {
2125 #print "--> ACK\n";
2126 }
2127 elsif ($1 =~ /-/)
2128 {
2129 #print "--> NACK\n";
2130 }
2131 }
2132 elsif ($line =~ /putpkt: (.*)/)
2133 {
2134 if ($1 =~ /\$([^#]+)#[0-9a-fA-F]{2}/)
2135 {
2136 $opt_g and print "response: $1\n";
2137 my @raw_rsp_bytes = split(/ */, $1);
2138 print "<-- ";
2139 dump_raw_response(\@raw_rsp_bytes);
2140 print "\n";
2141 }
2142 elsif ($1 =~ /\+/)
2143 {
2144 #print "<-- ACK\n";
2145 }
2146 elsif ($1 =~ /-/)
2147 {
2148 #print "<-- NACK\n";
2149 }
2150 }
2151 elsif ($line =~ /send packet: (.*)/)
2152 {
2153 if ($1 =~ /\$([^#]+)#[0-9a-fA-F]{2}/)
2154 {
2155 $opt_g and print "command: $1\n";
2156 my @raw_cmd_bytes = split(/ */, $1);
2157 print "--> ";
Greg Clayton5c3de152012-01-25 21:52:15 +00002158 $packet_start_time = $curr_time;
Greg Claytone51dc6f2011-05-20 02:00:47 +00002159 dump_raw_command(\@raw_cmd_bytes);
2160 }
2161 elsif ($1 =~ /\+/)
2162 {
2163 #print "--> ACK\n";
2164 }
2165 elsif ($1 =~ /-/)
2166 {
2167 #print "--> NACK\n";
2168 }
2169 }
2170 elsif ($line =~ /read packet: (.*)/)
2171 {
Greg Clayton86729962011-06-02 22:21:38 +00002172 if ($1 =~ /\$([^#]*)#[0-9a-fA-F]{2}/)
Greg Claytone51dc6f2011-05-20 02:00:47 +00002173 {
2174 $opt_g and print "response: $1\n";
2175 my @raw_rsp_bytes = split(/ */, $1);
2176 print "<-- ";
2177 dump_raw_response(\@raw_rsp_bytes);
2178 print "\n";
2179 }
2180 elsif ($1 =~ /\+/)
2181 {
2182 #print "<-- ACK\n";
2183 }
2184 elsif ($1 =~ /-/)
2185 {
2186 #print "<-- NACK\n";
2187 }
2188 }
2189 elsif ($line =~ /Sending packet: \$([^#]+)#[0-9a-fA-F]{2}\.\.\.(.*)/)
2190 {
2191 $opt_g and print "command: $1\n";
2192 my @raw_cmd_bytes = split(/ */, $1);
2193 print "\n--> ";
Greg Clayton5c3de152012-01-25 21:52:15 +00002194 $packet_start_time = $curr_time;
Greg Claytone51dc6f2011-05-20 02:00:47 +00002195 dump_raw_command(\@raw_cmd_bytes);
2196 process_log_line($2);
2197 }
2198 elsif ($line =~ /Packet received: (.*)/)
2199 {
2200 $opt_g and print "response: $1\n";
2201 my @raw_rsp_bytes = split(/ */, $1);
2202 print "<-- ";
2203 dump_raw_response(\@raw_rsp_bytes);
2204 print "\n";
2205 }
2206
2207 if ($extract_cmd)
2208 {
2209 my $beg = index($line, '("') + 2;
2210 my $end = rindex($line, '");');
Greg Clayton5c3de152012-01-25 21:52:15 +00002211 $packet_start_time = $curr_time;
Greg Claytone51dc6f2011-05-20 02:00:47 +00002212 dump_command(substr($line, $beg, $end - $beg));
2213 }
2214}
2215
2216
2217our $line_num = 0;
2218while(<>)
2219{
2220 $line_num++;
2221 $opt_q or printf("# %5d: $_", $line_num);
2222 process_log_line($_);
2223}
2224
Greg Clayton5c3de152012-01-25 21:52:15 +00002225if (%packet_times)
2226{
2227 print "----------------------------------------------------------------------\n";
2228 print "Packet timing summary:\n";
2229 print "----------------------------------------------------------------------\n";
2230 print "Packet Time %\n";
2231 print "---------------------- -------- ------\n";
2232 my @packet_names = keys %packet_times;
2233 my $total_packet_times = 0.0;
2234 foreach my $key (@packet_names)
2235 {
2236 $total_packet_times += $packet_times{$key};
2237 }
2238
2239 foreach my $value (sort {$packet_times{$b} cmp $packet_times{$a}} @packet_names)
2240 {
2241 my $percent = ($packet_times{$value} / $total_packet_times) * 100.0;
2242 if ($percent < 10.0)
2243 {
2244 printf("%22s %1.6f %2.2f\n", $value, $packet_times{$value}, $percent);
2245
2246 }
2247 else
2248 {
2249 printf("%22s %1.6f %2.2f\n", $value, $packet_times{$value}, $percent);
2250 }
2251 }
2252 print "---------------------- -------- ------\n";
2253 printf (" Total %1.6f 100.00\n", $total_packet_times);
2254}
2255
2256
Greg Claytone51dc6f2011-05-20 02:00:47 +00002257
2258
2259
2260
2261