source: cprs/branches/tmg-cprs/m_files/TMGIDE3.m

TMGIDE3 ;TMG/kst/A debugger/tracer for GT.M (Controller code) ;04/14/08
         ;;1.0;TMG-LIB;**1**;03/23/09

 ;" TMG IDE Debugger Controller
 ;"
 ;" K. Toppenberg
 ;" 4-14-2008
 ;" License: GPL Applies
 ;"
 ;"------------------------------------------------------------
 ;"------------------------------------------------------------
 ;"Notes:    HOW DOES IT ALL WORK?
 ;"
 ;"Here is how the system fits together:
 ;"
 ;"Below is what happens in the CONTROLLING job
 ;"=================================================
 ;" -- LaunchIntr^TMGIDE5(JobNum) sets up a signaling global and then
 ;"                     creates a 'mupip intrpt JobNum', then starts listening
 ;"                     in Controller^TMGIDE3 for communication from the interrupted job.
 ;"                     (See below about how this communication gets started)
 ;" -- Controller^TMGIDE3 polls a communicating global location and can talk back
 ;"                     and forth with the other job.  When it gets a message to
 ;"                     DO TRAP %ZPOS, it then calls STEPTRAP^TMGIDE2, and returns
 ;"                     the result of that function back to the other job.
 ;" -- STEPTRAP^TMGIDE2 is the same interface as the prior debugger.  It shows
 ;"                     the code, allows the user to move around, and interact
 ;"                     with the code.  If the user wants to query variables
 ;"                     in the other process, then a message is sent out, and
 ;"                     a copy of that variable is passed back here for display.
 ;"                     If the user wants to modify the other environment, then
 ;"                     arbitrary M code can be entered by the user, and it is passed
 ;"                     to the other job for execution in that job process space.
 ;"                     When ready to execute the next line of code, then STEPTRAP
 ;"                     quits with a result signalling a zstep INTO or OVER.
 ;"
 ;"Below is what happens in the OTHER job
 ;"=================================================
 ;" -- mupip intrpt JobNum --> causes the specified job to execute the code
 ;"                     stored in $ZINTERRUPT.  For VistA (or if setup in
 ;"                     in an environmental script during GT.M launch), this
 ;"                     code is to run JOBEXAM^ZU (slightly customized)
 ;" -- JOBEXAM^ZU --> looks for signaling global, and if found runs INTERUPT^TMGIDE5
 ;" -- INTERUPT^TMGIDE5 --> sets up $ZSTEP and then calls ZSTEP INTO and
 ;"                     quits out of the $ZINTERRUPT code.
 ;" -- ZSTEP --> causes GT.M to execute the code in $ZSTEP before performing
 ;"                     the next line of mumps code for the program that was
 ;"                     running at the time the interrupt request was received.
 ;" -- $ZSTEP holds instruction to run $$STEPTRAP^TMGIDE4($ZPOS)
 ;" -- STEPTRAP^TMGIDE4 --> sends message to CONTROLLING JOB and waits for reply.
 ;"                     Reply will either be a request from the user for more
 ;"                     information from this job, or a final reply that allows
 ;"                     execution to continue, either by a step INTO, OVER, or
 ;"                     a plain ZCONTINUE (which will stop further code-stepping)


Controller
       ;"Purpose: This code will wait for messages from the executing process, and
       ;"         will display the code as it changes, and send messages back to
       ;"         all the user to control the process remotely.

       ;"Notice: There are

       ;"A globally-scoped var that will be checked in STEPTRAP^TMGIDE2
       if +$get(tmgDbgRemoteJob)'>0 set tmgDbgRemoteJob=1

       ;"write #
       new i for i=1:1:12 write !
       write "=== TMG IDE Controller (Job# "_$JOB_") ===",!,!
       write "Waiting for action from SENDING (Remote) process (ESC to abort)",!
       new msgRef set msgRef=$name(^TMG("TMGIDE","CONTROLLER"))
       kill @msgRef
       set @msgRef@("JOB")=$JOB

       new Msg,UsrInput,Cmd
       new hangDelay set hangDelay=0.2

       new ideBlankLine set $piece(ideBlankLine," ",78)=" "
       ;"new HxSize set HxSize=8     ;"hard codes in history length of 8
       new TMGdbgLine
       new TMGlastline set TMGlastLine=""
       new HxShowNum set HxShowNum=0
       new HxLine,HxLineMax,HxLineCur
       do INITKB^XGF()  ;"set up keyboard input escape code processing
       ;
Init   set @msgRef@("STATUS")="AVAIL"
       set @msgRef@("MSG-OUT")=""
       new TMGstartH set TMGstartH=$piece($H,",",2)
       new tempCh,%
       ;
Loop   set Msg=$get(@msgRef@("MSG-IN"))
       set Cmd=$piece(Msg," ",1)
       ;
       if Cmd="INQ" do HndlINQ(Msg) goto Loop
       if Cmd="LISTEN" do HndlListen(Msg) goto Loop
       if Cmd="DONE" do HndlDone(Msg) goto LstnDone  ;"This is when SENDER signals a quit.
       if Cmd="WRITE" do HndlWrite(Msg) goto Loop
       if Cmd="DO" goto:($$HndlDo(Msg)'=0) Loop goto LstnDone ;"Leave if CONTROLLER signals a quit
       if Cmd="READ" do HndlRead(Msg) goto Loop
       if Cmd="NEED" do HndlNeed(Msg) goto Loop
       ;
       ;"Checking UserAborted grabs keystrokes, and prevents user from getting out of RUN mode
       ;"in ^TMGIDE2, so only check here after an X second delay.
       if $piece($H,",",2)-TMGstartH<2 goto Loop
       read *tempCh:0
       if tempCh'=27 goto Loop
       write !,"Abort From Remote Debugging Controller"
       set TMGstartH=$piece($H,",",2)
       set %=2 do YN^DICN write !
       if %'=1 goto Loop
       ;
LstnDone ;
       write !,"Quitting.",!
       kill @msgRef
       kill tmgDbgRemoteJob
       quit
       ;
;"-------------------------------
;"-------------------------------
       ;
ACK    SET @msgRef@("MSG-OUT")="ACK "_$J
       SET @msgRef@("MSG-IN")=""
       QUIT

HndlINQ(Msg)  ;"Expects 'INQ <Job#>'
       ;"write "Msg=",Msg,!  ;"temp!!
       set tmgDbgRemoteJob=+$piece(Msg," ",2)
       do ACK
       quit

HndlListen(Msg)
       new JobToControl
       set JobToControl=+$piece(Msg," ",3)
       set @msgRef@("STATUS")="LISTENING TO "_JobToControl
       set @msgRef@("MSG-OUT")=@msgRef@("STATUS")
       DO ACK
       quit

HndlWrite(Msg)
       write $piece(Msg," ",2,99),!
       DO ACK
       quit

HndlDo(Msg)
       ;"Purpose: Handle message from interrupted application to DO something.
       ;"Result: 1 = OK to continue
       ;"        0 = should quit controller.
       new result set result=1  ;"default to continue
       new msgResult set msgResult=""
       if $piece(Msg," ",2)="PROMPT" do
       . set msgResult=$$Prompt()
       else  if $piece(Msg," ",2)="TRAP" do
       . new idePos set idePos=$piece(Msg," ",3)
       . new TMGMsg set TMGMsg=$piece(Msg," ",4)
       . set msgResult=$$STEPTRAP^TMGIDE2(idePos,TMGMsg)
       . if msgResult=0 set result=0  ;"STEPTRAP result of 0 means to stop controller.
       set @msgRef@("MSG-OUT")=msgResult
       set @msgRef@("MSG-IN")=""
       set TMGstartH=$piece($H,",",2) ;"restart timer countdown before allowing user input.
       quit result

HndlDone(Msg)
       DO ACK
       quit

HndlRead(Msg)
       new result
       write $piece(Msg," ",2,99)
       read result:$get(DTIME,3600),!
       if result="" set result="<null>"
       set @msgRef@("MSG-OUT")=result
       set @msgRef@("MSG-IN")=""
       quit

HndlNeed(Msg)
       set SndJob=+$piece(Msg," ",3)
       set @MsgRef@("STATUS")="CONTROLLING "_SndJob
       set @MsgRef@("MSG-OUT")=@MsgCtrlRef@("STATUS")
       quit

;"-------------------------------------------------------------------

Prompt()
       ;"Purpose: to interact with user and run through code.

       ;"new i write # for i=1:1:12 write !
       write "=== TMG IDE Controller ===",!,!

Ppt2
       set HxShowNum=+$get(HxShowNum)
       set TMGStepMode="into"  ;"kt added 5/3/06
       set HxLine=$get(^TMG("TMGIDE","CMD HISTORY",$J,HxShowNum))
       set HxLineMax=$get(^TMG("TMGIDE","CMD HISTORY",$J,"MAX"),0)

       write "Remote command (^ to quit): "
       if HxShowNum=0 write "^// "
       else  write "// ",HxLine

       set TMGdbgLine=$$READ^TMGIDE()  ;"$$READ^XGF  ;"returns line terminator in tmgXGRT
       set tmgXGRT=$get(tmgXGRT) ;"ensure existence
       if TMGdbgLine="?" do  goto Ppt2
       . write !,"Here you should enter any valid M command, as would normally",!
       . write "entered at a GTM> prompt.",!
       . write "  examples:  WRITE ""HELLO"",!  or DO ^TMGTEST",!

       if (TMGdbgLine="")&(HxShowNum>0) set TMGdbgLine=HxLine

       if (tmgXGRT="DOWN")!(tmgXGRT="RIGHT")!(TMGdbgLine="]") do  goto Ppt2
       . set HxShowNum=HxShowNum-1
       . if HxShowNum<0 set HxShowNum=HxLineMax
       . ;"write "setting HxShowNum=",HxShowNum,!
       . do CHA^TMGTERM(1) write ideBlankLine do CHA^TMGTERM(1)

       if (tmgXGRT="UP")!(tmgXGRT="LEFT")!(TMGdbgLine="[") do  goto Ppt2
       . set HxShowNum=HxShowNum+1
       . if HxShowNum>HxLineMax set HxShowNum=0
       . ;"write "setting HxShowNum=",HxShowNum,!
       . do CHA^TMGTERM(1) write ideBlankLine do CHA^TMGTERM(1)

       if TMGdbgLine="" set TMGdbgLine="^"
       write !

       ;"Save Cmd history
       set HxLineCur=$get(^TMG("TMGIDE","CMD HISTORY",$J,"CUR"),0)  ;"<-- points to last used, not next avail
       set HxLineMax=$get(^TMG("TMGIDE","CMD HISTORY",$J,"MAX"),0) ;"equals buffer size AFTER it fills
       set HxLineCur=HxLineCur+1
       ;"if HxLineCur>HxSize set HxLineCur=1
       set ^TMG("TMGIDE","CMD HISTORY",$J,HxLineCur)=TMGdbgLine
       set ^TMG("TMGIDE","CMD HISTORY",$J,"CUR")=HxLineCur
       if HxLineCur>HxLineMax do
       . set HxLineMax=HxLineCur
       . set ^TMG("TMGIDE","CMD HISTORY",$J,"MAX")=HxLineMax
       ;"write "Saving line in #",HxLineCur," Max=",HxLineMax,!

       quit TMGdbgLine