1#!/usr/bin/perl 2 3use strict; 4 5#---------------------------------------------------------------------- 6# Globals 7#---------------------------------------------------------------------- 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; # verbose 429our $opt_g = 0; # debug 430our $opt_q = 0; # quiet 431our $opt_r = undef; 432use Getopt::Std; 433getopts('gvqr:'); 434 435our $registers_aref = undef; 436 437if (length($opt_r)) 438{ 439 if (exists $reg_map{$opt_r}) 440 { 441 $registers_aref = $reg_map{$opt_r}; 442 } 443 else 444 { 445 die "Can't get registers group for '$opt_r'\n"; 446 } 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_suffix 464{ 465 if ($thread_suffix_supported) 466 { 467 my $arrayref = shift; 468 # Skip leading semi-colon if needed 469 $$arrayref[0] == ';' and shift @$arrayref; 470 my $thread_href = extract_key_value_pairs ($arrayref); 471 if (exists $thread_href->{thread}) 472 { 473 return $thread_href->{thread}; 474 } 475 } 476 return undef; 477} 478 479sub calculate_max_register_name_length 480{ 481 $max_register_name_len = 7; 482 foreach my $reg_href (@$registers_aref) 483 { 484 my $name_len = length($reg_href->{name}); 485 if ($max_register_name_len < $name_len) 486 { 487 $max_register_name_len = $name_len; 488 } 489 } 490} 491#---------------------------------------------------------------------- 492# Hash that maps command characters to the appropriate functions using 493# the command character as the key and the value being a reference to 494# the dump function for dumping the command itself. 495#---------------------------------------------------------------------- 496our %cmd_callbacks = 497( 498 '?' => \&dump_last_signal_cmd, 499 'H' => \&dump_set_thread_cmd, 500 'T' => \&dump_thread_is_alive_cmd, 501 'q' => \&dump_general_query_cmd, 502 'Q' => \&dump_general_set_cmd, 503 'g' => \&dump_read_regs_cmd, 504 'G' => \&dump_write_regs_cmd, 505 'p' => \&dump_read_single_register_cmd, 506 'P' => \&dump_write_single_register_cmd, 507 'm' => \&dump_read_mem_cmd, 508 'M' => \&dump_write_mem_cmd, 509 'X' => \&dump_write_mem_binary_cmd, 510 'Z' => \&dump_bp_wp_command, 511 'z' => \&dump_bp_wp_command, 512 'k' => \&dump_kill_cmd, 513 'A' => \&dump_A_command, 514 'c' => \&dump_continue_cmd, 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 commands 521 'v' => \&dump_extended_cmd 522); 523 524#---------------------------------------------------------------------- 525# Hash that maps command characters to the appropriate functions using 526# the command character as the key and the value being a reference to 527# the dump function for the response to the command. 528#---------------------------------------------------------------------- 529our %rsp_callbacks = 530( 531 'c' => \&dump_stop_reply_packet, 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 commands 544 'v' => \&dump_extended_rsp, 545); 546 547 548sub dump_register_value 549{ 550 my $indent = shift; 551 my $arrayref = shift; 552 my $reg_num = shift; 553 554 if ($reg_num >= @$registers_aref) 555 { 556 printf("\tinvalid register index %d\n", $reg_num); 557 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 easy 580# processing 581#---------------------------------------------------------------------- 582sub extract_command 583{ 584 my $cmd_str = shift; 585 my @cmd_chars = split(/ */, $cmd_str); 586 if ($cmd_chars[0] ne '$') 587 { 588 # only set the current command if it isn't a reply 589 $curr_cmd = $cmd_chars[0]; 590 } 591 return @cmd_chars; 592} 593 594#---------------------------------------------------------------------- 595# Strip the 3 checksum array entries after we don't need them anymore 596#---------------------------------------------------------------------- 597sub strip_checksum 598{ 599 my $arrayref = shift; 600 splice(@$arrayref, -3); 601} 602 603#---------------------------------------------------------------------- 604# Dump all strings in array by joining them together with no space 605# between them 606#---------------------------------------------------------------------- 607sub dump_chars 608{ 609 print join('',@_); 610} 611 612#---------------------------------------------------------------------- 613# Check if the response is an error 'EXX' 614#---------------------------------------------------------------------- 615sub is_error_response 616{ 617 if ($_[0] eq 'E') 618 { 619 shift; 620 print "ERROR = " . join('',@_) . "\n"; 621 return 1; 622 } 623 return 0; 624} 625 626#---------------------------------------------------------------------- 627# 'H' command 628#---------------------------------------------------------------------- 629sub dump_set_thread_cmd 630{ 631 my $cmd = shift; 632 my $mod = shift; 633 print "set_thread ( $mod, " . join('',@_) . " )\n"; 634} 635 636#---------------------------------------------------------------------- 637# 'T' command 638#---------------------------------------------------------------------- 639our $T_cmd_tid = -1; 640sub dump_thread_is_alive_cmd 641{ 642 my $cmd = shift; 643 $T_cmd_tid = get_hex(\@_); 644 printf("thread_is_alive ( $tid_format )\n", $T_cmd_tid); 645} 646 647sub dump_thread_is_alive_rsp 648{ 649 my $rsp = join('',@_); 650 651 printf("thread_is_alive ( $tid_format ) =>", $T_cmd_tid); 652 if ($rsp eq 'OK') 653 { 654 print " alive.\n"; 655 } 656 else 657 { 658 print " dead.\n"; 659 } 660} 661 662#---------------------------------------------------------------------- 663# 'H' response 664#---------------------------------------------------------------------- 665sub dump_set_thread_rsp 666{ 667 if (!is_error_response(@_)) 668 { 669 print join('',@_) . "\n"; 670 } 671} 672 673#---------------------------------------------------------------------- 674# 'q' command 675#---------------------------------------------------------------------- 676our $gen_query_cmd; 677our $qRegisterInfo_reg_num = -1; 678sub dump_general_query_cmd 679{ 680 $gen_query_cmd = join('',@_); 681 if ($gen_query_cmd eq 'qC') 682 { 683 print 'get_current_pid ()'; 684 } 685 elsif ($gen_query_cmd eq 'qfThreadInfo') 686 { 687 print 'get_first_active_threads ()'; 688 } 689 elsif ($gen_query_cmd eq 'qsThreadInfo') 690 { 691 print 'get_subsequent_active_threads ()'; 692 } 693 elsif (index($gen_query_cmd, 'qThreadExtraInfo') == 0) 694 { 695 # qThreadExtraInfo,id 696 print 'get_thread_extra_info ()'; 697 } 698 elsif (index($gen_query_cmd, 'qThreadStopInfo') == 0) 699 { 700 # qThreadStopInfoXXXX 701 @_ = splice(@_, length('qThreadStopInfo')); 702 my $tid = get_addr(\@_); 703 printf('get_thread_stop_info ( thread = 0x%4.4x )', $tid); 704 } 705 elsif (index($gen_query_cmd, 'qSymbol:') == 0) 706 { 707 # qCRC:addr,length 708 print 'gdb_ready_to_serve_symbol_lookups ()'; 709 } 710 elsif (index($gen_query_cmd, 'qCRC:') == 0) 711 { 712 # qCRC:addr,length 713 @_ = splice(@_, length('qCRC:')); 714 my $address = get_addr(\@_); 715 shift @_; 716 my $length = join('', @_); 717 printf("compute_crc (addr = $addr_format, length = $length)", $address); 718 } 719 elsif (index($gen_query_cmd, 'qGetTLSAddr:') == 0) 720 { 721 # qGetTLSAddr:thread-id,offset,lm 722 @_ = splice(@_, length('qGetTLSAddr:')); 723 my ($tid, $offset, $lm) = split (/,/, join('', @_)); 724 print "get_thread_local_storage_addr (thread-id = $tid, offset = $offset, lm = $lm)"; 725 } 726 elsif ($gen_query_cmd eq 'qOffsets') 727 { 728 print 'get_section_offsets ()'; 729 } 730 elsif (index($gen_query_cmd, 'qRegisterInfo') == 0) 731 { 732 @_ = splice(@_, length('qRegisterInfo')); 733 $qRegisterInfo_reg_num = get_hex(\@_); 734 735 printf "get_dynamic_register_info ($qRegisterInfo_reg_num)"; 736 } 737 else 738 { 739 print $gen_query_cmd; 740 } 741 print "\n"; 742} 743 744#---------------------------------------------------------------------- 745# 'q' response 746#---------------------------------------------------------------------- 747sub dump_general_query_rsp 748{ 749 my $gen_query_rsp = join('',@_); 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 else 765 { 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 else 809 { 810 print join('',@_) . "\n"; 811 } 812} 813 814#---------------------------------------------------------------------- 815# 'Q' command 816#---------------------------------------------------------------------- 817our $gen_set_cmd; 818sub dump_general_set_cmd 819{ 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 max 835 # packet payload size supported by gdb 836 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 else 854 { 855 print $gen_query_cmd; 856 } 857 print "\n"; 858} 859 860#---------------------------------------------------------------------- 861# 'k' command 862#---------------------------------------------------------------------- 863sub dump_kill_cmd 864{ 865 my $cmd = shift; 866 print "kill (" . join('',@_) . ")\n"; 867} 868 869#---------------------------------------------------------------------- 870# 'g' command 871#---------------------------------------------------------------------- 872sub dump_read_regs_cmd 873{ 874 my $cmd = shift; 875 print "read_registers ()\n"; 876} 877 878#---------------------------------------------------------------------- 879# 'G' command 880#---------------------------------------------------------------------- 881sub dump_write_regs_cmd 882{ 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_rsp 901{ 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_rsp 923{ 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 string 933# Separator: ',' 934# Arg2: permissions as string that must be a string that contains any 935# combination of 'r' (readable) 'w' (writable) or 'x' (executable) 936# 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. 940# 941# Examples: 942# _M10,rw # allocate 16 bytes with read + write permissions 943# _M100,rx # allocate 256 bytes with read + execute permissions 944#---------------------------------------------------------------------- 945sub dump_allocate_memory_cmd 946{ 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_rsp 954{ 955 if (@_ == 3 and $_[0] == 'E') 956 { 957 printf("allocated memory addr = ERROR (%s))\n", join('',@_)); 958 } 959 else 960 { 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 string 970# 971# Returns: "OK" on success "EXX" on error 972# 973# Examples: 974# _m201000 # Free previously allocated memory at address 0x201000 975#---------------------------------------------------------------------- 976sub dump_deallocate_memory_cmd 977{ 978 shift; shift; # shift off the '_' and the 'm' 979 printf("deallocate_memory ( addr = 0x%s)\n", join('',@_)); 980} 981 982 983#---------------------------------------------------------------------- 984# 'p' command 985#---------------------------------------------------------------------- 986sub dump_read_single_register_cmd 987{ 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 else 998 { 999 print "read_register ( reg = \"$reg_href->{name}\" )\n"; 1000 } 1001} 1002 1003 1004#---------------------------------------------------------------------- 1005# 'P' command 1006#---------------------------------------------------------------------- 1007sub dump_write_single_register_cmd 1008{ 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' command 1025#---------------------------------------------------------------------- 1026our $read_mem_address = 0; 1027sub dump_read_mem_cmd 1028{ 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' response 1037#---------------------------------------------------------------------- 1038sub dump_read_mem_rsp 1039{ 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) 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 else 1060 { 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' command 1082#---------------------------------------------------------------------- 1083sub dump_continue_cmd 1084{ 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 else 1096 { 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_cmd 1106{ 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 else 1128 { 1129 printf("%s_with_signal (signal = 0x%2.2x)\n", $cmd_str, $signal); 1130 } 1131} 1132 1133#---------------------------------------------------------------------- 1134# 'A' command 1135#---------------------------------------------------------------------- 1136sub dump_A_command 1137{ 1138 my $cmd = get_exptected_char(\@_, 'A') or print "error: incorrect command letter for argument packet, exptected 'A'\n"; 1139 printf("set_program_arguments (\n"); 1140 do 1141 { 1142 my $arg_len = get_uint(\@_); 1143 get_exptected_char(\@_, ',') or die "error: missing comma after argument length...?\n"; 1144 my $arg_idx = get_uint(\@_); 1145 get_exptected_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_exptected_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' command 1165#---------------------------------------------------------------------- 1166sub dump_bp_wp_command 1167{ 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 else 1179 { 1180 printf("insert $point_types[$type]($addr_format, %d)\n", $address, $length); 1181 } 1182} 1183 1184 1185#---------------------------------------------------------------------- 1186# 'X' command 1187#---------------------------------------------------------------------- 1188sub dump_write_mem_binary_cmd 1189{ 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' command 1201#---------------------------------------------------------------------- 1202sub dump_write_mem_cmd 1203{ 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 format 1224 # 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' command 1239#---------------------------------------------------------------------- 1240our $extended_rsp_callback = 0; 1241sub dump_extended_cmd 1242{ 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' response 1260#---------------------------------------------------------------------- 1261sub dump_extended_rsp 1262{ 1263 if ($extended_rsp_callback) 1264 { 1265 &$extended_rsp_callback(@_); 1266 } 1267 $extended_rsp_callback = 0; 1268} 1269 1270#---------------------------------------------------------------------- 1271# 'vAttachWait' command 1272#---------------------------------------------------------------------- 1273sub dump_attach_wait_command 1274{ 1275 print "attach_wait ( "; 1276 while (@_) 1277 { 1278 printf("%c", get8(\@_)) 1279 } 1280 printf " )\n"; 1281 1282} 1283 1284#---------------------------------------------------------------------- 1285# 'vAttach' command 1286#---------------------------------------------------------------------- 1287sub dump_attach_command 1288{ 1289 printf("attach ( pid = %i )", get_hex(\@_)); 1290 $extended_rsp_callback = \&dump_stop_reply_packet; 1291} 1292 1293#---------------------------------------------------------------------- 1294# 'vCont' command 1295#---------------------------------------------------------------------- 1296sub dump_extended_continue_cmd 1297{ 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' response 1361#---------------------------------------------------------------------- 1362sub dump_extended_continue_rsp 1363{ 1364 if (scalar(@_) == 0) 1365 { 1366 print "$unimplemented_str\n"; 1367 } 1368 else 1369 { 1370 print "extended_continue supports " . join('',@_) . "\n"; 1371 } 1372} 1373 1374#---------------------------------------------------------------------- 1375# Dump the command ascii for any unknown commands 1376#---------------------------------------------------------------------- 1377sub dump_other_cmd 1378{ 1379 print "other = " . join('',@_) . "\n"; 1380} 1381 1382#---------------------------------------------------------------------- 1383# Check to see if the response was unsupported with appropriate checksum 1384#---------------------------------------------------------------------- 1385sub rsp_is_unsupported 1386{ 1387 return join('',@_) eq "#00"; 1388} 1389 1390#---------------------------------------------------------------------- 1391# Check to see if the response was "OK" with appropriate checksum 1392#---------------------------------------------------------------------- 1393sub rsp_is_OK 1394{ 1395 return join('',@_) eq "OK#9a"; 1396} 1397 1398#---------------------------------------------------------------------- 1399# Dump a response for an unknown command 1400#---------------------------------------------------------------------- 1401sub dump_other_rsp 1402{ 1403 print "other = " . join('',@_) . "\n"; 1404} 1405 1406#---------------------------------------------------------------------- 1407# Get a byte from the ascii string assuming that the 2 nibble ascii 1408# 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 get8 1415{ 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 get16 1430{ 1431 my $arrayref = shift; 1432 my $val = 0; 1433 if ($swap) 1434 { 1435 $val = get8($arrayref) | 1436 get8($arrayref) << 8; 1437 } 1438 else 1439 { 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 get32 1455{ 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 else 1466 { 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 string 1477# 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 get64 1483{ 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 else 1499 { 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 string 1508# 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 get80 1514{ 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 else 1532 { 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 string 1541# 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 get96 1547{ 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 else 1567 { 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 string 1576# 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 get128 1582{ 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 else 1606 { 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 string 1615# 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 get256 1621{ 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 else 1661 { 1662 (@nibbles) = splice(@$arrayref, 0, ((256/8) * 2)); 1663 } 1664 $val = join('', @nibbles); 1665 return $val; 1666} 1667 1668#---------------------------------------------------------------------- 1669# Get a 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 it 1675#---------------------------------------------------------------------- 1676sub get_uint 1677{ 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 expected 1690# 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 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#---------------------------------------------------------------------- 1698sub get_exptected_char 1699{ 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_hex 1717{ 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 else 1731 { 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_addr 1747{ 1748 get_hex(shift); 1749} 1750 1751sub get_hex_string 1752{ 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_data 1766{ 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_packet 1834{ 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', # 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 1878 ); 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# '?' command 1911#---------------------------------------------------------------------- 1912sub dump_last_signal_cmd 1913{ 1914 my $cmd = shift; 1915 print 'last_signal (' . join('',@_) . ")\n"; 1916} 1917 1918sub dump_raw_command 1919{ 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 else 1934 { 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 else 1945 { 1946 # Strip the command byte for responses since we injected that above 1947 dump_other_cmd(@$cmd_aref); 1948 } 1949} 1950 1951sub dump_standard_response 1952{ 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_response 1978{ 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 else 1989 { 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 else 2002 { 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 responses 2009# for commands that are unsupported or OK. 2010#---------------------------------------------------------------------- 2011sub dump_command 2012{ 2013 my $cmd_str = shift; 2014 2015 # Dump the original command string if verbose is on 2016 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 reply 2028 $cmd = $curr_cmd; # set the command byte appropriately 2029 shift @cmd_chars; # remove the '$' from the cmd bytes 2030 } 2031 2032 # Check for common responses across all commands and handle them 2033 # if we can 2034 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 responses 2047 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 else 2062 { 2063 # Strip the command byte for responses since we injected that above 2064 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 and 2076# tossing any other lines. 2077 2078#---------------------------------------------------------------------- 2079sub process_log_line 2080{ 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 else 2096 { 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 else 2103 { 2104 $curr_time = 0.0 2105 } 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 else 2270 { 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