2284 lines · plain
1#!/usr/bin/env perl2 3use strict;4 5#----------------------------------------------------------------------6# Globals7#----------------------------------------------------------------------8our $unimplemented_str = "UNIMPLEMENTED";9our $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" };23our $reg256_href = { extract => \&get256, format => "0x%s" };24our $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;28our $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;34our $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 214 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 303 '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; # verbose429our $opt_g = 0; # debug430our $opt_q = 0; # quiet431our $opt_r = undef;432use Getopt::Std;433getopts('gvqr:'); 434 435our $registers_aref = undef;436 437if (length($opt_r))438{439 if (exists $reg_map{$opt_r})440 {441 $registers_aref = $reg_map{$opt_r}; 442 }443 else444 {445 die "Can't get registers group for '$opt_r'\n";446 }447}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_suffix464{465 if ($thread_suffix_supported)466 {467 my $arrayref = shift;468 # Skip leading semi-colon if needed469 $$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_length480{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 using493# the command character as the key and the value being a reference to494# 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,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,520 # extended commands521 'v' => \&dump_extended_cmd522);523 524#----------------------------------------------------------------------525# Hash that maps command characters to the appropriate functions using526# the command character as the key and the value being a reference to527# the dump function for the response to the command.528#----------------------------------------------------------------------529our %rsp_callbacks = 530(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,542 543 # extended commands544 'v' => \&dump_extended_rsp,545);546 547 548sub dump_register_value549{550 my $indent = shift;551 my $arrayref = shift;552 my $reg_num = shift;553 554 if ($reg_num >= @$registers_aref)555 {556 printf("\tinvalid register index %d\n", $reg_num);557 return;558 }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 easy580# processing581#----------------------------------------------------------------------582sub extract_command583{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 reply589 $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 anymore596#----------------------------------------------------------------------597sub strip_checksum598{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 them606#----------------------------------------------------------------------607sub dump_chars608{609 print join('',@_);610}611 612#----------------------------------------------------------------------613# Check if the response is an error 'EXX'614#----------------------------------------------------------------------615sub is_error_response616{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' command628#----------------------------------------------------------------------629sub dump_set_thread_cmd630{631 my $cmd = shift;632 my $mod = shift;633 print "set_thread ( $mod, " . join('',@_) . " )\n";634}635 636#----------------------------------------------------------------------637# 'T' command638#----------------------------------------------------------------------639our $T_cmd_tid = -1;640sub dump_thread_is_alive_cmd641{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_rsp648{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 else657 {658 print " dead.\n";659 }660}661 662#----------------------------------------------------------------------663# 'H' response664#----------------------------------------------------------------------665sub dump_set_thread_rsp666{667 if (!is_error_response(@_))668 {669 print join('',@_) . "\n";670 }671}672 673#----------------------------------------------------------------------674# 'q' command675#----------------------------------------------------------------------676our $gen_query_cmd;677our $qRegisterInfo_reg_num = -1;678sub dump_general_query_cmd679{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,id696 print 'get_thread_extra_info ()';697 }698 elsif (index($gen_query_cmd, 'qThreadStopInfo') == 0)699 {700 # qThreadStopInfoXXXX701 @_ = 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,length708 print 'gdb_ready_to_serve_symbol_lookups ()';709 }710 elsif (index($gen_query_cmd, 'qCRC:') == 0)711 {712 # qCRC:addr,length713 @_ = 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,lm722 @_ = 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'));733 $qRegisterInfo_reg_num = get_hex(\@_);734 735 printf "get_dynamic_register_info ($qRegisterInfo_reg_num)";736 }737 else738 {739 print $gen_query_cmd;740 }741 print "\n";742}743 744#----------------------------------------------------------------------745# 'q' response746#----------------------------------------------------------------------747sub dump_general_query_rsp748{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)752 {753 shift @_; shift @_;754 my $pid = get_hex(\@_);755 printf("pid = $pid_format\n", $pid);756 return;757 }758 elsif (index($gen_query_cmd, 'qRegisterInfo') == 0)759 {760 if ($gen_query_rsp_len == 0)761 {762 print "$unimplemented_str\n"; 763 }764 else765 {766 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 my $pseudo = 0;775 foreach (@name_and_values)776 {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; }781 }782 if (defined $reg_name and $byte_size > 0)783 {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 };}792 }793 }794 elsif ($gen_query_rsp_len == 3 and index($gen_query_rsp, 'E') == 0)795 {796 calculate_max_register_name_length();797 }798 }799 }800 elsif ($gen_query_cmd =~ 'qThreadStopInfo')801 {802 dump_stop_reply_packet (@_);803 }804 if (dump_standard_response(\@_))805 {806 # Do nothing...807 }808 else809 {810 print join('',@_) . "\n";811 }812}813 814#----------------------------------------------------------------------815# 'Q' command816#----------------------------------------------------------------------817our $gen_set_cmd;818sub dump_general_set_cmd819{820 $gen_query_cmd = join('',@_);821 if ($gen_query_cmd eq 'QStartNoAckMode')822 {823 print "StartNoAckMode ()"824 }825 elsif ($gen_query_cmd eq 'QThreadSuffixSupported')826 {827 $thread_suffix_supported = 1;828 print "ThreadSuffixSupported ()"829 }830 elsif (index($gen_query_cmd, 'QSetMaxPayloadSize:') == 0)831 {832 @_ = splice(@_, length('QSetMaxPayloadSize:'));833 my $max_payload_size = get_hex(\@_);834 # QSetMaxPayloadSize:XXXX where XXXX is a hex length of the max835 # packet payload size supported by gdb836 printf("SetMaxPayloadSize ( 0x%x (%u))", $max_payload_size, $max_payload_size);837 }838 elsif (index ($gen_query_cmd, 'QSetSTDIN:') == 0)839 {840 @_ = splice(@_, length('QSetSTDIN:'));841 printf ("SetSTDIN (path ='%s')\n", get_hex_string (\@_));842 }843 elsif (index ($gen_query_cmd, 'QSetSTDOUT:') == 0)844 {845 @_ = splice(@_, length('QSetSTDOUT:'));846 printf ("SetSTDOUT (path ='%s')\n", get_hex_string (\@_));847 }848 elsif (index ($gen_query_cmd, 'QSetSTDERR:') == 0)849 {850 @_ = splice(@_, length('QSetSTDERR:'));851 printf ("SetSTDERR (path ='%s')\n", get_hex_string (\@_));852 }853 else854 {855 print $gen_query_cmd;856 }857 print "\n";858}859 860#----------------------------------------------------------------------861# 'k' command862#----------------------------------------------------------------------863sub dump_kill_cmd864{865 my $cmd = shift;866 print "kill (" . join('',@_) . ")\n";867}868 869#----------------------------------------------------------------------870# 'g' command871#----------------------------------------------------------------------872sub dump_read_regs_cmd873{874 my $cmd = shift;875 print "read_registers ()\n";876}877 878#----------------------------------------------------------------------879# 'G' command880#----------------------------------------------------------------------881sub dump_write_regs_cmd882{883 print "write_registers:\n";884 my $cmd = shift;885 foreach my $reg_href (@$registers_aref)886 {887 last if ($_[0] eq '#');888 if ($reg_href->{pseudo} == 0)889 {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); 896 }897 } 898}899 900sub dump_read_regs_rsp901{902 print "read_registers () =>\n";903 if (!is_error_response(@_))904 {905 # print join('',@_) . "\n";906 foreach my $reg_href (@$registers_aref)907 {908 last if ($_[0] eq '#');909 if ($reg_href->{pseudo} == 0)910 {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);917 }918 } 919 }920}921 922sub dump_read_single_register_rsp923{924 dump_register_value(0, \@_, $reg_cmd_reg);925 print "\n";926}927 928#----------------------------------------------------------------------929# '_M' - allocate memory command (LLDB extension)930#931# Command: '_M'932# Arg1: Hex byte size as big endian hex string933# Separator: ','934# Arg2: permissions as string that must be a string that contains any935# combination of 'r' (readable) 'w' (writable) or 'x' (executable)936#937# Returns: The address that was allocated as a big endian hex string938# on success, else an error "EXX" where XX are hex bytes939# that indicate an error code.940#941# Examples:942# _M10,rw # allocate 16 bytes with read + write permissions943# _M100,rx # allocate 256 bytes with read + execute permissions944#----------------------------------------------------------------------945sub dump_allocate_memory_cmd946{947 shift; shift; # shift off the '_' and the 'M'948 my $byte_size = get_addr(\@_);949 shift; # Skip ','950 printf("allocate_memory ( byte_size = %u (0x%x), permissions = %s)\n", $byte_size, $byte_size, join('',@_));951}952 953sub dump_allocate_memory_rsp954{955 if (@_ == 3 and $_[0] == 'E')956 {957 printf("allocated memory addr = ERROR (%s))\n", join('',@_)); 958 }959 else960 {961 printf("allocated memory addr = 0x%s\n", join('',@_)); 962 }963}964 965#----------------------------------------------------------------------966# '_m' - deallocate memory command (LLDB extension)967#968# Command: '_m'969# Arg1: Hex address as big endian hex string970#971# Returns: "OK" on success "EXX" on error972#973# Examples:974# _m201000 # Free previously allocated memory at address 0x201000975#----------------------------------------------------------------------976sub dump_deallocate_memory_cmd977{978 shift; shift; # shift off the '_' and the 'm'979 printf("deallocate_memory ( addr = 0x%s)\n", join('',@_));980}981 982 983#----------------------------------------------------------------------984# 'p' command985#----------------------------------------------------------------------986sub dump_read_single_register_cmd987{988 my $cmd = shift;989 $reg_cmd_reg = get_hex(\@_);990 my $thread = get_thread_from_thread_suffix (\@_);991 my $reg_href = $$registers_aref[$reg_cmd_reg];992 993 if (defined $thread)994 {995 print "read_register ( reg = \"$reg_href->{name}\", thread = $thread )\n";996 }997 else998 {999 print "read_register ( reg = \"$reg_href->{name}\" )\n";1000 }1001}1002 1003 1004#----------------------------------------------------------------------1005# 'P' command1006#----------------------------------------------------------------------1007sub dump_write_single_register_cmd1008{1009 my $cmd = shift;1010 my $reg_num = get_hex(\@_);1011 shift (@_); # Discard the '='1012 1013 print "write_register ( ";1014 dump_register_value(0, \@_, $reg_num);1015 my $thread = get_thread_from_thread_suffix (\@_);1016 if (defined $thread)1017 {1018 print ", thread = $thread";1019 }1020 print " )\n";1021}1022 1023#----------------------------------------------------------------------1024# 'm' command1025#----------------------------------------------------------------------1026our $read_mem_address = 0;1027sub dump_read_mem_cmd1028{1029 my $cmd = shift;1030 $read_mem_address = get_addr(\@_);1031 shift; # Skip ','1032 printf("read_mem ( $addr_format, %s )\n", $read_mem_address, join('',@_));1033}1034 1035#----------------------------------------------------------------------1036# 'm' response1037#----------------------------------------------------------------------1038sub dump_read_mem_rsp1039{1040 # If the memory read was 2 or 4 bytes, print it out in native format1041 # instead of just as bytes.1042 my $num_nibbles = @_;1043 if ($num_nibbles == 2)1044 {1045 printf(" 0x%2.2x", get8(\@_));1046 }1047 elsif ($num_nibbles == 4)1048 {1049 printf(" 0x%4.4x", get16(\@_));1050 }1051 elsif ($num_nibbles == 8)1052 {1053 printf(" 0x%8.8x", get32(\@_));1054 }1055 elsif ($num_nibbles == 16)1056 {1057 printf(" 0x%s", get64(\@_));1058 }1059 else1060 {1061 my $curr_address = $read_mem_address;1062 my $nibble;1063 my $nibble_offset = 0;1064 my $max_nibbles_per_line = 2 * $max_bytes_per_line;1065 foreach $nibble (@_)1066 {1067 if (($nibble_offset % $max_nibbles_per_line) == 0)1068 {1069 ($nibble_offset > 0) and print "\n ";1070 printf("$addr_format: ", $curr_address + $nibble_offset/2);1071 }1072 (($nibble_offset % 2) == 0) and print ' '; 1073 print $nibble;1074 $nibble_offset++;1075 }1076 }1077 print "\n";1078}1079 1080#----------------------------------------------------------------------1081# 'c' or 's' command1082#----------------------------------------------------------------------1083sub dump_continue_cmd1084{ 1085 my $cmd = shift;1086 my $cmd_str;1087 $cmd eq 'c' and $cmd_str = 'continue';1088 $cmd eq 's' and $cmd_str = 'step';1089 my $address = -1;1090 if (@_)1091 {1092 my $address = get_addr(\@_);1093 printf("%s ($addr_format)\n", $cmd_str, $address);1094 }1095 else1096 {1097 printf("%s ()\n", $cmd_str);1098 }1099}1100 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#----------------------------------------------------------------------1105sub dump_continue_with_signal_cmd1106{ 1107 my $cmd = shift;1108 my $address = -1;1109 my $cmd_str;1110 $cmd eq 'c' and $cmd_str = 'continue';1111 $cmd eq 's' and $cmd_str = 'step';1112 my $signal = get_hex(\@_);1113 if (@_)1114 {1115 my $address = 0;1116 if (@_ && $_[0] == ';')1117 {1118 shift;1119 $address = get_addr(\@_);1120 }1121 }1122 1123 if ($address != -1)1124 {1125 printf("%s_with_signal (signal = 0x%2.2x, address = $addr_format)\n", $cmd_str, $signal, $address);1126 }1127 else1128 {1129 printf("%s_with_signal (signal = 0x%2.2x)\n", $cmd_str, $signal);1130 }1131}1132 1133#----------------------------------------------------------------------1134# 'A' command1135#----------------------------------------------------------------------1136sub dump_A_command1137{ 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");1140 do1141 {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";1146 1147 my $arg = '';1148 my $num_hex8_bytes = $arg_len/2;1149 for (1 .. $num_hex8_bytes)1150 {1151 $arg .= sprintf("%c", get8(\@_))1152 }1153 printf(" <%3u> argv[%u] = '%s'\n", $arg_len, $arg_idx, $arg);1154 if (@_ > 0)1155 {1156 get_expected_char(\@_, ',') or die "error: missing comma after argument argument ASCII hex bytes...?\n";1157 } 1158 } while (@_ > 0); 1159 printf(" )\n");1160}1161 1162 1163#----------------------------------------------------------------------1164# 'z' and 'Z' command1165#----------------------------------------------------------------------1166sub dump_bp_wp_command1167{ 1168 my $cmd = shift;1169 my $type = shift;1170 shift; # Skip ','1171 my $address = get_addr(\@_);1172 shift; # Skip ','1173 my $length = join('',@_);1174 if ($cmd eq 'z')1175 {1176 printf("remove $point_types[$type]($addr_format, %d)\n", $address, $length);1177 }1178 else1179 {1180 printf("insert $point_types[$type]($addr_format, %d)\n", $address, $length); 1181 }1182}1183 1184 1185#----------------------------------------------------------------------1186# 'X' command1187#----------------------------------------------------------------------1188sub dump_write_mem_binary_cmd1189{ 1190 my $cmd = shift;1191 my $address = get_addr(\@_);1192 shift; # Skip ','1193 1194 my ($length, $binary) = split(/:/, join('',@_));1195 printf("write_mem_binary ( $addr_format, %d, %s)\n", $address, $length, $binary);1196 1197}1198 1199#----------------------------------------------------------------------1200# 'M' command1201#----------------------------------------------------------------------1202sub dump_write_mem_cmd1203{ 1204 my $cmd = shift;1205 my $address = get_addr(\@_);1206 shift; # Skip ','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);1211 1212 my $curr_address = $address;1213 my $nibble;1214 my $nibble_count = 0;1215 my $max_nibbles_per_line = 2 * $max_bytes_per_line;1216 foreach $nibble (@_)1217 {1218 (($nibble_count % 2) == 0) and print ' ';1219 print $nibble;1220 $nibble_count++;1221 }1222 1223 # If the memory to write is 2 or 4 bytes, print it out in native format1224 # instead of just as bytes.1225 if (@_ == 4)1226 {1227 printf(" ( 0x%4.4x )", get16(\@_));1228 }1229 elsif (@_ == 8)1230 {1231 printf(" ( 0x%8.8x )", get32(\@_));1232 }1233 print " )\n";1234 1235}1236 1237#----------------------------------------------------------------------1238# 'v' command1239#----------------------------------------------------------------------1240our $extended_rsp_callback = 0;1241sub dump_extended_cmd1242{1243 $extended_rsp_callback = 0;1244 if (join('', @_[0..4]) eq "vCont")1245 {1246 dump_extended_continue_cmd(splice(@_,5));1247 }1248 elsif (join('', @_[0..7]) eq 'vAttach;')1249 {1250 dump_attach_command (splice(@_,8));1251 }1252 elsif (join('', @_[0..11]) eq 'vAttachWait;')1253 {1254 dump_attach_wait_command (splice(@_,12));1255 }1256}1257 1258#----------------------------------------------------------------------1259# 'v' response1260#----------------------------------------------------------------------1261sub dump_extended_rsp1262{1263 if ($extended_rsp_callback)1264 {1265 &$extended_rsp_callback(@_);1266 }1267 $extended_rsp_callback = 0;1268}1269 1270#----------------------------------------------------------------------1271# 'vAttachWait' command1272#----------------------------------------------------------------------1273sub dump_attach_wait_command1274{1275 print "attach_wait ( ";1276 while (@_)1277 {1278 printf("%c", get8(\@_))1279 }1280 printf " )\n";1281 1282}1283 1284#----------------------------------------------------------------------1285# 'vAttach' command1286#----------------------------------------------------------------------1287sub dump_attach_command1288{1289 printf("attach ( pid = %i )", get_hex(\@_));1290 $extended_rsp_callback = \&dump_stop_reply_packet;1291}1292 1293#----------------------------------------------------------------------1294# 'vCont' command1295#----------------------------------------------------------------------1296sub dump_extended_continue_cmd1297{1298 print "extended_continue ( ";1299 my $cmd = shift;1300 if ($cmd eq '?')1301 {1302 print "list supported modes )\n";1303 $extended_rsp_callback = \&dump_extended_continue_rsp;1304 }1305 elsif ($cmd eq ';')1306 {1307 $extended_rsp_callback = \&dump_stop_reply_packet;1308 my $i = 0;1309 while ($#_ >= 0)1310 {1311 if ($i > 0)1312 {1313 print ", ";1314 }1315 my $continue_cmd = shift;1316 my $tmp;1317 if ($continue_cmd eq 'c')1318 { 1319 print "continue";1320 }1321 elsif ($continue_cmd eq 'C') 1322 {1323 print "continue with signal ";1324 print shift;1325 print shift;1326 }1327 elsif ($continue_cmd eq 's') 1328 { 1329 print "step";1330 }1331 elsif ($continue_cmd eq 'S') 1332 {1333 print "step with signal ";1334 print shift;1335 print shift;1336 }1337 1338 if ($_[0] eq ':')1339 {1340 shift; # Skip ':'1341 print " for thread ";1342 while ($#_ >= 0)1343 {1344 $tmp = shift;1345 if (length($tmp) > 0 && $tmp ne ';') {1346 print $tmp; 1347 } else { 1348 last;1349 }1350 }1351 }1352 $i++;1353 }1354 1355 printf " )\n";1356 }1357}1358 1359#----------------------------------------------------------------------1360# 'vCont' response1361#----------------------------------------------------------------------1362sub dump_extended_continue_rsp1363{1364 if (scalar(@_) == 0)1365 {1366 print "$unimplemented_str\n";1367 }1368 else1369 {1370 print "extended_continue supports " . join('',@_) . "\n";1371 }1372}1373 1374#----------------------------------------------------------------------1375# Dump the command ascii for any unknown commands1376#----------------------------------------------------------------------1377sub dump_other_cmd1378{1379 print "other = " . join('',@_) . "\n";1380}1381 1382#----------------------------------------------------------------------1383# Check to see if the response was unsupported with appropriate checksum1384#----------------------------------------------------------------------1385sub rsp_is_unsupported1386{1387 return join('',@_) eq "#00";1388}1389 1390#----------------------------------------------------------------------1391# Check to see if the response was "OK" with appropriate checksum1392#----------------------------------------------------------------------1393sub rsp_is_OK1394{1395 return join('',@_) eq "OK#9a";1396}1397 1398#----------------------------------------------------------------------1399# Dump a response for an unknown command1400#----------------------------------------------------------------------1401sub dump_other_rsp1402{1403 print "other = " . join('',@_) . "\n";1404}1405 1406#----------------------------------------------------------------------1407# Get a byte from the ascii string assuming that the 2 nibble ascii1408# characters are in hex. 1409#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#----------------------------------------------------------------------1414sub get81415{1416 my $arrayref = shift;1417 my $val = hex(shift(@$arrayref) . shift(@$arrayref));1418 return $val;1419}1420 1421#----------------------------------------------------------------------1422# Get a 16 bit integer and swap if $swap global is set to a non-zero 1423# value.1424#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#----------------------------------------------------------------------1429sub get161430{1431 my $arrayref = shift;1432 my $val = 0;1433 if ($swap)1434 {1435 $val = get8($arrayref) |1436 get8($arrayref) << 8;1437 }1438 else1439 {1440 $val = get8($arrayref) << 8 |1441 get8($arrayref) ;1442 }1443 return $val;1444}1445 1446#----------------------------------------------------------------------1447# Get a 32 bit integer and swap if $swap global is set to a non-zero 1448# value.1449#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#----------------------------------------------------------------------1454sub get321455{1456 my $arrayref = shift;1457 my $val = 0;1458 if ($swap)1459 {1460 $val = get8($arrayref) |1461 get8($arrayref) << 8 |1462 get8($arrayref) << 16 |1463 get8($arrayref) << 24 ;1464 }1465 else1466 {1467 $val = get8($arrayref) << 24 |1468 get8($arrayref) << 16 |1469 get8($arrayref) << 8 |1470 get8($arrayref) ;1471 }1472 return $val;1473}1474 1475#----------------------------------------------------------------------1476# Get a 64 bit hex value as a string1477#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#----------------------------------------------------------------------1482sub get641483{1484 my $arrayref = shift;1485 my $val = '';1486 my @nibbles;1487 if ($swap)1488 {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);1497 }1498 else1499 {1500 (@nibbles) = splice(@$arrayref, 0, ((64/8) * 2));1501 }1502 $val = join('', @nibbles); 1503 return $val;1504}1505 1506#----------------------------------------------------------------------1507# Get a 80 bit hex value as a string1508#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#----------------------------------------------------------------------1513sub get801514{1515 my $arrayref = shift;1516 my $val = '';1517 my @nibbles;1518 if ($swap)1519 {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);1530 }1531 else1532 {1533 (@nibbles) = splice(@$arrayref, 0, ((80/8) * 2));1534 }1535 $val = join('', @nibbles); 1536 return $val;1537}1538 1539#----------------------------------------------------------------------1540# Get a 96 bit hex value as a string1541#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#----------------------------------------------------------------------1546sub get961547{1548 my $arrayref = shift;1549 my $val = '';1550 my @nibbles;1551 if ($swap)1552 {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);1565 }1566 else1567 {1568 (@nibbles) = splice(@$arrayref, 0, ((96/8) * 2));1569 }1570 $val = join('', @nibbles); 1571 return $val;1572}1573 1574#----------------------------------------------------------------------1575# Get a 128 bit hex value as a string1576#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#----------------------------------------------------------------------1581sub get1281582{1583 my $arrayref = shift;1584 my $val = '';1585 my @nibbles;1586 if ($swap)1587 {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);1604 }1605 else1606 {1607 (@nibbles) = splice(@$arrayref, 0, ((128/8) * 2));1608 }1609 $val = join('', @nibbles); 1610 return $val;1611}1612 1613#----------------------------------------------------------------------1614# Get a 256 bit hex value as a string1615#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#----------------------------------------------------------------------1620sub get2561621{1622 my $arrayref = shift;1623 my $val = '';1624 my @nibbles;1625 if ($swap)1626 {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);1659 }1660 else1661 {1662 (@nibbles) = splice(@$arrayref, 0, ((256/8) * 2));1663 }1664 $val = join('', @nibbles); 1665 return $val;1666}1667 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.1671#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 it1675#----------------------------------------------------------------------1676sub get_uint1677{1678 my $arrayref = shift;1679 @$arrayref == 0 and return 0;1680 my $val = 0;1681 while ($$arrayref[0] =~ /[0-9]/)1682 {1683 $val = $val * 10 + int(shift(@$arrayref));1684 }1685 return $val;1686}1687 1688#----------------------------------------------------------------------1689# Check the first character in the array and if it matches the expected1690# character, return that character, else return undef;1691#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 expected1695# character doesn't match, it won't touch the array. If the first1696# character does match, it will shift it off and return it.1697#----------------------------------------------------------------------1698sub get_expected_char1699{1700 my $arrayref = shift;1701 my $expected_char = shift;1702 if ($expected_char eq $$arrayref[0])1703 {1704 return shift(@$arrayref);1705 }1706 return undef;1707}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.1711#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#----------------------------------------------------------------------1716sub get_hex1717{1718 my $arrayref = shift;1719 my $my_swap = @_ ? shift : 0;1720 my $shift = 0;1721 my $val = 0;1722 while ($$arrayref[0] =~ /[0-9a-fA-F]/)1723 {1724 if ($my_swap)1725 {1726 my $byte = hex(shift(@$arrayref)) << 4 | hex(shift(@$arrayref));1727 $val |= $byte << $shift;1728 $shift += 8;1729 }1730 else1731 {1732 $val <<= 4;1733 $val |= hex(shift(@$arrayref));1734 }1735 }1736 return $val;1737}1738 1739#----------------------------------------------------------------------1740# Get an address value by grabbing items off the front of the array.1741#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#----------------------------------------------------------------------1746sub get_addr1747{1748 get_hex(shift);1749}1750 1751sub get_hex_string1752{1753 my $arrayref = shift;1754 my $str = '';1755 while ($$arrayref[0] =~ /[0-9a-fA-F]/ and $$arrayref[1] =~ /[0-9a-fA-F]/)1756 {1757 my $hi_nibble = hex(shift(@$arrayref));1758 my $lo_nibble = hex(shift(@$arrayref));1759 my $byte = ($hi_nibble << 4) | $lo_nibble;1760 $str .= chr($byte);1761 }1762 return $str;1763}1764 1765sub dump_stop_reply_data1766{1767 while ($#_ >= 0)1768 {1769 last unless ($_[0] ne '#');1770 1771 1772 my $key = '';1773 my $value = '';1774 my $comment = '';1775 if ($_[0] =~ /[0-9a-fA-F]/ && $_[1] =~ /[0-9a-fA-F]/)1776 {1777 my $reg_num = get8(\@_);1778 shift(@_); # Skip ':'1779 if (defined ($registers_aref) && $reg_num < @$registers_aref)1780 {1781 dump_register_value(1, \@_, $reg_num);1782 print "\n";1783 shift(@_); # Skip ';'1784 next;1785 }1786 $key = sprintf("reg %u", $reg_num);1787 }1788 my $char;1789 1790 if (length($key) == 0)1791 {1792 while (1)1793 {1794 $char = shift(@_);1795 if (length($char) == 0 or $char eq ':' or $char eq '#') { last; }1796 $key .= $char;1797 }1798 }1799 1800 while (1)1801 {1802 $char = shift(@_);1803 if (length($char) == 0 or $char eq ';' or $char eq '#') { last; }1804 $value .= $char;1805 }1806 if ($key eq 'metype')1807 {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)'1819 );1820 if (exists $metype_to_name{$value})1821 {1822 $comment = $metype_to_name{$value};1823 }1824 }1825 printf("\t%*s = %s$comment\n", $max_register_name_len, $key, $value);1826 }1827}1828 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#----------------------------------------------------------------------1833sub dump_stop_reply_packet1834{1835 my $what = shift(@_);1836 if ($what eq 'S' or $what eq 'T')1837 {1838 my $signo = get8(\@_);1839 1840 our %signo_to_name = (1841 '1' => ' SIGHUP',1842 '2' => ' SIGINT',1843 '3' => ' SIGQUIT',1844 '4' => ' SIGILL',1845 '5' => ' SIGTRAP',1846 '6' => ' SIGABRT',1847 '7' => ' SIGPOLL/SIGEMT',1848 '8' => ' SIGFPE',1849 '9' => ' SIGKILL',1850 '10' => ' SIGBUS',1851 '11' => ' SIGSEGV',1852 '12' => ' SIGSYS',1853 '13' => ' SIGPIPE',1854 '14' => ' SIGALRM',1855 '15' => ' SIGTERM',1856 '16' => ' SIGURG',1857 '17' => ' SIGSTOP',1858 '18' => ' SIGTSTP',1859 '19' => ' SIGCONT',1860 '20' => ' SIGCHLD',1861 '21' => ' SIGTTIN',1862 '22' => ' SIGTTOU',1863 '23' => ' SIGIO',1864 '24' => ' SIGXCPU',1865 '25' => ' SIGXFSZ',1866 '26' => ' SIGVTALRM',1867 '27' => ' SIGPROF',1868 '28' => ' SIGWINCH',1869 '29' => ' SIGINFO',1870 '30' => ' SIGUSR1',1871 '31' => ' SIGUSR2',1872 '145' => ' TARGET_EXC_BAD_ACCESS', # 0x911873 '146' => ' TARGET_EXC_BAD_INSTRUCTION', # 0x921874 '147' => ' TARGET_EXC_ARITHMETIC', # 0x931875 '148' => ' TARGET_EXC_EMULATION', # 0x941876 '149' => ' TARGET_EXC_SOFTWARE', # 0x951877 '150' => ' TARGET_EXC_BREAKPOINT' # 0x961878 );1879 my $signo_str = sprintf("%i", $signo);1880 my $signo_name = '';1881 if (exists $signo_to_name{$signo_str})1882 {1883 $signo_name = $signo_to_name{$signo_str};1884 }1885 printf ("signal (signo=%u$signo_name)\n", $signo);1886 dump_stop_reply_data (@_);1887 }1888 elsif ($what eq 'W')1889 {1890 print 'process_exited( ' . shift(@_) . shift(@_) . " )\n";1891 }1892 elsif ($what eq 'X')1893 {1894 print 'process_terminated( ' . shift(@_) . shift(@_) . " )\n";1895 }1896 elsif ($what eq 'O')1897 {1898 my $console_output = '';1899 my $num_hex8_bytes = @_/2;1900 for (1 .. $num_hex8_bytes)1901 {1902 $console_output .= sprintf("%c", get8(\@_))1903 }1904 1905 print "program_console_output('$console_output')\n";1906 }1907}1908 1909#----------------------------------------------------------------------1910# '?' command1911#----------------------------------------------------------------------1912sub dump_last_signal_cmd1913{1914 my $cmd = shift;1915 print 'last_signal (' . join('',@_) . ")\n";1916}1917 1918sub dump_raw_command1919{1920 my $cmd_aref = shift;1921 my $callback_ref;1922 $curr_cmd = $$cmd_aref[0];1923 1924 if ($curr_cmd eq 'q' or $curr_cmd eq 'Q' or $curr_cmd eq '_')1925 {1926 $curr_full_cmd = '';1927 foreach my $ch (@$cmd_aref)1928 {1929 $ch !~ /[A-Za-z_]/ and last;1930 $curr_full_cmd .= $ch;1931 }1932 }1933 else1934 {1935 $curr_full_cmd = $curr_cmd;1936 }1937 1938 $curr_cmd eq '_' and $curr_cmd .= $$cmd_aref[1]; 1939 $callback_ref = $cmd_callbacks{$curr_cmd};1940 if ($callback_ref)1941 {1942 &$callback_ref(@$cmd_aref);1943 }1944 else1945 {1946 # Strip the command byte for responses since we injected that above1947 dump_other_cmd(@$cmd_aref); 1948 } 1949}1950 1951sub dump_standard_response1952{1953 my $cmd_aref = shift;1954 1955 my $cmd_len = scalar(@$cmd_aref);1956 if ($cmd_len == 0)1957 {1958 print "$unimplemented_str\n";1959 return 1;1960 } 1961 1962 my $response = join('', @$cmd_aref);1963 if ($response eq 'OK')1964 {1965 print "$success_str\n";1966 return 1;1967 }1968 1969 if ($cmd_len == 3 and index($response, 'E') == 0)1970 {1971 print "ERROR: " . substr($response, 1) . "\n";1972 return 1; 1973 }1974 1975 return 0;1976}1977sub dump_raw_response1978{1979 my $cmd_aref = shift;1980 my $callback_ref;1981 1982 if ($packet_start_time != 0.0)1983 {1984 if (length($curr_full_cmd) > 0)1985 {1986 $packet_times{$curr_full_cmd} += $curr_time - $packet_start_time;1987 }1988 else1989 {1990 $packet_times{$curr_cmd} += $curr_time - $packet_start_time;1991 }1992 $packet_start_time = 0.0;1993 }1994 1995 $callback_ref = $rsp_callbacks{$curr_cmd};1996 1997 if ($callback_ref)1998 {1999 &$callback_ref(@$cmd_aref);2000 }2001 else2002 {2003 dump_standard_response($cmd_aref) or dump_other_rsp(@$cmd_aref);2004 } 2005 2006}2007#----------------------------------------------------------------------2008# Dumps any command and handles simple error checking on the responses2009# for commands that are unsupported or OK.2010#----------------------------------------------------------------------2011sub dump_command2012{2013 my $cmd_str = shift;2014 2015 # Dump the original command string if verbose is on2016 if ($opt_v)2017 {2018 print "dump_command($cmd_str)\n ";2019 }2020 2021 my @cmd_chars = extract_command($cmd_str);2022 my $is_cmd = 1;2023 2024 my $cmd = $cmd_chars[0];2025 if ($cmd eq '$')2026 {2027 $is_cmd = 0; # Note that this is a reply2028 $cmd = $curr_cmd; # set the command byte appropriately2029 shift @cmd_chars; # remove the '$' from the cmd bytes2030 }2031 2032 # Check for common responses across all commands and handle them2033 # if we can2034 if ( $is_cmd == 0 )2035 {2036 if (rsp_is_unsupported(@cmd_chars))2037 {2038 print "$unimplemented_str\n";2039 return;2040 }2041 elsif (rsp_is_OK(@cmd_chars))2042 {2043 print "$success_str\n";2044 return;2045 }2046 # Strip the checksum information for responses2047 strip_checksum(\@cmd_chars);2048 }2049 2050 my $callback_ref;2051 if ($is_cmd) {2052 $callback_ref = $cmd_callbacks{$cmd};2053 } else {2054 $callback_ref = $rsp_callbacks{$cmd};2055 }2056 2057 if ($callback_ref)2058 {2059 &$callback_ref(@cmd_chars);2060 }2061 else2062 {2063 # Strip the command byte for responses since we injected that above2064 if ($is_cmd) {2065 dump_other_cmd(@cmd_chars); 2066 } else {2067 dump_other_rsp(@cmd_chars);2068 }2069 2070 } 2071}2072 2073 2074#----------------------------------------------------------------------2075# Process a gdbserver log line by looking for getpkt and putkpt and2076# tossing any other lines.2077 2078#----------------------------------------------------------------------2079sub process_log_line2080{2081 my $line = shift;2082 #($opt_v and $opt_g) and print "# $line";2083 2084 my $extract_cmd = 0;2085 my $delta_time = 0.0;2086 if ($line =~ /^(\s*)([1-9][0-9]+\.[0-9]+)([^0-9].*)$/)2087 {2088 my $leading_space = $1;2089 $curr_time = $2;2090 $line = $3;2091 if ($base_time == 0.0)2092 {2093 $base_time = $curr_time;2094 }2095 else2096 {2097 $delta_time = $curr_time - $last_time;2098 }2099 printf ("(%.6f, %+.6f): ", $curr_time - $base_time, $delta_time);2100 $last_time = $curr_time;2101 }2102 else2103 {2104 $curr_time = 0.02105 }2106 2107 if ($line =~ /getpkt /)2108 {2109 $extract_cmd = 1;2110 print "\n--> ";2111 $packet_start_time = $curr_time;2112 }2113 elsif ($line =~ /putpkt /)2114 {2115 $extract_cmd = 1;2116 print "<-- ";2117 }2118 elsif ($line =~ /.*Sent: \[[0-9]+\.[0-9]+[:0-9]*\] (.*)/)2119 {2120 $opt_g and print "maintenance dump-packets command: $1\n";2121 my @raw_cmd_bytes = split(/ */, $1);2122 $packet_start_time = $curr_time;2123 print "\n--> ";2124 dump_raw_command(\@raw_cmd_bytes);2125 process_log_line($2);2126 }2127 elsif ($line =~ /.*Recvd: \[[0-9]+\.[0-9]+[:0-9]*\] (.*)/)2128 {2129 $opt_g and print "maintenance dump-packets reply: $1\n";2130 my @raw_rsp_bytes = split(/ */, $1);2131 print "<-- ";2132 dump_raw_response(\@raw_rsp_bytes); 2133 print "\n";2134 }2135 elsif ($line =~ /getpkt: (.*)/)2136 {2137 if ($1 =~ /\$([^#]+)#[0-9a-fA-F]{2}/)2138 {2139 $opt_g and print "command: $1\n";2140 my @raw_cmd_bytes = split(/ */, $1);2141 print "--> ";2142 $packet_start_time = $curr_time;2143 dump_raw_command(\@raw_cmd_bytes); 2144 }2145 elsif ($1 =~ /\+/)2146 {2147 #print "--> ACK\n";2148 }2149 elsif ($1 =~ /-/)2150 {2151 #print "--> NACK\n";2152 }2153 }2154 elsif ($line =~ /putpkt: (.*)/)2155 {2156 if ($1 =~ /\$([^#]+)#[0-9a-fA-F]{2}/)2157 {2158 $opt_g and print "response: $1\n";2159 my @raw_rsp_bytes = split(/ */, $1);2160 print "<-- ";2161 dump_raw_response(\@raw_rsp_bytes); 2162 print "\n";2163 }2164 elsif ($1 =~ /\+/)2165 {2166 #print "<-- ACK\n";2167 }2168 elsif ($1 =~ /-/)2169 {2170 #print "<-- NACK\n";2171 }2172 }2173 elsif ($line =~ /send packet: (.*)/)2174 {2175 if ($1 =~ /\$([^#]+)#[0-9a-fA-F]{2}/)2176 {2177 $opt_g and print "command: $1\n";2178 my @raw_cmd_bytes = split(/ */, $1);2179 print "--> ";2180 $packet_start_time = $curr_time;2181 dump_raw_command(\@raw_cmd_bytes); 2182 }2183 elsif ($1 =~ /\+/)2184 {2185 #print "--> ACK\n";2186 }2187 elsif ($1 =~ /-/)2188 {2189 #print "--> NACK\n";2190 }2191 }2192 elsif ($line =~ /read packet: (.*)/)2193 {2194 if ($1 =~ /\$([^#]*)#[0-9a-fA-F]{2}/)2195 {2196 $opt_g and print "response: $1\n";2197 my @raw_rsp_bytes = split(/ */, $1);2198 print "<-- ";2199 dump_raw_response(\@raw_rsp_bytes); 2200 print "\n";2201 }2202 elsif ($1 =~ /\+/)2203 {2204 #print "<-- ACK\n";2205 }2206 elsif ($1 =~ /-/)2207 {2208 #print "<-- NACK\n";2209 }2210 }2211 elsif ($line =~ /Sending packet: \$([^#]+)#[0-9a-fA-F]{2}\.\.\.(.*)/)2212 {2213 $opt_g and print "command: $1\n";2214 my @raw_cmd_bytes = split(/ */, $1);2215 print "\n--> ";2216 $packet_start_time = $curr_time;2217 dump_raw_command(\@raw_cmd_bytes);2218 process_log_line($2);2219 }2220 elsif ($line =~ /Packet received: (.*)/)2221 {2222 $opt_g and print "response: $1\n";2223 my @raw_rsp_bytes = split(/ */, $1);2224 print "<-- ";2225 dump_raw_response(\@raw_rsp_bytes); 2226 print "\n";2227 }2228 2229 if ($extract_cmd)2230 {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));2235 }2236}2237 2238 2239our $line_num = 0;2240while(<>)2241{2242 $line_num++;2243 $opt_q or printf("# %5d: $_", $line_num);2244 process_log_line($_);2245}2246 2247if (%packet_times)2248{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)2257 {2258 $total_packet_times += $packet_times{$key};2259 }2260 2261 foreach my $value (sort {$packet_times{$b} cmp $packet_times{$a}} @packet_names)2262 {2263 my $percent = ($packet_times{$value} / $total_packet_times) * 100.0;2264 if ($percent < 10.0)2265 {2266 printf("%22s %1.6f %2.2f\n", $value, $packet_times{$value}, $percent);2267 2268 }2269 else2270 {2271 printf("%22s %1.6f %2.2f\n", $value, $packet_times{$value}, $percent); 2272 }2273 } 2274 print "---------------------- -------- ------\n";2275 printf (" Total %1.6f 100.00\n", $total_packet_times);2276}2277 2278 2279 2280 2281 2282 2283 2284