/* PL/I symbolic debugger module to handle miscellaneous commands */ othercmd: procedure; %include 'knldef.pli'; /*for CALL*/ %include 'external.inc'; /*for CALL*/ %include 'segdef.pli'; /*for CALL*/ %include 'putdef.pli'; %include 'scandef.pli'; %include 'workdef.pli'; %include 'breakdef.pli'; /*for SHOW BREAK*/ %include 'moddef.pli'; /*for SHOW BREAK*/ %include 'brksymdef.pli'; %include 'rundef.pli'; /*for SHOW CALLS*/ %include 'prologn.inc'; /*for SHOW CALLS*/ dcl (i,j,x) fixed bin(15) static, /*scratch*/ ttype fixed bin(7) static, tname char(31) varying static, oncode builtin, no_error fixed bin(15) external; /*IS.SUC, defined in debasm*/ /**************************************************************************************************************/ /********** * HELP * **********/ dcl dcl_line char(80) varying static, once_mode fixed bin(1); if nxtokenis(' HELP HEL HE H ? ') then do; i = nxtokenis(' DEBUGGER DEBUG DEBU DEB '); /*optional*/ i = nextp; do while (tname ^= ';'); ttype = nexttoken(tname); end; /*scan to end of command*/ dcl_line = 'DCL HELP DEBUG '!!substr(commandline,i,tokenp-i); nextp = ignore_rest_of_line; /*force rest of line to be ignored*/ once_mode = true; goto help_entry; end/*HELP*/; /******* * DCL * *******/ /* note: this code should precede the code for the procedure definition command */ dcl rad50 entry(char(*)) returns(fixed bin(31)), err fixed bin(15), mcr_event fixed bin(15) external, /*defined in debmain*/ mcr_esb(8) fixed bin(15); if nxtokenis('DCL') then do; dcl_line = ''; if nxtokenis(';') then once_mode = false; else do; once_mode = true; dcl_line = substr(commandline,startp); /*take rest of line, DCL command can contain semicolon*/ nextp = ignore_rest_of_line; goto help_entry; end; if debprocedure_define_level ^= 0 then goto command_done; on endfile(sysin) /*in case user hits control-z*/ begin; close file(sysin); /*must close and re-open to reset endfile condition*/ open file(sysin); goto command_done; end; on transmit(sysin) begin; close file(sysin); /*closing and opening to reset condition*/ open file(sysin); call error('TRANSMIT (SYSIN) ONCODE = '!!oncode); end; continueDCL: call put_skip_list('DCL>'); call chkknl; /* don't wait for command if user task aborted */ read file(sysin) into(dcl_line); if dcl_line ^= '' then do; dcl_line = 'DCL '!!dcl_line; help_entry: if debprocedure_define_level ^= 0 then goto command_done; if once_mode & (scan_state_nesting_level ^= 0) then call put_skip_list;/*puts first line of help/dcl at left margin*/ if length(dcl_line) > 79 then call error('DCL command line is too long'); /*if >79 RSX gives off the wall thoroughly confusing error code (DPB out of addr space)*/ call detach_ti; call spawn(rad50('MCR...'), /*no iop*/, mcr_event, mcr_esb, dcl_line, , err); if err^=no_error then call error('error spawning DCL, dsw='!!err); call waitfr(mcr_event, err); if err^=no_error then call error('error waiting on DCL, dsw='!!err); if mcr_esb(1) ^= 1 then call put_skip_list('error from DCL command, status=', mcr_esb(1)); call attach_ti; if ^once_mode then goto continueDCL; end; goto command_done; end/*DCL*/; /************* * INCLUDE * *************/ %include 'cantopen.inc'; if nxtokenis(' %INCLUDE %INCL %INC INCLUDE INCL INC @ ') then do; tname = nxsymtoken!!'.DEB'; call endscan; if include_open then call error('can''t nest include/indirect files'); on undefinedfile(includefile) call error(cantopen(tname,oncode)); open file(includefile) title(tname); call push_scan_state; /*save commandline so can have commands following on the line*/ include_open = true; in_include = true; goto command_done; end/*%INCLUDE*/; /********** * EXIT * **********/ if nxtokenis('EXIT') then do; call endscan; dcl doexit pointer external; /*defined in debasm*/ call fillpacket(doexit); call sendknl; signal finish; end/*EXIT*/; /**************** * Show Break * ****************/ %include 'plioctal.inc'; dcl trim entry(char(*)) returns(char(10) varying), ibpt fixed bin(15); if nxtokenis(show) then if nxtokenis(break) then do; call endscan; dcl any_breakpoints fixed bin(1); any_breakpoints = false; do ibpt = lbound(breakpoint,1) to hbound(breakpoint,1); if ( breakpoint(ibpt).location ^= 0 ) & ^ breakpoint(ibpt).to_be_cancelled then do; any_breakpoints = true; call workgrab(breakpoint(ibpt).module,scratch_workp); call put_skip_list(scratch_workp->workbuf.name,'\'); if breakpoint(ibpt).statementn ^= by_octal_address then call put_list(breakpoint(ibpt).statementn); else call put_list(pli_octal(breakpoint(ibpt).location)); if breakpoint(ibpt).aftercount > 1 then call put_list(' after:',breakpoint(ibpt).aftercount); if breakpoint(ibpt).do_number ^= 0 then call put_list(' DO',trim(breakpoint(ibpt).do_number)); end; end; if ^ any_breakpoints then call put_skip_list('there are no breakpoints currently set'); call workgrab(default_module, scratch_workp); call put_skip_list('currently at statement', userbreakstatement, ' in module ', scratch_workp->workbuf.name); goto command_done; end; nextp = startp; /***************************** * SHOW PROCEDURE, SHOW DO * *****************************/ dcl show_all fixed bin(1), nextline char(80) varying; if nxtokenis(show) then do; if nxtokenis(' PROCEDURE PROCEDURES PROC PROCS ') then do; ttype = nexttoken(tname); if tname = ';' then do; if debprocedure_define_level = 0 /*execute only if not defining*/ then do; if workget(any_name,debprocedure_class,debprocedure_subclass,scratch_workp) then do; show_all = true; call put_skip_list; do while(show_all); call put_list(scratch_workp->workbuf.name,' ');/*put list automatically wraps*/ show_all = worknext(any_name,debprocedure_class,debprocedure_subclass,scratch_workp); end; end; else call put_skip_list('there are no debug procedures defined'); end; goto command_done; end; if ttype ^= symbol_type then call error('invalid procedure name'); end; else do; ttype = nexttoken(tname); (nostringrange): if substr(tname,1,2) ^= 'DO' then goto not_show_do; end; call endscan; if workget(tname,debprocedure_class,any_parent,scratch_workp) then do; i = 0; do while(true); call workread(nextline,scratch_workp); if nextline = endmark then goto command_done; if i ^= 1 then call put_skip; /*1st line broken in 2 pieces to allow error recovery*/ call put_list(nextline); i = i + 1; end; end; else call error('debug procedure or do group, '!!tname!!', not found'); goto command_done; end; not_show_do: nextp = startp; /************************* * PROCEDURE definition * /*************************/ /* note: this code should follow code for DCL command - DCL command can contain colon */ j = errorp; i = nexttoken(tname); /* could be a procedure name */ if nxtokenis(':') then do; if i ^= symbol_type then call error('illegal procedure name'); if ^ nxtokenis(' PROCEDURE PROC ') then call error('PROCEDURE keyword missing in procedure declaration'); j = tokenp;/*save tokenp for below workwrite--endscan corrupts it*/ call endscan; debprocedure_startp = nextp; /*flag start of first line to allow re-entering on error*/ if workget(tname,debprocedure_class,debprocedure_subclass,scratch_workp) then call warning('previously defined procedure with same name is being replaced'); call workput(tname,debprocedure_class,debprocedure_subclass); call workwrite(substr(commandline,j,debprocedure_startp-j)); /*write PROCEDURE keyword separately for error recovery*/ call workwrite(substr(commandline,debprocedure_startp)); /*write first line of procedure*/ debprocedure_define_level = debprocedure_define_level + 1; goto command_done; end; nextp = startp; /*not procedure definition - restore scanning state*/ errorp = j; /*restore errorp so errors dont appear to be a token beyond actual location*/ /***************************** * %CALL a debug procedure * *****************************/ if nxtokenis('%CALL') then do; if nexttoken(tname) ^= symbol_type then call error('illegal procedure name'); call endscan; if workget(tname, debprocedure_class, any_parent, scratch_workp) then do; call push_scan_state; /*uses debprocedure_workp. following assume scratch_workp isnt used after above workget*/ nextp = -1; /*negative forces a read (do_command/debmain)*/ call workpos(scratch_workp->workbuf.curfilepos, debprocedure_workp); call workread(nextline, debprocedure_workp); /*skip initial PROCEDURE or DO keyword*/ end; else call error('debug procedure not found'); goto command_done; end; /**************** * SHOW CALLS * ****************/ /* we show module\statement not procedure\statement because some of the callers could be in local procedures of a module for which SET MODULE has not been done, in which case we can't determine the full name */ if nxtokenis(show) then if nxtokenis(' CALLS CALL ') then do; call endscan; dcl any_callers fixed bin(1), ( thisfp, callerfp, callee_return, parent_prolog ) fixed bin(15); /*addresses in user tsk*/ dcl stmtnumber entry(fixed bin(15), fixed bin(15)) returns(fixed bin(15)); /**put in include file if others use*/ any_callers = false; thisfp = userfp; caller_loop: call uplevel(thisfp, callerfp, parent_prolog); if callerfp ^= 0 /*note: we don't list the top dummy block which calls the main*/ then do; if thisfp ^= userfp then do; call put_skip; if any_callers then call put_list('which was '); call put_list('called at ', prologname(parent_prolog),'\',stmtnumber(callee_return, parent_prolog)); any_callers = true; end; callee_return = getword(thisfp+dsa_return); thisfp = callerfp; goto caller_loop; end; if ^ any_callers then call put_skip_list('no callers - currently in the main'); goto command_done; end; nextp = startp; /*************************** * CALL a user procedure * ***************************/ if nxtokenis('CALL') then do; /** temp call subset. no error checking. user must not have any breakpoints in called procedure! dsw is not restored to state on break - callee must not assume it's there. **/ /* code packet pointer defined in debasm: */ dcl docall pointer external; /* offsets (subscripts) in packet, defined in debasm: */ dcl ( ocalarg, ocalfp, ocalad ) fixed bin(15) external; dcl arg char(10) varying; tname = nxsymtoken; if ^ nxtokenis('(') then nextp = startp; /*force error on endscan*/ ttype = nexttoken(arg); if ttype^=decimal_constant_type then nextp = startp; if ^ nxtokenis(')') then nextp = startp; if ^ nxtokenis(';') /**temp special message till call syntax documented in help when official command*/ then call error('invalid calling sequence - syntax must be CALL name(number)'); nextp = tokenp; call endscan; x = external_address(tname, external_procedure_class, root_segment_fileaddr); /*for now, require to be in root (otherwise check for overlay loaded)*/ if x = not_found then call error('external procedure not found'); call fillpacket(docall); packet(ocalarg) = arg; packet(ocalfp) = userfp; packet(ocalad) = x; call sendknl; call rcvknl; goto command_done; end/*CALL*/; /********************* * Window Commands * *********************/ dcl window char(20) static initial(' WINDOW WIND WIN WI '); if nxtokenis(window) then do; on size goto badinput; if nexttoken(tname) ^= decimal_constant_type then goto badinput; (size): i = tname; /*upper line number*/ if i<1 ! i>23 then goto badinput; x = nxtokenis(','); if nexttoken(tname) ^= decimal_constant_type then goto badinput; call endscan; (size): j = tname; /*lower line number*/ if j<2 ! j>24 ! i>=j then badinput:call error('The window option is SET WINDOW top,bottom where 0