/************************************************************** * * * kernal interaction procedures for PL/I symbolic debugger * * * **************************************************************/ /* check to see if user task is still there */ chkknl: procedure; %include 'putdef.pli'; %include 'knldef.pli'; %include 'exitdef.pli'; /**************************************************************************************************************/ if user_exit_status = still_running ! user_exit_status = not_started /*must be able to send initial packet*/ then return; if user_exit_status = EX_SEV then call put_skip_list('user task aborted, debugger exiting'); else if user_exit_status ^= EX_SUC /*exit status for normal exit*/ then do; call put_skip_list('user task exited with status of',user_exit_status); call put_skip_list('if due to error on send or receive with debug task, status is the dsw'); end; debug_exit_status = user_exit_status; signal finish; end; /* send a code packet to the kernal in the user task call fillpacket first to set up the packet */ sendknl: procedure; %include 'knldef.pli'; %include 'exitdef.pli'; dcl (not_stopped, not_active, no_error) fixed bin(15) external, /*defined in debasm*/ dsw fixed bin(15); /**************************************************************************************************************/ /* we use stop rather than suspend to ease congestion on systems without a lot of memory. (stop allows the user task to be swapped out and stay out until the debug task wakes it up. if suspended, the task would still compete for memory even though not able to run, resulting in a lot of thrashing.) */ call chkknl; call send(usertaskrad50, packet, , dsw); if dsw^=no_error /*must be conditional - syserror is in an overlay now*/ then call syserror('error on send (SDAT$) to user task, dsw=',dsw); reresume: call unstop(usertaskrad50, dsw); if dsw = not_stopped then do; call wfsne; call chkknl; goto reresume; end; /*if task not stopped, we probably got control before it got to its stop - must wait to let it run to the stop before unstopping*/ if user_exit_status=not_started & dsw=not_active then return; /*first time - task not active is ok*/ if dsw^=no_error /*must be conditional - syserror is in an overlay now*/ then call syserror('error on unstop of user task, dsw=',dsw); end; /* receive a return packet from the kernal in the user task */ rcvknl: procedure; %include 'knldef.pli'; %include 'truefalse.inc'; dcl rcvpkt(15) fixed bin(15) /*defined(rcvpacket)*/ based(prcvpacket); prcvpacket=addr(rcvpacket); dcl (RCVEVF, exit_event) fixed bin(15) external, /*defined in debmain*/ (no_error, no_data) fixed bin(15) external, /*defined in debasm*/ dsw fixed bin(15); /**************************************************************************************************************/ do while(true); call rcveve(dsw); /*clear RCVEVF & set it whenever a message comes*/ if dsw ^= no_error /*must be conditional - syserror is in an overlay now*/ then call syserror('error on RCVEVE (CLEF$ or SRDA$) call, dsw=',dsw); call receiv(usertaskrad50, rcvpkt, , dsw); if dsw = no_error then return; if dsw ^= no_data /*must be conditional - syserror is in an overlay now*/ then call syserror('error on receive (RCVD$) from user task, dsw=',dsw); call wflor(RCVEVF, exit_event); /*wait for message or task exit*/ call chkknl; /*check to see if was task exit*/ end; end; /* put a some code into the packet for the next sendknl */ fillpacket: procedure(codepacketptr); dcl codepacketptr pointer /*to a code packet in debasm*/; %include 'knldef.pli'; dcl codepacket(13) fixed bin(15) based(codepacketptr), i fixed bin(15); /**************************************************************************************************************/ do i = 1 to 13; packet(i) = codepacket(i); end; end; /* read a word from user task memory */ getword: procedure(useraddr) returns(fixed bin(15)); dcl useraddr fixed bin(15); %include 'knldef.pli'; dcl dordwd pointer external; /*code packet pointer defined in debasm*/ dcl (ordwda, ordwdx) fixed bin(15) external;/*offsets (subscripts) in packet, defined in debasm*/ /**************************************************************************************************************/ call fillpacket(dordwd); packet(ordwda) = useraddr; call sendknl; call rcvknl; return(packet(ordwdx)); end; /* store into a word of user task memory */ putword: procedure(useraddr,word); dcl (useraddr,word) fixed bin(15); %include 'knldef.pli'; dcl dowrwd pointer external; /*code packet pointer defined in debasm*/ dcl (owrwda, owrwdx) fixed bin(15) external;/*offsets (subscripts) in packet, defined in debasm*/ /**************************************************************************************************************/ call fillpacket(dowrwd); packet(owrwda) = useraddr; packet(owrwdx) = word; call sendknl; end; /* get a handful of bytes from user task memory data is in rwbbuf on return */ getbytes: procedure(useraddr, n); dcl (useraddr, n) fixed bin(15); %include 'knldef.pli'; dcl dordb pointer external, /*code packet pointer defined in debasm*/ (ordba, ordbn) fixed bin(15) external, /*offsets (subscripts) in packet, defined in debasm*/ rwbmax fixed bin(15) external; /*size of rwbbuf, defined in debasm*/ /**************************************************************************************************************/ if n>rwbmax ! n<=0 then call error('bug in the debugger - getbytes for'!!n!!' bytes'); call fillpacket(dordb); packet(ordba) = useraddr; packet(ordbn) = n; call sendknl; call rcvknl; end; /* write a string of bytes (any length) into user task memory */ putstring: procedure(useraddr, str); dcl useraddr fixed bin(15), str char(*); %include 'knldef.pli'; dcl dowrb pointer external, /*code packet pointer defined in debasm*/ (owrba, owrbn) fixed bin(15) external, /*offsets (subscripts) in packet, defined in debasm*/ rwbmax fixed bin(15) external; /*size of rwbbuf, defined in debasm*/ dcl (running_addr, running_char, strlen, i) fixed bin(15); /**************************************************************************************************************/ running_addr = useraddr; running_char = 1; strlen = length(str); do while( running_char <= strlen ); call fillpacket(dowrb); packet(owrba) = running_addr; packet(owrbn) = min16( strlen-running_char+1, rwbmax ); do i = 1 to packet(owrbn); substr(rwbbuf,i,1) = substr(str,running_char+i-1,1); end; call sendknl; running_addr = running_addr + rwbmax; running_char = running_char + rwbmax; end; end;