| 1 | TMGIDE2 ;TMG/kst/A debugger/tracer for GT.M (core functionality) ;03/25/06
|
|---|
| 2 | ;;1.0;TMG-LIB;**1**;03/23/09
|
|---|
| 3 |
|
|---|
| 4 | ;" GT.M TRAP STEP
|
|---|
| 5 | ;"
|
|---|
| 6 | ;" K. Toppenberg
|
|---|
| 7 | ;" 4-13-2005
|
|---|
| 8 | ;" License: GPL Applies
|
|---|
| 9 | ;"
|
|---|
| 10 | ;"------------------------------------------------------------
|
|---|
| 11 | ;"------------------------------------------------------------
|
|---|
| 12 | ;" This code module will allow tracing through code.
|
|---|
| 13 | ;" It is used as follows:
|
|---|
| 14 | ;"
|
|---|
| 15 | ;" set $ZSTEP="do STEPTRAP^TMGIDE2($ZPOS) zstep into zcontinue"
|
|---|
| 16 | ;" zstep into
|
|---|
| 17 | ;" do ^MyFunction ;"<--- put the function you want to trace here
|
|---|
| 18 | ;"
|
|---|
| 19 | ;" set $ZSTEP="" ;"<---turn off step capture
|
|---|
| 20 | ;" quit
|
|---|
| 21 | ;"
|
|---|
| 22 | ;"
|
|---|
| 23 | ;" Dependencies:
|
|---|
| 24 | ;" Uses: ^TMGTERM,^TMGIDE
|
|---|
| 25 | ;"
|
|---|
| 26 | ;"Notes:
|
|---|
| 27 | ;" This function will be called inbetween lines of the main
|
|---|
| 28 | ;" program that is being traced. Thus this function can't do
|
|---|
| 29 | ;" anything that might change the environment of the main
|
|---|
| 30 | ;" program.
|
|---|
| 31 | ;"------------------------------------------------------------
|
|---|
| 32 | ;"------------------------------------------------------------
|
|---|
| 33 |
|
|---|
| 34 | ;"=======================================================================
|
|---|
| 35 | ;" API -- Public Functions.
|
|---|
| 36 | ;"=======================================================================
|
|---|
| 37 | ;"STEPTRAP(tmgIDEPos,TMGMsg)
|
|---|
| 38 | ;"ErrTrap(tmgIDEPos)
|
|---|
| 39 |
|
|---|
| 40 | ;"=======================================================================
|
|---|
| 41 | ;"PRIVATE API FUNCTIONS
|
|---|
| 42 | ;"=======================================================================
|
|---|
| 43 | ;"EvalWatches
|
|---|
| 44 | ;"BlankLine
|
|---|
| 45 | ;"ShowCode(ShowPos,ScrWidth,ScrHeight,Wipe,ViewOffset,LROffset)
|
|---|
| 46 | ;"GetStackInfo(Stack,tmgOrigIDEPos)
|
|---|
| 47 | ;"SetBreakpoint(pos,Condition)
|
|---|
| 48 | ;"RelBreakpoint(pos)
|
|---|
| 49 |
|
|---|
| 50 | ;"=======================================================================
|
|---|
| 51 | ;"=======================================================================
|
|---|
| 52 |
|
|---|
| 53 |
|
|---|
| 54 | STEPTRAP(tmgIDEPos,TMGMsg)
|
|---|
| 55 | ;"Purpose: This is the line that is called by GT.M for each zstep event.
|
|---|
| 56 | ;" It will be used to display the current code execution point, and
|
|---|
| 57 | ;" query user as to plans for future execution: run/step/ etc.
|
|---|
| 58 | ;"Input: tmgIDEPos -- a text line containing position, as returned bye $ZPOS
|
|---|
| 59 | ;" TMGMsg -- OPTIONAL -- can be used by programs to pass in info.
|
|---|
| 60 | ;" If TMGMsg=1, then this function was called without the
|
|---|
| 61 | ;" $ZSTEP value set, so this function should set it.
|
|---|
| 62 | ;"Global-scoped vars used:
|
|---|
| 63 | ;" tmgDbgRemoteJob = remote $J if controlling a remote process
|
|---|
| 64 | ;" Won't exist (or will be 0) otherwise.
|
|---|
| 65 | ;" tmgRunMode --
|
|---|
| 66 | ;" tmgStepMode --
|
|---|
| 67 | ;" TMGScrHeight --
|
|---|
| 68 | ;" TMGScrWidth --
|
|---|
| 69 | ;" TMGLROffset --
|
|---|
| 70 | ;" TMGdbgHideList (an array REF) -- holds modules to hide
|
|---|
| 71 | ;"Result: desired mode for next time:
|
|---|
| 72 | ;" 1=step into
|
|---|
| 73 | ;" 2=step over
|
|---|
| 74 | ;" 3-step outof
|
|---|
| 75 | ;" (anything else) -- stop debugging. <-- I think...
|
|---|
| 76 | ;" 0-->signals request to stop when remote debugging.
|
|---|
| 77 |
|
|---|
| 78 | ;"tmgRunMode: 0=running mode (NOTE: tmgRunMode comes from tmgRunMode)
|
|---|
| 79 | ;" 1=stepping mode
|
|---|
| 80 | ;" 2=Don't show code
|
|---|
| 81 | ;" 3=running SLOW mode
|
|---|
| 82 | ;" -1=quit
|
|---|
| 83 | new tmgdbgTruth set tmgdbgTruth=$TEST ;"save initial value of $TEST
|
|---|
| 84 | if $ZTRAP'["^TMG" do SetErrTrap^TMGIDE ;"ensure no redirecting of error trap
|
|---|
| 85 | new tmgDbgResult set tmgDbgResult=1 ;"1=step into, 2=step over
|
|---|
| 86 | new tmgDbgNakedRef set tmgDbgNakedRef=$$LGR^TMGIDE ;"save naked reference
|
|---|
| 87 | set tmgDbgHangTime=+$get(tmgDbgHangTime,0.25)
|
|---|
| 88 |
|
|---|
| 89 | set tmgRunMode=$get(tmgRunMode,1)
|
|---|
| 90 | ;"Keep track of changes to variable system table
|
|---|
| 91 | if (tmgRunMode'=0)&(+$get(tmgDbgOptions("VARTRACE"))=1) do RecordVTrace^TMGIDE6
|
|---|
| 92 | set tmgStepMode=$get(tmgStepMode,"into")
|
|---|
| 93 |
|
|---|
| 94 | set tmgDbgRemoteJob=+$get(tmgDbgRemoteJob)
|
|---|
| 95 | new TMGdbgJNum set TMGdbgJNum=$J
|
|---|
| 96 | if tmgDbgRemoteJob set TMGdbgJNum=tmgDbgRemoteJob
|
|---|
| 97 | new ArrayName set ArrayName=$name(^TMG("TMGIDE",TMGdbgJNum,"MODULES"))
|
|---|
| 98 | new %TMG set %TMG=$get(%)
|
|---|
| 99 |
|
|---|
| 100 | new tpBlankLine,tpAction,tpKeyIn,tpI,tpDone
|
|---|
| 101 | new ViewOffset set ViewOffset=0
|
|---|
| 102 |
|
|---|
| 103 | new savedIO,savedX,savedY
|
|---|
| 104 | set savedIO=$IO
|
|---|
| 105 | set savedX=$X,savedY=$Y
|
|---|
| 106 |
|
|---|
| 107 | new ScrHeight,ScrWidth,LROffset
|
|---|
| 108 | set ScrHeight=$get(TMGScrHeight,10)
|
|---|
| 109 | set ScrWidth=+$get(TMGScrWidth)
|
|---|
| 110 | if (ScrWidth'>0)!(tmgRunMode=1) do ;"If pause after every show, take time to check dimensions.
|
|---|
| 111 | . if $$GetScrnSize^TMGKERNL(,.ScrWidth)
|
|---|
| 112 | . set TMGScrWidth=ScrWidth
|
|---|
| 113 | set LROffset=$get(TMGLROffset,0)
|
|---|
| 114 | use $P:(WIDTH=ScrWidth:NOWRAP) ;"reset IO to the screen
|
|---|
| 115 |
|
|---|
| 116 | set tpBlankLine=" "
|
|---|
| 117 | for tpI=1:1:ScrWidth-1 set tpBlankLine=tpBlankLine_" "
|
|---|
| 118 |
|
|---|
| 119 | new relPos set relPos=tmgIDEPos
|
|---|
| 120 | new tmgOrigIDEPos set tmgOrigIDEPos=tmgIDEPos
|
|---|
| 121 | new tempPos set tempPos=$$ConvertPos^TMGIDE(tmgIDEPos,ArrayName)
|
|---|
| 122 | if tempPos'="" set tmgIDEPos=tempPos
|
|---|
| 123 |
|
|---|
| 124 | ;"don't show hidden modules (setup in TMGIDE module)
|
|---|
| 125 | if $$ShouldSkip($piece(tmgIDEPos,"^",2)) goto SPDone
|
|---|
| 126 | ;"Record trace, if not a hidden module
|
|---|
| 127 | if +$get(tmgDbgOptions("TRACE"))=1 do RecordTrace^TMGIDE6(tmgOrigIDEPos)
|
|---|
| 128 |
|
|---|
| 129 | ;"Note: Conditional Breakpoints: I will have to try to get this working later.
|
|---|
| 130 | ;"I have it such that the condition is recognized. But now I need to
|
|---|
| 131 | ;"Differientate between stepping through code, and a breakpoint from
|
|---|
| 132 | ;"a full speed run.
|
|---|
| 133 | new stpSkip set stpSkip=0
|
|---|
| 134 | if $$IsBreakpoint(tmgIDEPos) do ;"goto:(stpSkip=1) SPDone
|
|---|
| 135 | . new ifS set ifS=$$GetBrkCond(tmgIDEPos) if ifS="" quit
|
|---|
| 136 | . new $etrap set $etrap="write ""ERROR in breakpoint condition code."",! quit"
|
|---|
| 137 | . if (@ifS=0) set stpSkip=1
|
|---|
| 138 | . if @ifS write "Condition FOUND!!" ;"do PressToCont^TMGUSRIF
|
|---|
| 139 |
|
|---|
| 140 | do VCUSAV2^TMGTERM
|
|---|
| 141 | new CsrOnBreakline set CsrOnBreakline=0
|
|---|
| 142 | if tmgRunMode'=2 do ;"2=Don't show code
|
|---|
| 143 | . do ShowCode(tmgIDEPos,ScrWidth,ScrHeight,,ViewOffset,LROffset,.CsrOnBreakline)
|
|---|
| 144 | . write CsrOnBreakline,! ;"temps
|
|---|
| 145 | else do
|
|---|
| 146 | . do CUP^TMGTERM(1,2)
|
|---|
| 147 | write tpBlankLine,!
|
|---|
| 148 | write tpBlankLine,!
|
|---|
| 149 | do CUU^TMGTERM(2)
|
|---|
| 150 | if tmgRunMode'=1 do ;"Not stepping mode
|
|---|
| 151 | . write tpBlankLine,!
|
|---|
| 152 | . do CUU^TMGTERM(1)
|
|---|
| 153 | . do EvalWatches
|
|---|
| 154 | . write "(Press any key to pause"
|
|---|
| 155 | . if tmgRunMode=3 write "; '+' for faster, '-' for slower)",!
|
|---|
| 156 | . else write ")",!
|
|---|
| 157 | . read *tpKeyIn:0
|
|---|
| 158 | . if tmgRunMode=3 do
|
|---|
| 159 | . . if tpKeyIn=43 set tmgDbgHangTime=tmgDbgHangTime/2 ;"43= '+'
|
|---|
| 160 | . . else if tpKeyIn=45 set tmgDbgHangTime=tmgDbgHangTime*2 ;"45= '-'
|
|---|
| 161 | . . hang tmgDbgHangTime
|
|---|
| 162 | . if (tpKeyIn>0) set tmgRunMode=1
|
|---|
| 163 | if tmgRunMode'=2 do ;"2=Don't show code
|
|---|
| 164 | . do CmdPrompt ;"display prompt and interact with user
|
|---|
| 165 | do VCULOAD2^TMGTERM
|
|---|
| 166 | ;
|
|---|
| 167 | SPDone ;"Finish up and return to GTM execution
|
|---|
| 168 | if tmgStepMode="into" set tmgDbgResult=1
|
|---|
| 169 | if tmgStepMode="over" set tmgDbgResult=2
|
|---|
| 170 | if tmgStepMode="outof" set tmgDbgResult=3
|
|---|
| 171 |
|
|---|
| 172 |
|
|---|
| 173 | if $get(TMGMsg)=1 do ;"call was without $ZSTEP set, so we should set it.
|
|---|
| 174 | . new code set code="N TMGTrap "
|
|---|
| 175 | . set code=code_"S TMGTrap=$$STEPTRAP^TMGIDE2($ZPOS) "
|
|---|
| 176 | . set code=code_"zstep:(TMGTrap=1) into zstep:(TMGTrap=2) over zstep:(TMGTrap=3) outof "
|
|---|
| 177 | . set code=code_"zcontinue"
|
|---|
| 178 | . ;"set $ZSTEP="N TMGTrap S TMGTrap=$$STEPTRAP^TMGIDE2($ZPOS) zstep:(TMGTrap=1) into zstep:(TMGTrap=2) over zstep:(TMGTrap=3) outof zcontinue"
|
|---|
| 179 | . set $ZSTEP=code
|
|---|
| 180 | . zstep:(tmgDbgResult=1) into
|
|---|
| 181 | . zstep:(tmgDbgResult=2) over
|
|---|
| 182 | . zstep:(tmgDbgResult=3) outof
|
|---|
| 183 |
|
|---|
| 184 |
|
|---|
| 185 | ;"Restore environment
|
|---|
| 186 | if $data(savedIO) use savedIO ;"turn IO back to what it was when coming into this function.
|
|---|
| 187 | set $X=+$get(savedX),$Y=+$get(savedY) ;"Restore screen POS variables.
|
|---|
| 188 | set %=%TMG
|
|---|
| 189 | if tmgDbgNakedRef'["""""" do ;"If holds "" index, skip over
|
|---|
| 190 | . new discard set discard=$get(@tmgDbgNakedRef) ;"restore naked reference.
|
|---|
| 191 | if tmgdbgTruth ;"This will restore initial value of $TEST
|
|---|
| 192 | quit tmgDbgResult
|
|---|
| 193 | ;"============================================================================
|
|---|
| 194 |
|
|---|
| 195 | CmdPrompt
|
|---|
| 196 | ;"Purpose: Display the command prompt, and handle user input
|
|---|
| 197 | ;"Note: uses some variables with global scope, because this code block
|
|---|
| 198 | ;" was simply cut out of main routine above.
|
|---|
| 199 | ;"Result: None
|
|---|
| 200 | if tmgRunMode'=1 quit ;"Only interact with user if in stepping mode (1)
|
|---|
| 201 | new $etrap set $etrap="set result="""",$etrap="""",$ecode="""""
|
|---|
| 202 | new tpDone set tpDone=0
|
|---|
| 203 | for do quit:tpDone=1
|
|---|
| 204 | . do ShowCode(tmgIDEPos,ScrWidth,ScrHeight,,ViewOffset,LROffset,.CsrOnBreakline)
|
|---|
| 205 | . new tempi for tempi=1:1:2 write tpBlankLine,! ;"create empty space below display.
|
|---|
| 206 | . do CUU^TMGTERM(2)
|
|---|
| 207 | . if CsrOnBreakline=1 do
|
|---|
| 208 | . . new ifS set ifS=$$GetBrkCond($$RelConvertPos^TMGIDE(relPos,ViewOffset,ArrayName))
|
|---|
| 209 | . . if ifS'="" write "Breakpoint test: [",ifS,"]",!
|
|---|
| 210 | . write "}"
|
|---|
| 211 | . do EvalWatches
|
|---|
| 212 | . set $X=1
|
|---|
| 213 | . write "Action (? for help): "
|
|---|
| 214 | . write "step "_$$UP^TMGIDE(tmgStepMode)_"// "
|
|---|
| 215 | . do ClrLine
|
|---|
| 216 | . set tpAction=$$READ^TMGIDE() write !
|
|---|
| 217 | . if tpAction="" set tpAction=$$UP^TMGIDE($extract(tmgStepMode,1,1))
|
|---|
| 218 | . new origAction set origAction=tpAction
|
|---|
| 219 | . do TranslateKeys(.tpAction,$get(tmgXGRT))
|
|---|
| 220 | . set tpDone=("RLIHOXTQ"[tpAction)
|
|---|
| 221 | . if tpAction="R" set tmgRunMode=0 quit ;"Run Quickly
|
|---|
| 222 | . if tpAction="L" set tmgRunMode=3 quit ;"Run slowly
|
|---|
| 223 | . if tpAction="H" set tmgRunMode=2 quit ;"HIDE
|
|---|
| 224 | . if tpAction="I" set tmgStepMode="into" quit ;"Step INTO
|
|---|
| 225 | . if tpAction="O" set tmgStepMode="over" quit ;"Step OVER
|
|---|
| 226 | . if tpAction="T" set tmgStepMode="outof" quit ;"Step OUTOF
|
|---|
| 227 | . if tpAction="X" do HndlDone quit ;"Turn off debugger (keep running)
|
|---|
| 228 | . if tpAction="Q" do HndlQuit quit ;"Quit from debugger (stop running)
|
|---|
| 229 | . if tpAction="M" do HndlMCode quit ;"Execute M code
|
|---|
| 230 | . if tpAction="B" do HndlSetBrk quit ;"Toggle a breakpoint at current location
|
|---|
| 231 | . if tpAction="E" do HndlExpand quit ;"Expand line
|
|---|
| 232 | . if tpAction="W" do HndlWatch(origAction) quit ;"Watch
|
|---|
| 233 | . if tpAction="C" do HndlCstBrk quit ;"Custom breakpoint
|
|---|
| 234 | . if tpAction="J" do HndlJmpDisp(.tmgIDEPos,.ViewOffset) quit ;"Jump to new display location
|
|---|
| 235 | . if tpAction="BC" do HndlBrkCond quit ;"Enter a breakpoint condition (IF code)
|
|---|
| 236 | . if $$MoveKey(tpAction) quit
|
|---|
| 237 | . if tpAction="+" set TMGScrWidth=$get(TMGScrWidth)+1 quit
|
|---|
| 238 | . if tpAction="-" set:(TMGScrWidth>10) TMGScrWidth=$get(TMGScrWidth)-1 quit
|
|---|
| 239 | . if tpAction="=" do HndlScrW quit
|
|---|
| 240 | . if tpAction="CLS" write # quit
|
|---|
| 241 | . if tpAction="TABLE" do HndlTable quit
|
|---|
| 242 | . if tpAction["SHOW" do HndlShow quit
|
|---|
| 243 | . if tpAction["BROWSE" do HndlBrowse quit
|
|---|
| 244 | . if tpAction["NODES" do HndlNodes quit
|
|---|
| 245 | . if tpAction["STACK" do HndlStack(.tmgIDEPos,.ViewOffset) quit
|
|---|
| 246 | . if tpAction["RESYNC" kill @ArrayName quit
|
|---|
| 247 | . if tpAction["HIDE" do SetupSkips quit
|
|---|
| 248 | . if tpAction["FULL" do FULL^VALM1,INITKB^XGF() quit
|
|---|
| 249 | . if tpAction["UCASE" do HndlToggleMode("UCASE") quit
|
|---|
| 250 | . if tpAction["LCASE" do HndlToggleMode("LCASE") quit
|
|---|
| 251 | . if tpAction["XCMD" do HndlToggleMode("XCMD") quit
|
|---|
| 252 | . if tpAction["SCMD" do HndlToggleMode("SCMD") quit
|
|---|
| 253 | . if tpAction["TRACE" do ShowTrace^TMGIDE6 quit
|
|---|
| 254 | . if tpAction["TVDIFF" do HndlToggleMode("VARTRACE") quit
|
|---|
| 255 | . if tpAction["VDIFF" do ShowVTrace^TMGIDE6 quit
|
|---|
| 256 | . if tpAction["COLORS" do EditColors^TMGIDE6 quit
|
|---|
| 257 | . if tpAction["INITKB" do INITKB^XGF() quit ;"set up keyboard input escape code processing
|
|---|
| 258 | . else do HndlHelp quit
|
|---|
| 259 | quit
|
|---|
| 260 |
|
|---|
| 261 | BlankLine ;
|
|---|
| 262 | write tpBlankLine
|
|---|
| 263 | do CHA^TMGTERM(1) ;"move to x=1 on this line
|
|---|
| 264 | quit
|
|---|
| 265 |
|
|---|
| 266 | ClrLine ;
|
|---|
| 267 | ;"Purpose: clear out line
|
|---|
| 268 | new loop
|
|---|
| 269 | new tempX set tempX=$X
|
|---|
| 270 | for loop=1:1:20 write " "
|
|---|
| 271 | for loop=1:1:20 write $char(8) ;"backspace
|
|---|
| 272 | set $X=tempX
|
|---|
| 273 | quit
|
|---|
| 274 |
|
|---|
| 275 | TranslateKeys(tpAction,tmgXGRT)
|
|---|
| 276 | ;"Purpose: translate input keys into a standard output.
|
|---|
| 277 | ;"Input: tpAction -- PASS BY REFERENCE.
|
|---|
| 278 | set tpAction=$$UP^TMGIDE(tpAction)
|
|---|
| 279 | set tmgXGRT=$get(tmgXGRT)
|
|---|
| 280 | if tmgXGRT="UP" set tpAction="A"
|
|---|
| 281 | if tmgXGRT="PREV" set tpAction="AA"
|
|---|
| 282 | if tmgXGRT="DOWN" set tpAction="Z"
|
|---|
| 283 | if tmgXGRT="NEXT" set tpAction="ZZ"
|
|---|
| 284 | if tmgXGRT="RIGHT" set tpAction="]"
|
|---|
| 285 | if tmgXGRT="LEFT" set tpAction="["
|
|---|
| 286 | if (tpAction="<AU>") set tpAction="<UP>"
|
|---|
| 287 | if (tpAction="A") set tpAction="<UP>"
|
|---|
| 288 | if (tpAction="AA") set tpAction="<PGUP>"
|
|---|
| 289 | if (tpAction="<AD>") set tpAction="<DN>"
|
|---|
| 290 | if (tpAction="Z") set tpAction="<DN>"
|
|---|
| 291 | if (tpAction="ZZ") set tpAction="<PGDN>"
|
|---|
| 292 | if (tpAction="<AL>") set tpAction="<LEFT>"
|
|---|
| 293 | if (tpAction="[") set tpAction="<LEFT>"
|
|---|
| 294 | if (tpAction="[[") set tpAction="<HOME>"
|
|---|
| 295 | if (tpAction="<AR>") set tpAction="<RIGHT>"
|
|---|
| 296 | if (tpAction="]") set tpAction="<RIGHT>"
|
|---|
| 297 | if (tpAction="]]") set tpAction="<END>"
|
|---|
| 298 | if (tpAction="^") set tpAction="Q"
|
|---|
| 299 | if "wW"[$piece(tpAction," ",1) set tpAction="W"
|
|---|
| 300 | quit
|
|---|
| 301 |
|
|---|
| 302 | MoveKey(tpAction)
|
|---|
| 303 | ;"Purpose: Handle movement keys
|
|---|
| 304 | ;"result: 1 if tpAction is a movement key, 0 otherwise
|
|---|
| 305 | if (tpAction="<UP>") do quit 1
|
|---|
| 306 | . set ViewOffset=ViewOffset-1
|
|---|
| 307 | if (tpAction="<DN>") do quit 1
|
|---|
| 308 | . set ViewOffset=ViewOffset+1
|
|---|
| 309 | if (tpAction="<PGUP>") do quit 1
|
|---|
| 310 | . set ViewOffset=ViewOffset-1
|
|---|
| 311 | . set ViewOffset=ViewOffset-ScrHeight+2;
|
|---|
| 312 | if (tpAction="<PGDN>") do quit 1
|
|---|
| 313 | . set ViewOffset=ViewOffset+1
|
|---|
| 314 | . set ViewOffset=ViewOffset+ScrHeight-2;
|
|---|
| 315 | if (tpAction="<LEFT>") do quit 1
|
|---|
| 316 | . if LROffset>1 set LROffset=LROffset-1
|
|---|
| 317 | if (tpAction="<HOME>") do quit 1
|
|---|
| 318 | . set LROffset=0
|
|---|
| 319 | if tpAction="<RIGHT>" do quit 1
|
|---|
| 320 | . if LROffset=0 set LROffset=1
|
|---|
| 321 | . set LROffset=LROffset+1
|
|---|
| 322 | if (tpAction="<END>") do quit 1
|
|---|
| 323 | . if LROffset=0 set LROffset=1
|
|---|
| 324 | . set LROffset=LROffset+20
|
|---|
| 325 | quit 0
|
|---|
| 326 |
|
|---|
| 327 | EvalWatches
|
|---|
| 328 | ;"Purpose: Run code that evaluates watches.
|
|---|
| 329 | if $get(tmgWatchLine)'="" do
|
|---|
| 330 | . new $etrap set $etrap="write ""(Invalid M Code!. Error Trapped.)"" set $etrap="""",$ecode="""""
|
|---|
| 331 | . xecute tmgWatchLine
|
|---|
| 332 | if $data(tmgDgbWatches("*")) do ShowVTrace^TMGIDE6
|
|---|
| 333 | write !
|
|---|
| 334 | quit
|
|---|
| 335 |
|
|---|
| 336 | HndlMCode ;
|
|---|
| 337 | ;"Purpose: Handle option to execute arbitrary code.
|
|---|
| 338 | do CUU^TMGTERM(1)
|
|---|
| 339 | do CHA^TMGTERM(1) ;"move to x=1 on this line
|
|---|
| 340 | write tpBlankLine,!
|
|---|
| 341 | do CUU^TMGTERM(1)
|
|---|
| 342 | set tpLine=$$Trim^TMGIDE($piece(origAction," ",2,999))
|
|---|
| 343 | if tpLine="" read " enter M code (^ to cancel): ",tpLine,!
|
|---|
| 344 | if (tpLine'="^") do
|
|---|
| 345 | . if +$get(tmgDbgRemoteJob) do RemoteXecute(tpLine) quit
|
|---|
| 346 | . new $etrap set $etrap="write ""(Invalid M Code!. Error Trapped.)"",! set $etrap="""",$ecode="""""
|
|---|
| 347 | . write ! ;"get below bottom line for output.
|
|---|
| 348 | . xecute tpLine
|
|---|
| 349 | quit
|
|---|
| 350 |
|
|---|
| 351 | HndlShow;
|
|---|
| 352 | ;"Purpose: Handle option to show a variable.
|
|---|
| 353 | do Box
|
|---|
| 354 | do SetColors("NORM")
|
|---|
| 355 | do CUP^TMGTERM(1,2) ;"Cursor to line (1,2)
|
|---|
| 356 | new varName set varName=$$Trim^TMGSTUTL($extract(origAction,5,999))
|
|---|
| 357 | if +$get(tmgDbgRemoteJob) set varName=$$GetRemoteVar(varName)
|
|---|
| 358 | write ! ;"get below bottom line for output.
|
|---|
| 359 | new zbTemp set zbTemp=0
|
|---|
| 360 | if varName["$" do
|
|---|
| 361 | . new tempCode
|
|---|
| 362 | . new $etrap set $etrap="write ""(Invalid M Code!. Error Trapped.)"",! set $etrap="""",$ecode="""""
|
|---|
| 363 | . write varName,"='"
|
|---|
| 364 | . set tempCode="do DebugWrite(1,"_varName_")"
|
|---|
| 365 | . xecute tempCode
|
|---|
| 366 | . write "' "
|
|---|
| 367 | else if varName'="" do
|
|---|
| 368 | . set varName=$$CREF^TMGIDE(varName) ;"convert open to closed format
|
|---|
| 369 | . set zbTemp=$$ArrayDump^TMGIDE(varName)
|
|---|
| 370 | if zbTemp=0 do
|
|---|
| 371 | . do SetColors("Highlight")
|
|---|
| 372 | . do PressToCont^TMGUSRIF
|
|---|
| 373 | do SetColors("Reset")
|
|---|
| 374 | quit
|
|---|
| 375 |
|
|---|
| 376 | HndlToggleMode(Mode)
|
|---|
| 377 | ;"Purpose: Toggle UCASE or LCASE in Options
|
|---|
| 378 | ;"This will effect the translation of all commands into forced Upper Case
|
|---|
| 379 | ;"or forced Lowercase, or leave as found if both options are set to 0
|
|---|
| 380 | quit:($get(Mode)="")
|
|---|
| 381 | set tmgDbgOptions(Mode)='+$get(tmgDbgOptions(Mode))
|
|---|
| 382 | write "Mode for "
|
|---|
| 383 | if "UCASE,LCASE,XCMD,SCMD"[Mode do
|
|---|
| 384 | . write "forcing "
|
|---|
| 385 | . write $select(Mode="UCASE":"UPPER case",Mode="LCASE":"LOWER case",1:"")
|
|---|
| 386 | . write $select(Mode="XCMD":"expansion",Mode="SCMD":"shortening",1:"")
|
|---|
| 387 | . write " of mumps command "
|
|---|
| 388 | if "TRACE"[Mode do
|
|---|
| 389 | . write "recording TRACE of execution "
|
|---|
| 390 | write "turned: "
|
|---|
| 391 | write $select(tmgDbgOptions(Mode)=0:"OFF",1:"ON")," ",!
|
|---|
| 392 | if tmgDbgOptions(Mode)=1 do
|
|---|
| 393 | . if Mode="UCASE" set tmgDbgOptions("LCASE")=0
|
|---|
| 394 | . if Mode="LCASE" set tmgDbgOptions("UCASE")=0
|
|---|
| 395 | . if Mode="XCMD" set tmgDbgOptions("SCMD")=0
|
|---|
| 396 | . if Mode="SCMD" set tmgDbgOptions("XCMD")=0
|
|---|
| 397 | ;"do PressToCont^TMGUSRIF
|
|---|
| 398 | quit
|
|---|
| 399 |
|
|---|
| 400 | HndlWatch(tpAction) ;
|
|---|
| 401 | ;"Purpose: Handle option to add watch
|
|---|
| 402 | do CUU^TMGTERM(1)
|
|---|
| 403 | do CHA^TMGTERM(1) ;"move to x=1 on this line
|
|---|
| 404 | write tpBlankLine,!
|
|---|
| 405 | do CUU^TMGTERM(1)
|
|---|
| 406 | write !,tpAction ;"TEMP!
|
|---|
| 407 | if (tpAction["+")!(tpAction["-") do
|
|---|
| 408 | . new watchVar
|
|---|
| 409 | . if (tpAction["+") do
|
|---|
| 410 | . . set watchVar=$$Trim^TMGIDE($piece(origAction,"+",2))
|
|---|
| 411 | . . if watchVar="" quit
|
|---|
| 412 | . . if watchVar="^" set watchVar="tmgDbgNakedRef"
|
|---|
| 413 | . . set tmgDgbWatches(watchVar)=""
|
|---|
| 414 | . . if watchVar="*" write "Watching variable CHANGES"
|
|---|
| 415 | . else if (tpAction["-") do
|
|---|
| 416 | . . set watchVar=$$Trim^TMGIDE($piece(origAction,"-",2))
|
|---|
| 417 | . . if watchVar="" quit
|
|---|
| 418 | . . if watchVar="^" set watchVar="tmgDbgNakedRef"
|
|---|
| 419 | . . kill tmgDgbWatches(watchVar)
|
|---|
| 420 | . set tmgWatchLine=""
|
|---|
| 421 | . new v set v=""
|
|---|
| 422 | . for set v=$order(tmgDgbWatches(v)) quit:(v="") do
|
|---|
| 423 | . . if v="*" quit ;" this signal for watching CHANGES handled elsewhere.
|
|---|
| 424 | . . set tmgWatchLine=tmgWatchLine_" write """_v_" =["",$get("_v_"),""], """
|
|---|
| 425 | else do
|
|---|
| 426 | . kill tmgDgbWatches
|
|---|
| 427 | . new tempCode
|
|---|
| 428 | . read "Enter M code (^ to cancel): ",tempCode,!
|
|---|
| 429 | . if tempCode'="^" set tmgWatchLine=tempCode
|
|---|
| 430 | quit
|
|---|
| 431 |
|
|---|
| 432 | HndlQuit ;
|
|---|
| 433 | ;"Purpose: To create a crash, so can quit debugger, OR if in Remote
|
|---|
| 434 | ;" mode, then do same thing as 'X' command
|
|---|
| 435 | if +$get(tmgDbgRemoteJob) goto HndlDone ;"quit will occur from there
|
|---|
| 436 | kill @ArrayName
|
|---|
| 437 | set $etrap="" ;"remove error trap
|
|---|
| 438 | write !!!!!!!!!!!
|
|---|
| 439 | write "CREATING AN ARTIFICIAL ERROR TO STOP EXECUTION.",!
|
|---|
| 440 | write "--->Enter 'ZGOTO' from the GTM> prompt to clear error.",!!
|
|---|
| 441 | set $ZSTEP="" ;"turn off step capture
|
|---|
| 442 | xecute "write CrashNonVariable"
|
|---|
| 443 | quit
|
|---|
| 444 |
|
|---|
| 445 | HndlDone ;
|
|---|
| 446 | ;"Purpose: To turn off the debugger, allowing program to continue full speed.
|
|---|
| 447 | ;"Globally-scoped vars uses: tmgDbgResult, tmgStepMode
|
|---|
| 448 | if +$get(tmgDbgRemoteJob) do
|
|---|
| 449 | . new temp set temp=$$MessageOut("DONE")
|
|---|
| 450 | . set tmgStepMode="DONE"
|
|---|
| 451 | . set tmgDbgResult=0 ;"Will signal to stop looking for remote messages in TMGIDE3
|
|---|
| 452 | else do
|
|---|
| 453 | . set $ZSTEP="" ;"Turn off debugger
|
|---|
| 454 | set TMGMsg=0 ;"ensure $ZSTEP is not turned back on.
|
|---|
| 455 | quit
|
|---|
| 456 |
|
|---|
| 457 |
|
|---|
| 458 | HndlScrW ;
|
|---|
| 459 | ;"Purpose: Handle option to set screen width
|
|---|
| 460 | new tempWidth
|
|---|
| 461 | read "Enter screen width: ",tempWidth,!
|
|---|
| 462 | if (+tempWidth>10) set TMGScrWidth=tempWidth,ScrWidth=tempWidth
|
|---|
| 463 | set tpBlankLine=" "
|
|---|
| 464 | for tpI=1:1:ScrWidth-1 set tpBlankLine=tpBlankLine_" "
|
|---|
| 465 | write # ;"clear screen
|
|---|
| 466 | do ShowCode(tmgIDEPos,ScrWidth,ScrHeight,,ViewOffset,LROffset,.CsrOnBreakline) ;"<---- not working!
|
|---|
| 467 | quit
|
|---|
| 468 |
|
|---|
| 469 | HndlExpand ;
|
|---|
| 470 | ;"Purpose: handle option to expand one mumps like of code.
|
|---|
| 471 | new expPos,zbLabel,zbOffset,zbRoutine
|
|---|
| 472 | do ParsePos^TMGIDE(tmgIDEPos,.zbLabel,.zbOffset,.zbRoutine)
|
|---|
| 473 | set expPos=zbLabel_"+"_+(zbOffset+ViewOffset)_"^"_zbRoutine
|
|---|
| 474 | write !
|
|---|
| 475 | do ExpandLine^TMGIDE(expPos)
|
|---|
| 476 | new tempKey read " --- Press Enter To Continue--",tempKey:$get(DTIME,3600)
|
|---|
| 477 | quit
|
|---|
| 478 |
|
|---|
| 479 | HndlStack(ShowPos,ViewOffset) ;
|
|---|
| 480 | ;"Purpose: Handle option to show and interact with stack.
|
|---|
| 481 | ;"Input: ShowPos -- OPTIONAL. PASS BY REFERENCE. Will be changed to user selected value.
|
|---|
| 482 | ;" ViewOffset -- OPTIONAL. PASS BY REFERENCE. Will be changed to 0 if user selects new Pos.
|
|---|
| 483 | ;"Globally scoped vars used: tmgOrigIDEPos
|
|---|
| 484 | write ! ;"get below bottom line for output.
|
|---|
| 485 | new Stack do GetStackInfo(.Stack,tmgOrigIDEPos)
|
|---|
| 486 | new Menu set Menu(0)="Pick Stack Entry to BROWSE TO"
|
|---|
| 487 | new menuI set menuI=1
|
|---|
| 488 | new TMGi for TMGi=1:1 quit:($get(Stack(TMGi))="") do
|
|---|
| 489 | . new $etrap set $etrap="set $etrap="""",$ecode="""""
|
|---|
| 490 | . new addr set addr=$piece($$TRIM^XLFSTR(Stack(TMGi))," ",2)
|
|---|
| 491 | . new txt set txt=$$TRIM^XLFSTR($text(@addr))
|
|---|
| 492 | . set txt=$$TRIM^XLFSTR(txt,$char(9))
|
|---|
| 493 | . new line set line=addr_" Code: "_txt
|
|---|
| 494 | . if $length(line)>TMGScrWidth set line=$extract(line,1,TMGScrWidth-10)_"..."
|
|---|
| 495 | . set Menu(menuI)=line_$char(9)_addr
|
|---|
| 496 | . set menuI=menuI+1
|
|---|
| 497 | new UsrSlct set UsrSlct=$$Menu^TMGUSRIF(.Menu)
|
|---|
| 498 | write "User selection: [",UsrSlct,"]",!
|
|---|
| 499 | if (UsrSlct["^")&($length(UsrSlct)>1) do
|
|---|
| 500 | . set ShowPos=UsrSlct
|
|---|
| 501 | . set ViewOffset=0
|
|---|
| 502 | write # ;"clr screen.
|
|---|
| 503 | quit
|
|---|
| 504 |
|
|---|
| 505 | HndlNodes ;
|
|---|
| 506 | ;"Purpse: Handle option to browse a variable by nodes.
|
|---|
| 507 | new varName set varName=$$Trim^TMGIDE($extract(origAction,7,999))
|
|---|
| 508 | write ! ;"get below bottom line for output.
|
|---|
| 509 | do BRWSASK2^TMGMISC
|
|---|
| 510 | quit
|
|---|
| 511 |
|
|---|
| 512 | HndlBrowse ;
|
|---|
| 513 | ;"Purpose: Handle option to browse a variable.
|
|---|
| 514 | new varName set varName=$$Trim^TMGIDE($extract(origAction,7,999))
|
|---|
| 515 | write ! ;"get below bottom line for output.
|
|---|
| 516 | do BRWSNOD2^TMGMISC(varName)
|
|---|
| 517 | quit
|
|---|
| 518 |
|
|---|
| 519 | HndlBrkCond ;
|
|---|
| 520 | ;"Purpose: Handle option to browse conditional break
|
|---|
| 521 | write "Enter an IF condition. Examples: 'A=1' or '$$FN1^MOD(A)=2'",!
|
|---|
| 522 | read "Enter IF condition (^ to cancel, @ to delete): ",tpLine,!
|
|---|
| 523 | if (tpLine="^") quit
|
|---|
| 524 | new brkPos set brkPos=$$RelConvertPos^TMGIDE(relPos,ViewOffset,ArrayName)
|
|---|
| 525 | do SetBrkCond(brkPos,tpLine)
|
|---|
| 526 | quit
|
|---|
| 527 |
|
|---|
| 528 | HndlCstBrk ;
|
|---|
| 529 | ;"Purpose: Set a custom breakpoint
|
|---|
| 530 | new brkPos
|
|---|
| 531 | read !,"Enter breakpoint (e.g. Label+8^MyFunct): ",brkPos,!
|
|---|
| 532 | do SetBreakpoint(brkPos)
|
|---|
| 533 | quit
|
|---|
| 534 |
|
|---|
| 535 | HndlSetBrk ;
|
|---|
| 536 | ;"Purpose: Set breakpoint at current point
|
|---|
| 537 | ;"write !,"Trying to determine correct breakpoint. relPos=",relPos," ViewOffset=",ViewOffset,!
|
|---|
| 538 | new brkPos set brkPos=$$RelConvertPos^TMGIDE(relPos,ViewOffset,ArrayName)
|
|---|
| 539 | ;"write "brkPos=",brkPos,!
|
|---|
| 540 | if brkPos="" write "relPos=",relPos," view offset=",ViewOffset," ArrayName=",ArrayName,!
|
|---|
| 541 | do ToggleBreakpoint(brkPos)
|
|---|
| 542 | quit
|
|---|
| 543 |
|
|---|
| 544 | HndlTable ;
|
|---|
| 545 | ;"Purpose: Handle option for Table command
|
|---|
| 546 | if +$get(tmgDbgRemoteJob) do
|
|---|
| 547 | . new temp set temp=$$MessageOut("TABLE")
|
|---|
| 548 | . if temp="" quit
|
|---|
| 549 | . new i set i=""
|
|---|
| 550 | . for set i=$order(@temp@(i)) quit:(i="") do
|
|---|
| 551 | . . new j set j=""
|
|---|
| 552 | . . for set j=$order(@temp@(i,j)) quit:(j="") do
|
|---|
| 553 | . . . write $get(@temp@(i,j)),!
|
|---|
| 554 | else do
|
|---|
| 555 | . write ! ;"get below bottom line for output.
|
|---|
| 556 | . zshow "*"
|
|---|
| 557 | new tempKey read " --- Press Enter To Continue--",tempKey:$get(DTIME,3600)
|
|---|
| 558 | quit
|
|---|
| 559 |
|
|---|
| 560 | HndlJmpDisp(ShowPos,ViewOffset)
|
|---|
| 561 | ;"Purpose: to allow user to enter in a location to show in code displayer
|
|---|
| 562 | ;"Input: ShowPos : PASS BY REFERENCE. The new location to change to
|
|---|
| 563 | ;" ViewOffset : PASS BY REFERECE. Will be changed to 0 if ShowPos changed.
|
|---|
| 564 | new tempLoc
|
|---|
| 565 | write "(Example: MYLABL+2^MYCODE)",!
|
|---|
| 566 | write "Enter location to jump display to: "
|
|---|
| 567 | read tempLoc:$get(DTIME,999),!
|
|---|
| 568 | if (tempLoc'="^")&(tempLoc["^")&(tempLoc'[" ") do
|
|---|
| 569 | . if $TEXT(@tempLoc)'="" do
|
|---|
| 570 | . . set ShowPos=tempLoc
|
|---|
| 571 | . . set ViewOffset=0
|
|---|
| 572 | . else do
|
|---|
| 573 | . . write "Sorry. No code found at ",tempLoc,!
|
|---|
| 574 | . . do PressToCont^TMGUSRIF
|
|---|
| 575 | quit
|
|---|
| 576 | ;
|
|---|
| 577 | HndlHelp ;
|
|---|
| 578 | ;"Purpose: Handle option for help.
|
|---|
| 579 | do Box
|
|---|
| 580 | do SetColors("NORM")
|
|---|
| 581 | do CUP^TMGTERM(1,2) ;"Cursor to line (1,2)
|
|---|
| 582 | do HlpWrite(" {L} : Run sLow mode | {M} : exec M code | {SHOW [var]} : show [var]")
|
|---|
| 583 | do HlpWrite(" {O} : Step OVER line | {I} : step INTO line | {STACK} : stack show/jump")
|
|---|
| 584 | do HlpWrite(" {R} : Run | {T} Step OUT | {H} : Hide debug code | {CLS} : clear screen")
|
|---|
| 585 | do HlpWrite(" {B} : Toggle Brkpoint | {C} : Custom breakpoint| {BC} : breakpoint code")
|
|---|
| 586 | do HlpWrite(" {W} : Set watch code | {W +MyVar} :Watch MyVar| {W -MyVar} :Remove watch")
|
|---|
| 587 | do HlpWrite(" {A},{AA} : Scroll up | {Z},{ZZ} : Scroll down | {W +^} : Add Naked Ref")
|
|---|
| 588 | do HlpWrite(" {[},{[[} : Scroll left | {]},{]]} : Scroll right | {W +*} : Watch Var changes")
|
|---|
| 589 | do HlpWrite(" {X} : Turn off debug | {Q} : Abort | {BROWSE} [var] : browse [var]")
|
|---|
| 590 | do HlpWrite(" {-},{+} : Screen width | {=} : Enter width | {HIDE} : manage/hide modules")
|
|---|
| 591 | do SetColors("SPECIAL")
|
|---|
| 592 | do PressToCont^TMGUSRIF
|
|---|
| 593 | do Box
|
|---|
| 594 | do SetColors("NORM")
|
|---|
| 595 | do CUP^TMGTERM(1,2) ;"Cursor to line (1,2)
|
|---|
| 596 | do HlpWrite(" {TABLE} : Symbol table | {NODES} : Browse var | {INITKB} : restore key fn")
|
|---|
| 597 | do HlpWrite(" {J} : Jump display | {FULL} : Undo Scrl Zone | {E} : expand current line")
|
|---|
| 598 | do HlpWrite(" {UCASE} : Force U Case | {LCASE} : Force L Case | {COLORS} : Edit colors ")
|
|---|
| 599 | do HlpWrite(" {XCMD} : Force ExpndCmd| {SCMD} : Force ShrtnCmd | {TRACE} : Show Trace ")
|
|---|
| 600 | do HlpWrite(" {VDIFF} : Show Var Chng| {TVDIFF} Toggle TraceVar| {RESYNC} : sync display ")
|
|---|
| 601 | ;"write HlpWrite(" "),!
|
|---|
| 602 | do SetColors("SPECIAL")
|
|---|
| 603 | do PressToCont^TMGUSRIF
|
|---|
| 604 | do SetColors("Reset")
|
|---|
| 605 | quit
|
|---|
| 606 | ;
|
|---|
| 607 | HlpWrite(line)
|
|---|
| 608 | for quit:($length(line)'>0) do
|
|---|
| 609 | . if $find(line,"{")>0 do
|
|---|
| 610 | . . new part set part=$piece(line,"{",1)
|
|---|
| 611 | . . do SetColors("NORM")
|
|---|
| 612 | . . write part
|
|---|
| 613 | . . set line=$piece(line,"{",2,999)
|
|---|
| 614 | . . set part=$piece(line,"}",1)
|
|---|
| 615 | . . do SetColors("SPECIAL")
|
|---|
| 616 | . . write part
|
|---|
| 617 | . . set line=$piece(line,"}",2,999)
|
|---|
| 618 | . else do
|
|---|
| 619 | . . do SetColors("NORM")
|
|---|
| 620 | . . write line,!
|
|---|
| 621 | . . set line=""
|
|---|
| 622 | do SetColors("NORM")
|
|---|
| 623 | quit
|
|---|
| 624 |
|
|---|
| 625 | ErrTrap(tmgIDEPos)
|
|---|
| 626 | ;"Purpose: This is the line that is called by GT.M for each ztrap event.
|
|---|
| 627 | ;" It will be used to display the current code execution point
|
|---|
| 628 | if $$ShouldSkip($piece(tmgIDEPos,"^",2)) DO
|
|---|
| 629 | . write !,"Error at ",$P($ZSTATUS,",",2)," -- in code that debugger can't display.",!
|
|---|
| 630 | . write "Error is: ",$P($ZSTATUS,",",3,99),!
|
|---|
| 631 | . write !,"Dropping to command line via BREAK",!
|
|---|
| 632 | . BREAK
|
|---|
| 633 | new ScrHeight,ScrWidth
|
|---|
| 634 | set ScrHeight=$get(TMGScrHeight,10)
|
|---|
| 635 | set ScrWidth=$get(TMGScrWidth,70)
|
|---|
| 636 | do VCUSAV2^TMGTERM
|
|---|
| 637 | do ShowCode(tmgIDEPos,ScrWidth,ScrHeight,0)
|
|---|
| 638 | ETDone do VCULOAD2^TMGTERM
|
|---|
| 639 | quit
|
|---|
| 640 |
|
|---|
| 641 |
|
|---|
| 642 | ShowCode(ShowPos,ScrWidth,ScrHeight,Wipe,ViewOffset,LROffset,CsrOnBreakline)
|
|---|
| 643 | ;"Purpose: This will display code at the top of the screen
|
|---|
| 644 | ;"Input: ShowPos -- string like this: X+2^ROUTINE[$DMOD]
|
|---|
| 645 | ;" ScrWidth -- width of code display (Num of columns)
|
|---|
| 646 | ;" ScrHeight -- height of code display (number of rows)
|
|---|
| 647 | ;" Wipe -- OPTIONAL. if 1, then code area is wiped blank
|
|---|
| 648 | ;" ViewOffset -- OPTIONAL. If a value is supplied, then
|
|---|
| 649 | ;" the display will be shifted up or down (i.e. to view
|
|---|
| 650 | ;" code other than at the point of execution)
|
|---|
| 651 | ;" Positive numbers will scroll page downward.
|
|---|
| 652 | ;" LROffset -- OPTIONAL. if value > 0 then the display
|
|---|
| 653 | ;" of each line will begin with this number character.
|
|---|
| 654 | ;" (i.e. will shift screen so that long lines can be seen.)
|
|---|
| 655 | ;" 0->no offset; 1->no offset (start at character 1); 2->offset 1
|
|---|
| 656 | ;" CsrOnBreakline -- OPTIONAL. PASS BY REFERENCE. Will return 1
|
|---|
| 657 | ;" if cursor is on a break line, otherwise 0
|
|---|
| 658 |
|
|---|
| 659 | new cdLoop,scRoutine,scLabel,scOffset,scS
|
|---|
| 660 | new LastRou,LastLabel,LastOffset
|
|---|
| 661 | new dbFGColor,bBGColor,nlFGColor,nlBGColor
|
|---|
| 662 | new StartOffset,scCursorLine,cbLineLen
|
|---|
| 663 | new zBreakIdx set zBreakIdx=-1
|
|---|
| 664 | new TMGdbgJNum set TMGdbgJNum=$J
|
|---|
| 665 | if +$get(tmgDbgRemoteJob) set TMGdbgJNum=+tmgDbgRemoteJob
|
|---|
| 666 | new zArrayName set zArrayName=$name(^TMG("TMGIDE",TMGdbgJNum,"MODULES"))
|
|---|
| 667 | set ScrWidth=$get(ScrWidth,80)
|
|---|
| 668 | set ScrHeight=$get(ScrHeight,10)
|
|---|
| 669 | set LROffset=+$get(LROffset,1)
|
|---|
| 670 | new ideBlankLine set $piece(ideBlankLine," ",ScrWidth-1)=""
|
|---|
| 671 | do CUP^TMGTERM(1,1) ;"Cursor to line (1,1)
|
|---|
| 672 | if $get(Wipe)=1 do goto SCDone ;"Blank screen and then quit
|
|---|
| 673 | . do SetColors("Reset")
|
|---|
| 674 | . for cdLoop=0:1:ScrHeight+1 write ideBlankLine,!
|
|---|
| 675 |
|
|---|
| 676 | set scS=$piece(ShowPos,"$",1) ;"e.g. X+2^ROUTINE$DMOD-->X+2^ROUTINE
|
|---|
| 677 | do ParsePos^TMGIDE(scS,.scLabel,.scOffset,.scRoutine)
|
|---|
| 678 | if scRoutine="" do goto SCDone
|
|---|
| 679 | . write !,!,"Error -- invalid position provided to ShowCode routine: ",ShowPos,!
|
|---|
| 680 | . write "scS=",scS,!
|
|---|
| 681 |
|
|---|
| 682 | ;"setup to show a symbol for breakpoint
|
|---|
| 683 | new zbS set zbS=""
|
|---|
| 684 | for set zbS=$order(^TMG("TMGIDE",TMGdbgJNum,"ZBREAK",zbS)) quit:(zbS="") do
|
|---|
| 685 | . new zbRoutine,zbLabel,zbOffset
|
|---|
| 686 | . new tempPos set tempPos=$$ConvertPos^TMGIDE(zbS,zArrayName)
|
|---|
| 687 | . do ParsePos^TMGIDE(tempPos,.zbLabel,.zbOffset,.zbRoutine)
|
|---|
| 688 | . if zbRoutine'=scRoutine quit
|
|---|
| 689 | . if zbLabel'=scLabel quit
|
|---|
| 690 | . set zBreakIdx(zbOffset)=1
|
|---|
| 691 |
|
|---|
| 692 | if scOffset>(ScrHeight) set StartOffset=(scOffset-ScrHeight)+2
|
|---|
| 693 | else set StartOffset=0
|
|---|
| 694 | set StartOffset=StartOffset+$get(ViewOffset)
|
|---|
| 695 |
|
|---|
| 696 | ;"====Draw the top line ==========================================
|
|---|
| 697 | do SetColors("NORM")
|
|---|
| 698 | write "=== "
|
|---|
| 699 | do SetColors("SPECIAL")
|
|---|
| 700 | set scS="Routine: "_scLabel_"^"_scRoutine_" "
|
|---|
| 701 | if $data(tmgOrigIDEPos) set scS=scS_"("_tmgOrigIDEPos_")"
|
|---|
| 702 | else set scS=scS_"("_ShowPos_")"
|
|---|
| 703 | write scS
|
|---|
| 704 | do SetColors("NORM")
|
|---|
| 705 | write " "
|
|---|
| 706 | for cdLoop=1:1:ScrWidth-$length(scS)-5 write "="
|
|---|
| 707 | do SetColors("NORM")
|
|---|
| 708 | write !
|
|---|
| 709 |
|
|---|
| 710 | set CsrOnBreakline=0
|
|---|
| 711 | for cdLoop=StartOffset:1:(StartOffset+ScrHeight) do
|
|---|
| 712 | . do SetColors("NORM")
|
|---|
| 713 | . do SetTempBkColor("Reset")
|
|---|
| 714 | . new cbLine,cbRef,cbCursor,cBrkLine
|
|---|
| 715 | . set cBrkLine=$data(zBreakIdx(cdLoop))
|
|---|
| 716 | . set cbRef=scLabel_"+"_cdLoop_"^"_scRoutine
|
|---|
| 717 | . set cbLine=$text(@cbRef)
|
|---|
| 718 | . set cbLine=$$Substitute^TMGIDE(cbLine,$Char(9)," ")
|
|---|
| 719 | . if LROffset>0 set cbLine=$extract(cbLine,LROffset,999)
|
|---|
| 720 | . set scCursorLine=scOffset+$get(ViewOffset)
|
|---|
| 721 | . new cHighCsrPos set cHighCsrPos=(cdLoop=scCursorLine)
|
|---|
| 722 | . new cHighExecPos set cHighExecPos=(cdLoop=scOffset)
|
|---|
| 723 | . if cHighCsrPos do SetTempBkColor("Highlight")
|
|---|
| 724 | . if cHighExecPos do SetTempBkColor("HighExecPos")
|
|---|
| 725 | . if cBrkLine do
|
|---|
| 726 | . . if (cHighCsrPos=0)&(cHighExecPos=0) do
|
|---|
| 727 | . . . do SetTempBkColor("HighBkPos")
|
|---|
| 728 | . . else do
|
|---|
| 729 | . . . do SetTempBkColor("BkPos")
|
|---|
| 730 | . . . set CsrOnBreakline=1
|
|---|
| 731 | . write $select(cdLoop=scOffset:">",cBrkLine:"#",1:" ")
|
|---|
| 732 | . do SetColors("SPECIAL")
|
|---|
| 733 | . if cdLoop>0 write "+"_cdLoop_$select(cdLoop<10:" ",1:"")
|
|---|
| 734 | . else write " "
|
|---|
| 735 | . do SetColors("NORM")
|
|---|
| 736 | . if $length(cbLine)>(ScrWidth-1) set cbLine=$extract(cbLine,1,ScrWidth-4)_"..."
|
|---|
| 737 | . set cbLineLen=$length(cbLine)
|
|---|
| 738 | . new StartPos set StartPos=$X
|
|---|
| 739 | . if $get(TMGDEBUG) write cbLine ;"temp
|
|---|
| 740 | . else set cbLineLen=$$ShowLine^TMGIDE6(cbLine,.tmgDbgOptions,ScrWidth-StartPos)
|
|---|
| 741 | . write $extract(ideBlankLine,cbLineLen,ScrWidth-StartPos-1)
|
|---|
| 742 | . do SetTempBkColor("Reset"),SetColors("NORM")
|
|---|
| 743 | . write !
|
|---|
| 744 |
|
|---|
| 745 | ;"Draw bottom line.
|
|---|
| 746 | do SetColors("NORM")
|
|---|
| 747 | ;"do SetColors("SPECIAL")
|
|---|
| 748 | for cdLoop=1:1:ScrWidth write "~"
|
|---|
| 749 | ;"do SetColors("NORM")
|
|---|
| 750 | write !
|
|---|
| 751 | SCDone ;
|
|---|
| 752 | do VTATRIB^TMGTERM(0) ;"reset colors
|
|---|
| 753 | quit
|
|---|
| 754 |
|
|---|
| 755 | SetTempBkColor(mode)
|
|---|
| 756 | set mode=$get(mode) quit:mode=""
|
|---|
| 757 | new ref set ref=$name(^TMG("TMGIDE",$J,"COLORS"))
|
|---|
| 758 | if mode="Reset" kill @ref@("TEMP BACKGROUND") quit
|
|---|
| 759 | if "Highlight,HighExecPos,BkPos,HighBkPos"'[mode quit
|
|---|
| 760 | if $data(@ref)=0 do InitColors^TMGIDE6
|
|---|
| 761 | new bg set bg=$get(@ref@(mode))
|
|---|
| 762 | if bg="" quit
|
|---|
| 763 | set @ref@("TEMP BACKGROUND")=bg
|
|---|
| 764 | quit
|
|---|
| 765 | ;
|
|---|
| 766 | SetColors(mode)
|
|---|
| 767 | ;"Purpose: set colors in central location
|
|---|
| 768 | ;"Input: Mode -- the mode to change the colors to
|
|---|
| 769 | ;" bg -- OPTIONAL -- the default background. Default=15
|
|---|
| 770 | set mode=$get(mode,"Reset") if mode="" set mode="Reset"
|
|---|
| 771 | new ref set ref=$name(^TMG("TMGIDE",$J,"COLORS"))
|
|---|
| 772 | if $data(@ref)=0 do InitColors^TMGIDE6
|
|---|
| 773 | if mode="Reset" do VTATRIB^TMGTERM(0) goto SCDn ;"reset colors
|
|---|
| 774 | new colorSet merge colorSet=@ref@(mode) ;"Get colors for mode
|
|---|
| 775 | new fg set fg=$get(colorSet("fg"),15)
|
|---|
| 776 | new bg set bg=$get(colorSet("bg"),15)
|
|---|
| 777 | if (bg="@") do
|
|---|
| 778 | . set bg=$get(@ref@("TEMP BACKGROUND"),"@")
|
|---|
| 779 | . if bg="@" set bg=$get(@ref@("BACKGROUND"),0)
|
|---|
| 780 | if fg=bg do
|
|---|
| 781 | . if (fg<15) set fg=fg+1
|
|---|
| 782 | . else if (fg>0) set fg=fg-1
|
|---|
| 783 | do VCOLORS^TMGTERM(fg,bg)
|
|---|
| 784 | SCDn quit;
|
|---|
| 785 | ;
|
|---|
| 786 | Box ;
|
|---|
| 787 | ;"Purpose: Draw a box on the top of the screen.
|
|---|
| 788 | ;"Globals Scope Vars used: ScrWidth,ScrHeight
|
|---|
| 789 | set ScrWidth=$get(ScrWidth,80)
|
|---|
| 790 | set ScrHeight=$get(ScrHeight,10)
|
|---|
| 791 | new ideBlankLine set $piece(ideBlankLine," ",ScrWidth)=" "
|
|---|
| 792 | new ideBarLine set $piece(ideBarLine,"=",ScrWidth)="="
|
|---|
| 793 | do CUP^TMGTERM(1,1) ;"Cursor to line (1,1)
|
|---|
| 794 | do SetColors("Highlight")
|
|---|
| 795 | write ideBarLine,!
|
|---|
| 796 | do SetColors("NORM")
|
|---|
| 797 | new cdLoop for cdLoop=0:1:ScrHeight+1 write ideBlankLine,!
|
|---|
| 798 | do SetColors("Reset")
|
|---|
| 799 | quit
|
|---|
| 800 | ;
|
|---|
| 801 | GetStackInfo(Stack,ExecPos)
|
|---|
| 802 | ;"Purpose: to query GTM and get back filtered Stack information
|
|---|
| 803 | ;"Input: Stack -- PASS BY REFERENCE. An array to received back info. Old info is killed
|
|---|
| 804 | ;" ExecPos -- OPTIONAL. Current execution position
|
|---|
| 805 | kill Stack
|
|---|
| 806 | new i,count set count=1
|
|---|
| 807 | if $STACK<3 quit ;"0-2 are steps getting into debugger
|
|---|
| 808 | for i=0:1:$STACK do ;"was 3:1:
|
|---|
| 809 | . new s set s=$STACK(i,"PLACE")
|
|---|
| 810 | . if s["TMGIDE" quit
|
|---|
| 811 | . if s["GTM$DMOD" quit
|
|---|
| 812 | . if s="@" set s=s_""""_$STACK(i,"MCODE")_""""
|
|---|
| 813 | . if s=$get(ExecPos) set s=s_" <--Current execution point" ;",i=$STACK+1
|
|---|
| 814 | . set Stack(count)=$STACK(i)_" "_s
|
|---|
| 815 | . set count=count+1
|
|---|
| 816 | quit
|
|---|
| 817 |
|
|---|
| 818 |
|
|---|
| 819 | ToggleBreakpoint(pos,condition)
|
|---|
| 820 | ;"Purpose: to set or release the GT.M breakpoint at position
|
|---|
| 821 | ;"Input: pos -- the position to alter
|
|---|
| 822 | ;" condition -- OPTIONAL -- should be contain valid M code such that
|
|---|
| 823 | ;" if @condition is valid. Examples:
|
|---|
| 824 | ;" i=1 or $data(VAR)=0 or $$MyFunct(var)=1
|
|---|
| 825 | ;"write "Here in ToggleBreakoint",!
|
|---|
| 826 | if $$IsBreakpoint(pos) do
|
|---|
| 827 | . ;"write " calling RelBreakpoint",!
|
|---|
| 828 | . do RelBreakpoint(pos)
|
|---|
| 829 | else do
|
|---|
| 830 | . ;"write "calling Set breakpoint",!
|
|---|
| 831 | . do SetBreakpoint(pos,.condition)
|
|---|
| 832 | quit
|
|---|
| 833 |
|
|---|
| 834 | IsBreakpoint(pos)
|
|---|
| 835 | ;"Purpose: to determine if position is a breakpoint pos
|
|---|
| 836 |
|
|---|
| 837 | ;"Note: I am concerned that pos might contain a name longer than 8 chars
|
|---|
| 838 | ;" and might give a false result, or ^TMP(...) might hold a name
|
|---|
| 839 | ;" longer than 8 chars.
|
|---|
| 840 | ;" BUT, if I just cut name off at 8 chars, it might not work well
|
|---|
| 841 | ;" with GTM v5
|
|---|
| 842 | new result set result=0
|
|---|
| 843 | new TMGdbgJNum set TMGdbgJNum=$J
|
|---|
| 844 | if +$get(tmgDbgRemoteJob) set TMGdbgJNum=+tmgDbgRemoteJob
|
|---|
| 845 | if $get(pos)'="" set result=$data(^TMG("TMGIDE",TMGdbgJNum,"ZBREAK",pos))
|
|---|
| 846 | quit (result'=0)
|
|---|
| 847 |
|
|---|
| 848 |
|
|---|
| 849 | EnsureBreakpoints()
|
|---|
| 850 | ;"Purpose: When an module is recompiled, GT.M drops the breakpoints for
|
|---|
| 851 | ;" that module. However, the breakpoints are still stored for this
|
|---|
| 852 | ;" debugger, meaning that the lines will still be highlighted etc,
|
|---|
| 853 | ;" --but they don't work. This function will go through stored
|
|---|
| 854 | ;" breakpoints and again register them with GT.M
|
|---|
| 855 |
|
|---|
| 856 | new pos set pos=""
|
|---|
| 857 | new TMGdbgJNum set TMGdbgJNum=$J
|
|---|
| 858 | if +$get(tmgDbgRemoteJob) set TMGdbgJNum=+tmgDbgRemoteJob
|
|---|
| 859 | for set pos=$order(^TMG("TMGIDE",TMGdbgJNum,"ZBREAK",pos)) quit:(pos="") do
|
|---|
| 860 | . do SetBreakpoint(pos)
|
|---|
| 861 | quit
|
|---|
| 862 |
|
|---|
| 863 |
|
|---|
| 864 | SetBreakpoint(pos,condition)
|
|---|
| 865 | ;"Purpose: set the GT.M breakpoint to pos position
|
|---|
| 866 | ;"Input: pos -- the position to alter
|
|---|
| 867 | ;" condition -- OPTIONAL -- should be contain valid M code such that
|
|---|
| 868 | ;" if @condition is valid. Examples:
|
|---|
| 869 | ;" i=1 or $data(VAR)=0 or $$MyFunct(var)=1
|
|---|
| 870 | ;"Globally scoped var used:
|
|---|
| 871 | ;" tmgDbgRemoteJob-- OPTIONAL -- if controlling a remote process, then = $J of that process
|
|---|
| 872 | ;" and action should not be done locally.
|
|---|
| 873 | if $get(pos)="" do goto SBkDone
|
|---|
| 874 | . write "?? no position specified ??",!
|
|---|
| 875 | ;
|
|---|
| 876 | new TMGdbgJNum set TMGdbgJNum=$J
|
|---|
| 877 | if +$get(tmgDbgRemoteJob) set TMGdbgJNum=+tmgDbgRemoteJob
|
|---|
| 878 | set ^TMG("TMGIDE",TMGdbgJNum,"ZBREAK",pos)=""
|
|---|
| 879 | do SetBrkCond(pos,.condition)
|
|---|
| 880 | ;
|
|---|
| 881 | if $get(tmgDbgRemoteJob) do
|
|---|
| 882 | . new temp set temp=$$MessageOut("BKPOS "_pos_" "_$get(condition))
|
|---|
| 883 | . write "Results from remote process=",temp,!
|
|---|
| 884 | else do
|
|---|
| 885 | . new brkLine set brkLine=pos_":""n tmg s tmgRunMode=1 s tmg=$$STEPTRAP^TMGIDE2($ZPOS,1)"""
|
|---|
| 886 | . new $etrap
|
|---|
| 887 | . set $etrap="K ^TMG(""TMGIDE"",$J,""ZBREAK"",pos) S $ETRAP="""",$ECODE="""""
|
|---|
| 888 | . ZBREAK @brkLine
|
|---|
| 889 | SBkDone quit
|
|---|
| 890 |
|
|---|
| 891 |
|
|---|
| 892 | SetBrkCond(pos,condition)
|
|---|
| 893 | ;"Purpose: A standardized SET for condition.
|
|---|
| 894 | ;"Input: pos --
|
|---|
| 895 | ;" condition --
|
|---|
| 896 | if $get(condition)="" quit
|
|---|
| 897 | if $get(pos)="" quit
|
|---|
| 898 | new TMGdbgJNum set TMGdbgJNum=$J
|
|---|
| 899 | if +$get(tmgDbgRemoteJob) set TMGdbgJNum=+tmgDbgRemoteJob
|
|---|
| 900 | if condition="@" kill ^TMG("TMGIDE",TMGdbgJNum,"ZBREAK",pos,"IF")
|
|---|
| 901 | else set ^TMG("TMGIDE",TMGdbgJNum,"ZBREAK",pos,"IF")=condition
|
|---|
| 902 | if $$IsBreakpoint(pos)=0 do SetBreakpoint(pos)
|
|---|
| 903 | quit
|
|---|
| 904 |
|
|---|
| 905 |
|
|---|
| 906 | GetBrkCond(pos)
|
|---|
| 907 | ;"Purpose: A standardized GET for condition.
|
|---|
| 908 | ;"Results: returns condition code, or ""
|
|---|
| 909 | new result set result=""
|
|---|
| 910 | new TMGdbgJNum set TMGdbgJNum=$J
|
|---|
| 911 | if +$get(tmgDbgRemoteJob) set TMGdbgJNum=+tmgDbgRemoteJob
|
|---|
| 912 | set:(pos'="") result=$get(^TMG("TMGIDE",TMGdbgJNum,"ZBREAK",pos,"IF"))
|
|---|
| 913 | quit result
|
|---|
| 914 |
|
|---|
| 915 | RelBreakpoint(pos)
|
|---|
| 916 | ;"Purpose: to release a GT.M breakpoint at position
|
|---|
| 917 | new TMGdbgJNum set TMGdbgJNum=$J
|
|---|
| 918 | if +$get(tmgDbgRemoteJob) set TMGdbgJNum=+tmgDbgRemoteJob
|
|---|
| 919 | kill ^TMG("TMGIDE",TMGdbgJNum,"ZBREAK",pos)
|
|---|
| 920 | if $get(tmgDbgRemoteJob) do goto SBkDone
|
|---|
| 921 | . new temp set temp=$$MessageOut("RELBKPOS "_pos)
|
|---|
| 922 | else do
|
|---|
| 923 | . new brkLine set brkLine=pos_":""zcontinue"""
|
|---|
| 924 | . ZBREAK @brkLine
|
|---|
| 925 | ;"write "released breakpoint at: ",pos,!
|
|---|
| 926 | quit
|
|---|
| 927 |
|
|---|
| 928 |
|
|---|
| 929 | ShouldSkip(module)
|
|---|
| 930 | ;"Purpose: to see if module is in hidden list
|
|---|
| 931 | new result set result=0
|
|---|
| 932 | if $get(TMGdbgHideList)="" goto SSKDone
|
|---|
| 933 |
|
|---|
| 934 | new HideMod set HideMod=""
|
|---|
| 935 | for set HideMod=$order(@TMGdbgHideList@(HideMod)) quit:(HideMod="")!(result=1) do
|
|---|
| 936 | . if (module=HideMod) set result=1 quit
|
|---|
| 937 | . if HideMod'["*" quit
|
|---|
| 938 | . new tempMod set tempMod=$extract(HideMod,1,$find(HideMod,"*")-2)
|
|---|
| 939 | . new trimModule set trimModule=$extract(module,1,$length(tempMod))
|
|---|
| 940 | . set result=(trimModule=tempMod)
|
|---|
| 941 | SSKDone
|
|---|
| 942 | quit result
|
|---|
| 943 |
|
|---|
| 944 |
|
|---|
| 945 | SetupSkips
|
|---|
| 946 | ;"Purpose: to manage modules that are to be skipped over.
|
|---|
| 947 | ;"Input: none. But this modifies variable @TMGdbgHideList with global scope
|
|---|
| 948 | ;"results: none
|
|---|
| 949 |
|
|---|
| 950 | ;"For some reason, this gets lost at times....
|
|---|
| 951 | if $data(TMGdbgHideList)=0 set TMGdbgHideList=$name(^TMG("TMGIDE",$J,"HIDE LIST"))
|
|---|
| 952 |
|
|---|
| 953 | new menu,option
|
|---|
| 954 | set menu(0)="Pick Options for Hiding/Showing Modules"
|
|---|
| 955 | set menu(1)="SHOW current hidden list"_$c(9)_"SHOW"
|
|---|
| 956 | set menu(2)="ADD module to hidden list"_$c(9)_"ADD"
|
|---|
| 957 | set menu(3)="REMOVE module from hidden list"_$c(9)_"REMOVE"
|
|---|
| 958 | set menu(4)="Done."_$c(9)_"^"
|
|---|
| 959 |
|
|---|
| 960 | StSkp set option=$$Menu^TMGUSRIF(.menu)
|
|---|
| 961 | if option="SHOW" do ShowSkip
|
|---|
| 962 | if option="ADD" do AddSkip
|
|---|
| 963 | if option="REMOVE" do RmSkip
|
|---|
| 964 | if option="^" goto StSkDone
|
|---|
| 965 | goto StSkp
|
|---|
| 966 |
|
|---|
| 967 | StSkDone
|
|---|
| 968 | quit
|
|---|
| 969 |
|
|---|
| 970 | AddSkip
|
|---|
| 971 | ;"Purpose: to allow user to Add a module to hidden list
|
|---|
| 972 | ;"Input: none. But this modifies variable @TMGdbgHideList with global scope
|
|---|
| 973 | ;"results: none
|
|---|
| 974 |
|
|---|
| 975 | ASKP1 write "Enter name of module to add to hidden list (? for help, ^ to abort)",!
|
|---|
| 976 | new mod
|
|---|
| 977 | read "Enter module: ",mod:$get(DTIME,3600),!
|
|---|
| 978 | if mod="?" do goto ASKP1
|
|---|
| 979 | . write "Some modules of the code are not helpful to debugging one's code.",!
|
|---|
| 980 | . write "For example, if one did not ever want to trace into the code stored",!
|
|---|
| 981 | . write "in DIC, then DIC would be added as a module to be hidden. Then, when",!
|
|---|
| 982 | . write "debugging one's own code, all traces into ^DIC would be skipped over.",!
|
|---|
| 983 | . write "If only part of the name is specified, then ALL modules starting with",!
|
|---|
| 984 | . write "this name will be excluded.",!
|
|---|
| 985 | . do PressToCont^TMGUSERIF
|
|---|
| 986 | if mod="^" goto ASDone
|
|---|
| 987 | write "Add '",mod,"' as a module to be skipped over"
|
|---|
| 988 | new % set %=1
|
|---|
| 989 | do YN^DICN
|
|---|
| 990 | if $data(TMGdbgHideList)=0 set TMGdbgHideList=$name(^TMG("TMGIDE",$J,"HIDE LIST"))
|
|---|
| 991 | if %=1 set @TMGdbgHideList@(mod)=""
|
|---|
| 992 |
|
|---|
| 993 | ASDone
|
|---|
| 994 | quit
|
|---|
| 995 |
|
|---|
| 996 | RmSkip
|
|---|
| 997 | ;"Purpose: to allow user to remove a module from hidden list
|
|---|
| 998 | ;"Input: none. But this modifies variable @TMGdbgHideList with global scope
|
|---|
| 999 | ;"results: none
|
|---|
| 1000 |
|
|---|
| 1001 | new menu,option,idx
|
|---|
| 1002 | RmL1 kill menu
|
|---|
| 1003 | set idx=0
|
|---|
| 1004 | new mod set mod=""
|
|---|
| 1005 | ;"Load menu with current list.
|
|---|
| 1006 | for set mod=$order(@TMGdbgHideList@(mod)) quit:(mod="") do
|
|---|
| 1007 | . set idx=idx+1,menu(idx)=mod_$c(9)_mod
|
|---|
| 1008 | if $data(menu)=0 goto RmSkipDone
|
|---|
| 1009 | . write "--The list is currently empty--"
|
|---|
| 1010 | . do PressToCont^TMGUSRIF
|
|---|
| 1011 | set idx=idx+1
|
|---|
| 1012 | set menu(idx)="Done"_$c(9)_"^"
|
|---|
| 1013 | set menu(0)="Pick Module to remove from hidden list"
|
|---|
| 1014 | set option=$$Menu^TMGUSRIF(.menu)
|
|---|
| 1015 | if option="^" goto RmSkipDone
|
|---|
| 1016 | kill @TMGdbgHideList@(option)
|
|---|
| 1017 | goto RmL1
|
|---|
| 1018 |
|
|---|
| 1019 | RmSkipDone
|
|---|
| 1020 | quit
|
|---|
| 1021 |
|
|---|
| 1022 |
|
|---|
| 1023 | ShowSkip
|
|---|
| 1024 | ;"Purpose: to show the hidden list
|
|---|
| 1025 | ;"Input: none. But this uses variable @TMGdbgHideList with global scope
|
|---|
| 1026 | ;"results: none
|
|---|
| 1027 |
|
|---|
| 1028 | new mod set mod=""
|
|---|
| 1029 | if $data(@TMGdbgHideList)>0 do
|
|---|
| 1030 | . for set mod=$order(@TMGdbgHideList@(mod)) quit:(mod="") do
|
|---|
| 1031 | . . write " ",mod,!
|
|---|
| 1032 | else do
|
|---|
| 1033 | . write "--The list is currently empty--"
|
|---|
| 1034 | do PressToCont^TMGUSRIF
|
|---|
| 1035 | quit
|
|---|
| 1036 |
|
|---|
| 1037 |
|
|---|
| 1038 | ;"=============================================
|
|---|
| 1039 | ;" Code for when controlling another process
|
|---|
| 1040 | ;"=============================================
|
|---|
| 1041 |
|
|---|
| 1042 | MessageOut(Msg,timeOutTime,ignoreReply)
|
|---|
| 1043 | ;"Purpose: For use when in remote-control debugging mode. This will
|
|---|
| 1044 | ;" send a message to SENDER, not waiting for a reply
|
|---|
| 1045 | ;"Input: Msg -- the message to send
|
|---|
| 1046 | ;" timeOutTime -- OPTIONAL, default is 2 seconds
|
|---|
| 1047 | ;" ignoreReply -- OPTIONAL, default is 0 (don't ignore)
|
|---|
| 1048 | ;"Output: the returned message, or "" if timed out or no reply, or ignoreReply=1
|
|---|
| 1049 |
|
|---|
| 1050 | set timeOutTime=$get(timeOutTime,2)
|
|---|
| 1051 | set ignoreReply=$get(ignoreReply,0)
|
|---|
| 1052 | new result set result=""
|
|---|
| 1053 | set Msg="[CMD] "_$get(Msg)
|
|---|
| 1054 | set ^TMG("TMGIDE","CONTROLLER","MSG-OUT")=Msg
|
|---|
| 1055 | set ^TMG("TMGIDE","CONTROLLER","MSG-IN")=""
|
|---|
| 1056 | if (ignoreReply=0) for do quit:(result'="")!(timeOutTime<0)
|
|---|
| 1057 | . set result=$get(^TMG("TMGIDE","CONTROLLER","MSG-IN"))
|
|---|
| 1058 | . if (result'="") quit
|
|---|
| 1059 | . set timeOutTime=timeOutTime-0.1
|
|---|
| 1060 | . set ^TMG("TMGIDE","CONTROLLER","MSG-OUT")=Msg
|
|---|
| 1061 | . hang 0.1
|
|---|
| 1062 | if $piece(result," ",1)="[RSLT]" do
|
|---|
| 1063 | set result=$piece(result," ",2,999)
|
|---|
| 1064 | else do
|
|---|
| 1065 | . write !,"Unexpected reply: ",result,!
|
|---|
| 1066 | . do PressToCont^TMGUSRIF
|
|---|
| 1067 | . set result=""
|
|---|
| 1068 |
|
|---|
| 1069 | quit result
|
|---|
| 1070 |
|
|---|
| 1071 |
|
|---|
| 1072 | GetRemoteVar(varName)
|
|---|
| 1073 | ;"Purpose: Pass varName to remote process, have it evaluated there, and
|
|---|
| 1074 | ;" then passed back back here for display.
|
|---|
| 1075 | ;"Input: varName -- expression (variable name, or function) to be evaluated.
|
|---|
| 1076 | new temp set temp=$$MessageOut("EVAL "_$get(varName))
|
|---|
| 1077 | kill @varName
|
|---|
| 1078 | if (temp="")!(temp[" ") do goto GMVD
|
|---|
| 1079 | . write !,"Unexpected var name back: [",temp,"]",!
|
|---|
| 1080 | . set temp=""
|
|---|
| 1081 | merge @varName=@temp
|
|---|
| 1082 | GMVD quit varName
|
|---|
| 1083 |
|
|---|
| 1084 |
|
|---|
| 1085 | RemoteXecute(MCode)
|
|---|
| 1086 | ;"Purpose: Pass M Code to remote process for execution there.
|
|---|
| 1087 | ;"Input: A line of M code, as entered by user.
|
|---|
| 1088 | ;"Results: none
|
|---|
| 1089 | ;"Output: Any IO of M code should be shown in other process's IO
|
|---|
| 1090 | new temp set temp=$$MessageOut("XECUTE "_$get(MCode))
|
|---|
| 1091 | quit |
|---|
