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

Last change on this file since 1620 was 896, checked in by Kevin Toppenberg, 14 years ago

replacing soft links with actual files
File size: 9.5 KB
RevLine 
[896]1TMGIDE3 ;TMG/kst/A debugger/tracer for GT.M (Controller code) ;04/14/08
2 ;;1.0;TMG-LIB;**1**;03/23/09
3
4 ;" TMG IDE Debugger Controller
5 ;"
6 ;" K. Toppenberg
7 ;" 4-14-2008
8 ;" License: GPL Applies
9 ;"
10 ;"------------------------------------------------------------
11 ;"------------------------------------------------------------
12 ;"Notes: HOW DOES IT ALL WORK?
13 ;"
14 ;"Here is how the system fits together:
15 ;"
16 ;"Below is what happens in the CONTROLLING job
17 ;"=================================================
18 ;" -- LaunchIntr^TMGIDE5(JobNum) sets up a signaling global and then
19 ;" creates a 'mupip intrpt JobNum', then starts listening
20 ;" in Controller^TMGIDE3 for communication from the interrupted job.
21 ;" (See below about how this communication gets started)
22 ;" -- Controller^TMGIDE3 polls a communicating global location and can talk back
23 ;" and forth with the other job. When it gets a message to
24 ;" DO TRAP %ZPOS, it then calls STEPTRAP^TMGIDE2, and returns
25 ;" the result of that function back to the other job.
26 ;" -- STEPTRAP^TMGIDE2 is the same interface as the prior debugger. It shows
27 ;" the code, allows the user to move around, and interact
28 ;" with the code. If the user wants to query variables
29 ;" in the other process, then a message is sent out, and
30 ;" a copy of that variable is passed back here for display.
31 ;" If the user wants to modify the other environment, then
32 ;" arbitrary M code can be entered by the user, and it is passed
33 ;" to the other job for execution in that job process space.
34 ;" When ready to execute the next line of code, then STEPTRAP
35 ;" quits with a result signalling a zstep INTO or OVER.
36 ;"
37 ;"Below is what happens in the OTHER job
38 ;"=================================================
39 ;" -- mupip intrpt JobNum --> causes the specified job to execute the code
40 ;" stored in $ZINTERRUPT. For VistA (or if setup in
41 ;" in an environmental script during GT.M launch), this
42 ;" code is to run JOBEXAM^ZU (slightly customized)
43 ;" -- JOBEXAM^ZU --> looks for signaling global, and if found runs INTERUPT^TMGIDE5
44 ;" -- INTERUPT^TMGIDE5 --> sets up $ZSTEP and then calls ZSTEP INTO and
45 ;" quits out of the $ZINTERRUPT code.
46 ;" -- ZSTEP --> causes GT.M to execute the code in $ZSTEP before performing
47 ;" the next line of mumps code for the program that was
48 ;" running at the time the interrupt request was received.
49 ;" -- $ZSTEP holds instruction to run $$STEPTRAP^TMGIDE4($ZPOS)
50 ;" -- STEPTRAP^TMGIDE4 --> sends message to CONTROLLING JOB and waits for reply.
51 ;" Reply will either be a request from the user for more
52 ;" information from this job, or a final reply that allows
53 ;" execution to continue, either by a step INTO, OVER, or
54 ;" a plain ZCONTINUE (which will stop further code-stepping)
55
56
57Controller
58 ;"Purpose: This code will wait for messages from the executing process, and
59 ;" will display the code as it changes, and send messages back to
60 ;" all the user to control the process remotely.
61
62 ;"Notice: There are
63
64 ;"A globally-scoped var that will be checked in STEPTRAP^TMGIDE2
65 if +$get(tmgDbgRemoteJob)'>0 set tmgDbgRemoteJob=1
66
67 ;"write #
68 new i for i=1:1:12 write !
69 write "=== TMG IDE Controller (Job# "_$JOB_") ===",!,!
70 write "Waiting for action from SENDING (Remote) process (ESC to abort)",!
71 new msgRef set msgRef=$name(^TMG("TMGIDE","CONTROLLER"))
72 kill @msgRef
73 set @msgRef@("JOB")=$JOB
74
75 new Msg,UsrInput,Cmd
76 new hangDelay set hangDelay=0.2
77
78 new ideBlankLine set $piece(ideBlankLine," ",78)=" "
79 ;"new HxSize set HxSize=8 ;"hard codes in history length of 8
80 new TMGdbgLine
81 new TMGlastline set TMGlastLine=""
82 new HxShowNum set HxShowNum=0
83 new HxLine,HxLineMax,HxLineCur
84 do INITKB^XGF() ;"set up keyboard input escape code processing
85 ;
86Init set @msgRef@("STATUS")="AVAIL"
87 set @msgRef@("MSG-OUT")=""
88 new TMGstartH set TMGstartH=$piece($H,",",2)
89 new tempCh,%
90 ;
91Loop set Msg=$get(@msgRef@("MSG-IN"))
92 set Cmd=$piece(Msg," ",1)
93 ;
94 if Cmd="INQ" do HndlINQ(Msg) goto Loop
95 if Cmd="LISTEN" do HndlListen(Msg) goto Loop
96 if Cmd="DONE" do HndlDone(Msg) goto LstnDone ;"This is when SENDER signals a quit.
97 if Cmd="WRITE" do HndlWrite(Msg) goto Loop
98 if Cmd="DO" goto:($$HndlDo(Msg)'=0) Loop goto LstnDone ;"Leave if CONTROLLER signals a quit
99 if Cmd="READ" do HndlRead(Msg) goto Loop
100 if Cmd="NEED" do HndlNeed(Msg) goto Loop
101 ;
102 ;"Checking UserAborted grabs keystrokes, and prevents user from getting out of RUN mode
103 ;"in ^TMGIDE2, so only check here after an X second delay.
104 if $piece($H,",",2)-TMGstartH<2 goto Loop
105 read *tempCh:0
106 if tempCh'=27 goto Loop
107 write !,"Abort From Remote Debugging Controller"
108 set TMGstartH=$piece($H,",",2)
109 set %=2 do YN^DICN write !
110 if %'=1 goto Loop
111 ;
112LstnDone ;
113 write !,"Quitting.",!
114 kill @msgRef
115 kill tmgDbgRemoteJob
116 quit
117 ;
118;"-------------------------------
119;"-------------------------------
120 ;
121ACK SET @msgRef@("MSG-OUT")="ACK "_$J
122 SET @msgRef@("MSG-IN")=""
123 QUIT
124
125HndlINQ(Msg) ;"Expects 'INQ <Job#>'
126 ;"write "Msg=",Msg,! ;"temp!!
127 set tmgDbgRemoteJob=+$piece(Msg," ",2)
128 do ACK
129 quit
130
131HndlListen(Msg)
132 new JobToControl
133 set JobToControl=+$piece(Msg," ",3)
134 set @msgRef@("STATUS")="LISTENING TO "_JobToControl
135 set @msgRef@("MSG-OUT")=@msgRef@("STATUS")
136 DO ACK
137 quit
138
139HndlWrite(Msg)
140 write $piece(Msg," ",2,99),!
141 DO ACK
142 quit
143
144HndlDo(Msg)
145 ;"Purpose: Handle message from interrupted application to DO something.
146 ;"Result: 1 = OK to continue
147 ;" 0 = should quit controller.
148 new result set result=1 ;"default to continue
149 new msgResult set msgResult=""
150 if $piece(Msg," ",2)="PROMPT" do
151 . set msgResult=$$Prompt()
152 else if $piece(Msg," ",2)="TRAP" do
153 . new idePos set idePos=$piece(Msg," ",3)
154 . new TMGMsg set TMGMsg=$piece(Msg," ",4)
155 . set msgResult=$$STEPTRAP^TMGIDE2(idePos,TMGMsg)
156 . if msgResult=0 set result=0 ;"STEPTRAP result of 0 means to stop controller.
157 set @msgRef@("MSG-OUT")=msgResult
158 set @msgRef@("MSG-IN")=""
159 set TMGstartH=$piece($H,",",2) ;"restart timer countdown before allowing user input.
160 quit result
161
162HndlDone(Msg)
163 DO ACK
164 quit
165
166HndlRead(Msg)
167 new result
168 write $piece(Msg," ",2,99)
169 read result:$get(DTIME,3600),!
170 if result="" set result="<null>"
171 set @msgRef@("MSG-OUT")=result
172 set @msgRef@("MSG-IN")=""
173 quit
174
175HndlNeed(Msg)
176 set SndJob=+$piece(Msg," ",3)
177 set @MsgRef@("STATUS")="CONTROLLING "_SndJob
178 set @MsgRef@("MSG-OUT")=@MsgCtrlRef@("STATUS")
179 quit
180
181;"-------------------------------------------------------------------
182
183Prompt()
184 ;"Purpose: to interact with user and run through code.
185
186 ;"new i write # for i=1:1:12 write !
187 write "=== TMG IDE Controller ===",!,!
188
189Ppt2
190 set HxShowNum=+$get(HxShowNum)
191 set TMGStepMode="into" ;"kt added 5/3/06
192 set HxLine=$get(^TMG("TMGIDE","CMD HISTORY",$J,HxShowNum))
193 set HxLineMax=$get(^TMG("TMGIDE","CMD HISTORY",$J,"MAX"),0)
194
195 write "Remote command (^ to quit): "
196 if HxShowNum=0 write "^// "
197 else write "// ",HxLine
198
199 set TMGdbgLine=$$READ^TMGIDE() ;"$$READ^XGF ;"returns line terminator in tmgXGRT
200 set tmgXGRT=$get(tmgXGRT) ;"ensure existence
201 if TMGdbgLine="?" do goto Ppt2
202 . write !,"Here you should enter any valid M command, as would normally",!
203 . write "entered at a GTM> prompt.",!
204 . write " examples: WRITE ""HELLO"",! or DO ^TMGTEST",!
205
206 if (TMGdbgLine="")&(HxShowNum>0) set TMGdbgLine=HxLine
207
208 if (tmgXGRT="DOWN")!(tmgXGRT="RIGHT")!(TMGdbgLine="]") do goto Ppt2
209 . set HxShowNum=HxShowNum-1
210 . if HxShowNum<0 set HxShowNum=HxLineMax
211 . ;"write "setting HxShowNum=",HxShowNum,!
212 . do CHA^TMGTERM(1) write ideBlankLine do CHA^TMGTERM(1)
213
214 if (tmgXGRT="UP")!(tmgXGRT="LEFT")!(TMGdbgLine="[") do goto Ppt2
215 . set HxShowNum=HxShowNum+1
216 . if HxShowNum>HxLineMax set HxShowNum=0
217 . ;"write "setting HxShowNum=",HxShowNum,!
218 . do CHA^TMGTERM(1) write ideBlankLine do CHA^TMGTERM(1)
219
220 if TMGdbgLine="" set TMGdbgLine="^"
221 write !
222
223 ;"Save Cmd history
224 set HxLineCur=$get(^TMG("TMGIDE","CMD HISTORY",$J,"CUR"),0) ;"<-- points to last used, not next avail
225 set HxLineMax=$get(^TMG("TMGIDE","CMD HISTORY",$J,"MAX"),0) ;"equals buffer size AFTER it fills
226 set HxLineCur=HxLineCur+1
227 ;"if HxLineCur>HxSize set HxLineCur=1
228 set ^TMG("TMGIDE","CMD HISTORY",$J,HxLineCur)=TMGdbgLine
229 set ^TMG("TMGIDE","CMD HISTORY",$J,"CUR")=HxLineCur
230 if HxLineCur>HxLineMax do
231 . set HxLineMax=HxLineCur
232 . set ^TMG("TMGIDE","CMD HISTORY",$J,"MAX")=HxLineMax
233 ;"write "Saving line in #",HxLineCur," Max=",HxLineMax,!
234
235 quit TMGdbgLine
Note: See TracBrowser for help on using the repository browser.