| 1 | TMGIDE4 ;TMG/kst/A debugger/tracer for GT.M (Sender code) ;04/14/08
|
|---|
| 2 | ;;1.0;TMG-LIB;**1**;03/23/09
|
|---|
| 3 |
|
|---|
| 4 | ;" TMG IDE Debugger Sender
|
|---|
| 5 | ;"
|
|---|
| 6 | ;" K. Toppenberg
|
|---|
| 7 | ;" 4-14-2008
|
|---|
| 8 | ;" License: GPL Applies
|
|---|
| 9 | ;"
|
|---|
| 10 | ;"------------------------------------------------------------
|
|---|
| 11 | ;"------------------------------------------------------------
|
|---|
| 12 | ;"Notes: HOW DOES IT ALL WORK? See TMGIDE3.m notes
|
|---|
| 13 |
|
|---|
| 14 |
|
|---|
| 15 | Sender(Quiet)
|
|---|
| 16 | ;"Purpose: This code will be run from process to be debugged. It will
|
|---|
| 17 | ;" be controlled by another Controlling process.
|
|---|
| 18 | ;"Input: Quiet : OPTIONAL. If 1 then no TMGIDE extra output from this SENDER
|
|---|
| 19 |
|
|---|
| 20 | new TMGdbgResult,TMGdbgXLine
|
|---|
| 21 | set Quiet=+$get(Quiet)
|
|---|
| 22 | new MsgSndRef set MsgSndRef=$name(^TMG("TMGIDE","SENDER"))
|
|---|
| 23 | new % set %=2 ;"default NO
|
|---|
| 24 | if $data(@MsgSndRef)'=0 do
|
|---|
| 25 | . if Quiet set %=2
|
|---|
| 26 | . else do
|
|---|
| 27 | . . write "Is another debugging process already running"
|
|---|
| 28 | . . do YN^DICN write !
|
|---|
| 29 | . quit:(%'>0) ;"abort
|
|---|
| 30 | . if %=2 kill @MsgSndRef quit
|
|---|
| 31 | . write "OK to kill debug info and start over"
|
|---|
| 32 | . set %=1 do YN^DICN write !
|
|---|
| 33 | . if %=1 kill @MsgSndRef quit
|
|---|
| 34 | . set %=-1
|
|---|
| 35 | if (%'>0) goto SD2 ;"quit
|
|---|
| 36 |
|
|---|
| 37 | if 'Quiet write "Waiting up to 60 sec for a CONTROLLER process..."
|
|---|
| 38 | if $$MessageOut("INQ "_$J,60)="" goto SendDone
|
|---|
| 39 | if 'Quiet write " OK",!
|
|---|
| 40 | set TMGdbgResult=$$MessageOut("WRITE Welcome to the TMG debugging environment",,0)
|
|---|
| 41 | set TMGdbgResult=$$MessageOut("WRITE Enter any valid M command...",,0)
|
|---|
| 42 | SendL1
|
|---|
| 43 | if 'Quiet write !,!,"=== TMG IDE Sender (Job# ",$J,") ===",!,!
|
|---|
| 44 | if 'Quiet write "Waiting for command from Controller window... (^ to abort)"
|
|---|
| 45 | SendL2
|
|---|
| 46 | set TMGdbgXLine=$$MessageOut("DO PROMPT",9999,0)
|
|---|
| 47 | if TMGdbgXLine="" goto SendL2
|
|---|
| 48 | if TMGdbgXLine="^" goto SendDone
|
|---|
| 49 |
|
|---|
| 50 | if 'Quiet write !
|
|---|
| 51 | set TMGRunMode=1 ;"1=Step-by-step mode
|
|---|
| 52 | set $ZSTEP="N TMGTrap S TMGTrap=$$STEPTRAP^TMGIDE4($ZPOS) zstep:(TMGTrap=1) into zstep:(TMGTrap=2) over zcontinue"
|
|---|
| 53 |
|
|---|
| 54 | zstep into
|
|---|
| 55 | xecute TMGdbgXLine ;"<-- NOTE: step *INTO* this line. Shouldn't return from this until final QUIT of that process
|
|---|
| 56 | set $ZSTEP="" ;"turn off step capture
|
|---|
| 57 | goto SendL1
|
|---|
| 58 |
|
|---|
| 59 | SendDone
|
|---|
| 60 | if 'Quiet write !,"Sending DONE.."
|
|---|
| 61 | new TMGtemp set TMGtemp=$$MessageOut("DONE",1)
|
|---|
| 62 | if 'Quiet write TMGtemp,!
|
|---|
| 63 | kill ^TMG("TMGIDE","SENDER")
|
|---|
| 64 | SD2 ;
|
|---|
| 65 | quit
|
|---|
| 66 |
|
|---|
| 67 | HndlCmd(Msg)
|
|---|
| 68 | ;"Purpose: When the user enters a command from the prompt in the controlling process, then that command will be
|
|---|
| 69 | ;" forwarded here.
|
|---|
| 70 | new Cmd,result
|
|---|
| 71 | set result=""
|
|---|
| 72 | set Cmd=$piece(Msg," ",2)
|
|---|
| 73 | set Msg=$piece(Msg," ",3,999)
|
|---|
| 74 | if Cmd="BKPOS" set result=$$HndlBkPos(Msg) goto HCDone
|
|---|
| 75 | if Cmd="RELBKPOS" set result=$$HndlRelBkPos(Msg) goto HCDone
|
|---|
| 76 | if Cmd="EVAL" set result=$$HndlEval(Msg) goto HCDone
|
|---|
| 77 | if Cmd="XECUTE" set result=$$HndlXCod(Msg) goto HCDone
|
|---|
| 78 | if Cmd="TABLE" set result=$$HndlTable(Msg) goto HCDone
|
|---|
| 79 | if Cmd="DONE" set result="OK",$ZSTEP="" goto HCDone ;"turn off debugger
|
|---|
| 80 | ;
|
|---|
| 81 | HCDone quit "[RSLT] "_result
|
|---|
| 82 |
|
|---|
| 83 | HndlEval(Msg)
|
|---|
| 84 | ;"Purpose: to evaluate a local variable and pass result back to remote controller
|
|---|
| 85 | new varName set varName=Msg
|
|---|
| 86 | new result set result=""
|
|---|
| 87 | new ref set ref=$name(^TMG("TMGIDE","CONTROLLER","MSG-IN","VAR"))
|
|---|
| 88 | kill @ref
|
|---|
| 89 | if varName["$" do
|
|---|
| 90 | . new tempCode,$etrap,tempValue
|
|---|
| 91 | . set $etrap="set $etrap="""",$ecode="""""
|
|---|
| 92 | . set tempcode="set tempValue="_varName
|
|---|
| 93 | . xecute tempCode
|
|---|
| 94 | . merge @ref=tempValue
|
|---|
| 95 | else if varName'="" do
|
|---|
| 96 | . new tempCode,$etrap,tempValue
|
|---|
| 97 | . set $etrap="set $etrap="""",$ecode="""""
|
|---|
| 98 | . set varName=$$CREF^TMGIDE(varName) ;" convert open to closed format
|
|---|
| 99 | . merge ^TMG("TMGIDE","CONTROLLER","MSG-IN","VAR")=@varName
|
|---|
| 100 | set result=ref
|
|---|
| 101 |
|
|---|
| 102 | quit result
|
|---|
| 103 |
|
|---|
| 104 | HndlTable(Msg)
|
|---|
| 105 | ;"Purpose: to copy symbol table to a global, so controller can display.
|
|---|
| 106 | new ref set ref=$name(^TMG("TMGIDE","CONTROLLER","MSG-IN","VAR"))
|
|---|
| 107 | kill @ref
|
|---|
| 108 | zshow "*":@ref
|
|---|
| 109 | quit ref
|
|---|
| 110 |
|
|---|
| 111 |
|
|---|
| 112 | HndlBkPos(Msg)
|
|---|
| 113 | ;"Purpose: To set a breakpoint in running code, as specified by remote controller.
|
|---|
| 114 | ;"Input Msg: Format: '<BreakPointPosition> <Condition>' (Condition is optional)
|
|---|
| 115 | ;
|
|---|
| 116 | ;"write "Here in HndlBkPos^TMGIDE4. Msg=",Msg,!
|
|---|
| 117 | new result set result=0
|
|---|
| 118 | new pos set pos=$piece(Msg," ",1)
|
|---|
| 119 | if pos="" goto HBPD
|
|---|
| 120 | new condition set condition=$piece(Msg," ",2)
|
|---|
| 121 | new brkLine set brkLine=pos_":""n tmg set tmg=$$STEPTRAP^TMGIDE4($ZPOS,1)"""
|
|---|
| 122 | ;"write "About to set ZBREAK code: [",brkLine,"]",!
|
|---|
| 123 | do
|
|---|
| 124 | . new $etrap set $etrap="SET $ETRAP="""",$ECODE="""""
|
|---|
| 125 | . ZBREAK @brkLine
|
|---|
| 126 | . set result=1
|
|---|
| 127 | HBPD quit result
|
|---|
| 128 |
|
|---|
| 129 | HndlRelBkPos(msg) ;
|
|---|
| 130 | ;"Purpose: release a breakpoint.
|
|---|
| 131 | ;"Input Msg: Format: '<BreakPointPosition>'
|
|---|
| 132 | new result set result=0
|
|---|
| 133 | new pos set pos=$piece(Msg," ",1)
|
|---|
| 134 | if pos'="" do
|
|---|
| 135 | . new brkLine set brkLine=pos_":""zcontinue"""
|
|---|
| 136 | . ZBREAK @brkLine
|
|---|
| 137 | . set result=1
|
|---|
| 138 | quit result
|
|---|
| 139 |
|
|---|
| 140 | HndlXCod(MCode)
|
|---|
| 141 | ;"Purpose: To excute code in this proccess, based on request from controlling process
|
|---|
| 142 | ;"Result: 1 if error, 0 if OK
|
|---|
| 143 | new result set result=1 ;"default to error
|
|---|
| 144 | do
|
|---|
| 145 | . new $etrap set $etrap="write ""(Invalid M Code!. Error Trapped.)"",! set $etrap="""",$ecode="""""
|
|---|
| 146 | . xecute MCode
|
|---|
| 147 | . set result=0
|
|---|
| 148 | quit result
|
|---|
| 149 |
|
|---|
| 150 | ;"------------------------------------------------------------
|
|---|
| 151 | ;"------------------------------------------------------------
|
|---|
| 152 | STEPTRAP(idePos,TMGMsg)
|
|---|
| 153 | ;"Purpose: This is the line that is called by GT.M for each zstep event.
|
|---|
| 154 | ;" It will be used to display the current code execution point, and
|
|---|
| 155 | ;" query user as to plans for future execution: run/step/ etc.
|
|---|
| 156 | ;"Input: idePos -- a text line containing position, as returned bye $ZPOS
|
|---|
| 157 | ;" TMGMsg -- OPTIONAL -- can be used by programs to pass in info.
|
|---|
| 158 | ;" If TMGMsg=1, then this function was called without the
|
|---|
| 159 | ;" $ZSTEP value set, so this function should set it.
|
|---|
| 160 | ;"Result: 1=further execution should be via ZSTEP INTO
|
|---|
| 161 | ;" 2=further execution should be via ZSTEP OVER
|
|---|
| 162 | ;" (Anything else) -->further execution should be via ZCONTINUE
|
|---|
| 163 |
|
|---|
| 164 | new TMGdbgResult,TMGdbgMsg
|
|---|
| 165 | set TMGMsg="DO TRAP "_idePos_" "_$get(TMGMsg)
|
|---|
| 166 | STP2 set TMGdbgResult=$$MessageOut(TMGMsg,9999,0)
|
|---|
| 167 |
|
|---|
| 168 | ;"Check if message reply which is actually a request for more info
|
|---|
| 169 | if $piece(TMGdbgResult," ",1)="[CMD]" do goto STP2
|
|---|
| 170 | . new temp set temp=$$HndlCmd(TMGdbgResult)
|
|---|
| 171 | . set TMGMsg=temp
|
|---|
| 172 |
|
|---|
| 173 | quit TMGdbgResult
|
|---|
| 174 |
|
|---|
| 175 | ;"------------------------------------------------------------
|
|---|
| 176 | ;"------------------------------------------------------------
|
|---|
| 177 |
|
|---|
| 178 | MessageOut(Msg,timeOutTime,ignoreReply)
|
|---|
| 179 | ;"Purpose: to send message to Controller, and return the reply, or time out
|
|---|
| 180 | ;"Input: Msg -- the message to send
|
|---|
| 181 | ;" timeOutTime -- OPTIONAL, default is 2 seconds
|
|---|
| 182 | ;" ignoreReply -- OPTIONAL, default is 0
|
|---|
| 183 | ;"Output: the returned message, or "" if timed out or no reply, or ignoreReply=1
|
|---|
| 184 |
|
|---|
| 185 | set timeOutTime=$get(timeOutTime,2)
|
|---|
| 186 | set ignoreReply=$get(ignoreReply,0)
|
|---|
| 187 | new result set result=""
|
|---|
| 188 | set ^TMG("TMGIDE","CONTROLLER","MSG-OUT")="" ;"clear any old message
|
|---|
| 189 | set ^TMG("TMGIDE","CONTROLLER","MSG-IN")=Msg ;"DON'T DELETE THIS LINE
|
|---|
| 190 | if (ignoreReply=0) for do quit:(result'="")!(timeOutTime<0)
|
|---|
| 191 | . set result=$get(^TMG("TMGIDE","CONTROLLER","MSG-OUT"))
|
|---|
| 192 | . if (result'="") quit
|
|---|
| 193 | . set timeOutTime=timeOutTime-0.1
|
|---|
| 194 | . set ^TMG("TMGIDE","CONTROLLER","MSG-IN")=Msg
|
|---|
| 195 | . hang 0.1
|
|---|
| 196 | . if $$UserAborted^TMGUSRIF("from MessageOut^TMGIDE4") set timeOutTime=-1,result="^"
|
|---|
| 197 |
|
|---|
| 198 | if timeOutTime<0 do
|
|---|
| 199 | . new tempResult set tempResult=$$KeyPressed^TMGUSRIF(1,1)
|
|---|
| 200 | . if tempResult="^" set result="^"
|
|---|
| 201 |
|
|---|
| 202 | quit result
|
|---|
| 203 |
|
|---|
