1*be691f3bSpatrick#!/usr/bin/env perl 2061da546Spatrick 3061da546Spatrickuse strict; 4061da546Spatrick 5061da546Spatrick#---------------------------------------------------------------------- 6061da546Spatrick# Globals 7061da546Spatrick#---------------------------------------------------------------------- 8061da546Spatrickour $unimplemented_str = "UNIMPLEMENTED"; 9061da546Spatrickour $success_str = "OK"; 10061da546Spatrickour $swap = 1; 11061da546Spatrickour $addr_size = 4; 12061da546Spatrickour $thread_suffix_supported = 0; 13061da546Spatrickour $max_bytes_per_line = 32; 14061da546Spatrickour $addr_format = sprintf("0x%%%u.%ux", $addr_size*2, $addr_size*2); 15061da546Spatrickour $pid_format = "%04.4x"; 16061da546Spatrickour $tid_format = "%04.4x"; 17061da546Spatrickour $reg8_href = { extract => \&get8, format => "0x%2.2x" }; 18061da546Spatrickour $reg16_href = { extract => \&get16, format => "0x%4.4x" }; 19061da546Spatrickour $reg32_href = { extract => \&get32, format => "0x%8.8x" }; 20061da546Spatrickour $reg64_href = { extract => \&get64, format => "0x%s" }; 21061da546Spatrickour $reg80_href = { extract => \&get80, format => "0x%s" }; 22061da546Spatrickour $reg128_href = { extract => \&get128, format => "0x%s" }; 23061da546Spatrickour $reg256_href = { extract => \&get256, format => "0x%s" }; 24061da546Spatrickour $float32_href = { extract => \&get32, format => "0x%8.8x" }; 25061da546Spatrickour $float64_href = { extract => \&get64, format => "0x%s" }; 26061da546Spatrickour $float96_href = { extract => \&get96, format => "0x%s" }; 27061da546Spatrickour $curr_cmd = undef; 28061da546Spatrickour $curr_full_cmd = undef; 29061da546Spatrickour %packet_times; 30061da546Spatrickour $curr_time = 0.0; 31061da546Spatrickour $last_time = 0.0; 32061da546Spatrickour $base_time = 0.0; 33061da546Spatrickour $packet_start_time = 0.0; 34061da546Spatrickour $reg_cmd_reg; 35061da546Spatrickour %reg_map = ( 36061da546Spatrick 'i386-gdb' => [ 37061da546Spatrick { name => 'eax', info => $reg32_href }, 38061da546Spatrick { name => 'ecx', info => $reg32_href }, 39061da546Spatrick { name => 'edx', info => $reg32_href }, 40061da546Spatrick { name => 'ebx', info => $reg32_href }, 41061da546Spatrick { name => 'esp', info => $reg32_href }, 42061da546Spatrick { name => 'ebp', info => $reg32_href }, 43061da546Spatrick { name => 'esi', info => $reg32_href }, 44061da546Spatrick { name => 'edi', info => $reg32_href }, 45061da546Spatrick { name => 'eip', info => $reg32_href }, 46061da546Spatrick { name => 'eflags', info => $reg32_href }, 47061da546Spatrick { name => 'cs', info => $reg32_href }, 48061da546Spatrick { name => 'ss', info => $reg32_href }, 49061da546Spatrick { name => 'ds', info => $reg32_href }, 50061da546Spatrick { name => 'es', info => $reg32_href }, 51061da546Spatrick { name => 'fs', info => $reg32_href }, 52061da546Spatrick { name => 'gs', info => $reg32_href }, 53061da546Spatrick { name => 'st0', info => $reg80_href }, 54061da546Spatrick { name => 'st1', info => $reg80_href }, 55061da546Spatrick { name => 'st2', info => $reg80_href }, 56061da546Spatrick { name => 'st3', info => $reg80_href }, 57061da546Spatrick { name => 'st4', info => $reg80_href }, 58061da546Spatrick { name => 'st5', info => $reg80_href }, 59061da546Spatrick { name => 'st6', info => $reg80_href }, 60061da546Spatrick { name => 'st7', info => $reg80_href }, 61061da546Spatrick { name => 'fctrl', info => $reg32_href }, 62061da546Spatrick { name => 'fstat', info => $reg32_href }, 63061da546Spatrick { name => 'ftag', info => $reg32_href }, 64061da546Spatrick { name => 'fiseg', info => $reg32_href }, 65061da546Spatrick { name => 'fioff', info => $reg32_href }, 66061da546Spatrick { name => 'foseg', info => $reg32_href }, 67061da546Spatrick { name => 'fooff', info => $reg32_href }, 68061da546Spatrick { name => 'fop', info => $reg32_href }, 69061da546Spatrick { name => 'xmm0', info => $reg128_href }, 70061da546Spatrick { name => 'xmm1', info => $reg128_href }, 71061da546Spatrick { name => 'xmm2', info => $reg128_href }, 72061da546Spatrick { name => 'xmm3', info => $reg128_href }, 73061da546Spatrick { name => 'xmm4', info => $reg128_href }, 74061da546Spatrick { name => 'xmm5', info => $reg128_href }, 75061da546Spatrick { name => 'xmm6', info => $reg128_href }, 76061da546Spatrick { name => 'xmm7', info => $reg128_href }, 77061da546Spatrick { name => 'mxcsr', info => $reg32_href }, 78061da546Spatrick { name => 'mm0', info => $reg64_href }, 79061da546Spatrick { name => 'mm1', info => $reg64_href }, 80061da546Spatrick { name => 'mm2', info => $reg64_href }, 81061da546Spatrick { name => 'mm3', info => $reg64_href }, 82061da546Spatrick { name => 'mm4', info => $reg64_href }, 83061da546Spatrick { name => 'mm5', info => $reg64_href }, 84061da546Spatrick { name => 'mm6', info => $reg64_href }, 85061da546Spatrick { name => 'mm7', info => $reg64_href }, 86061da546Spatrick ], 87061da546Spatrick 88061da546Spatrick 'i386-lldb' => [ 89061da546Spatrick { name => 'eax', info => $reg32_href }, 90061da546Spatrick { name => 'ebx', info => $reg32_href }, 91061da546Spatrick { name => 'ecx', info => $reg32_href }, 92061da546Spatrick { name => 'edx', info => $reg32_href }, 93061da546Spatrick { name => 'edi', info => $reg32_href }, 94061da546Spatrick { name => 'esi', info => $reg32_href }, 95061da546Spatrick { name => 'ebp', info => $reg32_href }, 96061da546Spatrick { name => 'esp', info => $reg32_href }, 97061da546Spatrick { name => 'ss', info => $reg32_href }, 98061da546Spatrick { name => 'eflags', info => $reg32_href }, 99061da546Spatrick { name => 'eip', info => $reg32_href }, 100061da546Spatrick { name => 'cs', info => $reg32_href }, 101061da546Spatrick { name => 'ds', info => $reg32_href }, 102061da546Spatrick { name => 'es', info => $reg32_href }, 103061da546Spatrick { name => 'fs', info => $reg32_href }, 104061da546Spatrick { name => 'gs', info => $reg32_href }, 105061da546Spatrick { name => 'fctrl', info => $reg16_href }, 106061da546Spatrick { name => 'fstat', info => $reg16_href }, 107061da546Spatrick { name => 'ftag', info => $reg8_href }, 108061da546Spatrick { name => 'fop', info => $reg16_href }, 109061da546Spatrick { name => 'fioff', info => $reg32_href }, 110061da546Spatrick { name => 'fiseg', info => $reg16_href }, 111061da546Spatrick { name => 'fooff', info => $reg32_href }, 112061da546Spatrick { name => 'foseg', info => $reg16_href }, 113061da546Spatrick { name => 'mxcsr', info => $reg32_href }, 114061da546Spatrick { name => 'mxcsrmask', info => $reg32_href }, 115061da546Spatrick { name => 'stmm0', info => $reg80_href }, 116061da546Spatrick { name => 'stmm1', info => $reg80_href }, 117061da546Spatrick { name => 'stmm2', info => $reg80_href }, 118061da546Spatrick { name => 'stmm3', info => $reg80_href }, 119061da546Spatrick { name => 'stmm4', info => $reg80_href }, 120061da546Spatrick { name => 'stmm5', info => $reg80_href }, 121061da546Spatrick { name => 'stmm6', info => $reg80_href }, 122061da546Spatrick { name => 'stmm7', info => $reg80_href }, 123061da546Spatrick { name => 'xmm0', info => $reg128_href }, 124061da546Spatrick { name => 'xmm1', info => $reg128_href }, 125061da546Spatrick { name => 'xmm2', info => $reg128_href }, 126061da546Spatrick { name => 'xmm3', info => $reg128_href }, 127061da546Spatrick { name => 'xmm4', info => $reg128_href }, 128061da546Spatrick { name => 'xmm5', info => $reg128_href }, 129061da546Spatrick { name => 'xmm6', info => $reg128_href }, 130061da546Spatrick { name => 'xmm7', info => $reg128_href }, 131061da546Spatrick { name => 'trapno', info => $reg32_href }, 132061da546Spatrick { name => 'err', info => $reg32_href }, 133061da546Spatrick { name => 'faultvaddr', info => $reg32_href }, 134061da546Spatrick ], 135061da546Spatrick 136061da546Spatrick 'arm-gdb' => [ 137061da546Spatrick { name => 'r0' , info => $reg32_href }, 138061da546Spatrick { name => 'r1' , info => $reg32_href }, 139061da546Spatrick { name => 'r2' , info => $reg32_href }, 140061da546Spatrick { name => 'r3' , info => $reg32_href }, 141061da546Spatrick { name => 'r4' , info => $reg32_href }, 142061da546Spatrick { name => 'r5' , info => $reg32_href }, 143061da546Spatrick { name => 'r6' , info => $reg32_href }, 144061da546Spatrick { name => 'r7' , info => $reg32_href }, 145061da546Spatrick { name => 'r8' , info => $reg32_href }, 146061da546Spatrick { name => 'r9' , info => $reg32_href }, 147061da546Spatrick { name => 'r10' , info => $reg32_href }, 148061da546Spatrick { name => 'r11' , info => $reg32_href }, 149061da546Spatrick { name => 'r12' , info => $reg32_href }, 150061da546Spatrick { name => 'sp' , info => $reg32_href }, 151061da546Spatrick { name => 'lr' , info => $reg32_href }, 152061da546Spatrick { name => 'pc' , info => $reg32_href }, 153061da546Spatrick { name => 'f0' , info => $float96_href }, 154061da546Spatrick { name => 'f1' , info => $float96_href }, 155061da546Spatrick { name => 'f2' , info => $float96_href }, 156061da546Spatrick { name => 'f3' , info => $float96_href }, 157061da546Spatrick { name => 'f4' , info => $float96_href }, 158061da546Spatrick { name => 'f5' , info => $float96_href }, 159061da546Spatrick { name => 'f6' , info => $float96_href }, 160061da546Spatrick { name => 'f7' , info => $float96_href }, 161061da546Spatrick { name => 'fps' , info => $reg32_href }, 162061da546Spatrick { name => 'cpsr' , info => $reg32_href }, 163061da546Spatrick { name => 's0' , info => $float32_href }, 164061da546Spatrick { name => 's1' , info => $float32_href }, 165061da546Spatrick { name => 's2' , info => $float32_href }, 166061da546Spatrick { name => 's3' , info => $float32_href }, 167061da546Spatrick { name => 's4' , info => $float32_href }, 168061da546Spatrick { name => 's5' , info => $float32_href }, 169061da546Spatrick { name => 's6' , info => $float32_href }, 170061da546Spatrick { name => 's7' , info => $float32_href }, 171061da546Spatrick { name => 's8' , info => $float32_href }, 172061da546Spatrick { name => 's9' , info => $float32_href }, 173061da546Spatrick { name => 's10' , info => $float32_href }, 174061da546Spatrick { name => 's11' , info => $float32_href }, 175061da546Spatrick { name => 's12' , info => $float32_href }, 176061da546Spatrick { name => 's13' , info => $float32_href }, 177061da546Spatrick { name => 's14' , info => $float32_href }, 178061da546Spatrick { name => 's15' , info => $float32_href }, 179061da546Spatrick { name => 's16' , info => $float32_href }, 180061da546Spatrick { name => 's17' , info => $float32_href }, 181061da546Spatrick { name => 's18' , info => $float32_href }, 182061da546Spatrick { name => 's19' , info => $float32_href }, 183061da546Spatrick { name => 's20' , info => $float32_href }, 184061da546Spatrick { name => 's21' , info => $float32_href }, 185061da546Spatrick { name => 's22' , info => $float32_href }, 186061da546Spatrick { name => 's23' , info => $float32_href }, 187061da546Spatrick { name => 's24' , info => $float32_href }, 188061da546Spatrick { name => 's25' , info => $float32_href }, 189061da546Spatrick { name => 's26' , info => $float32_href }, 190061da546Spatrick { name => 's27' , info => $float32_href }, 191061da546Spatrick { name => 's28' , info => $float32_href }, 192061da546Spatrick { name => 's29' , info => $float32_href }, 193061da546Spatrick { name => 's30' , info => $float32_href }, 194061da546Spatrick { name => 's31' , info => $float32_href }, 195061da546Spatrick { name => 'fpscr' , info => $reg32_href }, 196061da546Spatrick { name => 'd16' , info => $float64_href }, 197061da546Spatrick { name => 'd17' , info => $float64_href }, 198061da546Spatrick { name => 'd18' , info => $float64_href }, 199061da546Spatrick { name => 'd19' , info => $float64_href }, 200061da546Spatrick { name => 'd20' , info => $float64_href }, 201061da546Spatrick { name => 'd21' , info => $float64_href }, 202061da546Spatrick { name => 'd22' , info => $float64_href }, 203061da546Spatrick { name => 'd23' , info => $float64_href }, 204061da546Spatrick { name => 'd24' , info => $float64_href }, 205061da546Spatrick { name => 'd25' , info => $float64_href }, 206061da546Spatrick { name => 'd26' , info => $float64_href }, 207061da546Spatrick { name => 'd27' , info => $float64_href }, 208061da546Spatrick { name => 'd28' , info => $float64_href }, 209061da546Spatrick { name => 'd29' , info => $float64_href }, 210061da546Spatrick { name => 'd30' , info => $float64_href }, 211061da546Spatrick { name => 'd31' , info => $float64_href }, 212061da546Spatrick ], 213061da546Spatrick 214061da546Spatrick 215061da546Spatrick 'arm-lldb' => [ 216061da546Spatrick { name => 'r0' , info => $reg32_href }, 217061da546Spatrick { name => 'r1' , info => $reg32_href }, 218061da546Spatrick { name => 'r2' , info => $reg32_href }, 219061da546Spatrick { name => 'r3' , info => $reg32_href }, 220061da546Spatrick { name => 'r4' , info => $reg32_href }, 221061da546Spatrick { name => 'r5' , info => $reg32_href }, 222061da546Spatrick { name => 'r6' , info => $reg32_href }, 223061da546Spatrick { name => 'r7' , info => $reg32_href }, 224061da546Spatrick { name => 'r8' , info => $reg32_href }, 225061da546Spatrick { name => 'r9' , info => $reg32_href }, 226061da546Spatrick { name => 'r10' , info => $reg32_href }, 227061da546Spatrick { name => 'r11' , info => $reg32_href }, 228061da546Spatrick { name => 'r12' , info => $reg32_href }, 229061da546Spatrick { name => 'sp' , info => $reg32_href }, 230061da546Spatrick { name => 'lr' , info => $reg32_href }, 231061da546Spatrick { name => 'pc' , info => $reg32_href }, 232061da546Spatrick { name => 'cpsr' , info => $reg32_href }, 233061da546Spatrick { name => 's0' , info => $float32_href }, 234061da546Spatrick { name => 's1' , info => $float32_href }, 235061da546Spatrick { name => 's2' , info => $float32_href }, 236061da546Spatrick { name => 's3' , info => $float32_href }, 237061da546Spatrick { name => 's4' , info => $float32_href }, 238061da546Spatrick { name => 's5' , info => $float32_href }, 239061da546Spatrick { name => 's6' , info => $float32_href }, 240061da546Spatrick { name => 's7' , info => $float32_href }, 241061da546Spatrick { name => 's8' , info => $float32_href }, 242061da546Spatrick { name => 's9' , info => $float32_href }, 243061da546Spatrick { name => 's10' , info => $float32_href }, 244061da546Spatrick { name => 's11' , info => $float32_href }, 245061da546Spatrick { name => 's12' , info => $float32_href }, 246061da546Spatrick { name => 's13' , info => $float32_href }, 247061da546Spatrick { name => 's14' , info => $float32_href }, 248061da546Spatrick { name => 's15' , info => $float32_href }, 249061da546Spatrick { name => 's16' , info => $float32_href }, 250061da546Spatrick { name => 's17' , info => $float32_href }, 251061da546Spatrick { name => 's18' , info => $float32_href }, 252061da546Spatrick { name => 's19' , info => $float32_href }, 253061da546Spatrick { name => 's20' , info => $float32_href }, 254061da546Spatrick { name => 's21' , info => $float32_href }, 255061da546Spatrick { name => 's22' , info => $float32_href }, 256061da546Spatrick { name => 's23' , info => $float32_href }, 257061da546Spatrick { name => 's24' , info => $float32_href }, 258061da546Spatrick { name => 's25' , info => $float32_href }, 259061da546Spatrick { name => 's26' , info => $float32_href }, 260061da546Spatrick { name => 's27' , info => $float32_href }, 261061da546Spatrick { name => 's28' , info => $float32_href }, 262061da546Spatrick { name => 's29' , info => $float32_href }, 263061da546Spatrick { name => 's30' , info => $float32_href }, 264061da546Spatrick { name => 's31' , info => $float32_href }, 265061da546Spatrick { name => 'd0' , info => $float64_href }, 266061da546Spatrick { name => 'd1' , info => $float64_href }, 267061da546Spatrick { name => 'd2' , info => $float64_href }, 268061da546Spatrick { name => 'd3' , info => $float64_href }, 269061da546Spatrick { name => 'd4' , info => $float64_href }, 270061da546Spatrick { name => 'd5' , info => $float64_href }, 271061da546Spatrick { name => 'd6' , info => $float64_href }, 272061da546Spatrick { name => 'd7' , info => $float64_href }, 273061da546Spatrick { name => 'd8' , info => $float64_href }, 274061da546Spatrick { name => 'd9' , info => $float64_href }, 275061da546Spatrick { name => 'd10' , info => $float64_href }, 276061da546Spatrick { name => 'd11' , info => $float64_href }, 277061da546Spatrick { name => 'd12' , info => $float64_href }, 278061da546Spatrick { name => 'd13' , info => $float64_href }, 279061da546Spatrick { name => 'd14' , info => $float64_href }, 280061da546Spatrick { name => 'd15' , info => $float64_href }, 281061da546Spatrick { name => 'd16' , info => $float64_href }, 282061da546Spatrick { name => 'd17' , info => $float64_href }, 283061da546Spatrick { name => 'd18' , info => $float64_href }, 284061da546Spatrick { name => 'd19' , info => $float64_href }, 285061da546Spatrick { name => 'd20' , info => $float64_href }, 286061da546Spatrick { name => 'd21' , info => $float64_href }, 287061da546Spatrick { name => 'd22' , info => $float64_href }, 288061da546Spatrick { name => 'd23' , info => $float64_href }, 289061da546Spatrick { name => 'd24' , info => $float64_href }, 290061da546Spatrick { name => 'd25' , info => $float64_href }, 291061da546Spatrick { name => 'd26' , info => $float64_href }, 292061da546Spatrick { name => 'd27' , info => $float64_href }, 293061da546Spatrick { name => 'd28' , info => $float64_href }, 294061da546Spatrick { name => 'd29' , info => $float64_href }, 295061da546Spatrick { name => 'd30' , info => $float64_href }, 296061da546Spatrick { name => 'd31' , info => $float64_href }, 297061da546Spatrick { name => 'fpscr' , info => $reg32_href }, 298061da546Spatrick { name => 'exc' , info => $reg32_href }, 299061da546Spatrick { name => 'fsr' , info => $reg32_href }, 300061da546Spatrick { name => 'far' , info => $reg32_href }, 301061da546Spatrick ], 302061da546Spatrick 303061da546Spatrick 'x86_64-gdb' => [ 304061da546Spatrick { name => 'rax' , info => $reg64_href }, 305061da546Spatrick { name => 'rbx' , info => $reg64_href }, 306061da546Spatrick { name => 'rcx' , info => $reg64_href }, 307061da546Spatrick { name => 'rdx' , info => $reg64_href }, 308061da546Spatrick { name => 'rsi' , info => $reg64_href }, 309061da546Spatrick { name => 'rdi' , info => $reg64_href }, 310061da546Spatrick { name => 'rbp' , info => $reg64_href }, 311061da546Spatrick { name => 'rsp' , info => $reg64_href }, 312061da546Spatrick { name => 'r8' , info => $reg64_href }, 313061da546Spatrick { name => 'r9' , info => $reg64_href }, 314061da546Spatrick { name => 'r10' , info => $reg64_href }, 315061da546Spatrick { name => 'r11' , info => $reg64_href }, 316061da546Spatrick { name => 'r12' , info => $reg64_href }, 317061da546Spatrick { name => 'r13' , info => $reg64_href }, 318061da546Spatrick { name => 'r14' , info => $reg64_href }, 319061da546Spatrick { name => 'r15' , info => $reg64_href }, 320061da546Spatrick { name => 'rip' , info => $reg64_href }, 321061da546Spatrick { name => 'eflags' , info => $reg32_href }, 322061da546Spatrick { name => 'cs' , info => $reg32_href }, 323061da546Spatrick { name => 'ss' , info => $reg32_href }, 324061da546Spatrick { name => 'ds' , info => $reg32_href }, 325061da546Spatrick { name => 'es' , info => $reg32_href }, 326061da546Spatrick { name => 'fs' , info => $reg32_href }, 327061da546Spatrick { name => 'gs' , info => $reg32_href }, 328061da546Spatrick { name => 'stmm0' , info => $reg80_href }, 329061da546Spatrick { name => 'stmm1' , info => $reg80_href }, 330061da546Spatrick { name => 'stmm2' , info => $reg80_href }, 331061da546Spatrick { name => 'stmm3' , info => $reg80_href }, 332061da546Spatrick { name => 'stmm4' , info => $reg80_href }, 333061da546Spatrick { name => 'stmm5' , info => $reg80_href }, 334061da546Spatrick { name => 'stmm6' , info => $reg80_href }, 335061da546Spatrick { name => 'stmm7' , info => $reg80_href }, 336061da546Spatrick { name => 'fctrl' , info => $reg32_href }, 337061da546Spatrick { name => 'fstat' , info => $reg32_href }, 338061da546Spatrick { name => 'ftag' , info => $reg32_href }, 339061da546Spatrick { name => 'fiseg' , info => $reg32_href }, 340061da546Spatrick { name => 'fioff' , info => $reg32_href }, 341061da546Spatrick { name => 'foseg' , info => $reg32_href }, 342061da546Spatrick { name => 'fooff' , info => $reg32_href }, 343061da546Spatrick { name => 'fop' , info => $reg32_href }, 344061da546Spatrick { name => 'xmm0' , info => $reg128_href }, 345061da546Spatrick { name => 'xmm1' , info => $reg128_href }, 346061da546Spatrick { name => 'xmm2' , info => $reg128_href }, 347061da546Spatrick { name => 'xmm3' , info => $reg128_href }, 348061da546Spatrick { name => 'xmm4' , info => $reg128_href }, 349061da546Spatrick { name => 'xmm5' , info => $reg128_href }, 350061da546Spatrick { name => 'xmm6' , info => $reg128_href }, 351061da546Spatrick { name => 'xmm7' , info => $reg128_href }, 352061da546Spatrick { name => 'xmm8' , info => $reg128_href }, 353061da546Spatrick { name => 'xmm9' , info => $reg128_href }, 354061da546Spatrick { name => 'xmm10' , info => $reg128_href }, 355061da546Spatrick { name => 'xmm11' , info => $reg128_href }, 356061da546Spatrick { name => 'xmm12' , info => $reg128_href }, 357061da546Spatrick { name => 'xmm13' , info => $reg128_href }, 358061da546Spatrick { name => 'xmm14' , info => $reg128_href }, 359061da546Spatrick { name => 'xmm15' , info => $reg128_href }, 360061da546Spatrick { name => 'mxcsr' , info => $reg32_href }, 361061da546Spatrick ], 362061da546Spatrick 363061da546Spatrick 'x86_64-lldb' => [ 364061da546Spatrick { name => 'rax' , info => $reg64_href }, 365061da546Spatrick { name => 'rbx' , info => $reg64_href }, 366061da546Spatrick { name => 'rcx' , info => $reg64_href }, 367061da546Spatrick { name => 'rdx' , info => $reg64_href }, 368061da546Spatrick { name => 'rdi' , info => $reg64_href }, 369061da546Spatrick { name => 'rsi' , info => $reg64_href }, 370061da546Spatrick { name => 'rbp' , info => $reg64_href }, 371061da546Spatrick { name => 'rsp' , info => $reg64_href }, 372061da546Spatrick { name => 'r8 ' , info => $reg64_href }, 373061da546Spatrick { name => 'r9 ' , info => $reg64_href }, 374061da546Spatrick { name => 'r10' , info => $reg64_href }, 375061da546Spatrick { name => 'r11' , info => $reg64_href }, 376061da546Spatrick { name => 'r12' , info => $reg64_href }, 377061da546Spatrick { name => 'r13' , info => $reg64_href }, 378061da546Spatrick { name => 'r14' , info => $reg64_href }, 379061da546Spatrick { name => 'r15' , info => $reg64_href }, 380061da546Spatrick { name => 'rip' , info => $reg64_href }, 381061da546Spatrick { name => 'rflags' , info => $reg64_href }, 382061da546Spatrick { name => 'cs' , info => $reg64_href }, 383061da546Spatrick { name => 'fs' , info => $reg64_href }, 384061da546Spatrick { name => 'gs' , info => $reg64_href }, 385061da546Spatrick { name => 'fctrl' , info => $reg16_href }, 386061da546Spatrick { name => 'fstat' , info => $reg16_href }, 387061da546Spatrick { name => 'ftag' , info => $reg8_href }, 388061da546Spatrick { name => 'fop' , info => $reg16_href }, 389061da546Spatrick { name => 'fioff' , info => $reg32_href }, 390061da546Spatrick { name => 'fiseg' , info => $reg16_href }, 391061da546Spatrick { name => 'fooff' , info => $reg32_href }, 392061da546Spatrick { name => 'foseg' , info => $reg16_href }, 393061da546Spatrick { name => 'mxcsr' , info => $reg32_href }, 394061da546Spatrick { name => 'mxcsrmask' , info => $reg32_href }, 395061da546Spatrick { name => 'stmm0' , info => $reg80_href }, 396061da546Spatrick { name => 'stmm1' , info => $reg80_href }, 397061da546Spatrick { name => 'stmm2' , info => $reg80_href }, 398061da546Spatrick { name => 'stmm3' , info => $reg80_href }, 399061da546Spatrick { name => 'stmm4' , info => $reg80_href }, 400061da546Spatrick { name => 'stmm5' , info => $reg80_href }, 401061da546Spatrick { name => 'stmm6' , info => $reg80_href }, 402061da546Spatrick { name => 'stmm7' , info => $reg80_href }, 403061da546Spatrick { name => 'xmm0' , info => $reg128_href }, 404061da546Spatrick { name => 'xmm1' , info => $reg128_href }, 405061da546Spatrick { name => 'xmm2' , info => $reg128_href }, 406061da546Spatrick { name => 'xmm3' , info => $reg128_href }, 407061da546Spatrick { name => 'xmm4' , info => $reg128_href }, 408061da546Spatrick { name => 'xmm5' , info => $reg128_href }, 409061da546Spatrick { name => 'xmm6' , info => $reg128_href }, 410061da546Spatrick { name => 'xmm7' , info => $reg128_href }, 411061da546Spatrick { name => 'xmm8' , info => $reg128_href }, 412061da546Spatrick { name => 'xmm9' , info => $reg128_href }, 413061da546Spatrick { name => 'xmm10' , info => $reg128_href }, 414061da546Spatrick { name => 'xmm11' , info => $reg128_href }, 415061da546Spatrick { name => 'xmm12' , info => $reg128_href }, 416061da546Spatrick { name => 'xmm13' , info => $reg128_href }, 417061da546Spatrick { name => 'xmm14' , info => $reg128_href }, 418061da546Spatrick { name => 'xmm15' , info => $reg128_href }, 419061da546Spatrick { name => 'trapno' , info => $reg32_href }, 420061da546Spatrick { name => 'err' , info => $reg32_href }, 421061da546Spatrick { name => 'faultvaddr' , info => $reg64_href }, 422061da546Spatrick ] 423061da546Spatrick); 424061da546Spatrick 425061da546Spatrickour $max_register_name_len = 0; 426061da546Spatrickcalculate_max_register_name_length(); 427061da546Spatrickour @point_types = ( "software_bp", "hardware_bp", "write_wp", "read_wp", "access_wp" ); 428061da546Spatrickour $opt_v = 0; # verbose 429061da546Spatrickour $opt_g = 0; # debug 430061da546Spatrickour $opt_q = 0; # quiet 431061da546Spatrickour $opt_r = undef; 432061da546Spatrickuse Getopt::Std; 433061da546Spatrickgetopts('gvqr:'); 434061da546Spatrick 435061da546Spatrickour $registers_aref = undef; 436061da546Spatrick 437061da546Spatrickif (length($opt_r)) 438061da546Spatrick{ 439061da546Spatrick if (exists $reg_map{$opt_r}) 440061da546Spatrick { 441061da546Spatrick $registers_aref = $reg_map{$opt_r}; 442061da546Spatrick } 443061da546Spatrick else 444061da546Spatrick { 445061da546Spatrick die "Can't get registers group for '$opt_r'\n"; 446061da546Spatrick } 447061da546Spatrick} 448061da546Spatrick 449061da546Spatricksub extract_key_value_pairs 450061da546Spatrick{ 451061da546Spatrick my $kv_href = {}; 452061da546Spatrick my $arrayref = shift; 453061da546Spatrick my $str = join('',@$arrayref); 454061da546Spatrick my @kv_strs = split(/;/, $str); 455061da546Spatrick foreach my $kv_str (@kv_strs) 456061da546Spatrick { 457061da546Spatrick my ($key, $value) = split(/:/, $kv_str); 458061da546Spatrick $kv_href->{$key} = $value; 459061da546Spatrick } 460061da546Spatrick return $kv_href; 461061da546Spatrick} 462061da546Spatrick 463061da546Spatricksub get_thread_from_thread_suffix 464061da546Spatrick{ 465061da546Spatrick if ($thread_suffix_supported) 466061da546Spatrick { 467061da546Spatrick my $arrayref = shift; 468061da546Spatrick # Skip leading semi-colon if needed 469061da546Spatrick $$arrayref[0] == ';' and shift @$arrayref; 470061da546Spatrick my $thread_href = extract_key_value_pairs ($arrayref); 471061da546Spatrick if (exists $thread_href->{thread}) 472061da546Spatrick { 473061da546Spatrick return $thread_href->{thread}; 474061da546Spatrick } 475061da546Spatrick } 476061da546Spatrick return undef; 477061da546Spatrick} 478061da546Spatrick 479061da546Spatricksub calculate_max_register_name_length 480061da546Spatrick{ 481061da546Spatrick $max_register_name_len = 7; 482061da546Spatrick foreach my $reg_href (@$registers_aref) 483061da546Spatrick { 484061da546Spatrick my $name_len = length($reg_href->{name}); 485061da546Spatrick if ($max_register_name_len < $name_len) 486061da546Spatrick { 487061da546Spatrick $max_register_name_len = $name_len; 488061da546Spatrick } 489061da546Spatrick } 490061da546Spatrick} 491061da546Spatrick#---------------------------------------------------------------------- 492061da546Spatrick# Hash that maps command characters to the appropriate functions using 493061da546Spatrick# the command character as the key and the value being a reference to 494061da546Spatrick# the dump function for dumping the command itself. 495061da546Spatrick#---------------------------------------------------------------------- 496061da546Spatrickour %cmd_callbacks = 497061da546Spatrick( 498061da546Spatrick '?' => \&dump_last_signal_cmd, 499061da546Spatrick 'H' => \&dump_set_thread_cmd, 500061da546Spatrick 'T' => \&dump_thread_is_alive_cmd, 501061da546Spatrick 'q' => \&dump_general_query_cmd, 502061da546Spatrick 'Q' => \&dump_general_set_cmd, 503061da546Spatrick 'g' => \&dump_read_regs_cmd, 504061da546Spatrick 'G' => \&dump_write_regs_cmd, 505061da546Spatrick 'p' => \&dump_read_single_register_cmd, 506061da546Spatrick 'P' => \&dump_write_single_register_cmd, 507061da546Spatrick 'm' => \&dump_read_mem_cmd, 508061da546Spatrick 'M' => \&dump_write_mem_cmd, 509061da546Spatrick 'X' => \&dump_write_mem_binary_cmd, 510061da546Spatrick 'Z' => \&dump_bp_wp_command, 511061da546Spatrick 'z' => \&dump_bp_wp_command, 512061da546Spatrick 'k' => \&dump_kill_cmd, 513061da546Spatrick 'A' => \&dump_A_command, 514061da546Spatrick 'c' => \&dump_continue_cmd, 515061da546Spatrick 's' => \&dump_continue_cmd, 516061da546Spatrick 'C' => \&dump_continue_with_signal_cmd, 517061da546Spatrick 'S' => \&dump_continue_with_signal_cmd, 518061da546Spatrick '_M' => \&dump_allocate_memory_cmd, 519061da546Spatrick '_m' => \&dump_deallocate_memory_cmd, 520061da546Spatrick # extended commands 521061da546Spatrick 'v' => \&dump_extended_cmd 522061da546Spatrick); 523061da546Spatrick 524061da546Spatrick#---------------------------------------------------------------------- 525061da546Spatrick# Hash that maps command characters to the appropriate functions using 526061da546Spatrick# the command character as the key and the value being a reference to 527061da546Spatrick# the dump function for the response to the command. 528061da546Spatrick#---------------------------------------------------------------------- 529061da546Spatrickour %rsp_callbacks = 530061da546Spatrick( 531061da546Spatrick 'c' => \&dump_stop_reply_packet, 532061da546Spatrick 's' => \&dump_stop_reply_packet, 533061da546Spatrick 'C' => \&dump_stop_reply_packet, 534061da546Spatrick '?' => \&dump_stop_reply_packet, 535061da546Spatrick 'T' => \&dump_thread_is_alive_rsp, 536061da546Spatrick 'H' => \&dump_set_thread_rsp, 537061da546Spatrick 'q' => \&dump_general_query_rsp, 538061da546Spatrick 'g' => \&dump_read_regs_rsp, 539061da546Spatrick 'p' => \&dump_read_single_register_rsp, 540061da546Spatrick 'm' => \&dump_read_mem_rsp, 541061da546Spatrick '_M' => \&dump_allocate_memory_rsp, 542061da546Spatrick 543061da546Spatrick # extended commands 544061da546Spatrick 'v' => \&dump_extended_rsp, 545061da546Spatrick); 546061da546Spatrick 547061da546Spatrick 548061da546Spatricksub dump_register_value 549061da546Spatrick{ 550061da546Spatrick my $indent = shift; 551061da546Spatrick my $arrayref = shift; 552061da546Spatrick my $reg_num = shift; 553061da546Spatrick 554061da546Spatrick if ($reg_num >= @$registers_aref) 555061da546Spatrick { 556061da546Spatrick printf("\tinvalid register index %d\n", $reg_num); 557061da546Spatrick return; 558061da546Spatrick } 559061da546Spatrick 560061da546Spatrick my $reg_href = $$registers_aref[$reg_num]; 561061da546Spatrick my $reg_name = $reg_href->{name}; 562061da546Spatrick if ($$arrayref[0] eq '#') 563061da546Spatrick { 564061da546Spatrick printf("\t%*s: error: EOS reached when trying to read register %d\n", $max_register_name_len, $reg_name, $reg_num); 565061da546Spatrick } 566061da546Spatrick 567061da546Spatrick my $reg_info = $reg_href->{info}; 568061da546Spatrick my $reg_extract = $reg_info->{extract}; 569061da546Spatrick my $reg_format = $reg_info->{format}; 570061da546Spatrick my $reg_val = &$reg_extract($arrayref); 571061da546Spatrick if ($indent) { 572061da546Spatrick printf("\t%*s = $reg_format", $max_register_name_len, $reg_name, $reg_val); 573061da546Spatrick } else { 574061da546Spatrick printf("%s = $reg_format", $reg_name, $reg_val); 575061da546Spatrick } 576061da546Spatrick} 577061da546Spatrick 578061da546Spatrick#---------------------------------------------------------------------- 579061da546Spatrick# Extract the command into an array of ASCII char strings for easy 580061da546Spatrick# processing 581061da546Spatrick#---------------------------------------------------------------------- 582061da546Spatricksub extract_command 583061da546Spatrick{ 584061da546Spatrick my $cmd_str = shift; 585061da546Spatrick my @cmd_chars = split(/ */, $cmd_str); 586061da546Spatrick if ($cmd_chars[0] ne '$') 587061da546Spatrick { 588061da546Spatrick # only set the current command if it isn't a reply 589061da546Spatrick $curr_cmd = $cmd_chars[0]; 590061da546Spatrick } 591061da546Spatrick return @cmd_chars; 592061da546Spatrick} 593061da546Spatrick 594061da546Spatrick#---------------------------------------------------------------------- 595061da546Spatrick# Strip the 3 checksum array entries after we don't need them anymore 596061da546Spatrick#---------------------------------------------------------------------- 597061da546Spatricksub strip_checksum 598061da546Spatrick{ 599061da546Spatrick my $arrayref = shift; 600061da546Spatrick splice(@$arrayref, -3); 601061da546Spatrick} 602061da546Spatrick 603061da546Spatrick#---------------------------------------------------------------------- 604061da546Spatrick# Dump all strings in array by joining them together with no space 605061da546Spatrick# between them 606061da546Spatrick#---------------------------------------------------------------------- 607061da546Spatricksub dump_chars 608061da546Spatrick{ 609061da546Spatrick print join('',@_); 610061da546Spatrick} 611061da546Spatrick 612061da546Spatrick#---------------------------------------------------------------------- 613061da546Spatrick# Check if the response is an error 'EXX' 614061da546Spatrick#---------------------------------------------------------------------- 615061da546Spatricksub is_error_response 616061da546Spatrick{ 617061da546Spatrick if ($_[0] eq 'E') 618061da546Spatrick { 619061da546Spatrick shift; 620061da546Spatrick print "ERROR = " . join('',@_) . "\n"; 621061da546Spatrick return 1; 622061da546Spatrick } 623061da546Spatrick return 0; 624061da546Spatrick} 625061da546Spatrick 626061da546Spatrick#---------------------------------------------------------------------- 627061da546Spatrick# 'H' command 628061da546Spatrick#---------------------------------------------------------------------- 629061da546Spatricksub dump_set_thread_cmd 630061da546Spatrick{ 631061da546Spatrick my $cmd = shift; 632061da546Spatrick my $mod = shift; 633061da546Spatrick print "set_thread ( $mod, " . join('',@_) . " )\n"; 634061da546Spatrick} 635061da546Spatrick 636061da546Spatrick#---------------------------------------------------------------------- 637061da546Spatrick# 'T' command 638061da546Spatrick#---------------------------------------------------------------------- 639061da546Spatrickour $T_cmd_tid = -1; 640061da546Spatricksub dump_thread_is_alive_cmd 641061da546Spatrick{ 642061da546Spatrick my $cmd = shift; 643061da546Spatrick $T_cmd_tid = get_hex(\@_); 644061da546Spatrick printf("thread_is_alive ( $tid_format )\n", $T_cmd_tid); 645061da546Spatrick} 646061da546Spatrick 647061da546Spatricksub dump_thread_is_alive_rsp 648061da546Spatrick{ 649061da546Spatrick my $rsp = join('',@_); 650061da546Spatrick 651061da546Spatrick printf("thread_is_alive ( $tid_format ) =>", $T_cmd_tid); 652061da546Spatrick if ($rsp eq 'OK') 653061da546Spatrick { 654061da546Spatrick print " alive.\n"; 655061da546Spatrick } 656061da546Spatrick else 657061da546Spatrick { 658061da546Spatrick print " dead.\n"; 659061da546Spatrick } 660061da546Spatrick} 661061da546Spatrick 662061da546Spatrick#---------------------------------------------------------------------- 663061da546Spatrick# 'H' response 664061da546Spatrick#---------------------------------------------------------------------- 665061da546Spatricksub dump_set_thread_rsp 666061da546Spatrick{ 667061da546Spatrick if (!is_error_response(@_)) 668061da546Spatrick { 669061da546Spatrick print join('',@_) . "\n"; 670061da546Spatrick } 671061da546Spatrick} 672061da546Spatrick 673061da546Spatrick#---------------------------------------------------------------------- 674061da546Spatrick# 'q' command 675061da546Spatrick#---------------------------------------------------------------------- 676061da546Spatrickour $gen_query_cmd; 677061da546Spatrickour $qRegisterInfo_reg_num = -1; 678061da546Spatricksub dump_general_query_cmd 679061da546Spatrick{ 680061da546Spatrick $gen_query_cmd = join('',@_); 681061da546Spatrick if ($gen_query_cmd eq 'qC') 682061da546Spatrick { 683061da546Spatrick print 'get_current_pid ()'; 684061da546Spatrick } 685061da546Spatrick elsif ($gen_query_cmd eq 'qfThreadInfo') 686061da546Spatrick { 687061da546Spatrick print 'get_first_active_threads ()'; 688061da546Spatrick } 689061da546Spatrick elsif ($gen_query_cmd eq 'qsThreadInfo') 690061da546Spatrick { 691061da546Spatrick print 'get_subsequent_active_threads ()'; 692061da546Spatrick } 693061da546Spatrick elsif (index($gen_query_cmd, 'qThreadExtraInfo') == 0) 694061da546Spatrick { 695061da546Spatrick # qThreadExtraInfo,id 696061da546Spatrick print 'get_thread_extra_info ()'; 697061da546Spatrick } 698061da546Spatrick elsif (index($gen_query_cmd, 'qThreadStopInfo') == 0) 699061da546Spatrick { 700061da546Spatrick # qThreadStopInfoXXXX 701061da546Spatrick @_ = splice(@_, length('qThreadStopInfo')); 702061da546Spatrick my $tid = get_addr(\@_); 703061da546Spatrick printf('get_thread_stop_info ( thread = 0x%4.4x )', $tid); 704061da546Spatrick } 705061da546Spatrick elsif (index($gen_query_cmd, 'qSymbol:') == 0) 706061da546Spatrick { 707061da546Spatrick # qCRC:addr,length 708061da546Spatrick print 'gdb_ready_to_serve_symbol_lookups ()'; 709061da546Spatrick } 710061da546Spatrick elsif (index($gen_query_cmd, 'qCRC:') == 0) 711061da546Spatrick { 712061da546Spatrick # qCRC:addr,length 713061da546Spatrick @_ = splice(@_, length('qCRC:')); 714061da546Spatrick my $address = get_addr(\@_); 715061da546Spatrick shift @_; 716061da546Spatrick my $length = join('', @_); 717061da546Spatrick printf("compute_crc (addr = $addr_format, length = $length)", $address); 718061da546Spatrick } 719061da546Spatrick elsif (index($gen_query_cmd, 'qGetTLSAddr:') == 0) 720061da546Spatrick { 721061da546Spatrick # qGetTLSAddr:thread-id,offset,lm 722061da546Spatrick @_ = splice(@_, length('qGetTLSAddr:')); 723061da546Spatrick my ($tid, $offset, $lm) = split (/,/, join('', @_)); 724061da546Spatrick print "get_thread_local_storage_addr (thread-id = $tid, offset = $offset, lm = $lm)"; 725061da546Spatrick } 726061da546Spatrick elsif ($gen_query_cmd eq 'qOffsets') 727061da546Spatrick { 728061da546Spatrick print 'get_section_offsets ()'; 729061da546Spatrick } 730061da546Spatrick elsif (index($gen_query_cmd, 'qRegisterInfo') == 0) 731061da546Spatrick { 732061da546Spatrick @_ = splice(@_, length('qRegisterInfo')); 733061da546Spatrick $qRegisterInfo_reg_num = get_hex(\@_); 734061da546Spatrick 735061da546Spatrick printf "get_dynamic_register_info ($qRegisterInfo_reg_num)"; 736061da546Spatrick } 737061da546Spatrick else 738061da546Spatrick { 739061da546Spatrick print $gen_query_cmd; 740061da546Spatrick } 741061da546Spatrick print "\n"; 742061da546Spatrick} 743061da546Spatrick 744061da546Spatrick#---------------------------------------------------------------------- 745061da546Spatrick# 'q' response 746061da546Spatrick#---------------------------------------------------------------------- 747061da546Spatricksub dump_general_query_rsp 748061da546Spatrick{ 749061da546Spatrick my $gen_query_rsp = join('',@_); 750061da546Spatrick my $gen_query_rsp_len = length ($gen_query_rsp); 751061da546Spatrick if ($gen_query_cmd eq 'qC' and index($gen_query_rsp, 'QC') == 0) 752061da546Spatrick { 753061da546Spatrick shift @_; shift @_; 754061da546Spatrick my $pid = get_hex(\@_); 755061da546Spatrick printf("pid = $pid_format\n", $pid); 756061da546Spatrick return; 757061da546Spatrick } 758061da546Spatrick elsif (index($gen_query_cmd, 'qRegisterInfo') == 0) 759061da546Spatrick { 760061da546Spatrick if ($gen_query_rsp_len == 0) 761061da546Spatrick { 762061da546Spatrick print "$unimplemented_str\n"; 763061da546Spatrick } 764061da546Spatrick else 765061da546Spatrick { 766061da546Spatrick if (index($gen_query_rsp, 'name') == 0) 767061da546Spatrick { 768061da546Spatrick $qRegisterInfo_reg_num == 0 and $registers_aref = []; 769061da546Spatrick 770061da546Spatrick my @name_and_values = split (/;/, $gen_query_rsp); 771061da546Spatrick 772061da546Spatrick my $reg_name = undef; 773061da546Spatrick my $byte_size = 0; 774061da546Spatrick my $pseudo = 0; 775061da546Spatrick foreach (@name_and_values) 776061da546Spatrick { 777061da546Spatrick my ($name, $value) = split /:/; 778061da546Spatrick if ($name eq "name") { $reg_name = $value; } 779061da546Spatrick elsif ($name eq "bitsize") { $byte_size = $value / 8; } 780061da546Spatrick elsif ($name eq "container-regs") { $pseudo = 1; } 781061da546Spatrick } 782061da546Spatrick if (defined $reg_name and $byte_size > 0) 783061da546Spatrick { 784061da546Spatrick if ($byte_size == 4) {push @$registers_aref, { name => $reg_name, info => $reg32_href , pseudo => $pseudo };} 785061da546Spatrick elsif ($byte_size == 8) {push @$registers_aref, { name => $reg_name, info => $reg64_href , pseudo => $pseudo };} 786061da546Spatrick elsif ($byte_size == 1) {push @$registers_aref, { name => $reg_name, info => $reg8_href , pseudo => $pseudo };} 787061da546Spatrick elsif ($byte_size == 2) {push @$registers_aref, { name => $reg_name, info => $reg16_href , pseudo => $pseudo };} 788061da546Spatrick elsif ($byte_size == 10) {push @$registers_aref, { name => $reg_name, info => $reg80_href , pseudo => $pseudo };} 789061da546Spatrick elsif ($byte_size == 12) {push @$registers_aref, { name => $reg_name, info => $float96_href , pseudo => $pseudo };} 790061da546Spatrick elsif ($byte_size == 16) {push @$registers_aref, { name => $reg_name, info => $reg128_href , pseudo => $pseudo };} 791061da546Spatrick elsif ($byte_size == 32) {push @$registers_aref, { name => $reg_name, info => $reg256_href , pseudo => $pseudo };} 792061da546Spatrick } 793061da546Spatrick } 794061da546Spatrick elsif ($gen_query_rsp_len == 3 and index($gen_query_rsp, 'E') == 0) 795061da546Spatrick { 796061da546Spatrick calculate_max_register_name_length(); 797061da546Spatrick } 798061da546Spatrick } 799061da546Spatrick } 800061da546Spatrick elsif ($gen_query_cmd =~ 'qThreadStopInfo') 801061da546Spatrick { 802061da546Spatrick dump_stop_reply_packet (@_); 803061da546Spatrick } 804061da546Spatrick if (dump_standard_response(\@_)) 805061da546Spatrick { 806061da546Spatrick # Do nothing... 807061da546Spatrick } 808061da546Spatrick else 809061da546Spatrick { 810061da546Spatrick print join('',@_) . "\n"; 811061da546Spatrick } 812061da546Spatrick} 813061da546Spatrick 814061da546Spatrick#---------------------------------------------------------------------- 815061da546Spatrick# 'Q' command 816061da546Spatrick#---------------------------------------------------------------------- 817061da546Spatrickour $gen_set_cmd; 818061da546Spatricksub dump_general_set_cmd 819061da546Spatrick{ 820061da546Spatrick $gen_query_cmd = join('',@_); 821061da546Spatrick if ($gen_query_cmd eq 'QStartNoAckMode') 822061da546Spatrick { 823061da546Spatrick print "StartNoAckMode ()" 824061da546Spatrick } 825061da546Spatrick elsif ($gen_query_cmd eq 'QThreadSuffixSupported') 826061da546Spatrick { 827061da546Spatrick $thread_suffix_supported = 1; 828061da546Spatrick print "ThreadSuffixSupported ()" 829061da546Spatrick } 830061da546Spatrick elsif (index($gen_query_cmd, 'QSetMaxPayloadSize:') == 0) 831061da546Spatrick { 832061da546Spatrick @_ = splice(@_, length('QSetMaxPayloadSize:')); 833061da546Spatrick my $max_payload_size = get_hex(\@_); 834061da546Spatrick # QSetMaxPayloadSize:XXXX where XXXX is a hex length of the max 835061da546Spatrick # packet payload size supported by gdb 836061da546Spatrick printf("SetMaxPayloadSize ( 0x%x (%u))", $max_payload_size, $max_payload_size); 837061da546Spatrick } 838061da546Spatrick elsif (index ($gen_query_cmd, 'QSetSTDIN:') == 0) 839061da546Spatrick { 840061da546Spatrick @_ = splice(@_, length('QSetSTDIN:')); 841061da546Spatrick printf ("SetSTDIN (path ='%s')\n", get_hex_string (\@_)); 842061da546Spatrick } 843061da546Spatrick elsif (index ($gen_query_cmd, 'QSetSTDOUT:') == 0) 844061da546Spatrick { 845061da546Spatrick @_ = splice(@_, length('QSetSTDOUT:')); 846061da546Spatrick printf ("SetSTDOUT (path ='%s')\n", get_hex_string (\@_)); 847061da546Spatrick } 848061da546Spatrick elsif (index ($gen_query_cmd, 'QSetSTDERR:') == 0) 849061da546Spatrick { 850061da546Spatrick @_ = splice(@_, length('QSetSTDERR:')); 851061da546Spatrick printf ("SetSTDERR (path ='%s')\n", get_hex_string (\@_)); 852061da546Spatrick } 853061da546Spatrick else 854061da546Spatrick { 855061da546Spatrick print $gen_query_cmd; 856061da546Spatrick } 857061da546Spatrick print "\n"; 858061da546Spatrick} 859061da546Spatrick 860061da546Spatrick#---------------------------------------------------------------------- 861061da546Spatrick# 'k' command 862061da546Spatrick#---------------------------------------------------------------------- 863061da546Spatricksub dump_kill_cmd 864061da546Spatrick{ 865061da546Spatrick my $cmd = shift; 866061da546Spatrick print "kill (" . join('',@_) . ")\n"; 867061da546Spatrick} 868061da546Spatrick 869061da546Spatrick#---------------------------------------------------------------------- 870061da546Spatrick# 'g' command 871061da546Spatrick#---------------------------------------------------------------------- 872061da546Spatricksub dump_read_regs_cmd 873061da546Spatrick{ 874061da546Spatrick my $cmd = shift; 875061da546Spatrick print "read_registers ()\n"; 876061da546Spatrick} 877061da546Spatrick 878061da546Spatrick#---------------------------------------------------------------------- 879061da546Spatrick# 'G' command 880061da546Spatrick#---------------------------------------------------------------------- 881061da546Spatricksub dump_write_regs_cmd 882061da546Spatrick{ 883061da546Spatrick print "write_registers:\n"; 884061da546Spatrick my $cmd = shift; 885061da546Spatrick foreach my $reg_href (@$registers_aref) 886061da546Spatrick { 887061da546Spatrick last if ($_[0] eq '#'); 888061da546Spatrick if ($reg_href->{pseudo} == 0) 889061da546Spatrick { 890061da546Spatrick my $reg_info_href = $reg_href->{info}; 891061da546Spatrick my $reg_name = $reg_href->{name}; 892061da546Spatrick my $reg_extract = $reg_info_href->{extract}; 893061da546Spatrick my $reg_format = $reg_info_href->{format}; 894061da546Spatrick my $reg_val = &$reg_extract(\@_); 895061da546Spatrick printf("\t%*s = $reg_format\n", $max_register_name_len, $reg_name, $reg_val); 896061da546Spatrick } 897061da546Spatrick } 898061da546Spatrick} 899061da546Spatrick 900061da546Spatricksub dump_read_regs_rsp 901061da546Spatrick{ 902061da546Spatrick print "read_registers () =>\n"; 903061da546Spatrick if (!is_error_response(@_)) 904061da546Spatrick { 905061da546Spatrick # print join('',@_) . "\n"; 906061da546Spatrick foreach my $reg_href (@$registers_aref) 907061da546Spatrick { 908061da546Spatrick last if ($_[0] eq '#'); 909061da546Spatrick if ($reg_href->{pseudo} == 0) 910061da546Spatrick { 911061da546Spatrick my $reg_info_href = $reg_href->{info}; 912061da546Spatrick my $reg_name = $reg_href->{name}; 913061da546Spatrick my $reg_extract = $reg_info_href->{extract}; 914061da546Spatrick my $reg_format = $reg_info_href->{format}; 915061da546Spatrick my $reg_val = &$reg_extract(\@_); 916061da546Spatrick printf("\t%*s = $reg_format\n", $max_register_name_len, $reg_name, $reg_val); 917061da546Spatrick } 918061da546Spatrick } 919061da546Spatrick } 920061da546Spatrick} 921061da546Spatrick 922061da546Spatricksub dump_read_single_register_rsp 923061da546Spatrick{ 924061da546Spatrick dump_register_value(0, \@_, $reg_cmd_reg); 925061da546Spatrick print "\n"; 926061da546Spatrick} 927061da546Spatrick 928061da546Spatrick#---------------------------------------------------------------------- 929061da546Spatrick# '_M' - allocate memory command (LLDB extension) 930061da546Spatrick# 931061da546Spatrick# Command: '_M' 932061da546Spatrick# Arg1: Hex byte size as big endian hex string 933061da546Spatrick# Separator: ',' 934061da546Spatrick# Arg2: permissions as string that must be a string that contains any 935061da546Spatrick# combination of 'r' (readable) 'w' (writable) or 'x' (executable) 936061da546Spatrick# 937061da546Spatrick# Returns: The address that was allocated as a big endian hex string 938061da546Spatrick# on success, else an error "EXX" where XX are hex bytes 939061da546Spatrick# that indicate an error code. 940061da546Spatrick# 941061da546Spatrick# Examples: 942061da546Spatrick# _M10,rw # allocate 16 bytes with read + write permissions 943061da546Spatrick# _M100,rx # allocate 256 bytes with read + execute permissions 944061da546Spatrick#---------------------------------------------------------------------- 945061da546Spatricksub dump_allocate_memory_cmd 946061da546Spatrick{ 947061da546Spatrick shift; shift; # shift off the '_' and the 'M' 948061da546Spatrick my $byte_size = get_addr(\@_); 949061da546Spatrick shift; # Skip ',' 950061da546Spatrick printf("allocate_memory ( byte_size = %u (0x%x), permissions = %s)\n", $byte_size, $byte_size, join('',@_)); 951061da546Spatrick} 952061da546Spatrick 953061da546Spatricksub dump_allocate_memory_rsp 954061da546Spatrick{ 955061da546Spatrick if (@_ == 3 and $_[0] == 'E') 956061da546Spatrick { 957061da546Spatrick printf("allocated memory addr = ERROR (%s))\n", join('',@_)); 958061da546Spatrick } 959061da546Spatrick else 960061da546Spatrick { 961061da546Spatrick printf("allocated memory addr = 0x%s\n", join('',@_)); 962061da546Spatrick } 963061da546Spatrick} 964061da546Spatrick 965061da546Spatrick#---------------------------------------------------------------------- 966061da546Spatrick# '_m' - deallocate memory command (LLDB extension) 967061da546Spatrick# 968061da546Spatrick# Command: '_m' 969061da546Spatrick# Arg1: Hex address as big endian hex string 970061da546Spatrick# 971061da546Spatrick# Returns: "OK" on success "EXX" on error 972061da546Spatrick# 973061da546Spatrick# Examples: 974061da546Spatrick# _m201000 # Free previously allocated memory at address 0x201000 975061da546Spatrick#---------------------------------------------------------------------- 976061da546Spatricksub dump_deallocate_memory_cmd 977061da546Spatrick{ 978061da546Spatrick shift; shift; # shift off the '_' and the 'm' 979061da546Spatrick printf("deallocate_memory ( addr = 0x%s)\n", join('',@_)); 980061da546Spatrick} 981061da546Spatrick 982061da546Spatrick 983061da546Spatrick#---------------------------------------------------------------------- 984061da546Spatrick# 'p' command 985061da546Spatrick#---------------------------------------------------------------------- 986061da546Spatricksub dump_read_single_register_cmd 987061da546Spatrick{ 988061da546Spatrick my $cmd = shift; 989061da546Spatrick $reg_cmd_reg = get_hex(\@_); 990061da546Spatrick my $thread = get_thread_from_thread_suffix (\@_); 991061da546Spatrick my $reg_href = $$registers_aref[$reg_cmd_reg]; 992061da546Spatrick 993061da546Spatrick if (defined $thread) 994061da546Spatrick { 995061da546Spatrick print "read_register ( reg = \"$reg_href->{name}\", thread = $thread )\n"; 996061da546Spatrick } 997061da546Spatrick else 998061da546Spatrick { 999061da546Spatrick print "read_register ( reg = \"$reg_href->{name}\" )\n"; 1000061da546Spatrick } 1001061da546Spatrick} 1002061da546Spatrick 1003061da546Spatrick 1004061da546Spatrick#---------------------------------------------------------------------- 1005061da546Spatrick# 'P' command 1006061da546Spatrick#---------------------------------------------------------------------- 1007061da546Spatricksub dump_write_single_register_cmd 1008061da546Spatrick{ 1009061da546Spatrick my $cmd = shift; 1010061da546Spatrick my $reg_num = get_hex(\@_); 1011061da546Spatrick shift (@_); # Discard the '=' 1012061da546Spatrick 1013061da546Spatrick print "write_register ( "; 1014061da546Spatrick dump_register_value(0, \@_, $reg_num); 1015061da546Spatrick my $thread = get_thread_from_thread_suffix (\@_); 1016061da546Spatrick if (defined $thread) 1017061da546Spatrick { 1018061da546Spatrick print ", thread = $thread"; 1019061da546Spatrick } 1020061da546Spatrick print " )\n"; 1021061da546Spatrick} 1022061da546Spatrick 1023061da546Spatrick#---------------------------------------------------------------------- 1024061da546Spatrick# 'm' command 1025061da546Spatrick#---------------------------------------------------------------------- 1026061da546Spatrickour $read_mem_address = 0; 1027061da546Spatricksub dump_read_mem_cmd 1028061da546Spatrick{ 1029061da546Spatrick my $cmd = shift; 1030061da546Spatrick $read_mem_address = get_addr(\@_); 1031061da546Spatrick shift; # Skip ',' 1032061da546Spatrick printf("read_mem ( $addr_format, %s )\n", $read_mem_address, join('',@_)); 1033061da546Spatrick} 1034061da546Spatrick 1035061da546Spatrick#---------------------------------------------------------------------- 1036061da546Spatrick# 'm' response 1037061da546Spatrick#---------------------------------------------------------------------- 1038061da546Spatricksub dump_read_mem_rsp 1039061da546Spatrick{ 1040061da546Spatrick # If the memory read was 2 or 4 bytes, print it out in native format 1041061da546Spatrick # instead of just as bytes. 1042061da546Spatrick my $num_nibbles = @_; 1043061da546Spatrick if ($num_nibbles == 2) 1044061da546Spatrick { 1045061da546Spatrick printf(" 0x%2.2x", get8(\@_)); 1046061da546Spatrick } 1047061da546Spatrick elsif ($num_nibbles == 4) 1048061da546Spatrick { 1049061da546Spatrick printf(" 0x%4.4x", get16(\@_)); 1050061da546Spatrick } 1051061da546Spatrick elsif ($num_nibbles == 8) 1052061da546Spatrick { 1053061da546Spatrick printf(" 0x%8.8x", get32(\@_)); 1054061da546Spatrick } 1055061da546Spatrick elsif ($num_nibbles == 16) 1056061da546Spatrick { 1057061da546Spatrick printf(" 0x%s", get64(\@_)); 1058061da546Spatrick } 1059061da546Spatrick else 1060061da546Spatrick { 1061061da546Spatrick my $curr_address = $read_mem_address; 1062061da546Spatrick my $nibble; 1063061da546Spatrick my $nibble_offset = 0; 1064061da546Spatrick my $max_nibbles_per_line = 2 * $max_bytes_per_line; 1065061da546Spatrick foreach $nibble (@_) 1066061da546Spatrick { 1067061da546Spatrick if (($nibble_offset % $max_nibbles_per_line) == 0) 1068061da546Spatrick { 1069061da546Spatrick ($nibble_offset > 0) and print "\n "; 1070061da546Spatrick printf("$addr_format: ", $curr_address + $nibble_offset/2); 1071061da546Spatrick } 1072061da546Spatrick (($nibble_offset % 2) == 0) and print ' '; 1073061da546Spatrick print $nibble; 1074061da546Spatrick $nibble_offset++; 1075061da546Spatrick } 1076061da546Spatrick } 1077061da546Spatrick print "\n"; 1078061da546Spatrick} 1079061da546Spatrick 1080061da546Spatrick#---------------------------------------------------------------------- 1081061da546Spatrick# 'c' or 's' command 1082061da546Spatrick#---------------------------------------------------------------------- 1083061da546Spatricksub dump_continue_cmd 1084061da546Spatrick{ 1085061da546Spatrick my $cmd = shift; 1086061da546Spatrick my $cmd_str; 1087061da546Spatrick $cmd eq 'c' and $cmd_str = 'continue'; 1088061da546Spatrick $cmd eq 's' and $cmd_str = 'step'; 1089061da546Spatrick my $address = -1; 1090061da546Spatrick if (@_) 1091061da546Spatrick { 1092061da546Spatrick my $address = get_addr(\@_); 1093061da546Spatrick printf("%s ($addr_format)\n", $cmd_str, $address); 1094061da546Spatrick } 1095061da546Spatrick else 1096061da546Spatrick { 1097061da546Spatrick printf("%s ()\n", $cmd_str); 1098061da546Spatrick } 1099061da546Spatrick} 1100061da546Spatrick 1101061da546Spatrick#---------------------------------------------------------------------- 1102061da546Spatrick# 'Css' continue (C) with signal (ss where 'ss' is two hex digits) 1103061da546Spatrick# 'Sss' step (S) with signal (ss where 'ss' is two hex digits) 1104061da546Spatrick#---------------------------------------------------------------------- 1105061da546Spatricksub dump_continue_with_signal_cmd 1106061da546Spatrick{ 1107061da546Spatrick my $cmd = shift; 1108061da546Spatrick my $address = -1; 1109061da546Spatrick my $cmd_str; 1110061da546Spatrick $cmd eq 'c' and $cmd_str = 'continue'; 1111061da546Spatrick $cmd eq 's' and $cmd_str = 'step'; 1112061da546Spatrick my $signal = get_hex(\@_); 1113061da546Spatrick if (@_) 1114061da546Spatrick { 1115061da546Spatrick my $address = 0; 1116061da546Spatrick if (@_ && $_[0] == ';') 1117061da546Spatrick { 1118061da546Spatrick shift; 1119061da546Spatrick $address = get_addr(\@_); 1120061da546Spatrick } 1121061da546Spatrick } 1122061da546Spatrick 1123061da546Spatrick if ($address != -1) 1124061da546Spatrick { 1125061da546Spatrick printf("%s_with_signal (signal = 0x%2.2x, address = $addr_format)\n", $cmd_str, $signal, $address); 1126061da546Spatrick } 1127061da546Spatrick else 1128061da546Spatrick { 1129061da546Spatrick printf("%s_with_signal (signal = 0x%2.2x)\n", $cmd_str, $signal); 1130061da546Spatrick } 1131061da546Spatrick} 1132061da546Spatrick 1133061da546Spatrick#---------------------------------------------------------------------- 1134061da546Spatrick# 'A' command 1135061da546Spatrick#---------------------------------------------------------------------- 1136061da546Spatricksub dump_A_command 1137061da546Spatrick{ 1138061da546Spatrick my $cmd = get_expected_char(\@_, 'A') or print "error: incorrect command letter for argument packet, expected 'A'\n"; 1139061da546Spatrick printf("set_program_arguments (\n"); 1140061da546Spatrick do 1141061da546Spatrick { 1142061da546Spatrick my $arg_len = get_uint(\@_); 1143061da546Spatrick get_expected_char(\@_, ',') or die "error: missing comma after argument length...?\n"; 1144061da546Spatrick my $arg_idx = get_uint(\@_); 1145061da546Spatrick get_expected_char(\@_, ',') or die "error: missing comma after argument number...?\n"; 1146061da546Spatrick 1147061da546Spatrick my $arg = ''; 1148061da546Spatrick my $num_hex8_bytes = $arg_len/2; 1149061da546Spatrick for (1 .. $num_hex8_bytes) 1150061da546Spatrick { 1151061da546Spatrick $arg .= sprintf("%c", get8(\@_)) 1152061da546Spatrick } 1153061da546Spatrick printf(" <%3u> argv[%u] = '%s'\n", $arg_len, $arg_idx, $arg); 1154061da546Spatrick if (@_ > 0) 1155061da546Spatrick { 1156061da546Spatrick get_expected_char(\@_, ',') or die "error: missing comma after argument argument ASCII hex bytes...?\n"; 1157061da546Spatrick } 1158061da546Spatrick } while (@_ > 0); 1159061da546Spatrick printf(" )\n"); 1160061da546Spatrick} 1161061da546Spatrick 1162061da546Spatrick 1163061da546Spatrick#---------------------------------------------------------------------- 1164061da546Spatrick# 'z' and 'Z' command 1165061da546Spatrick#---------------------------------------------------------------------- 1166061da546Spatricksub dump_bp_wp_command 1167061da546Spatrick{ 1168061da546Spatrick my $cmd = shift; 1169061da546Spatrick my $type = shift; 1170061da546Spatrick shift; # Skip ',' 1171061da546Spatrick my $address = get_addr(\@_); 1172061da546Spatrick shift; # Skip ',' 1173061da546Spatrick my $length = join('',@_); 1174061da546Spatrick if ($cmd eq 'z') 1175061da546Spatrick { 1176061da546Spatrick printf("remove $point_types[$type]($addr_format, %d)\n", $address, $length); 1177061da546Spatrick } 1178061da546Spatrick else 1179061da546Spatrick { 1180061da546Spatrick printf("insert $point_types[$type]($addr_format, %d)\n", $address, $length); 1181061da546Spatrick } 1182061da546Spatrick} 1183061da546Spatrick 1184061da546Spatrick 1185061da546Spatrick#---------------------------------------------------------------------- 1186061da546Spatrick# 'X' command 1187061da546Spatrick#---------------------------------------------------------------------- 1188061da546Spatricksub dump_write_mem_binary_cmd 1189061da546Spatrick{ 1190061da546Spatrick my $cmd = shift; 1191061da546Spatrick my $address = get_addr(\@_); 1192061da546Spatrick shift; # Skip ',' 1193061da546Spatrick 1194061da546Spatrick my ($length, $binary) = split(/:/, join('',@_)); 1195061da546Spatrick printf("write_mem_binary ( $addr_format, %d, %s)\n", $address, $length, $binary); 1196061da546Spatrick 1197061da546Spatrick} 1198061da546Spatrick 1199061da546Spatrick#---------------------------------------------------------------------- 1200061da546Spatrick# 'M' command 1201061da546Spatrick#---------------------------------------------------------------------- 1202061da546Spatricksub dump_write_mem_cmd 1203061da546Spatrick{ 1204061da546Spatrick my $cmd = shift; 1205061da546Spatrick my $address = get_addr(\@_); 1206061da546Spatrick shift; # Skip ',' 1207061da546Spatrick my ($length, $hex_bytes) = split(/:/, join('',@_)); 1208061da546Spatrick# printf("write_mem ( $addr_format, %d, %s)\n", $address, $length, $hex_bytes); 1209061da546Spatrick printf("write_mem ( addr = $addr_format, len = %d (0x%x), bytes = ", $address, $length, $length); 1210061da546Spatrick splice(@_, 0, length($length)+1); 1211061da546Spatrick 1212061da546Spatrick my $curr_address = $address; 1213061da546Spatrick my $nibble; 1214061da546Spatrick my $nibble_count = 0; 1215061da546Spatrick my $max_nibbles_per_line = 2 * $max_bytes_per_line; 1216061da546Spatrick foreach $nibble (@_) 1217061da546Spatrick { 1218061da546Spatrick (($nibble_count % 2) == 0) and print ' '; 1219061da546Spatrick print $nibble; 1220061da546Spatrick $nibble_count++; 1221061da546Spatrick } 1222061da546Spatrick 1223061da546Spatrick # If the memory to write is 2 or 4 bytes, print it out in native format 1224061da546Spatrick # instead of just as bytes. 1225061da546Spatrick if (@_ == 4) 1226061da546Spatrick { 1227061da546Spatrick printf(" ( 0x%4.4x )", get16(\@_)); 1228061da546Spatrick } 1229061da546Spatrick elsif (@_ == 8) 1230061da546Spatrick { 1231061da546Spatrick printf(" ( 0x%8.8x )", get32(\@_)); 1232061da546Spatrick } 1233061da546Spatrick print " )\n"; 1234061da546Spatrick 1235061da546Spatrick} 1236061da546Spatrick 1237061da546Spatrick#---------------------------------------------------------------------- 1238061da546Spatrick# 'v' command 1239061da546Spatrick#---------------------------------------------------------------------- 1240061da546Spatrickour $extended_rsp_callback = 0; 1241061da546Spatricksub dump_extended_cmd 1242061da546Spatrick{ 1243061da546Spatrick $extended_rsp_callback = 0; 1244061da546Spatrick if (join('', @_[0..4]) eq "vCont") 1245061da546Spatrick { 1246061da546Spatrick dump_extended_continue_cmd(splice(@_,5)); 1247061da546Spatrick } 1248061da546Spatrick elsif (join('', @_[0..7]) eq 'vAttach;') 1249061da546Spatrick { 1250061da546Spatrick dump_attach_command (splice(@_,8)); 1251061da546Spatrick } 1252061da546Spatrick elsif (join('', @_[0..11]) eq 'vAttachWait;') 1253061da546Spatrick { 1254061da546Spatrick dump_attach_wait_command (splice(@_,12)); 1255061da546Spatrick } 1256061da546Spatrick} 1257061da546Spatrick 1258061da546Spatrick#---------------------------------------------------------------------- 1259061da546Spatrick# 'v' response 1260061da546Spatrick#---------------------------------------------------------------------- 1261061da546Spatricksub dump_extended_rsp 1262061da546Spatrick{ 1263061da546Spatrick if ($extended_rsp_callback) 1264061da546Spatrick { 1265061da546Spatrick &$extended_rsp_callback(@_); 1266061da546Spatrick } 1267061da546Spatrick $extended_rsp_callback = 0; 1268061da546Spatrick} 1269061da546Spatrick 1270061da546Spatrick#---------------------------------------------------------------------- 1271061da546Spatrick# 'vAttachWait' command 1272061da546Spatrick#---------------------------------------------------------------------- 1273061da546Spatricksub dump_attach_wait_command 1274061da546Spatrick{ 1275061da546Spatrick print "attach_wait ( "; 1276061da546Spatrick while (@_) 1277061da546Spatrick { 1278061da546Spatrick printf("%c", get8(\@_)) 1279061da546Spatrick } 1280061da546Spatrick printf " )\n"; 1281061da546Spatrick 1282061da546Spatrick} 1283061da546Spatrick 1284061da546Spatrick#---------------------------------------------------------------------- 1285061da546Spatrick# 'vAttach' command 1286061da546Spatrick#---------------------------------------------------------------------- 1287061da546Spatricksub dump_attach_command 1288061da546Spatrick{ 1289061da546Spatrick printf("attach ( pid = %i )", get_hex(\@_)); 1290061da546Spatrick $extended_rsp_callback = \&dump_stop_reply_packet; 1291061da546Spatrick} 1292061da546Spatrick 1293061da546Spatrick#---------------------------------------------------------------------- 1294061da546Spatrick# 'vCont' command 1295061da546Spatrick#---------------------------------------------------------------------- 1296061da546Spatricksub dump_extended_continue_cmd 1297061da546Spatrick{ 1298061da546Spatrick print "extended_continue ( "; 1299061da546Spatrick my $cmd = shift; 1300061da546Spatrick if ($cmd eq '?') 1301061da546Spatrick { 1302061da546Spatrick print "list supported modes )\n"; 1303061da546Spatrick $extended_rsp_callback = \&dump_extended_continue_rsp; 1304061da546Spatrick } 1305061da546Spatrick elsif ($cmd eq ';') 1306061da546Spatrick { 1307061da546Spatrick $extended_rsp_callback = \&dump_stop_reply_packet; 1308061da546Spatrick my $i = 0; 1309061da546Spatrick while ($#_ >= 0) 1310061da546Spatrick { 1311061da546Spatrick if ($i > 0) 1312061da546Spatrick { 1313061da546Spatrick print ", "; 1314061da546Spatrick } 1315061da546Spatrick my $continue_cmd = shift; 1316061da546Spatrick my $tmp; 1317061da546Spatrick if ($continue_cmd eq 'c') 1318061da546Spatrick { 1319061da546Spatrick print "continue"; 1320061da546Spatrick } 1321061da546Spatrick elsif ($continue_cmd eq 'C') 1322061da546Spatrick { 1323061da546Spatrick print "continue with signal "; 1324061da546Spatrick print shift; 1325061da546Spatrick print shift; 1326061da546Spatrick } 1327061da546Spatrick elsif ($continue_cmd eq 's') 1328061da546Spatrick { 1329061da546Spatrick print "step"; 1330061da546Spatrick } 1331061da546Spatrick elsif ($continue_cmd eq 'S') 1332061da546Spatrick { 1333061da546Spatrick print "step with signal "; 1334061da546Spatrick print shift; 1335061da546Spatrick print shift; 1336061da546Spatrick } 1337061da546Spatrick 1338061da546Spatrick if ($_[0] eq ':') 1339061da546Spatrick { 1340061da546Spatrick shift; # Skip ':' 1341061da546Spatrick print " for thread "; 1342061da546Spatrick while ($#_ >= 0) 1343061da546Spatrick { 1344061da546Spatrick $tmp = shift; 1345061da546Spatrick if (length($tmp) > 0 && $tmp ne ';') { 1346061da546Spatrick print $tmp; 1347061da546Spatrick } else { 1348061da546Spatrick last; 1349061da546Spatrick } 1350061da546Spatrick } 1351061da546Spatrick } 1352061da546Spatrick $i++; 1353061da546Spatrick } 1354061da546Spatrick 1355061da546Spatrick printf " )\n"; 1356061da546Spatrick } 1357061da546Spatrick} 1358061da546Spatrick 1359061da546Spatrick#---------------------------------------------------------------------- 1360061da546Spatrick# 'vCont' response 1361061da546Spatrick#---------------------------------------------------------------------- 1362061da546Spatricksub dump_extended_continue_rsp 1363061da546Spatrick{ 1364061da546Spatrick if (scalar(@_) == 0) 1365061da546Spatrick { 1366061da546Spatrick print "$unimplemented_str\n"; 1367061da546Spatrick } 1368061da546Spatrick else 1369061da546Spatrick { 1370061da546Spatrick print "extended_continue supports " . join('',@_) . "\n"; 1371061da546Spatrick } 1372061da546Spatrick} 1373061da546Spatrick 1374061da546Spatrick#---------------------------------------------------------------------- 1375061da546Spatrick# Dump the command ascii for any unknown commands 1376061da546Spatrick#---------------------------------------------------------------------- 1377061da546Spatricksub dump_other_cmd 1378061da546Spatrick{ 1379061da546Spatrick print "other = " . join('',@_) . "\n"; 1380061da546Spatrick} 1381061da546Spatrick 1382061da546Spatrick#---------------------------------------------------------------------- 1383061da546Spatrick# Check to see if the response was unsupported with appropriate checksum 1384061da546Spatrick#---------------------------------------------------------------------- 1385061da546Spatricksub rsp_is_unsupported 1386061da546Spatrick{ 1387061da546Spatrick return join('',@_) eq "#00"; 1388061da546Spatrick} 1389061da546Spatrick 1390061da546Spatrick#---------------------------------------------------------------------- 1391061da546Spatrick# Check to see if the response was "OK" with appropriate checksum 1392061da546Spatrick#---------------------------------------------------------------------- 1393061da546Spatricksub rsp_is_OK 1394061da546Spatrick{ 1395061da546Spatrick return join('',@_) eq "OK#9a"; 1396061da546Spatrick} 1397061da546Spatrick 1398061da546Spatrick#---------------------------------------------------------------------- 1399061da546Spatrick# Dump a response for an unknown command 1400061da546Spatrick#---------------------------------------------------------------------- 1401061da546Spatricksub dump_other_rsp 1402061da546Spatrick{ 1403061da546Spatrick print "other = " . join('',@_) . "\n"; 1404061da546Spatrick} 1405061da546Spatrick 1406061da546Spatrick#---------------------------------------------------------------------- 1407061da546Spatrick# Get a byte from the ascii string assuming that the 2 nibble ascii 1408061da546Spatrick# characters are in hex. 1409061da546Spatrick# 1410061da546Spatrick# The argument for this function needs to be a reference to an array 1411061da546Spatrick# that contains single character strings and the array will get 1412061da546Spatrick# updated by shifting characters off the front of it (no leading # "0x") 1413061da546Spatrick#---------------------------------------------------------------------- 1414061da546Spatricksub get8 1415061da546Spatrick{ 1416061da546Spatrick my $arrayref = shift; 1417061da546Spatrick my $val = hex(shift(@$arrayref) . shift(@$arrayref)); 1418061da546Spatrick return $val; 1419061da546Spatrick} 1420061da546Spatrick 1421061da546Spatrick#---------------------------------------------------------------------- 1422061da546Spatrick# Get a 16 bit integer and swap if $swap global is set to a non-zero 1423061da546Spatrick# value. 1424061da546Spatrick# 1425061da546Spatrick# The argument for this function needs to be a reference to an array 1426061da546Spatrick# that contains single character strings and the array will get 1427061da546Spatrick# updated by shifting characters off the front of it (no leading # "0x") 1428061da546Spatrick#---------------------------------------------------------------------- 1429061da546Spatricksub get16 1430061da546Spatrick{ 1431061da546Spatrick my $arrayref = shift; 1432061da546Spatrick my $val = 0; 1433061da546Spatrick if ($swap) 1434061da546Spatrick { 1435061da546Spatrick $val = get8($arrayref) | 1436061da546Spatrick get8($arrayref) << 8; 1437061da546Spatrick } 1438061da546Spatrick else 1439061da546Spatrick { 1440061da546Spatrick $val = get8($arrayref) << 8 | 1441061da546Spatrick get8($arrayref) ; 1442061da546Spatrick } 1443061da546Spatrick return $val; 1444061da546Spatrick} 1445061da546Spatrick 1446061da546Spatrick#---------------------------------------------------------------------- 1447061da546Spatrick# Get a 32 bit integer and swap if $swap global is set to a non-zero 1448061da546Spatrick# value. 1449061da546Spatrick# 1450061da546Spatrick# The argument for this function needs to be a reference to an array 1451061da546Spatrick# that contains single character strings and the array will get 1452061da546Spatrick# updated by shifting characters off the front of it (no leading # "0x") 1453061da546Spatrick#---------------------------------------------------------------------- 1454061da546Spatricksub get32 1455061da546Spatrick{ 1456061da546Spatrick my $arrayref = shift; 1457061da546Spatrick my $val = 0; 1458061da546Spatrick if ($swap) 1459061da546Spatrick { 1460061da546Spatrick $val = get8($arrayref) | 1461061da546Spatrick get8($arrayref) << 8 | 1462061da546Spatrick get8($arrayref) << 16 | 1463061da546Spatrick get8($arrayref) << 24 ; 1464061da546Spatrick } 1465061da546Spatrick else 1466061da546Spatrick { 1467061da546Spatrick $val = get8($arrayref) << 24 | 1468061da546Spatrick get8($arrayref) << 16 | 1469061da546Spatrick get8($arrayref) << 8 | 1470061da546Spatrick get8($arrayref) ; 1471061da546Spatrick } 1472061da546Spatrick return $val; 1473061da546Spatrick} 1474061da546Spatrick 1475061da546Spatrick#---------------------------------------------------------------------- 1476061da546Spatrick# Get a 64 bit hex value as a string 1477061da546Spatrick# 1478061da546Spatrick# The argument for this function needs to be a reference to an array 1479061da546Spatrick# that contains single character strings and the array will get 1480061da546Spatrick# updated by shifting characters off the front of it (no leading # "0x") 1481061da546Spatrick#---------------------------------------------------------------------- 1482061da546Spatricksub get64 1483061da546Spatrick{ 1484061da546Spatrick my $arrayref = shift; 1485061da546Spatrick my $val = ''; 1486061da546Spatrick my @nibbles; 1487061da546Spatrick if ($swap) 1488061da546Spatrick { 1489061da546Spatrick push @nibbles, splice(@$arrayref, 14, 2); 1490061da546Spatrick push @nibbles, splice(@$arrayref, 12, 2); 1491061da546Spatrick push @nibbles, splice(@$arrayref, 10, 2); 1492061da546Spatrick push @nibbles, splice(@$arrayref, 8, 2); 1493061da546Spatrick push @nibbles, splice(@$arrayref, 6, 2); 1494061da546Spatrick push @nibbles, splice(@$arrayref, 4, 2); 1495061da546Spatrick push @nibbles, splice(@$arrayref, 2, 2); 1496061da546Spatrick push @nibbles, splice(@$arrayref, 0, 2); 1497061da546Spatrick } 1498061da546Spatrick else 1499061da546Spatrick { 1500061da546Spatrick (@nibbles) = splice(@$arrayref, 0, ((64/8) * 2)); 1501061da546Spatrick } 1502061da546Spatrick $val = join('', @nibbles); 1503061da546Spatrick return $val; 1504061da546Spatrick} 1505061da546Spatrick 1506061da546Spatrick#---------------------------------------------------------------------- 1507061da546Spatrick# Get a 80 bit hex value as a string 1508061da546Spatrick# 1509061da546Spatrick# The argument for this function needs to be a reference to an array 1510061da546Spatrick# that contains single character strings and the array will get 1511061da546Spatrick# updated by shifting characters off the front of it (no leading # "0x") 1512061da546Spatrick#---------------------------------------------------------------------- 1513061da546Spatricksub get80 1514061da546Spatrick{ 1515061da546Spatrick my $arrayref = shift; 1516061da546Spatrick my $val = ''; 1517061da546Spatrick my @nibbles; 1518061da546Spatrick if ($swap) 1519061da546Spatrick { 1520061da546Spatrick push @nibbles, splice(@$arrayref, 18, 2); 1521061da546Spatrick push @nibbles, splice(@$arrayref, 16, 2); 1522061da546Spatrick push @nibbles, splice(@$arrayref, 14, 2); 1523061da546Spatrick push @nibbles, splice(@$arrayref, 12, 2); 1524061da546Spatrick push @nibbles, splice(@$arrayref, 10, 2); 1525061da546Spatrick push @nibbles, splice(@$arrayref, 8, 2); 1526061da546Spatrick push @nibbles, splice(@$arrayref, 6, 2); 1527061da546Spatrick push @nibbles, splice(@$arrayref, 4, 2); 1528061da546Spatrick push @nibbles, splice(@$arrayref, 2, 2); 1529061da546Spatrick push @nibbles, splice(@$arrayref, 0, 2); 1530061da546Spatrick } 1531061da546Spatrick else 1532061da546Spatrick { 1533061da546Spatrick (@nibbles) = splice(@$arrayref, 0, ((80/8) * 2)); 1534061da546Spatrick } 1535061da546Spatrick $val = join('', @nibbles); 1536061da546Spatrick return $val; 1537061da546Spatrick} 1538061da546Spatrick 1539061da546Spatrick#---------------------------------------------------------------------- 1540061da546Spatrick# Get a 96 bit hex value as a string 1541061da546Spatrick# 1542061da546Spatrick# The argument for this function needs to be a reference to an array 1543061da546Spatrick# that contains single character strings and the array will get 1544061da546Spatrick# updated by shifting characters off the front of it (no leading # "0x") 1545061da546Spatrick#---------------------------------------------------------------------- 1546061da546Spatricksub get96 1547061da546Spatrick{ 1548061da546Spatrick my $arrayref = shift; 1549061da546Spatrick my $val = ''; 1550061da546Spatrick my @nibbles; 1551061da546Spatrick if ($swap) 1552061da546Spatrick { 1553061da546Spatrick push @nibbles, splice(@$arrayref, 22, 2); 1554061da546Spatrick push @nibbles, splice(@$arrayref, 20, 2); 1555061da546Spatrick push @nibbles, splice(@$arrayref, 18, 2); 1556061da546Spatrick push @nibbles, splice(@$arrayref, 16, 2); 1557061da546Spatrick push @nibbles, splice(@$arrayref, 14, 2); 1558061da546Spatrick push @nibbles, splice(@$arrayref, 12, 2); 1559061da546Spatrick push @nibbles, splice(@$arrayref, 10, 2); 1560061da546Spatrick push @nibbles, splice(@$arrayref, 8, 2); 1561061da546Spatrick push @nibbles, splice(@$arrayref, 6, 2); 1562061da546Spatrick push @nibbles, splice(@$arrayref, 4, 2); 1563061da546Spatrick push @nibbles, splice(@$arrayref, 2, 2); 1564061da546Spatrick push @nibbles, splice(@$arrayref, 0, 2); 1565061da546Spatrick } 1566061da546Spatrick else 1567061da546Spatrick { 1568061da546Spatrick (@nibbles) = splice(@$arrayref, 0, ((96/8) * 2)); 1569061da546Spatrick } 1570061da546Spatrick $val = join('', @nibbles); 1571061da546Spatrick return $val; 1572061da546Spatrick} 1573061da546Spatrick 1574061da546Spatrick#---------------------------------------------------------------------- 1575061da546Spatrick# Get a 128 bit hex value as a string 1576061da546Spatrick# 1577061da546Spatrick# The argument for this function needs to be a reference to an array 1578061da546Spatrick# that contains single character strings and the array will get 1579061da546Spatrick# updated by shifting characters off the front of it (no leading # "0x") 1580061da546Spatrick#---------------------------------------------------------------------- 1581061da546Spatricksub get128 1582061da546Spatrick{ 1583061da546Spatrick my $arrayref = shift; 1584061da546Spatrick my $val = ''; 1585061da546Spatrick my @nibbles; 1586061da546Spatrick if ($swap) 1587061da546Spatrick { 1588061da546Spatrick push @nibbles, splice(@$arrayref, 30, 2); 1589061da546Spatrick push @nibbles, splice(@$arrayref, 28, 2); 1590061da546Spatrick push @nibbles, splice(@$arrayref, 26, 2); 1591061da546Spatrick push @nibbles, splice(@$arrayref, 24, 2); 1592061da546Spatrick push @nibbles, splice(@$arrayref, 22, 2); 1593061da546Spatrick push @nibbles, splice(@$arrayref, 20, 2); 1594061da546Spatrick push @nibbles, splice(@$arrayref, 18, 2); 1595061da546Spatrick push @nibbles, splice(@$arrayref, 16, 2); 1596061da546Spatrick push @nibbles, splice(@$arrayref, 14, 2); 1597061da546Spatrick push @nibbles, splice(@$arrayref, 12, 2); 1598061da546Spatrick push @nibbles, splice(@$arrayref, 10, 2); 1599061da546Spatrick push @nibbles, splice(@$arrayref, 8, 2); 1600061da546Spatrick push @nibbles, splice(@$arrayref, 6, 2); 1601061da546Spatrick push @nibbles, splice(@$arrayref, 4, 2); 1602061da546Spatrick push @nibbles, splice(@$arrayref, 2, 2); 1603061da546Spatrick push @nibbles, splice(@$arrayref, 0, 2); 1604061da546Spatrick } 1605061da546Spatrick else 1606061da546Spatrick { 1607061da546Spatrick (@nibbles) = splice(@$arrayref, 0, ((128/8) * 2)); 1608061da546Spatrick } 1609061da546Spatrick $val = join('', @nibbles); 1610061da546Spatrick return $val; 1611061da546Spatrick} 1612061da546Spatrick 1613061da546Spatrick#---------------------------------------------------------------------- 1614061da546Spatrick# Get a 256 bit hex value as a string 1615061da546Spatrick# 1616061da546Spatrick# The argument for this function needs to be a reference to an array 1617061da546Spatrick# that contains single character strings and the array will get 1618061da546Spatrick# updated by shifting characters off the front of it (no leading # "0x") 1619061da546Spatrick#---------------------------------------------------------------------- 1620061da546Spatricksub get256 1621061da546Spatrick{ 1622061da546Spatrick my $arrayref = shift; 1623061da546Spatrick my $val = ''; 1624061da546Spatrick my @nibbles; 1625061da546Spatrick if ($swap) 1626061da546Spatrick { 1627061da546Spatrick push @nibbles, splice(@$arrayref, 62, 2); 1628061da546Spatrick push @nibbles, splice(@$arrayref, 60, 2); 1629061da546Spatrick push @nibbles, splice(@$arrayref, 58, 2); 1630061da546Spatrick push @nibbles, splice(@$arrayref, 56, 2); 1631061da546Spatrick push @nibbles, splice(@$arrayref, 54, 2); 1632061da546Spatrick push @nibbles, splice(@$arrayref, 52, 2); 1633061da546Spatrick push @nibbles, splice(@$arrayref, 50, 2); 1634061da546Spatrick push @nibbles, splice(@$arrayref, 48, 2); 1635061da546Spatrick push @nibbles, splice(@$arrayref, 46, 2); 1636061da546Spatrick push @nibbles, splice(@$arrayref, 44, 2); 1637061da546Spatrick push @nibbles, splice(@$arrayref, 42, 2); 1638061da546Spatrick push @nibbles, splice(@$arrayref, 40, 2); 1639061da546Spatrick push @nibbles, splice(@$arrayref, 38, 2); 1640061da546Spatrick push @nibbles, splice(@$arrayref, 36, 2); 1641061da546Spatrick push @nibbles, splice(@$arrayref, 34, 2); 1642061da546Spatrick push @nibbles, splice(@$arrayref, 32, 2); 1643061da546Spatrick push @nibbles, splice(@$arrayref, 30, 2); 1644061da546Spatrick push @nibbles, splice(@$arrayref, 28, 2); 1645061da546Spatrick push @nibbles, splice(@$arrayref, 26, 2); 1646061da546Spatrick push @nibbles, splice(@$arrayref, 24, 2); 1647061da546Spatrick push @nibbles, splice(@$arrayref, 22, 2); 1648061da546Spatrick push @nibbles, splice(@$arrayref, 20, 2); 1649061da546Spatrick push @nibbles, splice(@$arrayref, 18, 2); 1650061da546Spatrick push @nibbles, splice(@$arrayref, 16, 2); 1651061da546Spatrick push @nibbles, splice(@$arrayref, 14, 2); 1652061da546Spatrick push @nibbles, splice(@$arrayref, 12, 2); 1653061da546Spatrick push @nibbles, splice(@$arrayref, 10, 2); 1654061da546Spatrick push @nibbles, splice(@$arrayref, 8, 2); 1655061da546Spatrick push @nibbles, splice(@$arrayref, 6, 2); 1656061da546Spatrick push @nibbles, splice(@$arrayref, 4, 2); 1657061da546Spatrick push @nibbles, splice(@$arrayref, 2, 2); 1658061da546Spatrick push @nibbles, splice(@$arrayref, 0, 2); 1659061da546Spatrick } 1660061da546Spatrick else 1661061da546Spatrick { 1662061da546Spatrick (@nibbles) = splice(@$arrayref, 0, ((256/8) * 2)); 1663061da546Spatrick } 1664061da546Spatrick $val = join('', @nibbles); 1665061da546Spatrick return $val; 1666061da546Spatrick} 1667061da546Spatrick 1668061da546Spatrick#---------------------------------------------------------------------- 1669061da546Spatrick# Get an unsigned integer value by grabbing items off the front of 1670061da546Spatrick# the array stopping when a non-digit char string is encountered. 1671061da546Spatrick# 1672061da546Spatrick# The argument for this function needs to be a reference to an array 1673061da546Spatrick# that contains single character strings and the array will get 1674061da546Spatrick# updated by shifting characters off the front of it 1675061da546Spatrick#---------------------------------------------------------------------- 1676061da546Spatricksub get_uint 1677061da546Spatrick{ 1678061da546Spatrick my $arrayref = shift; 1679061da546Spatrick @$arrayref == 0 and return 0; 1680061da546Spatrick my $val = 0; 1681061da546Spatrick while ($$arrayref[0] =~ /[0-9]/) 1682061da546Spatrick { 1683061da546Spatrick $val = $val * 10 + int(shift(@$arrayref)); 1684061da546Spatrick } 1685061da546Spatrick return $val; 1686061da546Spatrick} 1687061da546Spatrick 1688061da546Spatrick#---------------------------------------------------------------------- 1689061da546Spatrick# Check the first character in the array and if it matches the expected 1690061da546Spatrick# character, return that character, else return undef; 1691061da546Spatrick# 1692061da546Spatrick# The argument for this function needs to be a reference to an array 1693061da546Spatrick# that contains single character strings and the array will get 1694061da546Spatrick# updated by shifting characters off the front of it. If the expected 1695061da546Spatrick# character doesn't match, it won't touch the array. If the first 1696061da546Spatrick# character does match, it will shift it off and return it. 1697061da546Spatrick#---------------------------------------------------------------------- 1698061da546Spatricksub get_expected_char 1699061da546Spatrick{ 1700061da546Spatrick my $arrayref = shift; 1701061da546Spatrick my $expected_char = shift; 1702061da546Spatrick if ($expected_char eq $$arrayref[0]) 1703061da546Spatrick { 1704061da546Spatrick return shift(@$arrayref); 1705061da546Spatrick } 1706061da546Spatrick return undef; 1707061da546Spatrick} 1708061da546Spatrick#---------------------------------------------------------------------- 1709061da546Spatrick# Get a hex value by grabbing items off the front of the array and 1710061da546Spatrick# stopping when a non-hex char string is encountered. 1711061da546Spatrick# 1712061da546Spatrick# The argument for this function needs to be a reference to an array 1713061da546Spatrick# that contains single character strings and the array will get 1714061da546Spatrick# updated by shifting characters off the front of it (no leading # "0x") 1715061da546Spatrick#---------------------------------------------------------------------- 1716061da546Spatricksub get_hex 1717061da546Spatrick{ 1718061da546Spatrick my $arrayref = shift; 1719061da546Spatrick my $my_swap = @_ ? shift : 0; 1720061da546Spatrick my $shift = 0; 1721061da546Spatrick my $val = 0; 1722061da546Spatrick while ($$arrayref[0] =~ /[0-9a-fA-F]/) 1723061da546Spatrick { 1724061da546Spatrick if ($my_swap) 1725061da546Spatrick { 1726061da546Spatrick my $byte = hex(shift(@$arrayref)) << 4 | hex(shift(@$arrayref)); 1727061da546Spatrick $val |= $byte << $shift; 1728061da546Spatrick $shift += 8; 1729061da546Spatrick } 1730061da546Spatrick else 1731061da546Spatrick { 1732061da546Spatrick $val <<= 4; 1733061da546Spatrick $val |= hex(shift(@$arrayref)); 1734061da546Spatrick } 1735061da546Spatrick } 1736061da546Spatrick return $val; 1737061da546Spatrick} 1738061da546Spatrick 1739061da546Spatrick#---------------------------------------------------------------------- 1740061da546Spatrick# Get an address value by grabbing items off the front of the array. 1741061da546Spatrick# 1742061da546Spatrick# The argument for this function needs to be a reference to an array 1743061da546Spatrick# that contains single character strings and the array will get 1744061da546Spatrick# updated by shifting characters off the front of it (no leading # "0x") 1745061da546Spatrick#---------------------------------------------------------------------- 1746061da546Spatricksub get_addr 1747061da546Spatrick{ 1748061da546Spatrick get_hex(shift); 1749061da546Spatrick} 1750061da546Spatrick 1751061da546Spatricksub get_hex_string 1752061da546Spatrick{ 1753061da546Spatrick my $arrayref = shift; 1754061da546Spatrick my $str = ''; 1755061da546Spatrick while ($$arrayref[0] =~ /[0-9a-fA-F]/ and $$arrayref[1] =~ /[0-9a-fA-F]/) 1756061da546Spatrick { 1757061da546Spatrick my $hi_nibble = hex(shift(@$arrayref)); 1758061da546Spatrick my $lo_nibble = hex(shift(@$arrayref)); 1759061da546Spatrick my $byte = ($hi_nibble << 4) | $lo_nibble; 1760061da546Spatrick $str .= chr($byte); 1761061da546Spatrick } 1762061da546Spatrick return $str; 1763061da546Spatrick} 1764061da546Spatrick 1765061da546Spatricksub dump_stop_reply_data 1766061da546Spatrick{ 1767061da546Spatrick while ($#_ >= 0) 1768061da546Spatrick { 1769061da546Spatrick last unless ($_[0] ne '#'); 1770061da546Spatrick 1771061da546Spatrick 1772061da546Spatrick my $key = ''; 1773061da546Spatrick my $value = ''; 1774061da546Spatrick my $comment = ''; 1775061da546Spatrick if ($_[0] =~ /[0-9a-fA-F]/ && $_[1] =~ /[0-9a-fA-F]/) 1776061da546Spatrick { 1777061da546Spatrick my $reg_num = get8(\@_); 1778061da546Spatrick shift(@_); # Skip ':' 1779061da546Spatrick if (defined ($registers_aref) && $reg_num < @$registers_aref) 1780061da546Spatrick { 1781061da546Spatrick dump_register_value(1, \@_, $reg_num); 1782061da546Spatrick print "\n"; 1783061da546Spatrick shift(@_); # Skip ';' 1784061da546Spatrick next; 1785061da546Spatrick } 1786061da546Spatrick $key = sprintf("reg %u", $reg_num); 1787061da546Spatrick } 1788061da546Spatrick my $char; 1789061da546Spatrick 1790061da546Spatrick if (length($key) == 0) 1791061da546Spatrick { 1792061da546Spatrick while (1) 1793061da546Spatrick { 1794061da546Spatrick $char = shift(@_); 1795061da546Spatrick if (length($char) == 0 or $char eq ':' or $char eq '#') { last; } 1796061da546Spatrick $key .= $char; 1797061da546Spatrick } 1798061da546Spatrick } 1799061da546Spatrick 1800061da546Spatrick while (1) 1801061da546Spatrick { 1802061da546Spatrick $char = shift(@_); 1803061da546Spatrick if (length($char) == 0 or $char eq ';' or $char eq '#') { last; } 1804061da546Spatrick $value .= $char; 1805061da546Spatrick } 1806061da546Spatrick if ($key eq 'metype') 1807061da546Spatrick { 1808061da546Spatrick our %metype_to_name = ( 1809061da546Spatrick '1' => ' (EXC_BAD_ACCESS)', 1810061da546Spatrick '2' => ' (EXC_BAD_INSTRUCTION)', 1811061da546Spatrick '3' => ' (EXC_ARITHMETIC)', 1812061da546Spatrick '4' => ' (EXC_EMULATION)', 1813061da546Spatrick '5' => ' (EXC_SOFTWARE)', 1814061da546Spatrick '6' => ' (EXC_BREAKPOINT)', 1815061da546Spatrick '7' => ' (EXC_SYSCALL)', 1816061da546Spatrick '8' => ' (EXC_MACH_SYSCALL)', 1817061da546Spatrick '9' => ' (EXC_RPC_ALERT)', 1818061da546Spatrick '10' => ' (EXC_CRASH)' 1819061da546Spatrick ); 1820061da546Spatrick if (exists $metype_to_name{$value}) 1821061da546Spatrick { 1822061da546Spatrick $comment = $metype_to_name{$value}; 1823061da546Spatrick } 1824061da546Spatrick } 1825061da546Spatrick printf("\t%*s = %s$comment\n", $max_register_name_len, $key, $value); 1826061da546Spatrick } 1827061da546Spatrick} 1828061da546Spatrick 1829061da546Spatrick#---------------------------------------------------------------------- 1830061da546Spatrick# Dumps a Stop Reply Packet which happens in response to a step, 1831061da546Spatrick# continue, last signal, and probably a few other commands. 1832061da546Spatrick#---------------------------------------------------------------------- 1833061da546Spatricksub dump_stop_reply_packet 1834061da546Spatrick{ 1835061da546Spatrick my $what = shift(@_); 1836061da546Spatrick if ($what eq 'S' or $what eq 'T') 1837061da546Spatrick { 1838061da546Spatrick my $signo = get8(\@_); 1839061da546Spatrick 1840061da546Spatrick our %signo_to_name = ( 1841061da546Spatrick '1' => ' SIGHUP', 1842061da546Spatrick '2' => ' SIGINT', 1843061da546Spatrick '3' => ' SIGQUIT', 1844061da546Spatrick '4' => ' SIGILL', 1845061da546Spatrick '5' => ' SIGTRAP', 1846061da546Spatrick '6' => ' SIGABRT', 1847061da546Spatrick '7' => ' SIGPOLL/SIGEMT', 1848061da546Spatrick '8' => ' SIGFPE', 1849061da546Spatrick '9' => ' SIGKILL', 1850061da546Spatrick '10' => ' SIGBUS', 1851061da546Spatrick '11' => ' SIGSEGV', 1852061da546Spatrick '12' => ' SIGSYS', 1853061da546Spatrick '13' => ' SIGPIPE', 1854061da546Spatrick '14' => ' SIGALRM', 1855061da546Spatrick '15' => ' SIGTERM', 1856061da546Spatrick '16' => ' SIGURG', 1857061da546Spatrick '17' => ' SIGSTOP', 1858061da546Spatrick '18' => ' SIGTSTP', 1859061da546Spatrick '19' => ' SIGCONT', 1860061da546Spatrick '20' => ' SIGCHLD', 1861061da546Spatrick '21' => ' SIGTTIN', 1862061da546Spatrick '22' => ' SIGTTOU', 1863061da546Spatrick '23' => ' SIGIO', 1864061da546Spatrick '24' => ' SIGXCPU', 1865061da546Spatrick '25' => ' SIGXFSZ', 1866061da546Spatrick '26' => ' SIGVTALRM', 1867061da546Spatrick '27' => ' SIGPROF', 1868061da546Spatrick '28' => ' SIGWINCH', 1869061da546Spatrick '29' => ' SIGINFO', 1870061da546Spatrick '30' => ' SIGUSR1', 1871061da546Spatrick '31' => ' SIGUSR2', 1872061da546Spatrick '145' => ' TARGET_EXC_BAD_ACCESS', # 0x91 1873061da546Spatrick '146' => ' TARGET_EXC_BAD_INSTRUCTION', # 0x92 1874061da546Spatrick '147' => ' TARGET_EXC_ARITHMETIC', # 0x93 1875061da546Spatrick '148' => ' TARGET_EXC_EMULATION', # 0x94 1876061da546Spatrick '149' => ' TARGET_EXC_SOFTWARE', # 0x95 1877061da546Spatrick '150' => ' TARGET_EXC_BREAKPOINT' # 0x96 1878061da546Spatrick ); 1879061da546Spatrick my $signo_str = sprintf("%i", $signo); 1880061da546Spatrick my $signo_name = ''; 1881061da546Spatrick if (exists $signo_to_name{$signo_str}) 1882061da546Spatrick { 1883061da546Spatrick $signo_name = $signo_to_name{$signo_str}; 1884061da546Spatrick } 1885061da546Spatrick printf ("signal (signo=%u$signo_name)\n", $signo); 1886061da546Spatrick dump_stop_reply_data (@_); 1887061da546Spatrick } 1888061da546Spatrick elsif ($what eq 'W') 1889061da546Spatrick { 1890061da546Spatrick print 'process_exited( ' . shift(@_) . shift(@_) . " )\n"; 1891061da546Spatrick } 1892061da546Spatrick elsif ($what eq 'X') 1893061da546Spatrick { 1894061da546Spatrick print 'process_terminated( ' . shift(@_) . shift(@_) . " )\n"; 1895061da546Spatrick } 1896061da546Spatrick elsif ($what eq 'O') 1897061da546Spatrick { 1898061da546Spatrick my $console_output = ''; 1899061da546Spatrick my $num_hex8_bytes = @_/2; 1900061da546Spatrick for (1 .. $num_hex8_bytes) 1901061da546Spatrick { 1902061da546Spatrick $console_output .= sprintf("%c", get8(\@_)) 1903061da546Spatrick } 1904061da546Spatrick 1905061da546Spatrick print "program_console_output('$console_output')\n"; 1906061da546Spatrick } 1907061da546Spatrick} 1908061da546Spatrick 1909061da546Spatrick#---------------------------------------------------------------------- 1910061da546Spatrick# '?' command 1911061da546Spatrick#---------------------------------------------------------------------- 1912061da546Spatricksub dump_last_signal_cmd 1913061da546Spatrick{ 1914061da546Spatrick my $cmd = shift; 1915061da546Spatrick print 'last_signal (' . join('',@_) . ")\n"; 1916061da546Spatrick} 1917061da546Spatrick 1918061da546Spatricksub dump_raw_command 1919061da546Spatrick{ 1920061da546Spatrick my $cmd_aref = shift; 1921061da546Spatrick my $callback_ref; 1922061da546Spatrick $curr_cmd = $$cmd_aref[0]; 1923061da546Spatrick 1924061da546Spatrick if ($curr_cmd eq 'q' or $curr_cmd eq 'Q' or $curr_cmd eq '_') 1925061da546Spatrick { 1926061da546Spatrick $curr_full_cmd = ''; 1927061da546Spatrick foreach my $ch (@$cmd_aref) 1928061da546Spatrick { 1929061da546Spatrick $ch !~ /[A-Za-z_]/ and last; 1930061da546Spatrick $curr_full_cmd .= $ch; 1931061da546Spatrick } 1932061da546Spatrick } 1933061da546Spatrick else 1934061da546Spatrick { 1935061da546Spatrick $curr_full_cmd = $curr_cmd; 1936061da546Spatrick } 1937061da546Spatrick 1938061da546Spatrick $curr_cmd eq '_' and $curr_cmd .= $$cmd_aref[1]; 1939061da546Spatrick $callback_ref = $cmd_callbacks{$curr_cmd}; 1940061da546Spatrick if ($callback_ref) 1941061da546Spatrick { 1942061da546Spatrick &$callback_ref(@$cmd_aref); 1943061da546Spatrick } 1944061da546Spatrick else 1945061da546Spatrick { 1946061da546Spatrick # Strip the command byte for responses since we injected that above 1947061da546Spatrick dump_other_cmd(@$cmd_aref); 1948061da546Spatrick } 1949061da546Spatrick} 1950061da546Spatrick 1951061da546Spatricksub dump_standard_response 1952061da546Spatrick{ 1953061da546Spatrick my $cmd_aref = shift; 1954061da546Spatrick 1955061da546Spatrick my $cmd_len = scalar(@$cmd_aref); 1956061da546Spatrick if ($cmd_len == 0) 1957061da546Spatrick { 1958061da546Spatrick print "$unimplemented_str\n"; 1959061da546Spatrick return 1; 1960061da546Spatrick } 1961061da546Spatrick 1962061da546Spatrick my $response = join('', @$cmd_aref); 1963061da546Spatrick if ($response eq 'OK') 1964061da546Spatrick { 1965061da546Spatrick print "$success_str\n"; 1966061da546Spatrick return 1; 1967061da546Spatrick } 1968061da546Spatrick 1969061da546Spatrick if ($cmd_len == 3 and index($response, 'E') == 0) 1970061da546Spatrick { 1971061da546Spatrick print "ERROR: " . substr($response, 1) . "\n"; 1972061da546Spatrick return 1; 1973061da546Spatrick } 1974061da546Spatrick 1975061da546Spatrick return 0; 1976061da546Spatrick} 1977061da546Spatricksub dump_raw_response 1978061da546Spatrick{ 1979061da546Spatrick my $cmd_aref = shift; 1980061da546Spatrick my $callback_ref; 1981061da546Spatrick 1982061da546Spatrick if ($packet_start_time != 0.0) 1983061da546Spatrick { 1984061da546Spatrick if (length($curr_full_cmd) > 0) 1985061da546Spatrick { 1986061da546Spatrick $packet_times{$curr_full_cmd} += $curr_time - $packet_start_time; 1987061da546Spatrick } 1988061da546Spatrick else 1989061da546Spatrick { 1990061da546Spatrick $packet_times{$curr_cmd} += $curr_time - $packet_start_time; 1991061da546Spatrick } 1992061da546Spatrick $packet_start_time = 0.0; 1993061da546Spatrick } 1994061da546Spatrick 1995061da546Spatrick $callback_ref = $rsp_callbacks{$curr_cmd}; 1996061da546Spatrick 1997061da546Spatrick if ($callback_ref) 1998061da546Spatrick { 1999061da546Spatrick &$callback_ref(@$cmd_aref); 2000061da546Spatrick } 2001061da546Spatrick else 2002061da546Spatrick { 2003061da546Spatrick dump_standard_response($cmd_aref) or dump_other_rsp(@$cmd_aref); 2004061da546Spatrick } 2005061da546Spatrick 2006061da546Spatrick} 2007061da546Spatrick#---------------------------------------------------------------------- 2008061da546Spatrick# Dumps any command and handles simple error checking on the responses 2009061da546Spatrick# for commands that are unsupported or OK. 2010061da546Spatrick#---------------------------------------------------------------------- 2011061da546Spatricksub dump_command 2012061da546Spatrick{ 2013061da546Spatrick my $cmd_str = shift; 2014061da546Spatrick 2015061da546Spatrick # Dump the original command string if verbose is on 2016061da546Spatrick if ($opt_v) 2017061da546Spatrick { 2018061da546Spatrick print "dump_command($cmd_str)\n "; 2019061da546Spatrick } 2020061da546Spatrick 2021061da546Spatrick my @cmd_chars = extract_command($cmd_str); 2022061da546Spatrick my $is_cmd = 1; 2023061da546Spatrick 2024061da546Spatrick my $cmd = $cmd_chars[0]; 2025061da546Spatrick if ($cmd eq '$') 2026061da546Spatrick { 2027061da546Spatrick $is_cmd = 0; # Note that this is a reply 2028061da546Spatrick $cmd = $curr_cmd; # set the command byte appropriately 2029061da546Spatrick shift @cmd_chars; # remove the '$' from the cmd bytes 2030061da546Spatrick } 2031061da546Spatrick 2032061da546Spatrick # Check for common responses across all commands and handle them 2033061da546Spatrick # if we can 2034061da546Spatrick if ( $is_cmd == 0 ) 2035061da546Spatrick { 2036061da546Spatrick if (rsp_is_unsupported(@cmd_chars)) 2037061da546Spatrick { 2038061da546Spatrick print "$unimplemented_str\n"; 2039061da546Spatrick return; 2040061da546Spatrick } 2041061da546Spatrick elsif (rsp_is_OK(@cmd_chars)) 2042061da546Spatrick { 2043061da546Spatrick print "$success_str\n"; 2044061da546Spatrick return; 2045061da546Spatrick } 2046061da546Spatrick # Strip the checksum information for responses 2047061da546Spatrick strip_checksum(\@cmd_chars); 2048061da546Spatrick } 2049061da546Spatrick 2050061da546Spatrick my $callback_ref; 2051061da546Spatrick if ($is_cmd) { 2052061da546Spatrick $callback_ref = $cmd_callbacks{$cmd}; 2053061da546Spatrick } else { 2054061da546Spatrick $callback_ref = $rsp_callbacks{$cmd}; 2055061da546Spatrick } 2056061da546Spatrick 2057061da546Spatrick if ($callback_ref) 2058061da546Spatrick { 2059061da546Spatrick &$callback_ref(@cmd_chars); 2060061da546Spatrick } 2061061da546Spatrick else 2062061da546Spatrick { 2063061da546Spatrick # Strip the command byte for responses since we injected that above 2064061da546Spatrick if ($is_cmd) { 2065061da546Spatrick dump_other_cmd(@cmd_chars); 2066061da546Spatrick } else { 2067061da546Spatrick dump_other_rsp(@cmd_chars); 2068061da546Spatrick } 2069061da546Spatrick 2070061da546Spatrick } 2071061da546Spatrick} 2072061da546Spatrick 2073061da546Spatrick 2074061da546Spatrick#---------------------------------------------------------------------- 2075061da546Spatrick# Process a gdbserver log line by looking for getpkt and putkpt and 2076061da546Spatrick# tossing any other lines. 2077061da546Spatrick 2078061da546Spatrick#---------------------------------------------------------------------- 2079061da546Spatricksub process_log_line 2080061da546Spatrick{ 2081061da546Spatrick my $line = shift; 2082061da546Spatrick #($opt_v and $opt_g) and print "# $line"; 2083061da546Spatrick 2084061da546Spatrick my $extract_cmd = 0; 2085061da546Spatrick my $delta_time = 0.0; 2086061da546Spatrick if ($line =~ /^(\s*)([1-9][0-9]+\.[0-9]+)([^0-9].*)$/) 2087061da546Spatrick { 2088061da546Spatrick my $leading_space = $1; 2089061da546Spatrick $curr_time = $2; 2090061da546Spatrick $line = $3; 2091061da546Spatrick if ($base_time == 0.0) 2092061da546Spatrick { 2093061da546Spatrick $base_time = $curr_time; 2094061da546Spatrick } 2095061da546Spatrick else 2096061da546Spatrick { 2097061da546Spatrick $delta_time = $curr_time - $last_time; 2098061da546Spatrick } 2099061da546Spatrick printf ("(%.6f, %+.6f): ", $curr_time - $base_time, $delta_time); 2100061da546Spatrick $last_time = $curr_time; 2101061da546Spatrick } 2102061da546Spatrick else 2103061da546Spatrick { 2104061da546Spatrick $curr_time = 0.0 2105061da546Spatrick } 2106061da546Spatrick 2107061da546Spatrick if ($line =~ /getpkt /) 2108061da546Spatrick { 2109061da546Spatrick $extract_cmd = 1; 2110061da546Spatrick print "\n--> "; 2111061da546Spatrick $packet_start_time = $curr_time; 2112061da546Spatrick } 2113061da546Spatrick elsif ($line =~ /putpkt /) 2114061da546Spatrick { 2115061da546Spatrick $extract_cmd = 1; 2116061da546Spatrick print "<-- "; 2117061da546Spatrick } 2118061da546Spatrick elsif ($line =~ /.*Sent: \[[0-9]+\.[0-9]+[:0-9]*\] (.*)/) 2119061da546Spatrick { 2120061da546Spatrick $opt_g and print "maintenance dump-packets command: $1\n"; 2121061da546Spatrick my @raw_cmd_bytes = split(/ */, $1); 2122061da546Spatrick $packet_start_time = $curr_time; 2123061da546Spatrick print "\n--> "; 2124061da546Spatrick dump_raw_command(\@raw_cmd_bytes); 2125061da546Spatrick process_log_line($2); 2126061da546Spatrick } 2127061da546Spatrick elsif ($line =~ /.*Recvd: \[[0-9]+\.[0-9]+[:0-9]*\] (.*)/) 2128061da546Spatrick { 2129061da546Spatrick $opt_g and print "maintenance dump-packets reply: $1\n"; 2130061da546Spatrick my @raw_rsp_bytes = split(/ */, $1); 2131061da546Spatrick print "<-- "; 2132061da546Spatrick dump_raw_response(\@raw_rsp_bytes); 2133061da546Spatrick print "\n"; 2134061da546Spatrick } 2135061da546Spatrick elsif ($line =~ /getpkt: (.*)/) 2136061da546Spatrick { 2137061da546Spatrick if ($1 =~ /\$([^#]+)#[0-9a-fA-F]{2}/) 2138061da546Spatrick { 2139061da546Spatrick $opt_g and print "command: $1\n"; 2140061da546Spatrick my @raw_cmd_bytes = split(/ */, $1); 2141061da546Spatrick print "--> "; 2142061da546Spatrick $packet_start_time = $curr_time; 2143061da546Spatrick dump_raw_command(\@raw_cmd_bytes); 2144061da546Spatrick } 2145061da546Spatrick elsif ($1 =~ /\+/) 2146061da546Spatrick { 2147061da546Spatrick #print "--> ACK\n"; 2148061da546Spatrick } 2149061da546Spatrick elsif ($1 =~ /-/) 2150061da546Spatrick { 2151061da546Spatrick #print "--> NACK\n"; 2152061da546Spatrick } 2153061da546Spatrick } 2154061da546Spatrick elsif ($line =~ /putpkt: (.*)/) 2155061da546Spatrick { 2156061da546Spatrick if ($1 =~ /\$([^#]+)#[0-9a-fA-F]{2}/) 2157061da546Spatrick { 2158061da546Spatrick $opt_g and print "response: $1\n"; 2159061da546Spatrick my @raw_rsp_bytes = split(/ */, $1); 2160061da546Spatrick print "<-- "; 2161061da546Spatrick dump_raw_response(\@raw_rsp_bytes); 2162061da546Spatrick print "\n"; 2163061da546Spatrick } 2164061da546Spatrick elsif ($1 =~ /\+/) 2165061da546Spatrick { 2166061da546Spatrick #print "<-- ACK\n"; 2167061da546Spatrick } 2168061da546Spatrick elsif ($1 =~ /-/) 2169061da546Spatrick { 2170061da546Spatrick #print "<-- NACK\n"; 2171061da546Spatrick } 2172061da546Spatrick } 2173061da546Spatrick elsif ($line =~ /send packet: (.*)/) 2174061da546Spatrick { 2175061da546Spatrick if ($1 =~ /\$([^#]+)#[0-9a-fA-F]{2}/) 2176061da546Spatrick { 2177061da546Spatrick $opt_g and print "command: $1\n"; 2178061da546Spatrick my @raw_cmd_bytes = split(/ */, $1); 2179061da546Spatrick print "--> "; 2180061da546Spatrick $packet_start_time = $curr_time; 2181061da546Spatrick dump_raw_command(\@raw_cmd_bytes); 2182061da546Spatrick } 2183061da546Spatrick elsif ($1 =~ /\+/) 2184061da546Spatrick { 2185061da546Spatrick #print "--> ACK\n"; 2186061da546Spatrick } 2187061da546Spatrick elsif ($1 =~ /-/) 2188061da546Spatrick { 2189061da546Spatrick #print "--> NACK\n"; 2190061da546Spatrick } 2191061da546Spatrick } 2192061da546Spatrick elsif ($line =~ /read packet: (.*)/) 2193061da546Spatrick { 2194061da546Spatrick if ($1 =~ /\$([^#]*)#[0-9a-fA-F]{2}/) 2195061da546Spatrick { 2196061da546Spatrick $opt_g and print "response: $1\n"; 2197061da546Spatrick my @raw_rsp_bytes = split(/ */, $1); 2198061da546Spatrick print "<-- "; 2199061da546Spatrick dump_raw_response(\@raw_rsp_bytes); 2200061da546Spatrick print "\n"; 2201061da546Spatrick } 2202061da546Spatrick elsif ($1 =~ /\+/) 2203061da546Spatrick { 2204061da546Spatrick #print "<-- ACK\n"; 2205061da546Spatrick } 2206061da546Spatrick elsif ($1 =~ /-/) 2207061da546Spatrick { 2208061da546Spatrick #print "<-- NACK\n"; 2209061da546Spatrick } 2210061da546Spatrick } 2211061da546Spatrick elsif ($line =~ /Sending packet: \$([^#]+)#[0-9a-fA-F]{2}\.\.\.(.*)/) 2212061da546Spatrick { 2213061da546Spatrick $opt_g and print "command: $1\n"; 2214061da546Spatrick my @raw_cmd_bytes = split(/ */, $1); 2215061da546Spatrick print "\n--> "; 2216061da546Spatrick $packet_start_time = $curr_time; 2217061da546Spatrick dump_raw_command(\@raw_cmd_bytes); 2218061da546Spatrick process_log_line($2); 2219061da546Spatrick } 2220061da546Spatrick elsif ($line =~ /Packet received: (.*)/) 2221061da546Spatrick { 2222061da546Spatrick $opt_g and print "response: $1\n"; 2223061da546Spatrick my @raw_rsp_bytes = split(/ */, $1); 2224061da546Spatrick print "<-- "; 2225061da546Spatrick dump_raw_response(\@raw_rsp_bytes); 2226061da546Spatrick print "\n"; 2227061da546Spatrick } 2228061da546Spatrick 2229061da546Spatrick if ($extract_cmd) 2230061da546Spatrick { 2231061da546Spatrick my $beg = index($line, '("') + 2; 2232061da546Spatrick my $end = rindex($line, '");'); 2233061da546Spatrick $packet_start_time = $curr_time; 2234061da546Spatrick dump_command(substr($line, $beg, $end - $beg)); 2235061da546Spatrick } 2236061da546Spatrick} 2237061da546Spatrick 2238061da546Spatrick 2239061da546Spatrickour $line_num = 0; 2240061da546Spatrickwhile(<>) 2241061da546Spatrick{ 2242061da546Spatrick $line_num++; 2243061da546Spatrick $opt_q or printf("# %5d: $_", $line_num); 2244061da546Spatrick process_log_line($_); 2245061da546Spatrick} 2246061da546Spatrick 2247061da546Spatrickif (%packet_times) 2248061da546Spatrick{ 2249061da546Spatrick print "----------------------------------------------------------------------\n"; 2250061da546Spatrick print "Packet timing summary:\n"; 2251061da546Spatrick print "----------------------------------------------------------------------\n"; 2252061da546Spatrick print "Packet Time %\n"; 2253061da546Spatrick print "---------------------- -------- ------\n"; 2254061da546Spatrick my @packet_names = keys %packet_times; 2255061da546Spatrick my $total_packet_times = 0.0; 2256061da546Spatrick foreach my $key (@packet_names) 2257061da546Spatrick { 2258061da546Spatrick $total_packet_times += $packet_times{$key}; 2259061da546Spatrick } 2260061da546Spatrick 2261061da546Spatrick foreach my $value (sort {$packet_times{$b} cmp $packet_times{$a}} @packet_names) 2262061da546Spatrick { 2263061da546Spatrick my $percent = ($packet_times{$value} / $total_packet_times) * 100.0; 2264061da546Spatrick if ($percent < 10.0) 2265061da546Spatrick { 2266061da546Spatrick printf("%22s %1.6f %2.2f\n", $value, $packet_times{$value}, $percent); 2267061da546Spatrick 2268061da546Spatrick } 2269061da546Spatrick else 2270061da546Spatrick { 2271061da546Spatrick printf("%22s %1.6f %2.2f\n", $value, $packet_times{$value}, $percent); 2272061da546Spatrick } 2273061da546Spatrick } 2274061da546Spatrick print "---------------------- -------- ------\n"; 2275061da546Spatrick printf (" Total %1.6f 100.00\n", $total_packet_times); 2276061da546Spatrick} 2277061da546Spatrick 2278061da546Spatrick 2279061da546Spatrick 2280061da546Spatrick 2281061da546Spatrick 2282061da546Spatrick 2283061da546Spatrick 2284