blob: 071d4781916fd2e6358e93d96d164c35187e9cfc [file] [log] [blame]
Greg Claytoneae5e262011-05-20 02:00:47 +00001#!/usr/bin/perl
2
3use strict;
4
5#----------------------------------------------------------------------
6# Globals
7#----------------------------------------------------------------------
Greg Clayton125628c2011-06-02 22:21:38 +00008our $unimplemented_str = "UNIMPLEMENTED";
Greg Claytoneae5e262011-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 Clayton1a3e9e62011-09-17 05:45:35 +000023our $reg256_href = { extract => \&get256, format => "0x%s" };
Greg Claytoneae5e262011-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 Clayton42721642012-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 Claytoneae5e262011-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 Clayton139da722011-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 Claytoneae5e262011-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 Clayton125628c2011-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 Claytoneae5e262011-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 Clayton5f4a5382012-01-25 03:20:34 +0000515 's' => \&dump_continue_cmd,
Greg Claytoneae5e262011-05-20 02:00:47 +0000516 'C' => \&dump_continue_with_signal_cmd,
Greg Clayton5f4a5382012-01-25 03:20:34 +0000517 'S' => \&dump_continue_with_signal_cmd,
Greg Claytoneae5e262011-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 Clayton5f4a5382012-01-25 03:20:34 +0000532 's' => \&dump_stop_reply_packet,
Greg Claytoneae5e262011-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);
Johnny Chen40a20432012-05-30 00:29:12 +0000557 return;
Greg Claytoneae5e262011-05-20 02:00:47 +0000558 }
559
560 my $reg_href = $$registers_aref[$reg_num];
561 my $reg_name = $reg_href->{name};
562 if ($$arrayref[0] eq '#')
563 {
564 printf("\t%*s: error: EOS reached when trying to read register %d\n", $max_register_name_len, $reg_name, $reg_num);
565 }
566
567 my $reg_info = $reg_href->{info};
568 my $reg_extract = $reg_info->{extract};
569 my $reg_format = $reg_info->{format};
570 my $reg_val = &$reg_extract($arrayref);
571 if ($indent) {
572 printf("\t%*s = $reg_format", $max_register_name_len, $reg_name, $reg_val);
573 } else {
574 printf("%s = $reg_format", $reg_name, $reg_val);
575 }
576}
577
578#----------------------------------------------------------------------
579# Extract the command into an array of ASCII char strings for easy
580# processing
581#----------------------------------------------------------------------
582sub extract_command
583{
584 my $cmd_str = shift;
585 my @cmd_chars = split(/ */, $cmd_str);
586 if ($cmd_chars[0] ne '$')
587 {
588 # only set the current command if it isn't a reply
589 $curr_cmd = $cmd_chars[0];
590 }
591 return @cmd_chars;
592}
593
594#----------------------------------------------------------------------
595# Strip the 3 checksum array entries after we don't need them anymore
596#----------------------------------------------------------------------
597sub strip_checksum
598{
599 my $arrayref = shift;
600 splice(@$arrayref, -3);
601}
602
603#----------------------------------------------------------------------
604# Dump all strings in array by joining them together with no space
605# between them
606#----------------------------------------------------------------------
607sub dump_chars
608{
609 print join('',@_);
610}
611
612#----------------------------------------------------------------------
613# Check if the response is an error 'EXX'
614#----------------------------------------------------------------------
615sub is_error_response
616{
617 if ($_[0] eq 'E')
618 {
619 shift;
620 print "ERROR = " . join('',@_) . "\n";
621 return 1;
622 }
623 return 0;
624}
625
626#----------------------------------------------------------------------
627# 'H' command
628#----------------------------------------------------------------------
629sub dump_set_thread_cmd
630{
631 my $cmd = shift;
632 my $mod = shift;
633 print "set_thread ( $mod, " . join('',@_) . " )\n";
634}
635
636#----------------------------------------------------------------------
637# 'T' command
638#----------------------------------------------------------------------
639our $T_cmd_tid = -1;
640sub dump_thread_is_alive_cmd
641{
642 my $cmd = shift;
643 $T_cmd_tid = get_hex(\@_);
644 printf("thread_is_alive ( $tid_format )\n", $T_cmd_tid);
645}
646
647sub dump_thread_is_alive_rsp
648{
649 my $rsp = join('',@_);
650
651 printf("thread_is_alive ( $tid_format ) =>", $T_cmd_tid);
652 if ($rsp eq 'OK')
653 {
654 print " alive.\n";
655 }
656 else
657 {
658 print " dead.\n";
659 }
660}
661
662#----------------------------------------------------------------------
663# 'H' response
664#----------------------------------------------------------------------
665sub dump_set_thread_rsp
666{
667 if (!is_error_response(@_))
668 {
669 print join('',@_) . "\n";
670 }
671}
672
673#----------------------------------------------------------------------
674# 'q' command
675#----------------------------------------------------------------------
676our $gen_query_cmd;
Greg Clayton125628c2011-06-02 22:21:38 +0000677our $qRegisterInfo_reg_num = -1;
Greg Claytoneae5e262011-05-20 02:00:47 +0000678sub dump_general_query_cmd
679{
680 $gen_query_cmd = join('',@_);
681 if ($gen_query_cmd eq 'qC')
682 {
683 print 'get_current_pid ()';
684 }
685 elsif ($gen_query_cmd eq 'qfThreadInfo')
686 {
687 print 'get_first_active_threads ()';
688 }
689 elsif ($gen_query_cmd eq 'qsThreadInfo')
690 {
691 print 'get_subsequent_active_threads ()';
692 }
693 elsif (index($gen_query_cmd, 'qThreadExtraInfo') == 0)
694 {
695 # qThreadExtraInfo,id
696 print 'get_thread_extra_info ()';
697 }
698 elsif (index($gen_query_cmd, 'qThreadStopInfo') == 0)
699 {
700 # qThreadStopInfoXXXX
701 @_ = splice(@_, length('qThreadStopInfo'));
702 my $tid = get_addr(\@_);
703 printf('get_thread_stop_info ( thread = 0x%4.4x )', $tid);
704 }
705 elsif (index($gen_query_cmd, 'qSymbol:') == 0)
706 {
707 # qCRC:addr,length
708 print 'gdb_ready_to_serve_symbol_lookups ()';
709 }
710 elsif (index($gen_query_cmd, 'qCRC:') == 0)
711 {
712 # qCRC:addr,length
713 @_ = splice(@_, length('qCRC:'));
714 my $address = get_addr(\@_);
715 shift @_;
716 my $length = join('', @_);
717 printf("compute_crc (addr = $addr_format, length = $length)", $address);
718 }
719 elsif (index($gen_query_cmd, 'qGetTLSAddr:') == 0)
720 {
721 # qGetTLSAddr:thread-id,offset,lm
722 @_ = splice(@_, length('qGetTLSAddr:'));
723 my ($tid, $offset, $lm) = split (/,/, join('', @_));
724 print "get_thread_local_storage_addr (thread-id = $tid, offset = $offset, lm = $lm)";
725 }
726 elsif ($gen_query_cmd eq 'qOffsets')
727 {
728 print 'get_section_offsets ()';
729 }
730 elsif (index($gen_query_cmd, 'qRegisterInfo') == 0)
731 {
732 @_ = splice(@_, length('qRegisterInfo'));
Greg Clayton125628c2011-06-02 22:21:38 +0000733 $qRegisterInfo_reg_num = get_hex(\@_);
734
735 printf "get_dynamic_register_info ($qRegisterInfo_reg_num)";
Greg Claytoneae5e262011-05-20 02:00:47 +0000736 }
737 else
738 {
739 print $gen_query_cmd;
740 }
741 print "\n";
742}
743
744#----------------------------------------------------------------------
745# 'q' response
746#----------------------------------------------------------------------
747sub dump_general_query_rsp
748{
749 my $gen_query_rsp = join('',@_);
Greg Clayton125628c2011-06-02 22:21:38 +0000750 my $gen_query_rsp_len = length ($gen_query_rsp);
Greg Claytoneae5e262011-05-20 02:00:47 +0000751 if ($gen_query_cmd eq 'qC' and index($gen_query_rsp, 'QC') == 0)
752 {
753 shift @_; shift @_;
754 my $pid = get_hex(\@_);
Greg Clayton125628c2011-06-02 22:21:38 +0000755 printf("pid = $pid_format\n", $pid);
Greg Claytoneae5e262011-05-20 02:00:47 +0000756 return;
757 }
758 elsif (index($gen_query_cmd, 'qRegisterInfo') == 0)
759 {
Greg Clayton125628c2011-06-02 22:21:38 +0000760 if ($gen_query_rsp_len == 0)
Greg Claytoneae5e262011-05-20 02:00:47 +0000761 {
Greg Clayton125628c2011-06-02 22:21:38 +0000762 print "$unimplemented_str\n";
Greg Claytoneae5e262011-05-20 02:00:47 +0000763 }
764 else
765 {
Greg Clayton125628c2011-06-02 22:21:38 +0000766 if (index($gen_query_rsp, 'name') == 0)
767 {
768 $qRegisterInfo_reg_num == 0 and $registers_aref = [];
769
770 my @name_and_values = split (/;/, $gen_query_rsp);
771
772 my $reg_name = undef;
773 my $byte_size = 0;
774 foreach (@name_and_values)
775 {
776 my ($name, $value) = split /:/;
777 if ($name eq "name") { $reg_name = $value; }
778 elsif ($name eq "bitsize") { $byte_size = $value / 8; last; }
779 }
780 if (defined $reg_name and $byte_size > 0)
781 {
782 if ($byte_size == 4) {push @$registers_aref, { name => $reg_name, info => $reg32_href };}
783 elsif ($byte_size == 8) {push @$registers_aref, { name => $reg_name, info => $reg64_href };}
Greg Clayton1a3e9e62011-09-17 05:45:35 +0000784 elsif ($byte_size == 1) {push @$registers_aref, { name => $reg_name, info => $reg8_href };}
785 elsif ($byte_size == 2) {push @$registers_aref, { name => $reg_name, info => $reg16_href };}
Greg Clayton125628c2011-06-02 22:21:38 +0000786 elsif ($byte_size == 10) {push @$registers_aref, { name => $reg_name, info => $reg80_href };}
787 elsif ($byte_size == 12) {push @$registers_aref, { name => $reg_name, info => $float96_href };}
788 elsif ($byte_size == 16) {push @$registers_aref, { name => $reg_name, info => $reg128_href };}
Greg Clayton1a3e9e62011-09-17 05:45:35 +0000789 elsif ($byte_size == 32) {push @$registers_aref, { name => $reg_name, info => $reg256_href };}
Greg Clayton125628c2011-06-02 22:21:38 +0000790 }
791 }
792 elsif ($gen_query_rsp_len == 3 and index($gen_query_rsp, 'E') == 0)
793 {
794 calculate_max_register_name_length();
795 }
Greg Claytoneae5e262011-05-20 02:00:47 +0000796 }
797 }
798 elsif ($gen_query_cmd =~ 'qThreadStopInfo')
799 {
800 dump_stop_reply_packet (@_);
801 }
802 if (dump_standard_response(\@_))
803 {
804 # Do nothing...
805 }
806 else
807 {
808 print join('',@_) . "\n";
809 }
810}
811
812#----------------------------------------------------------------------
813# 'Q' command
814#----------------------------------------------------------------------
815our $gen_set_cmd;
816sub dump_general_set_cmd
817{
818 $gen_query_cmd = join('',@_);
819 if ($gen_query_cmd eq 'QStartNoAckMode')
820 {
821 print "StartNoAckMode ()"
822 }
823 elsif ($gen_query_cmd eq 'QThreadSuffixSupported')
824 {
825 $thread_suffix_supported = 1;
826 print "ThreadSuffixSupported ()"
827 }
828 elsif (index($gen_query_cmd, 'QSetMaxPayloadSize:') == 0)
829 {
830 @_ = splice(@_, length('QSetMaxPayloadSize:'));
831 my $max_payload_size = get_hex(\@_);
832 # QSetMaxPayloadSize:XXXX where XXXX is a hex length of the max
833 # packet payload size supported by gdb
834 printf("SetMaxPayloadSize ( 0x%x (%u))", $max_payload_size, $max_payload_size);
835 }
Greg Clayton125628c2011-06-02 22:21:38 +0000836 elsif (index ($gen_query_cmd, 'QSetSTDIN:') == 0)
837 {
838 @_ = splice(@_, length('QSetSTDIN:'));
839 printf ("SetSTDIN (path ='%s')\n", get_hex_string (\@_));
840 }
841 elsif (index ($gen_query_cmd, 'QSetSTDOUT:') == 0)
842 {
843 @_ = splice(@_, length('QSetSTDOUT:'));
844 printf ("SetSTDOUT (path ='%s')\n", get_hex_string (\@_));
845 }
846 elsif (index ($gen_query_cmd, 'QSetSTDERR:') == 0)
847 {
848 @_ = splice(@_, length('QSetSTDERR:'));
849 printf ("SetSTDERR (path ='%s')\n", get_hex_string (\@_));
850 }
Greg Claytoneae5e262011-05-20 02:00:47 +0000851 else
852 {
853 print $gen_query_cmd;
854 }
855 print "\n";
856}
857
858#----------------------------------------------------------------------
859# 'k' command
860#----------------------------------------------------------------------
861sub dump_kill_cmd
862{
863 my $cmd = shift;
864 print "kill (" . join('',@_) . ")\n";
865}
866
867#----------------------------------------------------------------------
868# 'g' command
869#----------------------------------------------------------------------
870sub dump_read_regs_cmd
871{
872 my $cmd = shift;
873 print "read_registers ()\n";
874}
875
876#----------------------------------------------------------------------
877# 'G' command
878#----------------------------------------------------------------------
879sub dump_write_regs_cmd
880{
881 print "write_registers:\n";
882 my $cmd = shift;
883 foreach my $reg_href (@$registers_aref)
884 {
885 last if ($_[0] eq '#');
886 my $reg_info_href = $reg_href->{info};
887 my $reg_name = $reg_href->{name};
888 my $reg_extract = $reg_info_href->{extract};
889 my $reg_format = $reg_info_href->{format};
890 my $reg_val = &$reg_extract(\@_);
891 printf("\t%*s = $reg_format\n", $max_register_name_len, $reg_name, $reg_val);
892 }
893}
894
895sub dump_read_regs_rsp
896{
897 print "read_registers () =>\n";
898 if (!is_error_response(@_))
899 {
900 # print join('',@_) . "\n";
901 foreach my $reg_href (@$registers_aref)
902 {
903 last if ($_[0] eq '#');
904 my $reg_info_href = $reg_href->{info};
905 my $reg_name = $reg_href->{name};
906 my $reg_extract = $reg_info_href->{extract};
907 my $reg_format = $reg_info_href->{format};
908 my $reg_val = &$reg_extract(\@_);
909 printf("\t%*s = $reg_format\n", $max_register_name_len, $reg_name, $reg_val);
910 }
911 }
912}
913
914sub dump_read_single_register_rsp
915{
916 dump_register_value(0, \@_, $reg_cmd_reg);
917 print "\n";
918}
919
920#----------------------------------------------------------------------
921# '_M' - allocate memory command (LLDB extension)
922#
923# Command: '_M'
924# Arg1: Hex byte size as big endian hex string
925# Separator: ','
926# Arg2: permissions as string that must be a string that contains any
927# combination of 'r' (readable) 'w' (writable) or 'x' (executable)
928#
929# Returns: The address that was allocated as a big endian hex string
930# on success, else an error "EXX" where XX are hex bytes
931# that indicate an error code.
932#
933# Examples:
934# _M10,rw # allocate 16 bytes with read + write permissions
935# _M100,rx # allocate 256 bytes with read + execute permissions
936#----------------------------------------------------------------------
937sub dump_allocate_memory_cmd
938{
939 shift; shift; # shift off the '_' and the 'M'
940 my $byte_size = get_addr(\@_);
941 shift; # Skip ','
942 printf("allocate_memory ( byte_size = %u (0x%x), permissions = %s)\n", $byte_size, $byte_size, join('',@_));
943}
944
945sub dump_allocate_memory_rsp
946{
947 if (@_ == 3 and $_[0] == 'E')
948 {
949 printf("allocated memory addr = ERROR (%s))\n", join('',@_));
950 }
951 else
952 {
953 printf("allocated memory addr = 0x%s\n", join('',@_));
954 }
955}
956
Greg Claytoneae5e262011-05-20 02:00:47 +0000957#----------------------------------------------------------------------
958# '_m' - deallocate memory command (LLDB extension)
959#
960# Command: '_m'
961# Arg1: Hex address as big endian hex string
962#
963# Returns: "OK" on success "EXX" on error
964#
965# Examples:
966# _m201000 # Free previously allocated memory at address 0x201000
967#----------------------------------------------------------------------
968sub dump_deallocate_memory_cmd
969{
970 shift; shift; # shift off the '_' and the 'm'
971 printf("deallocate_memory ( addr = 0x%s)\n", join('',@_));
972}
973
974
975#----------------------------------------------------------------------
976# 'p' command
977#----------------------------------------------------------------------
978sub dump_read_single_register_cmd
979{
980 my $cmd = shift;
Greg Clayton1a3e9e62011-09-17 05:45:35 +0000981 $reg_cmd_reg = get_hex(\@_);
Greg Claytoneae5e262011-05-20 02:00:47 +0000982 my $thread = get_thread_from_thread_suffix (\@_);
Greg Clayton1a3e9e62011-09-17 05:45:35 +0000983 my $reg_href = $$registers_aref[$reg_cmd_reg];
Greg Clayton125628c2011-06-02 22:21:38 +0000984
Greg Claytoneae5e262011-05-20 02:00:47 +0000985 if (defined $thread)
986 {
Greg Clayton125628c2011-06-02 22:21:38 +0000987 print "read_register ( reg = \"$reg_href->{name}\", thread = $thread )\n";
Greg Claytoneae5e262011-05-20 02:00:47 +0000988 }
989 else
990 {
Greg Clayton125628c2011-06-02 22:21:38 +0000991 print "read_register ( reg = \"$reg_href->{name}\" )\n";
Greg Claytoneae5e262011-05-20 02:00:47 +0000992 }
993}
994
995
996#----------------------------------------------------------------------
997# 'P' command
998#----------------------------------------------------------------------
999sub dump_write_single_register_cmd
1000{
1001 my $cmd = shift;
1002 my $reg_num = get_hex(\@_);
1003 shift (@_); # Discard the '='
1004
1005 print "write_register ( ";
1006 dump_register_value(0, \@_, $reg_num);
1007 my $thread = get_thread_from_thread_suffix (\@_);
1008 if (defined $thread)
1009 {
1010 print ", thread = $thread";
1011 }
1012 print " )\n";
1013}
1014
1015#----------------------------------------------------------------------
1016# 'm' command
1017#----------------------------------------------------------------------
1018our $read_mem_address = 0;
1019sub dump_read_mem_cmd
1020{
1021 my $cmd = shift;
1022 $read_mem_address = get_addr(\@_);
1023 shift; # Skip ','
1024 printf("read_mem ( $addr_format, %s )\n", $read_mem_address, join('',@_));
1025}
1026
1027#----------------------------------------------------------------------
1028# 'm' response
1029#----------------------------------------------------------------------
1030sub dump_read_mem_rsp
1031{
1032 # If the memory read was 2 or 4 bytes, print it out in native format
1033 # instead of just as bytes.
1034 my $num_nibbles = @_;
1035 if ($num_nibbles == 2)
1036 {
1037 printf(" 0x%2.2x", get8(\@_));
1038 }
1039 elsif ($num_nibbles == 4)
1040 {
1041 printf(" 0x%4.4x", get16(\@_));
1042 }
1043 elsif ($num_nibbles == 8)
1044 {
1045 printf(" 0x%8.8x", get32(\@_));
1046 }
1047 elsif ($num_nibbles == 16)
1048 {
1049 printf(" 0x%s", get64(\@_));
1050 }
1051 else
1052 {
1053 my $curr_address = $read_mem_address;
1054 my $nibble;
1055 my $nibble_offset = 0;
1056 my $max_nibbles_per_line = 2 * $max_bytes_per_line;
1057 foreach $nibble (@_)
1058 {
1059 if (($nibble_offset % $max_nibbles_per_line) == 0)
1060 {
1061 ($nibble_offset > 0) and print "\n ";
1062 printf("$addr_format: ", $curr_address + $nibble_offset/2);
1063 }
1064 (($nibble_offset % 2) == 0) and print ' ';
1065 print $nibble;
1066 $nibble_offset++;
1067 }
1068 }
1069 print "\n";
1070}
1071
1072#----------------------------------------------------------------------
Greg Clayton5f4a5382012-01-25 03:20:34 +00001073# 'c' or 's' command
Greg Claytoneae5e262011-05-20 02:00:47 +00001074#----------------------------------------------------------------------
1075sub dump_continue_cmd
1076{
1077 my $cmd = shift;
Greg Clayton5f4a5382012-01-25 03:20:34 +00001078 my $cmd_str;
1079 $cmd eq 'c' and $cmd_str = 'continue';
1080 $cmd eq 's' and $cmd_str = 'step';
Greg Claytoneae5e262011-05-20 02:00:47 +00001081 my $address = -1;
1082 if (@_)
1083 {
1084 my $address = get_addr(\@_);
Greg Clayton5f4a5382012-01-25 03:20:34 +00001085 printf("%s ($addr_format)\n", $cmd_str, $address);
Greg Claytoneae5e262011-05-20 02:00:47 +00001086 }
1087 else
1088 {
Greg Clayton5f4a5382012-01-25 03:20:34 +00001089 printf("%s ()\n", $cmd_str);
Greg Claytoneae5e262011-05-20 02:00:47 +00001090 }
1091}
1092
1093#----------------------------------------------------------------------
1094# 'Css' continue (C) with signal (ss where 'ss' is two hex digits)
Greg Clayton5f4a5382012-01-25 03:20:34 +00001095# 'Sss' step (S) with signal (ss where 'ss' is two hex digits)
Greg Claytoneae5e262011-05-20 02:00:47 +00001096#----------------------------------------------------------------------
1097sub dump_continue_with_signal_cmd
1098{
1099 my $cmd = shift;
1100 my $address = -1;
Greg Clayton5f4a5382012-01-25 03:20:34 +00001101 my $cmd_str;
1102 $cmd eq 'c' and $cmd_str = 'continue';
1103 $cmd eq 's' and $cmd_str = 'step';
Greg Claytoneae5e262011-05-20 02:00:47 +00001104 my $signal = get_hex(\@_);
1105 if (@_)
1106 {
1107 my $address = 0;
1108 if (@_ && $_[0] == ';')
1109 {
1110 shift;
1111 $address = get_addr(\@_);
1112 }
1113 }
1114
1115 if ($address != -1)
1116 {
Greg Clayton5f4a5382012-01-25 03:20:34 +00001117 printf("%s_with_signal (signal = 0x%2.2x, address = $addr_format)\n", $cmd_str, $signal, $address);
Greg Claytoneae5e262011-05-20 02:00:47 +00001118 }
1119 else
1120 {
Greg Clayton5f4a5382012-01-25 03:20:34 +00001121 printf("%s_with_signal (signal = 0x%2.2x)\n", $cmd_str, $signal);
Greg Claytoneae5e262011-05-20 02:00:47 +00001122 }
1123}
1124
1125#----------------------------------------------------------------------
1126# 'A' command
1127#----------------------------------------------------------------------
1128sub dump_A_command
1129{
1130 my $cmd = get_exptected_char(\@_, 'A') or print "error: incorrect command letter for argument packet, exptected 'A'\n";
1131 printf("set_program_arguments (\n");
1132 do
1133 {
1134 my $arg_len = get_uint(\@_);
1135 get_exptected_char(\@_, ',') or die "error: missing comma after argument length...?\n";
1136 my $arg_idx = get_uint(\@_);
1137 get_exptected_char(\@_, ',') or die "error: missing comma after argument number...?\n";
1138
1139 my $arg = '';
1140 my $num_hex8_bytes = $arg_len/2;
1141 for (1 .. $num_hex8_bytes)
1142 {
1143 $arg .= sprintf("%c", get8(\@_))
1144 }
1145 printf(" <%3u> argv[%u] = '%s'\n", $arg_len, $arg_idx, $arg);
1146 if (@_ > 0)
1147 {
1148 get_exptected_char(\@_, ',') or die "error: missing comma after argument argument ASCII hex bytes...?\n";
1149 }
1150 } while (@_ > 0);
1151 printf(" )\n");
1152}
1153
1154
1155#----------------------------------------------------------------------
1156# 'z' and 'Z' command
1157#----------------------------------------------------------------------
1158sub dump_bp_wp_command
1159{
1160 my $cmd = shift;
1161 my $type = shift;
1162 shift; # Skip ','
1163 my $address = get_addr(\@_);
1164 shift; # Skip ','
1165 my $length = join('',@_);
1166 if ($cmd eq 'z')
1167 {
1168 printf("remove $point_types[$type]($addr_format, %d)\n", $address, $length);
1169 }
1170 else
1171 {
1172 printf("insert $point_types[$type]($addr_format, %d)\n", $address, $length);
1173 }
1174}
1175
1176
1177#----------------------------------------------------------------------
1178# 'X' command
1179#----------------------------------------------------------------------
1180sub dump_write_mem_binary_cmd
1181{
1182 my $cmd = shift;
1183 my $address = get_addr(\@_);
1184 shift; # Skip ','
1185
1186 my ($length, $binary) = split(/:/, join('',@_));
1187 printf("write_mem_binary ( $addr_format, %d, %s)\n", $address, $length, $binary);
1188
1189}
1190
1191#----------------------------------------------------------------------
1192# 'M' command
1193#----------------------------------------------------------------------
1194sub dump_write_mem_cmd
1195{
1196 my $cmd = shift;
1197 my $address = get_addr(\@_);
1198 shift; # Skip ','
1199 my ($length, $hex_bytes) = split(/:/, join('',@_));
1200# printf("write_mem ( $addr_format, %d, %s)\n", $address, $length, $hex_bytes);
1201 printf("write_mem ( addr = $addr_format, len = %d (0x%x), bytes = ", $address, $length, $length);
1202 splice(@_, 0, length($length)+1);
1203
1204 my $curr_address = $address;
1205 my $nibble;
1206 my $nibble_count = 0;
1207 my $max_nibbles_per_line = 2 * $max_bytes_per_line;
1208 foreach $nibble (@_)
1209 {
1210 (($nibble_count % 2) == 0) and print ' ';
1211 print $nibble;
1212 $nibble_count++;
1213 }
1214
1215 # If the memory to write is 2 or 4 bytes, print it out in native format
1216 # instead of just as bytes.
1217 if (@_ == 4)
1218 {
1219 printf(" ( 0x%4.4x )", get16(\@_));
1220 }
1221 elsif (@_ == 8)
1222 {
1223 printf(" ( 0x%8.8x )", get32(\@_));
1224 }
1225 print " )\n";
1226
1227}
1228
1229#----------------------------------------------------------------------
1230# 'v' command
1231#----------------------------------------------------------------------
1232our $extended_rsp_callback = 0;
1233sub dump_extended_cmd
1234{
1235 $extended_rsp_callback = 0;
1236 if (join('', @_[0..4]) eq "vCont")
1237 {
1238 dump_extended_continue_cmd(splice(@_,5));
1239 }
Greg Claytonf1f2a152013-01-18 23:30:12 +00001240 elsif (join('', @_[0..7]) eq 'vAttach;')
1241 {
1242 dump_attach_command (splice(@_,8));
1243 }
Greg Claytoneae5e262011-05-20 02:00:47 +00001244 elsif (join('', @_[0..11]) eq 'vAttachWait;')
1245 {
1246 dump_attach_wait_command (splice(@_,12));
1247 }
1248}
1249
1250#----------------------------------------------------------------------
1251# 'v' response
1252#----------------------------------------------------------------------
1253sub dump_extended_rsp
1254{
1255 if ($extended_rsp_callback)
1256 {
1257 &$extended_rsp_callback(@_);
1258 }
1259 $extended_rsp_callback = 0;
1260}
1261
1262#----------------------------------------------------------------------
1263# 'vAttachWait' command
1264#----------------------------------------------------------------------
1265sub dump_attach_wait_command
1266{
Greg Claytoneae5e262011-05-20 02:00:47 +00001267 print "attach_wait ( ";
1268 while (@_)
1269 {
1270 printf("%c", get8(\@_))
1271 }
1272 printf " )\n";
1273
1274}
1275
1276#----------------------------------------------------------------------
Greg Claytonf1f2a152013-01-18 23:30:12 +00001277# 'vAttach' command
1278#----------------------------------------------------------------------
1279sub dump_attach_command
1280{
1281 printf("attach ( pid = %i )", get_hex(\@_));
1282 $extended_rsp_callback = \&dump_stop_reply_packet;
1283}
1284
1285#----------------------------------------------------------------------
Greg Claytoneae5e262011-05-20 02:00:47 +00001286# 'vCont' command
1287#----------------------------------------------------------------------
1288sub dump_extended_continue_cmd
1289{
Greg Claytoneae5e262011-05-20 02:00:47 +00001290 print "extended_continue ( ";
1291 my $cmd = shift;
1292 if ($cmd eq '?')
1293 {
1294 print "list supported modes )\n";
1295 $extended_rsp_callback = \&dump_extended_continue_rsp;
1296 }
1297 elsif ($cmd eq ';')
1298 {
1299 $extended_rsp_callback = \&dump_stop_reply_packet;
1300 my $i = 0;
1301 while ($#_ >= 0)
1302 {
1303 if ($i > 0)
1304 {
1305 print ", ";
1306 }
1307 my $continue_cmd = shift;
1308 my $tmp;
1309 if ($continue_cmd eq 'c')
1310 {
1311 print "continue";
1312 }
1313 elsif ($continue_cmd eq 'C')
1314 {
1315 print "continue with signal ";
1316 print shift;
1317 print shift;
1318 }
1319 elsif ($continue_cmd eq 's')
1320 {
1321 print "step";
1322 }
1323 elsif ($continue_cmd eq 'S')
1324 {
1325 print "step with signal ";
1326 print shift;
1327 print shift;
1328 }
1329
1330 if ($_[0] eq ':')
1331 {
1332 shift; # Skip ':'
1333 print " for thread ";
1334 while ($#_ >= 0)
1335 {
1336 $tmp = shift;
1337 if (length($tmp) > 0 && $tmp ne ';') {
1338 print $tmp;
1339 } else {
1340 last;
1341 }
1342 }
1343 }
1344 $i++;
1345 }
1346
1347 printf " )\n";
1348 }
1349}
1350
1351#----------------------------------------------------------------------
1352# 'vCont' response
1353#----------------------------------------------------------------------
1354sub dump_extended_continue_rsp
1355{
Greg Clayton125628c2011-06-02 22:21:38 +00001356 if (scalar(@_) == 0)
1357 {
1358 print "$unimplemented_str\n";
1359 }
1360 else
1361 {
1362 print "extended_continue supports " . join('',@_) . "\n";
1363 }
Greg Claytoneae5e262011-05-20 02:00:47 +00001364}
1365
1366#----------------------------------------------------------------------
1367# Dump the command ascii for any unknown commands
1368#----------------------------------------------------------------------
1369sub dump_other_cmd
1370{
1371 print "other = " . join('',@_) . "\n";
1372}
1373
1374#----------------------------------------------------------------------
1375# Check to see if the response was unsupported with appropriate checksum
1376#----------------------------------------------------------------------
1377sub rsp_is_unsupported
1378{
1379 return join('',@_) eq "#00";
1380}
1381
1382#----------------------------------------------------------------------
1383# Check to see if the response was "OK" with appropriate checksum
1384#----------------------------------------------------------------------
1385sub rsp_is_OK
1386{
1387 return join('',@_) eq "OK#9a";
1388}
1389
1390#----------------------------------------------------------------------
1391# Dump a response for an unknown command
1392#----------------------------------------------------------------------
1393sub dump_other_rsp
1394{
1395 print "other = " . join('',@_) . "\n";
1396}
1397
1398#----------------------------------------------------------------------
1399# Get a byte from the ascii string assuming that the 2 nibble ascii
1400# characters are in hex.
1401#
1402# The argument for this function needs to be a reference to an array
1403# that contains single character strings and the array will get
1404# updated by shifting characters off the front of it (no leading # "0x")
1405#----------------------------------------------------------------------
1406sub get8
1407{
1408 my $arrayref = shift;
1409 my $val = hex(shift(@$arrayref) . shift(@$arrayref));
1410 return $val;
1411}
1412
1413#----------------------------------------------------------------------
1414# Get a 16 bit integer and swap if $swap global is set to a non-zero
1415# value.
1416#
1417# The argument for this function needs to be a reference to an array
1418# that contains single character strings and the array will get
1419# updated by shifting characters off the front of it (no leading # "0x")
1420#----------------------------------------------------------------------
1421sub get16
1422{
1423 my $arrayref = shift;
1424 my $val = 0;
1425 if ($swap)
1426 {
1427 $val = get8($arrayref) |
1428 get8($arrayref) << 8;
1429 }
1430 else
1431 {
1432 $val = get8($arrayref) << 8 |
1433 get8($arrayref) ;
1434 }
1435 return $val;
1436}
1437
1438#----------------------------------------------------------------------
1439# Get a 32 bit integer and swap if $swap global is set to a non-zero
1440# value.
1441#
1442# The argument for this function needs to be a reference to an array
1443# that contains single character strings and the array will get
1444# updated by shifting characters off the front of it (no leading # "0x")
1445#----------------------------------------------------------------------
1446sub get32
1447{
1448 my $arrayref = shift;
1449 my $val = 0;
1450 if ($swap)
1451 {
1452 $val = get8($arrayref) |
1453 get8($arrayref) << 8 |
1454 get8($arrayref) << 16 |
1455 get8($arrayref) << 24 ;
1456 }
1457 else
1458 {
1459 $val = get8($arrayref) << 24 |
1460 get8($arrayref) << 16 |
1461 get8($arrayref) << 8 |
1462 get8($arrayref) ;
1463 }
1464 return $val;
1465}
1466
1467#----------------------------------------------------------------------
1468# Get a 64 bit hex value as a string
1469#
1470# The argument for this function needs to be a reference to an array
1471# that contains single character strings and the array will get
1472# updated by shifting characters off the front of it (no leading # "0x")
1473#----------------------------------------------------------------------
1474sub get64
1475{
1476 my $arrayref = shift;
1477 my $val = '';
1478 my @nibbles;
1479 if ($swap)
1480 {
1481 push @nibbles, splice(@$arrayref, 14, 2);
1482 push @nibbles, splice(@$arrayref, 12, 2);
1483 push @nibbles, splice(@$arrayref, 10, 2);
1484 push @nibbles, splice(@$arrayref, 8, 2);
1485 push @nibbles, splice(@$arrayref, 6, 2);
1486 push @nibbles, splice(@$arrayref, 4, 2);
1487 push @nibbles, splice(@$arrayref, 2, 2);
1488 push @nibbles, splice(@$arrayref, 0, 2);
1489 }
1490 else
1491 {
Greg Clayton1a3e9e62011-09-17 05:45:35 +00001492 (@nibbles) = splice(@$arrayref, 0, ((64/8) * 2));
Greg Claytoneae5e262011-05-20 02:00:47 +00001493 }
1494 $val = join('', @nibbles);
1495 return $val;
1496}
1497
1498#----------------------------------------------------------------------
1499# Get a 80 bit hex value as a string
1500#
1501# The argument for this function needs to be a reference to an array
1502# that contains single character strings and the array will get
1503# updated by shifting characters off the front of it (no leading # "0x")
1504#----------------------------------------------------------------------
1505sub get80
1506{
1507 my $arrayref = shift;
1508 my $val = '';
1509 my @nibbles;
1510 if ($swap)
1511 {
1512 push @nibbles, splice(@$arrayref, 18, 2);
1513 push @nibbles, splice(@$arrayref, 16, 2);
1514 push @nibbles, splice(@$arrayref, 14, 2);
1515 push @nibbles, splice(@$arrayref, 12, 2);
1516 push @nibbles, splice(@$arrayref, 10, 2);
1517 push @nibbles, splice(@$arrayref, 8, 2);
1518 push @nibbles, splice(@$arrayref, 6, 2);
1519 push @nibbles, splice(@$arrayref, 4, 2);
1520 push @nibbles, splice(@$arrayref, 2, 2);
1521 push @nibbles, splice(@$arrayref, 0, 2);
1522 }
1523 else
1524 {
Greg Clayton1a3e9e62011-09-17 05:45:35 +00001525 (@nibbles) = splice(@$arrayref, 0, ((80/8) * 2));
Greg Claytoneae5e262011-05-20 02:00:47 +00001526 }
1527 $val = join('', @nibbles);
1528 return $val;
1529}
1530
1531#----------------------------------------------------------------------
1532# Get a 96 bit hex value as a string
1533#
1534# The argument for this function needs to be a reference to an array
1535# that contains single character strings and the array will get
1536# updated by shifting characters off the front of it (no leading # "0x")
1537#----------------------------------------------------------------------
1538sub get96
1539{
1540 my $arrayref = shift;
1541 my $val = '';
1542 my @nibbles;
1543 if ($swap)
1544 {
1545 push @nibbles, splice(@$arrayref, 22, 2);
1546 push @nibbles, splice(@$arrayref, 20, 2);
1547 push @nibbles, splice(@$arrayref, 18, 2);
1548 push @nibbles, splice(@$arrayref, 16, 2);
1549 push @nibbles, splice(@$arrayref, 14, 2);
1550 push @nibbles, splice(@$arrayref, 12, 2);
1551 push @nibbles, splice(@$arrayref, 10, 2);
1552 push @nibbles, splice(@$arrayref, 8, 2);
1553 push @nibbles, splice(@$arrayref, 6, 2);
1554 push @nibbles, splice(@$arrayref, 4, 2);
1555 push @nibbles, splice(@$arrayref, 2, 2);
1556 push @nibbles, splice(@$arrayref, 0, 2);
1557 }
1558 else
1559 {
Greg Clayton1a3e9e62011-09-17 05:45:35 +00001560 (@nibbles) = splice(@$arrayref, 0, ((96/8) * 2));
Greg Claytoneae5e262011-05-20 02:00:47 +00001561 }
1562 $val = join('', @nibbles);
1563 return $val;
1564}
1565
1566#----------------------------------------------------------------------
1567# Get a 128 bit hex value as a string
1568#
1569# The argument for this function needs to be a reference to an array
1570# that contains single character strings and the array will get
1571# updated by shifting characters off the front of it (no leading # "0x")
1572#----------------------------------------------------------------------
1573sub get128
1574{
1575 my $arrayref = shift;
1576 my $val = '';
1577 my @nibbles;
1578 if ($swap)
1579 {
1580 push @nibbles, splice(@$arrayref, 30, 2);
1581 push @nibbles, splice(@$arrayref, 28, 2);
1582 push @nibbles, splice(@$arrayref, 26, 2);
1583 push @nibbles, splice(@$arrayref, 24, 2);
1584 push @nibbles, splice(@$arrayref, 22, 2);
1585 push @nibbles, splice(@$arrayref, 20, 2);
1586 push @nibbles, splice(@$arrayref, 18, 2);
1587 push @nibbles, splice(@$arrayref, 16, 2);
1588 push @nibbles, splice(@$arrayref, 14, 2);
1589 push @nibbles, splice(@$arrayref, 12, 2);
1590 push @nibbles, splice(@$arrayref, 10, 2);
1591 push @nibbles, splice(@$arrayref, 8, 2);
1592 push @nibbles, splice(@$arrayref, 6, 2);
1593 push @nibbles, splice(@$arrayref, 4, 2);
1594 push @nibbles, splice(@$arrayref, 2, 2);
1595 push @nibbles, splice(@$arrayref, 0, 2);
1596 }
1597 else
1598 {
Greg Clayton1a3e9e62011-09-17 05:45:35 +00001599 (@nibbles) = splice(@$arrayref, 0, ((128/8) * 2));
1600 }
1601 $val = join('', @nibbles);
1602 return $val;
1603}
1604
1605#----------------------------------------------------------------------
1606# Get a 256 bit hex value as a string
1607#
1608# The argument for this function needs to be a reference to an array
1609# that contains single character strings and the array will get
1610# updated by shifting characters off the front of it (no leading # "0x")
1611#----------------------------------------------------------------------
1612sub get256
1613{
1614 my $arrayref = shift;
1615 my $val = '';
1616 my @nibbles;
1617 if ($swap)
1618 {
1619 push @nibbles, splice(@$arrayref, 62, 2);
1620 push @nibbles, splice(@$arrayref, 60, 2);
1621 push @nibbles, splice(@$arrayref, 58, 2);
1622 push @nibbles, splice(@$arrayref, 56, 2);
1623 push @nibbles, splice(@$arrayref, 54, 2);
1624 push @nibbles, splice(@$arrayref, 52, 2);
1625 push @nibbles, splice(@$arrayref, 50, 2);
1626 push @nibbles, splice(@$arrayref, 48, 2);
1627 push @nibbles, splice(@$arrayref, 46, 2);
1628 push @nibbles, splice(@$arrayref, 44, 2);
1629 push @nibbles, splice(@$arrayref, 42, 2);
1630 push @nibbles, splice(@$arrayref, 40, 2);
1631 push @nibbles, splice(@$arrayref, 38, 2);
1632 push @nibbles, splice(@$arrayref, 36, 2);
1633 push @nibbles, splice(@$arrayref, 34, 2);
1634 push @nibbles, splice(@$arrayref, 32, 2);
1635 push @nibbles, splice(@$arrayref, 30, 2);
1636 push @nibbles, splice(@$arrayref, 28, 2);
1637 push @nibbles, splice(@$arrayref, 26, 2);
1638 push @nibbles, splice(@$arrayref, 24, 2);
1639 push @nibbles, splice(@$arrayref, 22, 2);
1640 push @nibbles, splice(@$arrayref, 20, 2);
1641 push @nibbles, splice(@$arrayref, 18, 2);
1642 push @nibbles, splice(@$arrayref, 16, 2);
1643 push @nibbles, splice(@$arrayref, 14, 2);
1644 push @nibbles, splice(@$arrayref, 12, 2);
1645 push @nibbles, splice(@$arrayref, 10, 2);
1646 push @nibbles, splice(@$arrayref, 8, 2);
1647 push @nibbles, splice(@$arrayref, 6, 2);
1648 push @nibbles, splice(@$arrayref, 4, 2);
1649 push @nibbles, splice(@$arrayref, 2, 2);
1650 push @nibbles, splice(@$arrayref, 0, 2);
1651 }
1652 else
1653 {
1654 (@nibbles) = splice(@$arrayref, 0, ((256/8) * 2));
Greg Claytoneae5e262011-05-20 02:00:47 +00001655 }
1656 $val = join('', @nibbles);
1657 return $val;
1658}
1659
1660#----------------------------------------------------------------------
1661# Get a an unsigned integer value by grabbing items off the front of
1662# the array stopping when a non-digit char string is encountered.
1663#
1664# The argument for this function needs to be a reference to an array
1665# that contains single character strings and the array will get
1666# updated by shifting characters off the front of it
1667#----------------------------------------------------------------------
1668sub get_uint
1669{
1670 my $arrayref = shift;
1671 @$arrayref == 0 and return 0;
1672 my $val = 0;
1673 while ($$arrayref[0] =~ /[0-9]/)
1674 {
1675 $val = $val * 10 + int(shift(@$arrayref));
1676 }
1677 return $val;
1678}
1679
1680#----------------------------------------------------------------------
1681# Check the first character in the array and if it matches the expected
1682# character, return that character, else return undef;
1683#
1684# The argument for this function needs to be a reference to an array
1685# that contains single character strings and the array will get
1686# updated by shifting characters off the front of it. If the expected
1687# character doesn't match, it won't touch the array. If the first
1688# character does match, it will shift it off and return it.
1689#----------------------------------------------------------------------
1690sub get_exptected_char
1691{
1692 my $arrayref = shift;
1693 my $expected_char = shift;
1694 if ($expected_char eq $$arrayref[0])
1695 {
1696 return shift(@$arrayref);
1697 }
1698 return undef;
1699}
1700#----------------------------------------------------------------------
1701# Get a hex value by grabbing items off the front of the array and
1702# stopping when a non-hex char string is encountered.
1703#
1704# The argument for this function needs to be a reference to an array
1705# that contains single character strings and the array will get
1706# updated by shifting characters off the front of it (no leading # "0x")
1707#----------------------------------------------------------------------
1708sub get_hex
1709{
1710 my $arrayref = shift;
1711 my $my_swap = @_ ? shift : 0;
1712 my $shift = 0;
1713 my $val = 0;
1714 while ($$arrayref[0] =~ /[0-9a-fA-F]/)
1715 {
1716 if ($my_swap)
1717 {
1718 my $byte = hex(shift(@$arrayref)) << 4 | hex(shift(@$arrayref));
1719 $val |= $byte << $shift;
1720 $shift += 8;
1721 }
1722 else
1723 {
1724 $val <<= 4;
1725 $val |= hex(shift(@$arrayref));
1726 }
1727 }
1728 return $val;
1729}
1730
1731#----------------------------------------------------------------------
1732# Get an address value by grabbing items off the front of the array.
1733#
1734# The argument for this function needs to be a reference to an array
1735# that contains single character strings and the array will get
1736# updated by shifting characters off the front of it (no leading # "0x")
1737#----------------------------------------------------------------------
1738sub get_addr
1739{
1740 get_hex(shift);
1741}
1742
Greg Clayton125628c2011-06-02 22:21:38 +00001743sub get_hex_string
1744{
1745 my $arrayref = shift;
1746 my $str = '';
1747 while ($$arrayref[0] =~ /[0-9a-fA-F]/ and $$arrayref[1] =~ /[0-9a-fA-F]/)
1748 {
1749 my $hi_nibble = hex(shift(@$arrayref));
1750 my $lo_nibble = hex(shift(@$arrayref));
1751 my $byte = ($hi_nibble << 4) | $lo_nibble;
1752 $str .= chr($byte);
1753 }
1754 return $str;
1755}
1756
Greg Claytoneae5e262011-05-20 02:00:47 +00001757sub dump_stop_reply_data
1758{
1759 while ($#_ >= 0)
1760 {
1761 last unless ($_[0] ne '#');
1762
1763
1764 my $key = '';
1765 my $value = '';
Greg Clayton5df5dda2012-05-16 20:49:54 +00001766 my $comment = '';
Greg Claytoneae5e262011-05-20 02:00:47 +00001767 if ($_[0] =~ /[0-9a-fA-F]/ && $_[1] =~ /[0-9a-fA-F]/)
1768 {
1769 my $reg_num = get8(\@_);
1770 shift(@_); # Skip ':'
1771 if (defined ($registers_aref) && $reg_num < @$registers_aref)
1772 {
1773 dump_register_value(1, \@_, $reg_num);
1774 print "\n";
1775 shift(@_); # Skip ';'
1776 next;
1777 }
1778 $key = sprintf("reg %u", $reg_num);
1779 }
1780 my $char;
1781
1782 if (length($key) == 0)
1783 {
1784 while (1)
1785 {
1786 $char = shift(@_);
1787 if (length($char) == 0 or $char eq ':' or $char eq '#') { last; }
1788 $key .= $char;
1789 }
1790 }
1791
1792 while (1)
1793 {
1794 $char = shift(@_);
1795 if (length($char) == 0 or $char eq ';' or $char eq '#') { last; }
1796 $value .= $char;
1797 }
Greg Clayton5df5dda2012-05-16 20:49:54 +00001798 if ($key eq 'metype')
1799 {
1800 our %metype_to_name = (
1801 '1' => ' (EXC_BAD_ACCESS)',
1802 '2' => ' (EXC_BAD_INSTRUCTION)',
1803 '3' => ' (EXC_ARITHMETIC)',
1804 '4' => ' (EXC_EMULATION)',
1805 '5' => ' (EXC_SOFTWARE)',
1806 '6' => ' (EXC_BREAKPOINT)',
1807 '7' => ' (EXC_SYSCALL)',
1808 '8' => ' (EXC_MACH_SYSCALL)',
1809 '9' => ' (EXC_RPC_ALERT)',
1810 '10' => ' (EXC_CRASH)'
1811 );
1812 if (exists $metype_to_name{$value})
1813 {
1814 $comment = $metype_to_name{$value};
1815 }
1816 }
1817 printf("\t%*s = %s$comment\n", $max_register_name_len, $key, $value);
Greg Claytoneae5e262011-05-20 02:00:47 +00001818 }
1819}
1820
1821#----------------------------------------------------------------------
1822# Dumps a Stop Reply Packet which happens in response to a step,
1823# continue, last signal, and probably a few other commands.
1824#----------------------------------------------------------------------
1825sub dump_stop_reply_packet
1826{
1827 my $what = shift(@_);
Greg Clayton5df5dda2012-05-16 20:49:54 +00001828 if ($what eq 'S' or $what eq 'T')
Greg Claytoneae5e262011-05-20 02:00:47 +00001829 {
Greg Clayton5df5dda2012-05-16 20:49:54 +00001830 my $signo = get8(\@_);
1831
1832 our %signo_to_name = (
1833 '1' => ' SIGHUP',
1834 '2' => ' SIGINT',
1835 '3' => ' SIGQUIT',
1836 '4' => ' SIGILL',
1837 '5' => ' SIGTRAP',
1838 '6' => ' SIGABRT',
1839 '7' => ' SIGPOLL/SIGEMT',
1840 '8' => ' SIGFPE',
1841 '9' => ' SIGKILL',
1842 '10' => ' SIGBUS',
1843 '11' => ' SIGSEGV',
1844 '12' => ' SIGSYS',
1845 '13' => ' SIGPIPE',
1846 '14' => ' SIGALRM',
1847 '15' => ' SIGTERM',
1848 '16' => ' SIGURG',
1849 '17' => ' SIGSTOP',
1850 '18' => ' SIGTSTP',
1851 '19' => ' SIGCONT',
1852 '20' => ' SIGCHLD',
1853 '21' => ' SIGTTIN',
1854 '22' => ' SIGTTOU',
1855 '23' => ' SIGIO',
1856 '24' => ' SIGXCPU',
1857 '25' => ' SIGXFSZ',
1858 '26' => ' SIGVTALRM',
1859 '27' => ' SIGPROF',
1860 '28' => ' SIGWINCH',
1861 '29' => ' SIGINFO',
1862 '30' => ' SIGUSR1',
1863 '31' => ' SIGUSR2',
1864 '145' => ' TARGET_EXC_BAD_ACCESS', # 0x91
1865 '146' => ' TARGET_EXC_BAD_INSTRUCTION', # 0x92
1866 '147' => ' TARGET_EXC_ARITHMETIC', # 0x93
1867 '148' => ' TARGET_EXC_EMULATION', # 0x94
1868 '149' => ' TARGET_EXC_SOFTWARE', # 0x95
1869 '150' => ' TARGET_EXC_BREAKPOINT' # 0x96
1870 );
1871 my $signo_str = sprintf("%i", $signo);
1872 my $signo_name = '';
1873 if (exists $signo_to_name{$signo_str})
1874 {
1875 $signo_name = $signo_to_name{$signo_str};
1876 }
1877 printf ("signal (signo=%u$signo_name)\n", $signo);
Greg Claytoneae5e262011-05-20 02:00:47 +00001878 dump_stop_reply_data (@_);
1879 }
1880 elsif ($what eq 'W')
1881 {
1882 print 'process_exited( ' . shift(@_) . shift(@_) . " )\n";
1883 }
1884 elsif ($what eq 'X')
1885 {
1886 print 'process_terminated( ' . shift(@_) . shift(@_) . " )\n";
1887 }
1888 elsif ($what eq 'O')
1889 {
1890 my $console_output = '';
1891 my $num_hex8_bytes = @_/2;
1892 for (1 .. $num_hex8_bytes)
1893 {
1894 $console_output .= sprintf("%c", get8(\@_))
1895 }
1896
1897 print "program_console_output('$console_output')\n";
1898 }
1899}
1900
1901#----------------------------------------------------------------------
1902# '?' command
1903#----------------------------------------------------------------------
1904sub dump_last_signal_cmd
1905{
1906 my $cmd = shift;
1907 print 'last_signal (' . join('',@_) . ")\n";
1908}
1909
1910sub dump_raw_command
1911{
1912 my $cmd_aref = shift;
1913 my $callback_ref;
1914 $curr_cmd = $$cmd_aref[0];
Greg Clayton42721642012-01-25 21:52:15 +00001915
1916 if ($curr_cmd eq 'q' or $curr_cmd eq 'Q' or $curr_cmd eq '_')
1917 {
1918 $curr_full_cmd = '';
1919 foreach my $ch (@$cmd_aref)
1920 {
1921 $ch !~ /[A-Za-z_]/ and last;
1922 $curr_full_cmd .= $ch;
1923 }
1924 }
1925 else
1926 {
1927 $curr_full_cmd = $curr_cmd;
1928 }
1929
1930 $curr_cmd eq '_' and $curr_cmd .= $$cmd_aref[1];
Greg Claytoneae5e262011-05-20 02:00:47 +00001931 $callback_ref = $cmd_callbacks{$curr_cmd};
1932 if ($callback_ref)
1933 {
1934 &$callback_ref(@$cmd_aref);
1935 }
1936 else
1937 {
1938 # Strip the command byte for responses since we injected that above
1939 dump_other_cmd(@$cmd_aref);
1940 }
1941}
1942
1943sub dump_standard_response
1944{
1945 my $cmd_aref = shift;
1946
Greg Clayton125628c2011-06-02 22:21:38 +00001947 my $cmd_len = scalar(@$cmd_aref);
1948 if ($cmd_len == 0)
Greg Claytoneae5e262011-05-20 02:00:47 +00001949 {
Greg Clayton125628c2011-06-02 22:21:38 +00001950 print "$unimplemented_str\n";
Greg Claytoneae5e262011-05-20 02:00:47 +00001951 return 1;
1952 }
1953
1954 my $response = join('', @$cmd_aref);
1955 if ($response eq 'OK')
1956 {
1957 print "$success_str\n";
1958 return 1;
1959 }
1960
Greg Clayton125628c2011-06-02 22:21:38 +00001961 if ($cmd_len == 3 and index($response, 'E') == 0)
Greg Claytoneae5e262011-05-20 02:00:47 +00001962 {
1963 print "ERROR: " . substr($response, 1) . "\n";
1964 return 1;
1965 }
1966
1967 return 0;
1968}
1969sub dump_raw_response
1970{
1971 my $cmd_aref = shift;
1972 my $callback_ref;
1973
Greg Clayton42721642012-01-25 21:52:15 +00001974 if ($packet_start_time != 0.0)
1975 {
1976 if (length($curr_full_cmd) > 0)
1977 {
1978 $packet_times{$curr_full_cmd} += $curr_time - $packet_start_time;
1979 }
1980 else
1981 {
1982 $packet_times{$curr_cmd} += $curr_time - $packet_start_time;
1983 }
1984 $packet_start_time = 0.0;
1985 }
1986
Greg Claytoneae5e262011-05-20 02:00:47 +00001987 $callback_ref = $rsp_callbacks{$curr_cmd};
1988
1989 if ($callback_ref)
1990 {
1991 &$callback_ref(@$cmd_aref);
1992 }
1993 else
1994 {
1995 dump_standard_response($cmd_aref) or dump_other_rsp(@$cmd_aref);
1996 }
1997
1998}
1999#----------------------------------------------------------------------
2000# Dumps any command and handles simple error checking on the responses
2001# for commands that are unsupported or OK.
2002#----------------------------------------------------------------------
2003sub dump_command
2004{
2005 my $cmd_str = shift;
2006
2007 # Dump the original command string if verbose is on
2008 if ($opt_v)
2009 {
2010 print "dump_command($cmd_str)\n ";
2011 }
2012
2013 my @cmd_chars = extract_command($cmd_str);
2014 my $is_cmd = 1;
2015
2016 my $cmd = $cmd_chars[0];
2017 if ($cmd eq '$')
2018 {
2019 $is_cmd = 0; # Note that this is a reply
2020 $cmd = $curr_cmd; # set the command byte appropriately
2021 shift @cmd_chars; # remove the '$' from the cmd bytes
2022 }
2023
2024 # Check for common responses across all commands and handle them
2025 # if we can
2026 if ( $is_cmd == 0 )
2027 {
2028 if (rsp_is_unsupported(@cmd_chars))
2029 {
Greg Clayton125628c2011-06-02 22:21:38 +00002030 print "$unimplemented_str\n";
Greg Claytoneae5e262011-05-20 02:00:47 +00002031 return;
2032 }
2033 elsif (rsp_is_OK(@cmd_chars))
2034 {
2035 print "$success_str\n";
2036 return;
2037 }
2038 # Strip the checksum information for responses
2039 strip_checksum(\@cmd_chars);
2040 }
2041
2042 my $callback_ref;
2043 if ($is_cmd) {
2044 $callback_ref = $cmd_callbacks{$cmd};
2045 } else {
2046 $callback_ref = $rsp_callbacks{$cmd};
2047 }
2048
2049 if ($callback_ref)
2050 {
2051 &$callback_ref(@cmd_chars);
2052 }
2053 else
2054 {
2055 # Strip the command byte for responses since we injected that above
2056 if ($is_cmd) {
2057 dump_other_cmd(@cmd_chars);
2058 } else {
2059 dump_other_rsp(@cmd_chars);
2060 }
2061
2062 }
2063}
2064
2065
2066#----------------------------------------------------------------------
2067# Process a gdbserver log line by looking for getpkt and putkpt and
2068# tossing any other lines.
Greg Clayton42721642012-01-25 21:52:15 +00002069
Greg Claytoneae5e262011-05-20 02:00:47 +00002070#----------------------------------------------------------------------
2071sub process_log_line
2072{
2073 my $line = shift;
2074 #($opt_v and $opt_g) and print "# $line";
Greg Clayton42721642012-01-25 21:52:15 +00002075
Greg Claytoneae5e262011-05-20 02:00:47 +00002076 my $extract_cmd = 0;
Greg Clayton42721642012-01-25 21:52:15 +00002077 my $delta_time = 0.0;
2078 if ($line =~ /^(\s*)([1-9][0-9]+\.[0-9]+)([^0-9].*)$/)
2079 {
2080 my $leading_space = $1;
2081 $curr_time = $2;
2082 $line = $3;
2083 if ($base_time == 0.0)
2084 {
2085 $base_time = $curr_time;
2086 }
2087 else
2088 {
2089 $delta_time = $curr_time - $last_time;
2090 }
2091 printf ("(%.6f, %+.6f): ", $curr_time - $base_time, $delta_time);
2092 $last_time = $curr_time;
2093 }
2094 else
2095 {
2096 $curr_time = 0.0
2097 }
2098
Greg Claytoneae5e262011-05-20 02:00:47 +00002099 if ($line =~ /getpkt /)
2100 {
2101 $extract_cmd = 1;
2102 print "\n--> ";
Greg Clayton42721642012-01-25 21:52:15 +00002103 $packet_start_time = $curr_time;
Greg Claytoneae5e262011-05-20 02:00:47 +00002104 }
2105 elsif ($line =~ /putpkt /)
2106 {
2107 $extract_cmd = 1;
2108 print "<-- ";
2109 }
2110 elsif ($line =~ /.*Sent: \[[0-9]+\.[0-9]+[:0-9]*\] (.*)/)
2111 {
2112 $opt_g and print "maintenance dump-packets command: $1\n";
2113 my @raw_cmd_bytes = split(/ */, $1);
Greg Clayton42721642012-01-25 21:52:15 +00002114 $packet_start_time = $curr_time;
Greg Claytoneae5e262011-05-20 02:00:47 +00002115 print "\n--> ";
2116 dump_raw_command(\@raw_cmd_bytes);
2117 process_log_line($2);
2118 }
2119 elsif ($line =~ /.*Recvd: \[[0-9]+\.[0-9]+[:0-9]*\] (.*)/)
2120 {
2121 $opt_g and print "maintenance dump-packets reply: $1\n";
2122 my @raw_rsp_bytes = split(/ */, $1);
2123 print "<-- ";
2124 dump_raw_response(\@raw_rsp_bytes);
2125 print "\n";
2126 }
2127 elsif ($line =~ /getpkt: (.*)/)
2128 {
2129 if ($1 =~ /\$([^#]+)#[0-9a-fA-F]{2}/)
2130 {
2131 $opt_g and print "command: $1\n";
2132 my @raw_cmd_bytes = split(/ */, $1);
2133 print "--> ";
Greg Clayton42721642012-01-25 21:52:15 +00002134 $packet_start_time = $curr_time;
Greg Claytoneae5e262011-05-20 02:00:47 +00002135 dump_raw_command(\@raw_cmd_bytes);
2136 }
2137 elsif ($1 =~ /\+/)
2138 {
2139 #print "--> ACK\n";
2140 }
2141 elsif ($1 =~ /-/)
2142 {
2143 #print "--> NACK\n";
2144 }
2145 }
2146 elsif ($line =~ /putpkt: (.*)/)
2147 {
2148 if ($1 =~ /\$([^#]+)#[0-9a-fA-F]{2}/)
2149 {
2150 $opt_g and print "response: $1\n";
2151 my @raw_rsp_bytes = split(/ */, $1);
2152 print "<-- ";
2153 dump_raw_response(\@raw_rsp_bytes);
2154 print "\n";
2155 }
2156 elsif ($1 =~ /\+/)
2157 {
2158 #print "<-- ACK\n";
2159 }
2160 elsif ($1 =~ /-/)
2161 {
2162 #print "<-- NACK\n";
2163 }
2164 }
2165 elsif ($line =~ /send packet: (.*)/)
2166 {
2167 if ($1 =~ /\$([^#]+)#[0-9a-fA-F]{2}/)
2168 {
2169 $opt_g and print "command: $1\n";
2170 my @raw_cmd_bytes = split(/ */, $1);
2171 print "--> ";
Greg Clayton42721642012-01-25 21:52:15 +00002172 $packet_start_time = $curr_time;
Greg Claytoneae5e262011-05-20 02:00:47 +00002173 dump_raw_command(\@raw_cmd_bytes);
2174 }
2175 elsif ($1 =~ /\+/)
2176 {
2177 #print "--> ACK\n";
2178 }
2179 elsif ($1 =~ /-/)
2180 {
2181 #print "--> NACK\n";
2182 }
2183 }
2184 elsif ($line =~ /read packet: (.*)/)
2185 {
Greg Clayton125628c2011-06-02 22:21:38 +00002186 if ($1 =~ /\$([^#]*)#[0-9a-fA-F]{2}/)
Greg Claytoneae5e262011-05-20 02:00:47 +00002187 {
2188 $opt_g and print "response: $1\n";
2189 my @raw_rsp_bytes = split(/ */, $1);
2190 print "<-- ";
2191 dump_raw_response(\@raw_rsp_bytes);
2192 print "\n";
2193 }
2194 elsif ($1 =~ /\+/)
2195 {
2196 #print "<-- ACK\n";
2197 }
2198 elsif ($1 =~ /-/)
2199 {
2200 #print "<-- NACK\n";
2201 }
2202 }
2203 elsif ($line =~ /Sending packet: \$([^#]+)#[0-9a-fA-F]{2}\.\.\.(.*)/)
2204 {
2205 $opt_g and print "command: $1\n";
2206 my @raw_cmd_bytes = split(/ */, $1);
2207 print "\n--> ";
Greg Clayton42721642012-01-25 21:52:15 +00002208 $packet_start_time = $curr_time;
Greg Claytoneae5e262011-05-20 02:00:47 +00002209 dump_raw_command(\@raw_cmd_bytes);
2210 process_log_line($2);
2211 }
2212 elsif ($line =~ /Packet received: (.*)/)
2213 {
2214 $opt_g and print "response: $1\n";
2215 my @raw_rsp_bytes = split(/ */, $1);
2216 print "<-- ";
2217 dump_raw_response(\@raw_rsp_bytes);
2218 print "\n";
2219 }
2220
2221 if ($extract_cmd)
2222 {
2223 my $beg = index($line, '("') + 2;
2224 my $end = rindex($line, '");');
Greg Clayton42721642012-01-25 21:52:15 +00002225 $packet_start_time = $curr_time;
Greg Claytoneae5e262011-05-20 02:00:47 +00002226 dump_command(substr($line, $beg, $end - $beg));
2227 }
2228}
2229
2230
2231our $line_num = 0;
2232while(<>)
2233{
2234 $line_num++;
2235 $opt_q or printf("# %5d: $_", $line_num);
2236 process_log_line($_);
2237}
2238
Greg Clayton42721642012-01-25 21:52:15 +00002239if (%packet_times)
2240{
2241 print "----------------------------------------------------------------------\n";
2242 print "Packet timing summary:\n";
2243 print "----------------------------------------------------------------------\n";
2244 print "Packet Time %\n";
2245 print "---------------------- -------- ------\n";
2246 my @packet_names = keys %packet_times;
2247 my $total_packet_times = 0.0;
2248 foreach my $key (@packet_names)
2249 {
2250 $total_packet_times += $packet_times{$key};
2251 }
2252
2253 foreach my $value (sort {$packet_times{$b} cmp $packet_times{$a}} @packet_names)
2254 {
2255 my $percent = ($packet_times{$value} / $total_packet_times) * 100.0;
2256 if ($percent < 10.0)
2257 {
2258 printf("%22s %1.6f %2.2f\n", $value, $packet_times{$value}, $percent);
2259
2260 }
2261 else
2262 {
2263 printf("%22s %1.6f %2.2f\n", $value, $packet_times{$value}, $percent);
2264 }
2265 }
2266 print "---------------------- -------- ------\n";
2267 printf (" Total %1.6f 100.00\n", $total_packet_times);
2268}
2269
2270
Greg Claytoneae5e262011-05-20 02:00:47 +00002271
2272
2273
2274
2275