/* PL/I symbolic debugger module to handle undocumented commands for poking around debugger workfile */ pokework: procedure; %include 'putdef.pli'; %include 'scandef.pli'; %include 'moddef.pli'; %include 'workdef.pli'; %include 'typestr.inc'; %include 'plioctal.inc'; dcl (i,j,x) fixed bin(15) static, /*scratch*/ ttype fixed bin(7) static, tname char(31) varying static; /**************************************************************************************************************/ /* read from work file given optional name, class, and parent or given an address display the contents*/ type_limited_string: procedure (limited_string,max_length); dcl limited_string char(*) varying, max_length fixed bin(15); dcl min16 entry(fixed bin(15),fixed bin(15)) returns(fixed bin(15)); call type_string(substr(limited_string,1,min16(length(limited_string),max_length)),no_double_quotes); end type_limited_string; dcl savepos fixed bin(23) static; if nxtokenis('WK') then do; ttype = nexttoken(tname); if tname = ';' then do; if worknext(wk_name, wk_class, wk_parent, scratch_workp) then goto display; else goto notfound; end; if ttype = decimal_constant_type then do; call workgrab(tname,scratch_workp); goto display; end; if tname = ',' then wk_name = any_name; else do; wk_name = tname; ttype = nxtokenis(','); end; ttype = nexttoken(tname); if tname = ';' then do; nextp = tokenp; tname = ','; end; if tname = ',' then wk_class = any_class; else do; if ttype ^= decimal_constant_type then call error('class must be in decimal'); wk_class = tname; ttype = nxtokenis(','); end; ttype = nexttoken(tname); if tname = ';' then do; nextp = tokenp; tname = ','; end; if tname = ',' then wk_parent = any_parent; else do; if ttype ^= decimal_constant_type then call error('parent must be in decimal'); wk_parent = tname; end; call endscan; if ^ workget(wk_name, wk_class, wk_parent, scratch_workp) then notfound: call put_skip_list('next name:',wk_name,', class:',wk_class,', parent:',wk_parent,' not found'); else do; display: call put_skip_list('name: '''); call type_limited_string(scratch_workp->workbuf.name,31/*know max length*/); call put_list(''', class:',scratch_workp->workbuf.class,', parent:',scratch_workp->workbuf.parent); call put_skip_list('fileaddr:',scratch_workp->workbuf.fileaddr,', next:',scratch_workp->workbuf.next, ', value:',pli_octal(scratch_workp->workbuf.value)); if scratch_workp->workbuf.class = overlay_segment_class then do; read file(workfile) into(segment_data); call put_skip_list('The segment globals base is: ',segment_data.segment_globals_base); end; else if scratch_workp->workbuf.class = module_class then do; savepos = current_fileaddr(workfile); call symswitch(setting_module); call workpos(savepos, scratch_workp); read file(workfile) into(current_module); call put_skip_list('hash fileaddr:',current_module.hash_fileaddr,', data fileaddr:', current_module.data_fileaddr,', name:'''); call type_string(current_module.name,no_double_quotes);call put_list(''''); call put_skip_list('prolog:',pli_octal(current_module.prolog),', symfile name:'''); call type_limited_string(symfilename,34/*know max length*/); call put_list(''', symfile module base:',pli_octal(symfile_module_base)); call put_skip_list('base:',pli_octal(symfile_base),', end:',pli_octal(symfile_end), ', first: ',pli_octal(symfile_first)); call put_skip_list('offset:',pli_octal(symfile_offset),', next:',pli_octal(symfile_next)); do i = lbound(blocks,1) to hbound(blocks,1); call put_skip_list(i, ' ', blocks(i).name6, blocks(i).fileaddr, ' ', pli_octal(blocks(i).address), blocks(i).parent); end; end; else if scratch_workp->workbuf.class = block_class then do; read file(workfile) into(block_data); call put_skip_list('parent:',block_data.parent,', address:',pli_octal(block_data.address), ', symfile address:',pli_octal(block_data.symaddr)); end; else if scratch_workp->workbuf.class = external_procedure_class then do; read file(workfile) into(tname); call put_skip_list('symfile file name:''',tname,''''); end; end; goto command_done; end/*WK*/; /* read a line given its fileaddr */ if nxtokenis('WR') then do; dcl line char(132) varying static /*static to take space in overlay (auto space is in root)*/, oncode builtin; on transmit(workfile) call error('transmit on workfile, oncode ='!!oncode); on endfile(workfile) call error('endfile on workfile'); if nxtokenis(';') then nextp = tokenp; else do; if nexttoken(tname) ^= decimal_constant_type then call error('arg must be decimal constant'); call workpos(tname, scratch_workp); end; call endscan; read file(workfile) into(line); call put_skip; call type_string(line, no_double_quotes); goto command_done; end/*WR*/; /* show contents of the work index */ if nxtokenis('WX') then do; call endscan; call put_skip_list; do i = 1 to hbound(work_index,1); call put_list(work_index(i)); end; goto command_done; end/*WX*/; if nxtokenis('WH') then do; ttype = nexttoken(tname); call endscan; call put_skip_list(workhash(tname)); goto command_done; end/*WH*/; return; command_done: signal condition(endcmd); end;