source: WorldVistAEHR/trunk/r/ZZOTHER/ZJOB.m@ 701

Last change on this file since 701 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 7.5 KB
Line 
1ZJOB ;ISF/RWF - GT.M Job Exam ;8/15/07 16:28
2 ;;8.0;KERNEL;**349**;Jul 10, 1995;Build 2
3 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4 ; Various edits between Wally, Dave Whitten, Bhaskar, ;
5 ; and Chris Richardson over a period of time. ;
6 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
7 ;;
8 ;PID is decimal job number.
9 I $ZV'["GT.M" W !,"This is for GT.M only" Q
10 N PID,HEXPID,DTIME
11 S DTIME=600
12RPID ; Request the PID
13 F D Q:"^"[PID
14 . S PID=$$ASKJOB
15 . D:PID>0
16 . . N ACTION
17 . . S ACTION="L"
18 . . D DOIT
19 . . F D ASK Q:ACTION="^" D DOIT Q:ACTION="^"
20 . .Q
21 .Q
22 ; Single Exit
23 W !!
24 Q
25 ;
26ASK ; Ask for user input
27 R !,"Job Exam Action: L//",ACTION:DTIME
28 S:'$T ACTION="^"
29 S:ACTION="" ACTION="L"
30 I ACTION["^" Q ;Exit
31 ;
32 ;first non-space, UPPER character
33 S ACTION=$TR($E($TR(ACTION," ")),"klsv","KLSV")
34 Q
35 ;
36DOIT ; Action Prompt
37 I ACTION="S" D ^ZSY S ACTION="L" ;FALLTHRU
38 I ACTION="L"!(ACTION="V") D DISPLAY(PID,ACTION) Q
39 I ACTION="*" D LOAD^ZJOB1 S ACTION="^" Q
40 I ACTION="K" W !,"Sorry Kill Job not supported yet" Q ;G ACTION
41 ; All Else
42 W:ACTION'="?" !,"Unknown Action received"
43 ;ACTION["?"
44 W !,"Enter '^' to choose another JOB "
45 W !,"Enter 'L' to display status information about other Job"
46 W !,"Enter 'S' to display current System Status"
47 W !,"Enter 'V' to display local variables of other job"
48 W !,"Enter '*' to load other job's symbol table into current job and Q"
49 W !,"Enter 'K' to send a Kill Job command to other job"
50 Q
51 ;
52ASKJOB() ;Ask for Job PID/Commands
53 N PID
54 W !!,"Examine Another JOB Utility "
55 F S PID=$$RDJNUM Q:PID="^" Q:PID=+PID
56 Q PID
57 ;
58RDJNUM() ;
59 N INP,PID
60 S INP=""
61 R !,"Enter JOB number: ",INP:DTIME S:'$T INP="^"
62 S INP=$TR(INP,"hlsv","HLSV")
63 I "^"[INP Q "^" ;abend
64 ;
65 I INP["?" D Q " "
66 . W !,"To display information about another Job"
67 . W !," enter JOB number in Hexidecimal or Decimal"
68 . W !," Enter Hexadecimal with a leading/trailing 'h' "
69 . W !,"To display current System Status enter S"
70 . W !,"To exit enter ^"
71 .Q
72 I INP["S" D ^ZSY Q " " ;
73 ;
74 ; good hex or decimal number
75 S PID=$TR(INP,"abcdefh","ABCDEFH")
76 I $L($TR(PID,"0123456789ABCDEFH","")) D Q " "
77 . W !,"Invalid character in JOB number."
78 .Q
79 ;
80 ;If in Hex, Convert PID to decimal
81 I PID["H" S PID=$$DEC($TR(PID,"H")) ; ...and continue
82 ; good job number but it is your own job. Don't go there...
83 I PID=$JOB D Q " "
84 . W !,"Can't EXAMINE your own process."
85 .Q
86 ;
87 ; VA check to see if a GTM job exists.
88 I $L($T(XUSCNT)),'$$CHECK^XUSCNT(PID) W !,"Not running thru VA kernel." ;decimal job
89 ;
90 ;W !,"JOB #",PID," does not exist"
91 ;Q " " ; bad job number so re-ask
92 Q PID
93 ;
94INTRPT(JOB) ;Send MUPIP intrpt
95 N $ET,$ES S $ET="D IRTERR^ZJOB"
96 ; shouldn't interrupt ourself
97 I JOB=$JOB Q 0
98 ;We need a LOCK to guarantee commands from two processes don't conflict
99 N X,OLDINTRPT,TMP,ZSYSCMD,ZPATH,%J
100 L +^XUTL("XUSYS","COMMAND"):10 Q:'$T 0
101 ;
102 S ^XUTL("XUSYS","COMMAND")="EXAM",^("COMMAND",0)=$J_":"_$H
103 K ^XUTL("XUSYS",JOB,"JE")
104 S OLDINTRP=$ZINTERRUPT,%J=$J
105 S TMP=0,$ZINTERRUPT="S TMP=1"
106 ;
107 I $ZV["VMS" S JOB=$$HEX(JOB),%J=$$HEX(%J)
108 S ZSYSCMD="mupip intrpt "_JOB ; interrupt other job
109 I $ZV["VMS" S ZPATH="@gtm$dist:" ; VMS path
110 ;E S ZPATH="sudo $gtm_dist" ;$ztrnlnm("gtm_dist") ;Unix path
111 E S ZPATH="$gtm_dist/" ;Unix path
112 W !,"Send intrp to job. Any error means you don't have the privilege to intrpt.",!
113 ZSYSTEM ZPATH_ZSYSCMD ; System Request
114 ;Now send to self
115 ;
116 ;ZSYSTEM ZPATH_"mupip intrpt "_%J
117 ; wait is too long 60>>30
118 H 1 S TMP=1
119 ; wait for interrupt, will set TMP=1
120 ;F X=1:1:30 H 1 Q:TMP=1 ;ZINTERRUPT does not stop a HANG
121 ; Restore old $ZINTERRPT
122 S $ZINTERRUPT=OLDINTRP
123 K ^XUTL("XUSYS","COMMAND") ;Cleanup
124 L -^XUTL("XUSYS","COMMAND")
125 Q TMP ;Report if we received interrupt
126 ;
127ITRERR ;Handle error during Interrupt
128 U $P W !,"Error: ",$ES
129 S $ET="Q:($ES&$Q) 0 Q:$ES S $EC="""" Q 0"
130 Q
131 ;
132DISPLAY(JOB,ACTION) ;Display Job info, L is always the default. No need to test for it.
133 ; The "L" header is part of the "V" Option
134 ;Send the interupt
135 I '$$INTRPT(JOB) W !,"Unable to Examine JOB, please retry later" Q
136 D DISPL ;Show Header
137 I ACTION="V" D DISPV ;Show symbol table
138 Q
139 ;
140DISPL ; ACTION="L" means single page info
141 ; Show short job info
142 ; Current Routine and Line Number ;Current Line Executing
143 D GETINFO
144 S HEXJOB="" I $ZV["VMS" S HEXJOB=$$HEX(JOB)
145 W !,"JOB #: "_JOB W:$L(HEXJOB) " ("_HEXJOB_")" W ?40,"Process Name: "_$G(^XUTL("XUSYS",JOB,"NM"))
146 W !,"Device: "_$P($G(^XUTL("XUSYS",JOB,"JE","D",1))," ")
147 W !,"Process State: "_PS W:$L(IMAGE) ?40,"IMAGE: "_IMAGE_" ("_INAME_")"
148 W !,"JOB Type: "_JTYPE,?25,"CPU Time: "_CTIME,?50,"Login time: "_LTIME
149 W !!,"Routine line: <"_$G(^XUTL("XUSYS",JOB,"INTERRUPT"))_">"
150 W !,CODELINE
151 Q
152 ;
153 ; No Symbol Residue from this module. The following are ephemeral
154 ; S - Information Type
155 ; I - Variable
156DISPV ; ACTION="V" ; lookup how XTER is doing variable handling...
157 ; print $ZGBLDIR and $ZROUTINES
158 N C,I,S
159 F S="Stack","Locks","Devices","Intrinsic Variables","Variables" D
160 . S C=$E(S),I=""
161 . D:$D(^XUTL("XUSYS",JOB,"JE",C)) W !
162 . . W !,"Section "_S
163 . . F S I=$O(^XUTL("XUSYS",JOB,"JE",C,I)) Q:I="" W !,^(I)
164 . . Q
165 . Q
166 Q
167 ; ==============
168GETINFO ; Identify the Target Process's state.
169 ; Setup, process state > ps, Image name > iname, CPU time > ctime, Login time > ltime
170 S (PS,INAME,CTIME,LTIME,JTYPE,IMAGE,CODELINE)=""
171 S CODELINE=$G(^XUTL("XUSYS",JOB,"codeline"))
172 I $zv["VMS" D VSTATE Q
173 ; Assume Unix as default
174 D USTATE
175 Q
176 ;
177VSTATE ; VMS get Process state
178 S TNAME=$ZGETJPI(JOB,"TERMINAL"),NM=$ZGETJPI(JOB,"prcnam")
179 S JTYPE=$ZGETJPI(JOB,"jobtype"),PS=$ZGETJPI(JOB,"state")
180 S LTIME=$$DATETIME($ZGETJPI(PID,"LOGINTIM")),CTIME=$$CPUTIME($ZGETJPI(JOB,"cputim"))
181 Q
182 ;
183DATETIME(HOROLOG) ;
184 Q $ZDATE(HOROLOG,"DD-MON-YY 24:60:SS","Jan,Feb,Mar,Apr,May,Jun,Jul,Aug,Sep,Oct,Nov,Dec")
185 ;
186CPUTIME(S) ; Calculate the VMS CPU time from first argument, S
187 N T,SS,M,H,D
188 S T=S#100,S=S\100 S:$L(T)=1 T="0"_T
189 S SS=S#60,S=S\60 S:$L(SS)=1 SS="0"_SS
190 S M=S#60,S=S\60 S:$L(M)=1 M="0"_M
191 S H=S#24,D=S\24 S:$L(H)=1 H="0"_H
192 Q D_" "_H_":"_M_":"_SS_"."_T
193 ;
194BLINDPID ;
195 N ZE S ZE=$ZS,$EC=""
196 I ZE["NOPRIV" S NOPRIV=1
197 Q
198 ; MAY BE REDUNDANT OR WRONG
199USTATE ;UNIX Process state.
200 N %FILE,%TEXT,U,%J,ZCMD,$ET,$ES
201 S $ET="D UERR^ZJOB",STATE="",U="^"
202 S %FILE="/tmp/_gtm_sy_"_$J_".tmp"
203 ;S ZCMD="ps ef -C mumps >"_%FILE ;| grep "_JOB_">"_%FILE
204 S ZCMD="ps eo pid,tty,stat,time,etime,cmd -C mumps >"_%FILE ;| grep "_JOB_">"_%FILE
205 ;W !,ZCMD
206 ZSYSTEM ZCMD
207 O %FILE:(readonly)
208 ; Get only line of text from temp file
209 U %FILE
210 F EXIT=0:0 R %TEXT Q:%TEXT="" D Q:EXIT
211 . Q:+%TEXT'=JOB
212 . S %TEXT=$$VPE(%TEXT," ",U) ; parse each line of the ps output
213 . S TNAME=$P(%TEXT,U,2),PS=$P(%TEXT,U,3),CTIME=$P(%TEXT,U,4),LTIME=$P(%TEXT,U,5),JTYPE=$P(%TEXT,U,7)
214 . S EXIT=1
215 .Q
216 ;
217 U $P C %FILE:DELETE
218 S PS=$S(PS="S":"hib",PS="D":"lef",PS="R":"run",1:PS)
219 Q
220 ; ================
221UERR ;Error
222 S $EC=""
223 U $P W !,"Error: "_$ZS
224 Q:$Q -9
225 Q
226 ;
227HEX(D) ;Decimal to Hex
228 Q $$FUNC^%DH(D,8)
229DEC(H) ;Hex to Decimal
230 Q $$FUNC^%HD(H)
231 ;
232VPE(%OLDSTR,%OLDDEL,%NEWDEL) ; $PIECE extract based on variable length delimiter
233 N %LEN,%PIECE,%NEWSTR
234 S %STRING=$G(%STRING)
235 S %OLDDEL=$G(%OLDDEL) I %OLDDEL="" S %OLDDEL=" "
236 S %LEN=$L(%OLDDEL)
237 ; each %OLDDEL-sized chunk of %OLDSTR that might be delimiter
238 S %NEWDEL=$G(%NEWDEL) I %NEWDEL="" S %NEWDEL="^"
239 ; each piece of the old string
240 S %NEWSTR="" ; new reformatted string to return
241 F Q:%OLDSTR="" D
242 . S %PIECE=$P(%OLDSTR,%OLDDEL)
243 . S $P(%OLDSTR,%OLDDEL)=""
244 . S %NEWSTR=%NEWSTR_$S(%NEWSTR="":"",1:%NEWDEL)_%PIECE
245 . F Q:%OLDDEL'=$E(%OLDSTR,1,%LEN) S $E(%OLDSTR,1,%LEN)=""
246 .Q
247 Q %NEWSTR
248 ;
Note: See TracBrowser for help on using the repository browser.