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

 ;" TMG IDE Debugger Sender
 ;"
 ;" K. Toppenberg
 ;" 4-14-2008
 ;" License: GPL Applies
 ;"
 ;"------------------------------------------------------------
 ;"------------------------------------------------------------
 ;"Notes:    HOW DOES IT ALL WORK?  See TMGIDE3.m notes


Sender(Quiet)
       ;"Purpose: This code will be run from process to be debugged.  It will
       ;"         be controlled by another Controlling process.
       ;"Input: Quiet : OPTIONAL.  If 1 then no TMGIDE extra output from this SENDER

       new TMGdbgResult,TMGdbgXLine
       set Quiet=+$get(Quiet)
       new MsgSndRef set MsgSndRef=$name(^TMG("TMGIDE","SENDER"))
       new % set %=2 ;"default NO
       if $data(@MsgSndRef)'=0 do
       . if Quiet set %=2
       . else  do
       . . write "Is another debugging process already running"
       . . do YN^DICN write !
       . quit:(%'>0) ;"abort
       . if %=2 kill @MsgSndRef quit
       . write "OK to kill debug info and start over"
       . set %=1 do YN^DICN write !
       . if %=1 kill @MsgSndRef quit
       . set %=-1
       if (%'>0) goto SD2 ;"quit

       if 'Quiet write "Waiting up to 60 sec for a CONTROLLER process..."
       if $$MessageOut("INQ "_$J,60)="" goto SendDone
       if 'Quiet write " OK",!
       set TMGdbgResult=$$MessageOut("WRITE Welcome to the TMG debugging environment",,0)
       set TMGdbgResult=$$MessageOut("WRITE Enter any valid M command...",,0)
SendL1
       if 'Quiet write !,!,"=== TMG IDE Sender (Job# ",$J,") ===",!,!
       if 'Quiet write "Waiting for command from Controller window... (^ to abort)"
SendL2
       set TMGdbgXLine=$$MessageOut("DO PROMPT",9999,0)
       if TMGdbgXLine="" goto SendL2
       if TMGdbgXLine="^" goto SendDone

       if 'Quiet write !
       set TMGRunMode=1  ;"1=Step-by-step mode
       set $ZSTEP="N TMGTrap S TMGTrap=$$STEPTRAP^TMGIDE4($ZPOS) zstep:(TMGTrap=1) into zstep:(TMGTrap=2) over zcontinue"

       zstep into
       xecute TMGdbgXLine ;"<-- NOTE: step *INTO* this line.  Shouldn't return from this until final QUIT of that process
       set $ZSTEP=""  ;"turn off step capture
       goto SendL1

SendDone
       if 'Quiet write !,"Sending DONE.."
       new TMGtemp set TMGtemp=$$MessageOut("DONE",1)
       if 'Quiet write TMGtemp,!
       kill ^TMG("TMGIDE","SENDER")
SD2    ;
       quit

HndlCmd(Msg)
       ;"Purpose: When the user enters a command from the prompt in the controlling process, then that command will be
       ;"         forwarded here.
       new Cmd,result
       set result=""
       set Cmd=$piece(Msg," ",2)
       set Msg=$piece(Msg," ",3,999)
       if Cmd="BKPOS" set result=$$HndlBkPos(Msg) goto HCDone
       if Cmd="RELBKPOS" set result=$$HndlRelBkPos(Msg) goto HCDone
       if Cmd="EVAL" set result=$$HndlEval(Msg) goto HCDone
       if Cmd="XECUTE" set result=$$HndlXCod(Msg) goto HCDone
       if Cmd="TABLE" set result=$$HndlTable(Msg) goto HCDone
       if Cmd="DONE" set result="OK",$ZSTEP="" goto HCDone  ;"turn off debugger
       ;
HCDone quit "[RSLT] "_result

HndlEval(Msg)
       ;"Purpose: to evaluate a local variable and pass result back to remote controller
       new varName set varName=Msg
       new result set result=""
       new ref set ref=$name(^TMG("TMGIDE","CONTROLLER","MSG-IN","VAR"))
       kill @ref
       if varName["$" do
       . new tempCode,$etrap,tempValue
       . set $etrap="set $etrap="""",$ecode="""""
       . set tempcode="set tempValue="_varName
       . xecute tempCode
       . merge @ref=tempValue
       else  if varName'="" do
       . new tempCode,$etrap,tempValue
       . set $etrap="set $etrap="""",$ecode="""""
       . set varName=$$CREF^TMGIDE(varName) ;" convert open to closed format
       . merge ^TMG("TMGIDE","CONTROLLER","MSG-IN","VAR")=@varName
       set result=ref

       quit result

HndlTable(Msg)
       ;"Purpose: to copy symbol table to a global, so controller can display.
       new ref set ref=$name(^TMG("TMGIDE","CONTROLLER","MSG-IN","VAR"))
       kill @ref
       zshow "*":@ref
       quit ref


HndlBkPos(Msg)
       ;"Purpose: To set a breakpoint in running code, as specified by remote controller.
       ;"Input Msg: Format:  '<BreakPointPosition> <Condition>'  (Condition is optional)
       ;
       ;"write "Here in HndlBkPos^TMGIDE4.  Msg=",Msg,!
       new result set result=0
       new pos set pos=$piece(Msg," ",1)
       if pos="" goto HBPD
       new condition set condition=$piece(Msg," ",2)
       new brkLine set brkLine=pos_":""n tmg set tmg=$$STEPTRAP^TMGIDE4($ZPOS,1)"""
       ;"write "About to set ZBREAK code: [",brkLine,"]",!
       do
       . new $etrap set $etrap="SET $ETRAP="""",$ECODE="""""
       . ZBREAK @brkLine
       . set result=1
HBPD  quit result

HndlRelBkPos(msg) ;
       ;"Purpose: release a breakpoint.
       ;"Input Msg: Format:  '<BreakPointPosition>'
       new result set result=0
       new pos set pos=$piece(Msg," ",1)
       if pos'="" do
       . new brkLine set brkLine=pos_":""zcontinue"""
       . ZBREAK @brkLine
       . set result=1
       quit result

HndlXCod(MCode)
       ;"Purpose: To excute code in this proccess, based on request from controlling process
       ;"Result: 1 if error, 0 if OK
       new result set result=1 ;"default to error
       do
       . new $etrap set $etrap="write ""(Invalid M Code!.  Error Trapped.)"",! set $etrap="""",$ecode="""""
       . xecute MCode
       . set result=0
       quit result

 ;"------------------------------------------------------------
 ;"------------------------------------------------------------
STEPTRAP(idePos,TMGMsg)
        ;"Purpose: This is the line that is called by GT.M for each zstep event.
        ;"      It will be used to display the current code execution point, and
        ;"      query user as to plans for future execution: run/step/ etc.
        ;"Input: idePos -- a text line containing position, as returned bye $ZPOS
        ;"        TMGMsg -- OPTIONAL -- can be used by programs to pass in info.
        ;"                  If TMGMsg=1, then this function was called without the
        ;"                  $ZSTEP value set, so this function should set it.
        ;"Result: 1=further execution should be via ZSTEP INTO
        ;"        2=further execution should be via ZSTEP OVER
        ;"        (Anything else) -->further execution should be via ZCONTINUE

       new TMGdbgResult,TMGdbgMsg
       set TMGMsg="DO TRAP "_idePos_" "_$get(TMGMsg)
STP2   set TMGdbgResult=$$MessageOut(TMGMsg,9999,0)

       ;"Check if message reply which is actually a request for more info
       if $piece(TMGdbgResult," ",1)="[CMD]" do  goto STP2
       . new temp set temp=$$HndlCmd(TMGdbgResult)
       . set TMGMsg=temp

       quit TMGdbgResult

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

MessageOut(Msg,timeOutTime,ignoreReply)
       ;"Purpose: to send message to Controller, and return the reply, or time out
       ;"Input: Msg --  the message to send
       ;"       timeOutTime -- OPTIONAL, default is 2 seconds
       ;"       ignoreReply -- OPTIONAL, default is 0
       ;"Output: the returned message, or "" if timed out or no reply, or ignoreReply=1

       set timeOutTime=$get(timeOutTime,2)
       set ignoreReply=$get(ignoreReply,0)
       new result set result=""
       set ^TMG("TMGIDE","CONTROLLER","MSG-OUT")=""  ;"clear any old message
       set ^TMG("TMGIDE","CONTROLLER","MSG-IN")=Msg  ;"DON'T DELETE THIS LINE
       if (ignoreReply=0) for  do  quit:(result'="")!(timeOutTime<0)
       . set result=$get(^TMG("TMGIDE","CONTROLLER","MSG-OUT"))
       . if (result'="") quit
       . set timeOutTime=timeOutTime-0.1
       . set ^TMG("TMGIDE","CONTROLLER","MSG-IN")=Msg
       . hang 0.1
       . if $$UserAborted^TMGUSRIF("from MessageOut^TMGIDE4") set timeOutTime=-1,result="^"

       if timeOutTime<0 do
       . new tempResult set tempResult=$$KeyPressed^TMGUSRIF(1,1)
       . if tempResult="^" set result="^"

       quit result