/* PL/I symbolic debugger module to handle undocumented commands for poking around user task and for debugging debugger */ pokecmd: procedure; %include 'putdef.pli'; %include 'knldef.pli'; /*for R,WW,RG*/ %include 'scandef.pli'; %include 'workdef.pli'; %include 'symdef.pli'; /*for V,SY*/ %include 'moddef.pli'; /*for SY*/ %include 'brksymdef.pli'; %include 'breakdef.pli'; /*for BP*/ %include 'statement.inc'; /*for SN*/ %include 'segdef.pli'; /*for XG*/ %include 'external.inc'; /*for XP,XD*/ %include 'typestr.inc'; %include 'plioctal.inc'; /*misc external debugger procedures:*/ dcl octal entry(fixed bin(15)) returns(char(10) varying), octbin entry(char(*)) returns(fixed bin(15)), octexp entry(fixed bin(15)) returns(fixed bin(1)), octbyte entry(fixed bin(15)); dcl (i,j,x) fixed bin(15) static, /*scratch*/ ttype fixed bin(7) static, tname char(31) varying static, tsegment fixed bin(23); /**************************************************************************************************************/ /* show address of PL/I external (TKB data psect) */ if nxtokenis('XD') then do; call segment(tsegment); tname = nxsymtoken; call endscan; call put_skip_list(pli_octal(external_address(tname, external_data_class, tsegment))); goto command_done; end/*XD*/; /* show address of PL/I external (TKB instruction psect) */ if nxtokenis('XP') then do; call segment(tsegment); tname = nxsymtoken; call endscan; call put_skip_list(pli_octal(external_address(tname, external_procedure_class, tsegment))); goto command_done; end/*XP*/; /* show address of global symbol */ if nxtokenis('XG') then do; dcl global_address entry(char(*) varying, fixed bin(23)) returns(fixed bin(15)); call segment(tsegment); if tsegment = any_parent then tsegment = root_segment_fileaddr; /*default to root, not next-encountered*/ tname = nxsymtoken; call endscan; call put_skip_list(pli_octal(global_address(tname, tsegment))); goto command_done; end/*XG*/; /* read word in user task memory given octal address */ if nxtokenis('R') then do; dcl char2 char(2) based; if octexp(x) then readword_addr = x; call endscan; suppress_address_error = true; x=getword(readword_addr); suppress_address_error = false; call put_skip_list(octal(readword_addr), ': dec:',x,', oct: '); call octbyte(x); call put_list(''''); call type_string(addr(x)->char2,no_double_quotes); call put_list(''''); readword_addr = readword_addr + 2; goto command_done; end/*R*/; /* write word into user task memory given octal address & octal value */ if nxtokenis('WW') then do; x = octexp(i); if ^ octexp(x) then nextp = startp; /*force error on endscan*/ /*only need check 2nd arg, since if first fails 2nd will too*/ call endscan; suppress_address_error = true; call putword(i, x); suppress_address_error = false; goto command_done; end/*WW*/; /* show user's registers */ if nxtokenis('RG') then do; call endscan; /* code packet pointer defined in debasm: */ dcl doregs pointer external; /* offsets (subscripts) in packet, defined in debasm: */ dcl ( oregr0, oregr1, oregr2, oregr3 ) fixed bin(15) external; call put_skip_list('at breakpoint, user task had TI: '); if user_attached then call put_list('attached'); else call put_list('detached'); call fillpacket(doregs); call sendknl; call rcvknl; call put_skip_list('r0:',pli_octal(packet(oregr0)), ', r1:',pli_octal(packet(oregr1)), ', r2:',pli_octal(packet(oregr2)), ', r3:',pli_octal(packet(oregr3)), ', dsw:',userdsw); call put_skip_list('pc:',pli_octal(userpc),', r5:',pli_octal(userr5),', ps:',pli_octal(userps), ', sp:',pli_octal(usersp),', fp:',pli_octal(userfp)); goto command_done; end/*RG*/; /* show statement number given octal address */ if nxtokenis('SA') then do; dcl stmtnumber entry(fixed bin(15), fixed bin(15)) returns(fixed bin(15)), block_fileaddr fixed bin(23); call block(block_fileaddr); if ^ octexp(x) then nextp = startp; /*force error on endscan if omitted*/ call endscan; call workgrab(block_fileaddr, scratch_workp); /*get the block record*/ call workgrab(scratch_workp->workbuf.parent, scratch_workp); /*get the module record*/ call put_skip_list(stmtnumber(x, scratch_workp->workbuf.value/*addr of prolog*/)); goto command_done; end; /* show address of statement given statement number */ if nxtokenis('SN') then do; call statement; call endscan; call put_skip_list(pli_octal(statement_address)); goto command_done; end; /* symbol-related commands */ /* show important symbol structure values for last-referenced symbol */ if nxtokenis('V') then do; call endscan; call put_skip_list('module:',main_symp->symbol.module_fileaddr, ', specified block:', main_symp->symbol.specified_block_code, ', actual block:', main_symp->symbol.actual_block_code); if main_symp->symbol.is_external then call put_skip_list('external'); else do; if main_symp->symbol.addressing = based_addressing then call put_skip_list('based'); else if main_symp->symbol.addressing = static_addressing then call put_skip_list('static'); else if main_symp->symbol.addressing = auto_addressing then call put_skip_list('auto'); else if main_symp->symbol.addressing = argument_addressing then call put_skip_list('argument'); else call put_skip_list('not a variable'); end; call put_list(' offset: ', pli_octal(main_symp->symbol.offset), ', basing addr: ', pli_octal(main_symp->symbol.basing_address), ', parent: ', pli_octal(main_symp->symbol.parent_structure)); call put_skip_list('descriptor address: ', pli_octal(main_symp->symbol.descriptor), ', address: ', pli_octal(main_symp->symbol.address), ', len:', main_symp->symbol.len, ', type:', main_symp->symbol.type); goto command_done; end; /* read symbol table entry from symbol file given octal virtual address */ if nxtokenis('SY') then do; dcl (zsymp, zarryp) pointer; dcl symarry(10) fixed bin(15) /*defined(zsymp->symbol.nextsym)*/ based(zarryp); dcl zread fixed bin(1); zread = octexp(x); call endscan; zsymp = main_symp; if zread then do; if x < symfile_base then call put_skip_list('lowest valid address is ', pli_octal(symfile_base)); if x > symfile_end - 128 then call put_skip_list('highest valid address is ', pli_octal(symfile_end)); call read_symbol(x, scratch_symp); zsymp = scratch_symp; end; zarryp = addr(zsymp->symbol.nextsym); call put_skip_list(''''); call type_string(zsymp->symbol.name,no_double_quotes); call put_list('''', zsymp->symbol.namelength); call put_list(' symfile addr: ',pli_octal(zsymp->symbol.symaddr)); call put_skip; do i=1 to 10; call octbyte(symarry(i)); if i=5 then call put_skip; end; goto command_done; end/*SY*/; /* dump breakpoint table */ if nxtokenis('BP') then do; call put_skip_list('# overlay breakpoints:', overlay_breakpoints); do i=lbound(breakpoint,1) to hbound(breakpoint,1); call put_skip; call put_skip_list('stmt:',breakpoint(i).statementn,', lbl:',pli_octal(breakpoint(i).label), ', loc:',pli_octal(breakpoint(i).location),', ovly:',pli_octal(breakpoint(i).overlay), ', unmap:',breakpoint(i).overlay_unmapped); call put_skip_list('mod:',breakpoint(i).module,', prolog:',pli_octal(breakpoint(i).prolog), ', instr:',pli_octal(breakpoint(i).instruction),', after:',breakpoint(i).aftercount); call put_skip_list('can:',breakpoint(i).to_be_cancelled,', donm:',breakpoint(i).do_number, ', dofa:',breakpoint(i).do_fileaddr); end; goto command_done; end/*BP*/; call pokework; /*undocumented commands for poking around debugger workfile*/ /*must be separate module or we get >100 warnings & compiler wont compile us*/ return; command_done: signal condition(endcmd); end;