source: cprs/branches/tmg-cprs/m_files/TMGIDE4.m@ 1044

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

replacing soft links with actual files

File size: 8.0 KB
Line 
1TMGIDE4 ;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
15Sender(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)
42SendL1
43 if 'Quiet write !,!,"=== TMG IDE Sender (Job# ",$J,") ===",!,!
44 if 'Quiet write "Waiting for command from Controller window... (^ to abort)"
45SendL2
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
59SendDone
60 if 'Quiet write !,"Sending DONE.."
61 new TMGtemp set TMGtemp=$$MessageOut("DONE",1)
62 if 'Quiet write TMGtemp,!
63 kill ^TMG("TMGIDE","SENDER")
64SD2 ;
65 quit
66
67HndlCmd(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 ;
81HCDone quit "[RSLT] "_result
82
83HndlEval(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
104HndlTable(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
112HndlBkPos(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
127HBPD quit result
128
129HndlRelBkPos(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
140HndlXCod(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 ;"------------------------------------------------------------
152STEPTRAP(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)
166STP2 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
178MessageOut(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
Note: See TracBrowser for help on using the repository browser.