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: ' ' (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: '' 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