5 #----------------------------------------------------------------------
7 #----------------------------------------------------------------------
8 our $unimplemented_str = "UNIMPLEMENTED";
9 our $success_str = "OK";
12 our $thread_suffix_supported = 0;
13 our $max_bytes_per_line = 32;
14 our $addr_format = sprintf("0x%%%u.%ux", $addr_size*2, $addr_size*2);
15 our $pid_format = "%04.4x";
16 our $tid_format = "%04.4x";
17 our $reg8_href = { extract
=> \
&get8
, format
=> "0x%2.2x" };
18 our $reg16_href = { extract
=> \
&get16
, format
=> "0x%4.4x" };
19 our $reg32_href = { extract
=> \
&get32
, format
=> "0x%8.8x" };
20 our $reg64_href = { extract
=> \
&get64
, format
=> "0x%s" };
21 our $reg80_href = { extract
=> \
&get80
, format
=> "0x%s" };
22 our $reg128_href = { extract
=> \
&get128
, format
=> "0x%s" };
23 our $reg256_href = { extract
=> \
&get256
, format
=> "0x%s" };
24 our $float32_href = { extract
=> \
&get32
, format
=> "0x%8.8x" };
25 our $float64_href = { extract
=> \
&get64
, format
=> "0x%s" };
26 our $float96_href = { extract
=> \
&get96
, format
=> "0x%s" };
27 our $curr_cmd = undef;
28 our $curr_full_cmd = undef;
33 our $packet_start_time = 0.0;
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 },
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 },
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 },
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 },
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 },
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 },
425 our $max_register_name_len = 0;
426 calculate_max_register_name_length
();
427 our @point_types = ( "software_bp", "hardware_bp", "write_wp", "read_wp", "access_wp" );
428 our $opt_v = 0; # verbose
429 our $opt_g = 0; # debug
430 our $opt_q = 0; # quiet
435 our $registers_aref = undef;
439 if (exists $reg_map{$opt_r})
441 $registers_aref = $reg_map{$opt_r};
445 die "Can't get registers group for '$opt_r'\n";
449 sub extract_key_value_pairs
452 my $arrayref = shift;
453 my $str = join('',@
$arrayref);
454 my @kv_strs = split(/;/, $str);
455 foreach my $kv_str (@kv_strs)
457 my ($key, $value) = split(/:/, $kv_str);
458 $kv_href->{$key} = $value;
463 sub get_thread_from_thread_suffix
465 if ($thread_suffix_supported)
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
})
473 return $thread_href->{thread
};
479 sub calculate_max_register_name_length
481 $max_register_name_len = 7;
482 foreach my $reg_href (@
$registers_aref)
484 my $name_len = length($reg_href->{name
});
485 if ($max_register_name_len < $name_len)
487 $max_register_name_len = $name_len;
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 #----------------------------------------------------------------------
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
,
515 's' => \
&dump_continue_cmd
,
516 'C' => \
&dump_continue_with_signal_cmd
,
517 'S' => \
&dump_continue_with_signal_cmd
,
518 '_M' => \
&dump_allocate_memory_cmd
,
519 '_m' => \
&dump_deallocate_memory_cmd
,
521 'v' => \
&dump_extended_cmd
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 #----------------------------------------------------------------------
531 'c' => \
&dump_stop_reply_packet
,
532 's' => \
&dump_stop_reply_packet
,
533 '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
,
544 'v' => \
&dump_extended_rsp
,
548 sub dump_register_value
551 my $arrayref = shift;
554 if ($reg_num >= @
$registers_aref)
556 printf("\tinvalid register index %d\n", $reg_num);
560 my $reg_href = $$registers_aref[$reg_num];
561 my $reg_name = $reg_href->{name
};
562 if ($$arrayref[0] eq '#')
564 printf("\t%*s: error: EOS reached when trying to read register %d\n", $max_register_name_len, $reg_name, $reg_num);
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);
572 printf("\t%*s = $reg_format", $max_register_name_len, $reg_name, $reg_val);
574 printf("%s = $reg_format", $reg_name, $reg_val);
578 #----------------------------------------------------------------------
579 # Extract the command into an array of ASCII char strings for easy
581 #----------------------------------------------------------------------
585 my @cmd_chars = split(/ */, $cmd_str);
586 if ($cmd_chars[0] ne '$')
588 # only set the current command if it isn't a reply
589 $curr_cmd = $cmd_chars[0];
594 #----------------------------------------------------------------------
595 # Strip the 3 checksum array entries after we don't need them anymore
596 #----------------------------------------------------------------------
599 my $arrayref = shift;
600 splice(@
$arrayref, -3);
603 #----------------------------------------------------------------------
604 # Dump all strings in array by joining them together with no space
606 #----------------------------------------------------------------------
612 #----------------------------------------------------------------------
613 # Check if the response is an error 'EXX'
614 #----------------------------------------------------------------------
615 sub is_error_response
620 print "ERROR = " . join('',@_) . "\n";
626 #----------------------------------------------------------------------
628 #----------------------------------------------------------------------
629 sub dump_set_thread_cmd
633 print "set_thread ( $mod, " . join('',@_) . " )\n";
636 #----------------------------------------------------------------------
638 #----------------------------------------------------------------------
640 sub dump_thread_is_alive_cmd
643 $T_cmd_tid = get_hex
(\
@_);
644 printf("thread_is_alive ( $tid_format )\n", $T_cmd_tid);
647 sub dump_thread_is_alive_rsp
649 my $rsp = join('',@_);
651 printf("thread_is_alive ( $tid_format ) =>", $T_cmd_tid);
662 #----------------------------------------------------------------------
664 #----------------------------------------------------------------------
665 sub dump_set_thread_rsp
667 if (!is_error_response
(@_))
669 print join('',@_) . "\n";
673 #----------------------------------------------------------------------
675 #----------------------------------------------------------------------
677 our $qRegisterInfo_reg_num = -1;
678 sub dump_general_query_cmd
680 $gen_query_cmd = join('',@_);
681 if ($gen_query_cmd eq 'qC')
683 print 'get_current_pid ()';
685 elsif ($gen_query_cmd eq 'qfThreadInfo')
687 print 'get_first_active_threads ()';
689 elsif ($gen_query_cmd eq 'qsThreadInfo')
691 print 'get_subsequent_active_threads ()';
693 elsif (index($gen_query_cmd, 'qThreadExtraInfo') == 0)
695 # qThreadExtraInfo,id
696 print 'get_thread_extra_info ()';
698 elsif (index($gen_query_cmd, 'qThreadStopInfo') == 0)
700 # qThreadStopInfoXXXX
701 @_ = splice(@_, length('qThreadStopInfo'));
702 my $tid = get_addr
(\
@_);
703 printf('get_thread_stop_info ( thread = 0x%4.4x )', $tid);
705 elsif (index($gen_query_cmd, 'qSymbol:') == 0)
708 print 'gdb_ready_to_serve_symbol_lookups ()';
710 elsif (index($gen_query_cmd, 'qCRC:') == 0)
713 @_ = splice(@_, length('qCRC:'));
714 my $address = get_addr
(\
@_);
716 my $length = join('', @_);
717 printf("compute_crc (addr = $addr_format, length = $length)", $address);
719 elsif (index($gen_query_cmd, 'qGetTLSAddr:') == 0)
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)";
726 elsif ($gen_query_cmd eq 'qOffsets')
728 print 'get_section_offsets ()';
730 elsif (index($gen_query_cmd, 'qRegisterInfo') == 0)
732 @_ = splice(@_, length('qRegisterInfo'));
733 $qRegisterInfo_reg_num = get_hex
(\
@_);
735 printf "get_dynamic_register_info ($qRegisterInfo_reg_num)";
739 print $gen_query_cmd;
744 #----------------------------------------------------------------------
746 #----------------------------------------------------------------------
747 sub dump_general_query_rsp
749 my $gen_query_rsp = join('',@_);
750 my $gen_query_rsp_len = length ($gen_query_rsp);
751 if ($gen_query_cmd eq 'qC' and index($gen_query_rsp, 'QC') == 0)
754 my $pid = get_hex
(\
@_);
755 printf("pid = $pid_format\n", $pid);
758 elsif (index($gen_query_cmd, 'qRegisterInfo') == 0)
760 if ($gen_query_rsp_len == 0)
762 print "$unimplemented_str\n";
766 if (index($gen_query_rsp, 'name') == 0)
768 $qRegisterInfo_reg_num == 0 and $registers_aref = [];
770 my @name_and_values = split (/;/, $gen_query_rsp);
772 my $reg_name = undef;
775 foreach (@name_and_values)
777 my ($name, $value) = split /:/;
778 if ($name eq "name") { $reg_name = $value; }
779 elsif ($name eq "bitsize") { $byte_size = $value / 8; }
780 elsif ($name eq "container-regs") { $pseudo = 1; }
782 if (defined $reg_name and $byte_size > 0)
784 if ($byte_size == 4) {push @
$registers_aref, { name
=> $reg_name, info
=> $reg32_href , pseudo
=> $pseudo };}
785 elsif ($byte_size == 8) {push @
$registers_aref, { name
=> $reg_name, info
=> $reg64_href , pseudo
=> $pseudo };}
786 elsif ($byte_size == 1) {push @
$registers_aref, { name
=> $reg_name, info
=> $reg8_href , pseudo
=> $pseudo };}
787 elsif ($byte_size == 2) {push @
$registers_aref, { name
=> $reg_name, info
=> $reg16_href , pseudo
=> $pseudo };}
788 elsif ($byte_size == 10) {push @
$registers_aref, { name
=> $reg_name, info
=> $reg80_href , pseudo
=> $pseudo };}
789 elsif ($byte_size == 12) {push @
$registers_aref, { name
=> $reg_name, info
=> $float96_href , pseudo
=> $pseudo };}
790 elsif ($byte_size == 16) {push @
$registers_aref, { name
=> $reg_name, info
=> $reg128_href , pseudo
=> $pseudo };}
791 elsif ($byte_size == 32) {push @
$registers_aref, { name
=> $reg_name, info
=> $reg256_href , pseudo
=> $pseudo };}
794 elsif ($gen_query_rsp_len == 3 and index($gen_query_rsp, 'E') == 0)
796 calculate_max_register_name_length
();
800 elsif ($gen_query_cmd =~ 'qThreadStopInfo')
802 dump_stop_reply_packet
(@_);
804 if (dump_standard_response
(\
@_))
810 print join('',@_) . "\n";
814 #----------------------------------------------------------------------
816 #----------------------------------------------------------------------
818 sub dump_general_set_cmd
820 $gen_query_cmd = join('',@_);
821 if ($gen_query_cmd eq 'QStartNoAckMode')
823 print "StartNoAckMode ()"
825 elsif ($gen_query_cmd eq 'QThreadSuffixSupported')
827 $thread_suffix_supported = 1;
828 print "ThreadSuffixSupported ()"
830 elsif (index($gen_query_cmd, 'QSetMaxPayloadSize:') == 0)
832 @_ = splice(@_, length('QSetMaxPayloadSize:'));
833 my $max_payload_size = get_hex
(\
@_);
834 # QSetMaxPayloadSize:XXXX where XXXX is a hex length of the max
835 # packet payload size supported by gdb
836 printf("SetMaxPayloadSize ( 0x%x (%u))", $max_payload_size, $max_payload_size);
838 elsif (index ($gen_query_cmd, 'QSetSTDIN:') == 0)
840 @_ = splice(@_, length('QSetSTDIN:'));
841 printf ("SetSTDIN (path ='%s')\n", get_hex_string
(\
@_));
843 elsif (index ($gen_query_cmd, 'QSetSTDOUT:') == 0)
845 @_ = splice(@_, length('QSetSTDOUT:'));
846 printf ("SetSTDOUT (path ='%s')\n", get_hex_string
(\
@_));
848 elsif (index ($gen_query_cmd, 'QSetSTDERR:') == 0)
850 @_ = splice(@_, length('QSetSTDERR:'));
851 printf ("SetSTDERR (path ='%s')\n", get_hex_string
(\
@_));
855 print $gen_query_cmd;
860 #----------------------------------------------------------------------
862 #----------------------------------------------------------------------
866 print "kill (" . join('',@_) . ")\n";
869 #----------------------------------------------------------------------
871 #----------------------------------------------------------------------
872 sub dump_read_regs_cmd
875 print "read_registers ()\n";
878 #----------------------------------------------------------------------
880 #----------------------------------------------------------------------
881 sub dump_write_regs_cmd
883 print "write_registers:\n";
885 foreach my $reg_href (@
$registers_aref)
887 last if ($_[0] eq '#');
888 if ($reg_href->{pseudo
} == 0)
890 my $reg_info_href = $reg_href->{info
};
891 my $reg_name = $reg_href->{name
};
892 my $reg_extract = $reg_info_href->{extract
};
893 my $reg_format = $reg_info_href->{format
};
894 my $reg_val = &$reg_extract(\
@_);
895 printf("\t%*s = $reg_format\n", $max_register_name_len, $reg_name, $reg_val);
900 sub dump_read_regs_rsp
902 print "read_registers () =>\n";
903 if (!is_error_response
(@_))
905 # print join('',@_) . "\n";
906 foreach my $reg_href (@
$registers_aref)
908 last if ($_[0] eq '#');
909 if ($reg_href->{pseudo
} == 0)
911 my $reg_info_href = $reg_href->{info
};
912 my $reg_name = $reg_href->{name
};
913 my $reg_extract = $reg_info_href->{extract
};
914 my $reg_format = $reg_info_href->{format
};
915 my $reg_val = &$reg_extract(\
@_);
916 printf("\t%*s = $reg_format\n", $max_register_name_len, $reg_name, $reg_val);
922 sub dump_read_single_register_rsp
924 dump_register_value
(0, \
@_, $reg_cmd_reg);
928 #----------------------------------------------------------------------
929 # '_M' - allocate memory command (LLDB extension)
932 # Arg1: Hex byte size as big endian hex string
934 # Arg2: permissions as string that must be a string that contains any
935 # combination of 'r' (readable) 'w' (writable) or 'x' (executable)
937 # Returns: The address that was allocated as a big endian hex string
938 # on success, else an error "EXX" where XX are hex bytes
939 # that indicate an error code.
942 # _M10,rw # allocate 16 bytes with read + write permissions
943 # _M100,rx # allocate 256 bytes with read + execute permissions
944 #----------------------------------------------------------------------
945 sub dump_allocate_memory_cmd
947 shift; shift; # shift off the '_' and the 'M'
948 my $byte_size = get_addr
(\
@_);
950 printf("allocate_memory ( byte_size = %u (0x%x), permissions = %s)\n", $byte_size, $byte_size, join('',@_));
953 sub dump_allocate_memory_rsp
955 if (@_ == 3 and $_[0] == 'E')
957 printf("allocated memory addr = ERROR (%s))\n", join('',@_));
961 printf("allocated memory addr = 0x%s\n", join('',@_));
965 #----------------------------------------------------------------------
966 # '_m' - deallocate memory command (LLDB extension)
969 # Arg1: Hex address as big endian hex string
971 # Returns: "OK" on success "EXX" on error
974 # _m201000 # Free previously allocated memory at address 0x201000
975 #----------------------------------------------------------------------
976 sub dump_deallocate_memory_cmd
978 shift; shift; # shift off the '_' and the 'm'
979 printf("deallocate_memory ( addr = 0x%s)\n", join('',@_));
983 #----------------------------------------------------------------------
985 #----------------------------------------------------------------------
986 sub dump_read_single_register_cmd
989 $reg_cmd_reg = get_hex
(\
@_);
990 my $thread = get_thread_from_thread_suffix
(\
@_);
991 my $reg_href = $$registers_aref[$reg_cmd_reg];
995 print "read_register ( reg = \"$reg_href->{name}\", thread = $thread )\n";
999 print "read_register ( reg = \"$reg_href->{name}\" )\n";
1004 #----------------------------------------------------------------------
1006 #----------------------------------------------------------------------
1007 sub dump_write_single_register_cmd
1010 my $reg_num = get_hex
(\
@_);
1011 shift (@_); # Discard the '='
1013 print "write_register ( ";
1014 dump_register_value
(0, \
@_, $reg_num);
1015 my $thread = get_thread_from_thread_suffix
(\
@_);
1016 if (defined $thread)
1018 print ", thread = $thread";
1023 #----------------------------------------------------------------------
1025 #----------------------------------------------------------------------
1026 our $read_mem_address = 0;
1027 sub dump_read_mem_cmd
1030 $read_mem_address = get_addr
(\
@_);
1032 printf("read_mem ( $addr_format, %s )\n", $read_mem_address, join('',@_));
1035 #----------------------------------------------------------------------
1037 #----------------------------------------------------------------------
1038 sub dump_read_mem_rsp
1040 # If the memory read was 2 or 4 bytes, print it out in native format
1041 # instead of just as bytes.
1042 my $num_nibbles = @_;
1043 if ($num_nibbles == 2)
1045 printf(" 0x%2.2x", get8
(\
@_));
1047 elsif ($num_nibbles == 4)
1049 printf(" 0x%4.4x", get16
(\
@_));
1051 elsif ($num_nibbles == 8)
1053 printf(" 0x%8.8x", get32
(\
@_));
1055 elsif ($num_nibbles == 16)
1057 printf(" 0x%s", get64
(\
@_));
1061 my $curr_address = $read_mem_address;
1063 my $nibble_offset = 0;
1064 my $max_nibbles_per_line = 2 * $max_bytes_per_line;
1065 foreach $nibble (@_)
1067 if (($nibble_offset % $max_nibbles_per_line) == 0)
1069 ($nibble_offset > 0) and print "\n ";
1070 printf("$addr_format: ", $curr_address + $nibble_offset/2);
1072 (($nibble_offset % 2) == 0) and print ' ';
1080 #----------------------------------------------------------------------
1081 # 'c' or 's' command
1082 #----------------------------------------------------------------------
1083 sub dump_continue_cmd
1087 $cmd eq 'c' and $cmd_str = 'continue';
1088 $cmd eq 's' and $cmd_str = 'step';
1092 my $address = get_addr
(\
@_);
1093 printf("%s ($addr_format)\n", $cmd_str, $address);
1097 printf("%s ()\n", $cmd_str);
1101 #----------------------------------------------------------------------
1102 # 'Css' continue (C) with signal (ss where 'ss' is two hex digits)
1103 # 'Sss' step (S) with signal (ss where 'ss' is two hex digits)
1104 #----------------------------------------------------------------------
1105 sub dump_continue_with_signal_cmd
1110 $cmd eq 'c' and $cmd_str = 'continue';
1111 $cmd eq 's' and $cmd_str = 'step';
1112 my $signal = get_hex
(\
@_);
1116 if (@_ && $_[0] == ';')
1119 $address = get_addr
(\
@_);
1125 printf("%s_with_signal (signal = 0x%2.2x, address = $addr_format)\n", $cmd_str, $signal, $address);
1129 printf("%s_with_signal (signal = 0x%2.2x)\n", $cmd_str, $signal);
1133 #----------------------------------------------------------------------
1135 #----------------------------------------------------------------------
1138 my $cmd = get_expected_char
(\
@_, 'A') or print "error: incorrect command letter for argument packet, expected 'A'\n";
1139 printf("set_program_arguments (\n");
1142 my $arg_len = get_uint
(\
@_);
1143 get_expected_char
(\
@_, ',') or die "error: missing comma after argument length...?\n";
1144 my $arg_idx = get_uint
(\
@_);
1145 get_expected_char
(\
@_, ',') or die "error: missing comma after argument number...?\n";
1148 my $num_hex8_bytes = $arg_len/2;
1149 for (1 .. $num_hex8_bytes)
1151 $arg .= sprintf("%c", get8
(\
@_))
1153 printf(" <%3u> argv[%u] = '%s'\n", $arg_len, $arg_idx, $arg);
1156 get_expected_char
(\
@_, ',') or die "error: missing comma after argument argument ASCII hex bytes...?\n";
1163 #----------------------------------------------------------------------
1164 # 'z' and 'Z' command
1165 #----------------------------------------------------------------------
1166 sub dump_bp_wp_command
1171 my $address = get_addr
(\
@_);
1173 my $length = join('',@_);
1176 printf("remove $point_types[$type]($addr_format, %d)\n", $address, $length);
1180 printf("insert $point_types[$type]($addr_format, %d)\n", $address, $length);
1185 #----------------------------------------------------------------------
1187 #----------------------------------------------------------------------
1188 sub dump_write_mem_binary_cmd
1191 my $address = get_addr
(\
@_);
1194 my ($length, $binary) = split(/:/, join('',@_));
1195 printf("write_mem_binary ( $addr_format, %d, %s)\n", $address, $length, $binary);
1199 #----------------------------------------------------------------------
1201 #----------------------------------------------------------------------
1202 sub dump_write_mem_cmd
1205 my $address = get_addr
(\
@_);
1207 my ($length, $hex_bytes) = split(/:/, join('',@_));
1208 # printf("write_mem ( $addr_format, %d, %s)\n", $address, $length, $hex_bytes);
1209 printf("write_mem ( addr = $addr_format, len = %d (0x%x), bytes = ", $address, $length, $length);
1210 splice(@_, 0, length($length)+1);
1212 my $curr_address = $address;
1214 my $nibble_count = 0;
1215 my $max_nibbles_per_line = 2 * $max_bytes_per_line;
1216 foreach $nibble (@_)
1218 (($nibble_count % 2) == 0) and print ' ';
1223 # If the memory to write is 2 or 4 bytes, print it out in native format
1224 # instead of just as bytes.
1227 printf(" ( 0x%4.4x )", get16
(\
@_));
1231 printf(" ( 0x%8.8x )", get32
(\
@_));
1237 #----------------------------------------------------------------------
1239 #----------------------------------------------------------------------
1240 our $extended_rsp_callback = 0;
1241 sub dump_extended_cmd
1243 $extended_rsp_callback = 0;
1244 if (join('', @_[0..4]) eq "vCont")
1246 dump_extended_continue_cmd
(splice(@_,5));
1248 elsif (join('', @_[0..7]) eq 'vAttach;')
1250 dump_attach_command
(splice(@_,8));
1252 elsif (join('', @_[0..11]) eq 'vAttachWait;')
1254 dump_attach_wait_command
(splice(@_,12));
1258 #----------------------------------------------------------------------
1260 #----------------------------------------------------------------------
1261 sub dump_extended_rsp
1263 if ($extended_rsp_callback)
1265 &$extended_rsp_callback(@_);
1267 $extended_rsp_callback = 0;
1270 #----------------------------------------------------------------------
1271 # 'vAttachWait' command
1272 #----------------------------------------------------------------------
1273 sub dump_attach_wait_command
1275 print "attach_wait ( ";
1278 printf("%c", get8
(\
@_))
1284 #----------------------------------------------------------------------
1286 #----------------------------------------------------------------------
1287 sub dump_attach_command
1289 printf("attach ( pid = %i )", get_hex
(\
@_));
1290 $extended_rsp_callback = \
&dump_stop_reply_packet
;
1293 #----------------------------------------------------------------------
1295 #----------------------------------------------------------------------
1296 sub dump_extended_continue_cmd
1298 print "extended_continue ( ";
1302 print "list supported modes )\n";
1303 $extended_rsp_callback = \
&dump_extended_continue_rsp
;
1307 $extended_rsp_callback = \
&dump_stop_reply_packet
;
1315 my $continue_cmd = shift;
1317 if ($continue_cmd eq 'c')
1321 elsif ($continue_cmd eq 'C')
1323 print "continue with signal ";
1327 elsif ($continue_cmd eq 's')
1331 elsif ($continue_cmd eq 'S')
1333 print "step with signal ";
1341 print " for thread ";
1345 if (length($tmp) > 0 && $tmp ne ';') {
1359 #----------------------------------------------------------------------
1361 #----------------------------------------------------------------------
1362 sub dump_extended_continue_rsp
1364 if (scalar(@_) == 0)
1366 print "$unimplemented_str\n";
1370 print "extended_continue supports " . join('',@_) . "\n";
1374 #----------------------------------------------------------------------
1375 # Dump the command ascii for any unknown commands
1376 #----------------------------------------------------------------------
1379 print "other = " . join('',@_) . "\n";
1382 #----------------------------------------------------------------------
1383 # Check to see if the response was unsupported with appropriate checksum
1384 #----------------------------------------------------------------------
1385 sub rsp_is_unsupported
1387 return join('',@_) eq "#00";
1390 #----------------------------------------------------------------------
1391 # Check to see if the response was "OK" with appropriate checksum
1392 #----------------------------------------------------------------------
1395 return join('',@_) eq "OK#9a";
1398 #----------------------------------------------------------------------
1399 # Dump a response for an unknown command
1400 #----------------------------------------------------------------------
1403 print "other = " . join('',@_) . "\n";
1406 #----------------------------------------------------------------------
1407 # Get a byte from the ascii string assuming that the 2 nibble ascii
1408 # characters are in hex.
1410 # The argument for this function needs to be a reference to an array
1411 # that contains single character strings and the array will get
1412 # updated by shifting characters off the front of it (no leading # "0x")
1413 #----------------------------------------------------------------------
1416 my $arrayref = shift;
1417 my $val = hex(shift(@
$arrayref) . shift(@
$arrayref));
1421 #----------------------------------------------------------------------
1422 # Get a 16 bit integer and swap if $swap global is set to a non-zero
1425 # The argument for this function needs to be a reference to an array
1426 # that contains single character strings and the array will get
1427 # updated by shifting characters off the front of it (no leading # "0x")
1428 #----------------------------------------------------------------------
1431 my $arrayref = shift;
1435 $val = get8
($arrayref) |
1436 get8
($arrayref) << 8;
1440 $val = get8
($arrayref) << 8 |
1446 #----------------------------------------------------------------------
1447 # Get a 32 bit integer and swap if $swap global is set to a non-zero
1450 # The argument for this function needs to be a reference to an array
1451 # that contains single character strings and the array will get
1452 # updated by shifting characters off the front of it (no leading # "0x")
1453 #----------------------------------------------------------------------
1456 my $arrayref = shift;
1460 $val = get8
($arrayref) |
1461 get8
($arrayref) << 8 |
1462 get8
($arrayref) << 16 |
1463 get8
($arrayref) << 24 ;
1467 $val = get8
($arrayref) << 24 |
1468 get8
($arrayref) << 16 |
1469 get8
($arrayref) << 8 |
1475 #----------------------------------------------------------------------
1476 # Get a 64 bit hex value as a string
1478 # The argument for this function needs to be a reference to an array
1479 # that contains single character strings and the array will get
1480 # updated by shifting characters off the front of it (no leading # "0x")
1481 #----------------------------------------------------------------------
1484 my $arrayref = shift;
1489 push @nibbles, splice(@
$arrayref, 14, 2);
1490 push @nibbles, splice(@
$arrayref, 12, 2);
1491 push @nibbles, splice(@
$arrayref, 10, 2);
1492 push @nibbles, splice(@
$arrayref, 8, 2);
1493 push @nibbles, splice(@
$arrayref, 6, 2);
1494 push @nibbles, splice(@
$arrayref, 4, 2);
1495 push @nibbles, splice(@
$arrayref, 2, 2);
1496 push @nibbles, splice(@
$arrayref, 0, 2);
1500 (@nibbles) = splice(@
$arrayref, 0, ((64/8) * 2));
1502 $val = join('', @nibbles);
1506 #----------------------------------------------------------------------
1507 # Get a 80 bit hex value as a string
1509 # The argument for this function needs to be a reference to an array
1510 # that contains single character strings and the array will get
1511 # updated by shifting characters off the front of it (no leading # "0x")
1512 #----------------------------------------------------------------------
1515 my $arrayref = shift;
1520 push @nibbles, splice(@
$arrayref, 18, 2);
1521 push @nibbles, splice(@
$arrayref, 16, 2);
1522 push @nibbles, splice(@
$arrayref, 14, 2);
1523 push @nibbles, splice(@
$arrayref, 12, 2);
1524 push @nibbles, splice(@
$arrayref, 10, 2);
1525 push @nibbles, splice(@
$arrayref, 8, 2);
1526 push @nibbles, splice(@
$arrayref, 6, 2);
1527 push @nibbles, splice(@
$arrayref, 4, 2);
1528 push @nibbles, splice(@
$arrayref, 2, 2);
1529 push @nibbles, splice(@
$arrayref, 0, 2);
1533 (@nibbles) = splice(@
$arrayref, 0, ((80/8) * 2));
1535 $val = join('', @nibbles);
1539 #----------------------------------------------------------------------
1540 # Get a 96 bit hex value as a string
1542 # The argument for this function needs to be a reference to an array
1543 # that contains single character strings and the array will get
1544 # updated by shifting characters off the front of it (no leading # "0x")
1545 #----------------------------------------------------------------------
1548 my $arrayref = shift;
1553 push @nibbles, splice(@
$arrayref, 22, 2);
1554 push @nibbles, splice(@
$arrayref, 20, 2);
1555 push @nibbles, splice(@
$arrayref, 18, 2);
1556 push @nibbles, splice(@
$arrayref, 16, 2);
1557 push @nibbles, splice(@
$arrayref, 14, 2);
1558 push @nibbles, splice(@
$arrayref, 12, 2);
1559 push @nibbles, splice(@
$arrayref, 10, 2);
1560 push @nibbles, splice(@
$arrayref, 8, 2);
1561 push @nibbles, splice(@
$arrayref, 6, 2);
1562 push @nibbles, splice(@
$arrayref, 4, 2);
1563 push @nibbles, splice(@
$arrayref, 2, 2);
1564 push @nibbles, splice(@
$arrayref, 0, 2);
1568 (@nibbles) = splice(@
$arrayref, 0, ((96/8) * 2));
1570 $val = join('', @nibbles);
1574 #----------------------------------------------------------------------
1575 # Get a 128 bit hex value as a string
1577 # The argument for this function needs to be a reference to an array
1578 # that contains single character strings and the array will get
1579 # updated by shifting characters off the front of it (no leading # "0x")
1580 #----------------------------------------------------------------------
1583 my $arrayref = shift;
1588 push @nibbles, splice(@
$arrayref, 30, 2);
1589 push @nibbles, splice(@
$arrayref, 28, 2);
1590 push @nibbles, splice(@
$arrayref, 26, 2);
1591 push @nibbles, splice(@
$arrayref, 24, 2);
1592 push @nibbles, splice(@
$arrayref, 22, 2);
1593 push @nibbles, splice(@
$arrayref, 20, 2);
1594 push @nibbles, splice(@
$arrayref, 18, 2);
1595 push @nibbles, splice(@
$arrayref, 16, 2);
1596 push @nibbles, splice(@
$arrayref, 14, 2);
1597 push @nibbles, splice(@
$arrayref, 12, 2);
1598 push @nibbles, splice(@
$arrayref, 10, 2);
1599 push @nibbles, splice(@
$arrayref, 8, 2);
1600 push @nibbles, splice(@
$arrayref, 6, 2);
1601 push @nibbles, splice(@
$arrayref, 4, 2);
1602 push @nibbles, splice(@
$arrayref, 2, 2);
1603 push @nibbles, splice(@
$arrayref, 0, 2);
1607 (@nibbles) = splice(@
$arrayref, 0, ((128/8) * 2));
1609 $val = join('', @nibbles);
1613 #----------------------------------------------------------------------
1614 # Get a 256 bit hex value as a string
1616 # The argument for this function needs to be a reference to an array
1617 # that contains single character strings and the array will get
1618 # updated by shifting characters off the front of it (no leading # "0x")
1619 #----------------------------------------------------------------------
1622 my $arrayref = shift;
1627 push @nibbles, splice(@
$arrayref, 62, 2);
1628 push @nibbles, splice(@
$arrayref, 60, 2);
1629 push @nibbles, splice(@
$arrayref, 58, 2);
1630 push @nibbles, splice(@
$arrayref, 56, 2);
1631 push @nibbles, splice(@
$arrayref, 54, 2);
1632 push @nibbles, splice(@
$arrayref, 52, 2);
1633 push @nibbles, splice(@
$arrayref, 50, 2);
1634 push @nibbles, splice(@
$arrayref, 48, 2);
1635 push @nibbles, splice(@
$arrayref, 46, 2);
1636 push @nibbles, splice(@
$arrayref, 44, 2);
1637 push @nibbles, splice(@
$arrayref, 42, 2);
1638 push @nibbles, splice(@
$arrayref, 40, 2);
1639 push @nibbles, splice(@
$arrayref, 38, 2);
1640 push @nibbles, splice(@
$arrayref, 36, 2);
1641 push @nibbles, splice(@
$arrayref, 34, 2);
1642 push @nibbles, splice(@
$arrayref, 32, 2);
1643 push @nibbles, splice(@
$arrayref, 30, 2);
1644 push @nibbles, splice(@
$arrayref, 28, 2);
1645 push @nibbles, splice(@
$arrayref, 26, 2);
1646 push @nibbles, splice(@
$arrayref, 24, 2);
1647 push @nibbles, splice(@
$arrayref, 22, 2);
1648 push @nibbles, splice(@
$arrayref, 20, 2);
1649 push @nibbles, splice(@
$arrayref, 18, 2);
1650 push @nibbles, splice(@
$arrayref, 16, 2);
1651 push @nibbles, splice(@
$arrayref, 14, 2);
1652 push @nibbles, splice(@
$arrayref, 12, 2);
1653 push @nibbles, splice(@
$arrayref, 10, 2);
1654 push @nibbles, splice(@
$arrayref, 8, 2);
1655 push @nibbles, splice(@
$arrayref, 6, 2);
1656 push @nibbles, splice(@
$arrayref, 4, 2);
1657 push @nibbles, splice(@
$arrayref, 2, 2);
1658 push @nibbles, splice(@
$arrayref, 0, 2);
1662 (@nibbles) = splice(@
$arrayref, 0, ((256/8) * 2));
1664 $val = join('', @nibbles);
1668 #----------------------------------------------------------------------
1669 # Get an unsigned integer value by grabbing items off the front of
1670 # the array stopping when a non-digit char string is encountered.
1672 # The argument for this function needs to be a reference to an array
1673 # that contains single character strings and the array will get
1674 # updated by shifting characters off the front of it
1675 #----------------------------------------------------------------------
1678 my $arrayref = shift;
1679 @
$arrayref == 0 and return 0;
1681 while ($$arrayref[0] =~ /[0-9]/)
1683 $val = $val * 10 + int(shift(@
$arrayref));
1688 #----------------------------------------------------------------------
1689 # Check the first character in the array and if it matches the expected
1690 # character, return that character, else return undef;
1692 # The argument for this function needs to be a reference to an array
1693 # that contains single character strings and the array will get
1694 # updated by shifting characters off the front of it. If the expected
1695 # character doesn't match, it won't touch the array. If the first
1696 # character does match, it will shift it off and return it.
1697 #----------------------------------------------------------------------
1698 sub get_expected_char
1700 my $arrayref = shift;
1701 my $expected_char = shift;
1702 if ($expected_char eq $$arrayref[0])
1704 return shift(@
$arrayref);
1708 #----------------------------------------------------------------------
1709 # Get a hex value by grabbing items off the front of the array and
1710 # stopping when a non-hex char string is encountered.
1712 # The argument for this function needs to be a reference to an array
1713 # that contains single character strings and the array will get
1714 # updated by shifting characters off the front of it (no leading # "0x")
1715 #----------------------------------------------------------------------
1718 my $arrayref = shift;
1719 my $my_swap = @_ ?
shift : 0;
1722 while ($$arrayref[0] =~ /[0-9a-fA-F]/)
1726 my $byte = hex(shift(@
$arrayref)) << 4 | hex(shift(@
$arrayref));
1727 $val |= $byte << $shift;
1733 $val |= hex(shift(@
$arrayref));
1739 #----------------------------------------------------------------------
1740 # Get an address value by grabbing items off the front of the array.
1742 # The argument for this function needs to be a reference to an array
1743 # that contains single character strings and the array will get
1744 # updated by shifting characters off the front of it (no leading # "0x")
1745 #----------------------------------------------------------------------
1753 my $arrayref = shift;
1755 while ($$arrayref[0] =~ /[0-9a-fA-F]/ and $$arrayref[1] =~ /[0-9a-fA-F]/)
1757 my $hi_nibble = hex(shift(@
$arrayref));
1758 my $lo_nibble = hex(shift(@
$arrayref));
1759 my $byte = ($hi_nibble << 4) | $lo_nibble;
1765 sub dump_stop_reply_data
1769 last unless ($_[0] ne '#');
1775 if ($_[0] =~ /[0-9a-fA-F]/ && $_[1] =~ /[0-9a-fA-F]/)
1777 my $reg_num = get8
(\
@_);
1778 shift(@_); # Skip ':'
1779 if (defined ($registers_aref) && $reg_num < @
$registers_aref)
1781 dump_register_value
(1, \
@_, $reg_num);
1783 shift(@_); # Skip ';'
1786 $key = sprintf("reg %u", $reg_num);
1790 if (length($key) == 0)
1795 if (length($char) == 0 or $char eq ':' or $char eq '#') { last; }
1803 if (length($char) == 0 or $char eq ';' or $char eq '#') { last; }
1806 if ($key eq 'metype')
1808 our %metype_to_name = (
1809 '1' => ' (EXC_BAD_ACCESS)',
1810 '2' => ' (EXC_BAD_INSTRUCTION)',
1811 '3' => ' (EXC_ARITHMETIC)',
1812 '4' => ' (EXC_EMULATION)',
1813 '5' => ' (EXC_SOFTWARE)',
1814 '6' => ' (EXC_BREAKPOINT)',
1815 '7' => ' (EXC_SYSCALL)',
1816 '8' => ' (EXC_MACH_SYSCALL)',
1817 '9' => ' (EXC_RPC_ALERT)',
1818 '10' => ' (EXC_CRASH)'
1820 if (exists $metype_to_name{$value})
1822 $comment = $metype_to_name{$value};
1825 printf("\t%*s = %s$comment\n", $max_register_name_len, $key, $value);
1829 #----------------------------------------------------------------------
1830 # Dumps a Stop Reply Packet which happens in response to a step,
1831 # continue, last signal, and probably a few other commands.
1832 #----------------------------------------------------------------------
1833 sub dump_stop_reply_packet
1835 my $what = shift(@_);
1836 if ($what eq 'S' or $what eq 'T')
1838 my $signo = get8
(\
@_);
1840 our %signo_to_name = (
1847 '7' => ' SIGPOLL/SIGEMT',
1866 '26' => ' SIGVTALRM',
1868 '28' => ' SIGWINCH',
1872 '145' => ' TARGET_EXC_BAD_ACCESS', # 0x91
1873 '146' => ' TARGET_EXC_BAD_INSTRUCTION', # 0x92
1874 '147' => ' TARGET_EXC_ARITHMETIC', # 0x93
1875 '148' => ' TARGET_EXC_EMULATION', # 0x94
1876 '149' => ' TARGET_EXC_SOFTWARE', # 0x95
1877 '150' => ' TARGET_EXC_BREAKPOINT' # 0x96
1879 my $signo_str = sprintf("%i", $signo);
1880 my $signo_name = '';
1881 if (exists $signo_to_name{$signo_str})
1883 $signo_name = $signo_to_name{$signo_str};
1885 printf ("signal (signo=%u$signo_name)\n", $signo);
1886 dump_stop_reply_data
(@_);
1888 elsif ($what eq 'W')
1890 print 'process_exited( ' . shift(@_) . shift(@_) . " )\n";
1892 elsif ($what eq 'X')
1894 print 'process_terminated( ' . shift(@_) . shift(@_) . " )\n";
1896 elsif ($what eq 'O')
1898 my $console_output = '';
1899 my $num_hex8_bytes = @_/2;
1900 for (1 .. $num_hex8_bytes)
1902 $console_output .= sprintf("%c", get8
(\
@_))
1905 print "program_console_output('$console_output')\n";
1909 #----------------------------------------------------------------------
1911 #----------------------------------------------------------------------
1912 sub dump_last_signal_cmd
1915 print 'last_signal (' . join('',@_) . ")\n";
1918 sub dump_raw_command
1920 my $cmd_aref = shift;
1922 $curr_cmd = $$cmd_aref[0];
1924 if ($curr_cmd eq 'q' or $curr_cmd eq 'Q' or $curr_cmd eq '_')
1926 $curr_full_cmd = '';
1927 foreach my $ch (@
$cmd_aref)
1929 $ch !~ /[A-Za-z_]/ and last;
1930 $curr_full_cmd .= $ch;
1935 $curr_full_cmd = $curr_cmd;
1938 $curr_cmd eq '_' and $curr_cmd .= $$cmd_aref[1];
1939 $callback_ref = $cmd_callbacks{$curr_cmd};
1942 &$callback_ref(@
$cmd_aref);
1946 # Strip the command byte for responses since we injected that above
1947 dump_other_cmd
(@
$cmd_aref);
1951 sub dump_standard_response
1953 my $cmd_aref = shift;
1955 my $cmd_len = scalar(@
$cmd_aref);
1958 print "$unimplemented_str\n";
1962 my $response = join('', @
$cmd_aref);
1963 if ($response eq 'OK')
1965 print "$success_str\n";
1969 if ($cmd_len == 3 and index($response, 'E') == 0)
1971 print "ERROR: " . substr($response, 1) . "\n";
1977 sub dump_raw_response
1979 my $cmd_aref = shift;
1982 if ($packet_start_time != 0.0)
1984 if (length($curr_full_cmd) > 0)
1986 $packet_times{$curr_full_cmd} += $curr_time - $packet_start_time;
1990 $packet_times{$curr_cmd} += $curr_time - $packet_start_time;
1992 $packet_start_time = 0.0;
1995 $callback_ref = $rsp_callbacks{$curr_cmd};
1999 &$callback_ref(@
$cmd_aref);
2003 dump_standard_response
($cmd_aref) or dump_other_rsp
(@
$cmd_aref);
2007 #----------------------------------------------------------------------
2008 # Dumps any command and handles simple error checking on the responses
2009 # for commands that are unsupported or OK.
2010 #----------------------------------------------------------------------
2013 my $cmd_str = shift;
2015 # Dump the original command string if verbose is on
2018 print "dump_command($cmd_str)\n ";
2021 my @cmd_chars = extract_command
($cmd_str);
2024 my $cmd = $cmd_chars[0];
2027 $is_cmd = 0; # Note that this is a reply
2028 $cmd = $curr_cmd; # set the command byte appropriately
2029 shift @cmd_chars; # remove the '$' from the cmd bytes
2032 # Check for common responses across all commands and handle them
2036 if (rsp_is_unsupported
(@cmd_chars))
2038 print "$unimplemented_str\n";
2041 elsif (rsp_is_OK
(@cmd_chars))
2043 print "$success_str\n";
2046 # Strip the checksum information for responses
2047 strip_checksum
(\
@cmd_chars);
2052 $callback_ref = $cmd_callbacks{$cmd};
2054 $callback_ref = $rsp_callbacks{$cmd};
2059 &$callback_ref(@cmd_chars);
2063 # Strip the command byte for responses since we injected that above
2065 dump_other_cmd
(@cmd_chars);
2067 dump_other_rsp
(@cmd_chars);
2074 #----------------------------------------------------------------------
2075 # Process a gdbserver log line by looking for getpkt and putkpt and
2076 # tossing any other lines.
2078 #----------------------------------------------------------------------
2079 sub process_log_line
2082 #($opt_v and $opt_g) and print "# $line";
2084 my $extract_cmd = 0;
2085 my $delta_time = 0.0;
2086 if ($line =~ /^(\s*)([1-9][0-9]+\.[0-9]+)([^0-9].*)$/)
2088 my $leading_space = $1;
2091 if ($base_time == 0.0)
2093 $base_time = $curr_time;
2097 $delta_time = $curr_time - $last_time;
2099 printf ("(%.6f, %+.6f): ", $curr_time - $base_time, $delta_time);
2100 $last_time = $curr_time;
2107 if ($line =~ /getpkt /)
2111 $packet_start_time = $curr_time;
2113 elsif ($line =~ /putpkt /)
2118 elsif ($line =~ /.*Sent: \[[0-9]+\.[0-9]+[:0-9]*\] (.*)/)
2120 $opt_g and print "maintenance dump-packets command: $1\n";
2121 my @raw_cmd_bytes = split(/ */, $1);
2122 $packet_start_time = $curr_time;
2124 dump_raw_command
(\
@raw_cmd_bytes);
2125 process_log_line
($2);
2127 elsif ($line =~ /.*Recvd: \[[0-9]+\.[0-9]+[:0-9]*\] (.*)/)
2129 $opt_g and print "maintenance dump-packets reply: $1\n";
2130 my @raw_rsp_bytes = split(/ */, $1);
2132 dump_raw_response
(\
@raw_rsp_bytes);
2135 elsif ($line =~ /getpkt: (.*)/)
2137 if ($1 =~ /\$([^#]+)#[0-9a-fA-F]{2}/)
2139 $opt_g and print "command: $1\n";
2140 my @raw_cmd_bytes = split(/ */, $1);
2142 $packet_start_time = $curr_time;
2143 dump_raw_command
(\
@raw_cmd_bytes);
2151 #print "--> NACK\n";
2154 elsif ($line =~ /putpkt: (.*)/)
2156 if ($1 =~ /\$([^#]+)#[0-9a-fA-F]{2}/)
2158 $opt_g and print "response: $1\n";
2159 my @raw_rsp_bytes = split(/ */, $1);
2161 dump_raw_response
(\
@raw_rsp_bytes);
2170 #print "<-- NACK\n";
2173 elsif ($line =~ /send packet: (.*)/)
2175 if ($1 =~ /\$([^#]+)#[0-9a-fA-F]{2}/)
2177 $opt_g and print "command: $1\n";
2178 my @raw_cmd_bytes = split(/ */, $1);
2180 $packet_start_time = $curr_time;
2181 dump_raw_command
(\
@raw_cmd_bytes);
2189 #print "--> NACK\n";
2192 elsif ($line =~ /read packet: (.*)/)
2194 if ($1 =~ /\$([^#]*)#[0-9a-fA-F]{2}/)
2196 $opt_g and print "response: $1\n";
2197 my @raw_rsp_bytes = split(/ */, $1);
2199 dump_raw_response
(\
@raw_rsp_bytes);
2208 #print "<-- NACK\n";
2211 elsif ($line =~ /Sending packet: \$([^#]+)#[0-9a-fA-F]{2}\.\.\.(.*)/)
2213 $opt_g and print "command: $1\n";
2214 my @raw_cmd_bytes = split(/ */, $1);
2216 $packet_start_time = $curr_time;
2217 dump_raw_command
(\
@raw_cmd_bytes);
2218 process_log_line
($2);
2220 elsif ($line =~ /Packet received: (.*)/)
2222 $opt_g and print "response: $1\n";
2223 my @raw_rsp_bytes = split(/ */, $1);
2225 dump_raw_response
(\
@raw_rsp_bytes);
2231 my $beg = index($line, '("') + 2;
2232 my $end = rindex($line, '");');
2233 $packet_start_time = $curr_time;
2234 dump_command
(substr($line, $beg, $end - $beg));
2243 $opt_q or printf("# %5d: $_", $line_num);
2244 process_log_line
($_);
2249 print "----------------------------------------------------------------------\n";
2250 print "Packet timing summary:\n";
2251 print "----------------------------------------------------------------------\n";
2252 print "Packet Time %\n";
2253 print "---------------------- -------- ------\n";
2254 my @packet_names = keys %packet_times;
2255 my $total_packet_times = 0.0;
2256 foreach my $key (@packet_names)
2258 $total_packet_times += $packet_times{$key};
2261 foreach my $value (sort {$packet_times{$b} cmp $packet_times{$a}} @packet_names)
2263 my $percent = ($packet_times{$value} / $total_packet_times) * 100.0;
2264 if ($percent < 10.0)
2266 printf("%22s %1.6f %2.2f\n", $value, $packet_times{$value}, $percent);
2271 printf("%22s %1.6f %2.2f\n", $value, $packet_times{$value}, $percent);
2274 print "---------------------- -------- ------\n";
2275 printf (" Total %1.6f 100.00\n", $total_packet_times);