249 lines
7.5 KiB
Mathematica
249 lines
7.5 KiB
Mathematica
ZJOB ;ISF/RWF - GT.M Job Exam ;8/15/07 16:28
|
|
;;8.0;KERNEL;**349**;Jul 10, 1995;Build 2
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
; Various edits between Wally, Dave Whitten, Bhaskar, ;
|
|
; and Chris Richardson over a period of time. ;
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;;
|
|
;PID is decimal job number.
|
|
I $ZV'["GT.M" W !,"This is for GT.M only" Q
|
|
N PID,HEXPID,DTIME
|
|
S DTIME=600
|
|
RPID ; Request the PID
|
|
F D Q:"^"[PID
|
|
. S PID=$$ASKJOB
|
|
. D:PID>0
|
|
. . N ACTION
|
|
. . S ACTION="L"
|
|
. . D DOIT
|
|
. . F D ASK Q:ACTION="^" D DOIT Q:ACTION="^"
|
|
. .Q
|
|
.Q
|
|
; Single Exit
|
|
W !!
|
|
Q
|
|
;
|
|
ASK ; Ask for user input
|
|
R !,"Job Exam Action: L//",ACTION:DTIME
|
|
S:'$T ACTION="^"
|
|
S:ACTION="" ACTION="L"
|
|
I ACTION["^" Q ;Exit
|
|
;
|
|
;first non-space, UPPER character
|
|
S ACTION=$TR($E($TR(ACTION," ")),"klsv","KLSV")
|
|
Q
|
|
;
|
|
DOIT ; Action Prompt
|
|
I ACTION="S" D ^ZSY S ACTION="L" ;FALLTHRU
|
|
I ACTION="L"!(ACTION="V") D DISPLAY(PID,ACTION) Q
|
|
I ACTION="*" D LOAD^ZJOB1 S ACTION="^" Q
|
|
I ACTION="K" W !,"Sorry Kill Job not supported yet" Q ;G ACTION
|
|
; All Else
|
|
W:ACTION'="?" !,"Unknown Action received"
|
|
;ACTION["?"
|
|
W !,"Enter '^' to choose another JOB "
|
|
W !,"Enter 'L' to display status information about other Job"
|
|
W !,"Enter 'S' to display current System Status"
|
|
W !,"Enter 'V' to display local variables of other job"
|
|
W !,"Enter '*' to load other job's symbol table into current job and Q"
|
|
W !,"Enter 'K' to send a Kill Job command to other job"
|
|
Q
|
|
;
|
|
ASKJOB() ;Ask for Job PID/Commands
|
|
N PID
|
|
W !!,"Examine Another JOB Utility "
|
|
F S PID=$$RDJNUM Q:PID="^" Q:PID=+PID
|
|
Q PID
|
|
;
|
|
RDJNUM() ;
|
|
N INP,PID
|
|
S INP=""
|
|
R !,"Enter JOB number: ",INP:DTIME S:'$T INP="^"
|
|
S INP=$TR(INP,"hlsv","HLSV")
|
|
I "^"[INP Q "^" ;abend
|
|
;
|
|
I INP["?" D Q " "
|
|
. W !,"To display information about another Job"
|
|
. W !," enter JOB number in Hexidecimal or Decimal"
|
|
. W !," Enter Hexadecimal with a leading/trailing 'h' "
|
|
. W !,"To display current System Status enter S"
|
|
. W !,"To exit enter ^"
|
|
.Q
|
|
I INP["S" D ^ZSY Q " " ;
|
|
;
|
|
; good hex or decimal number
|
|
S PID=$TR(INP,"abcdefh","ABCDEFH")
|
|
I $L($TR(PID,"0123456789ABCDEFH","")) D Q " "
|
|
. W !,"Invalid character in JOB number."
|
|
.Q
|
|
;
|
|
;If in Hex, Convert PID to decimal
|
|
I PID["H" S PID=$$DEC($TR(PID,"H")) ; ...and continue
|
|
; good job number but it is your own job. Don't go there...
|
|
I PID=$JOB D Q " "
|
|
. W !,"Can't EXAMINE your own process."
|
|
.Q
|
|
;
|
|
; VA check to see if a GTM job exists.
|
|
I $L($T(XUSCNT)),'$$CHECK^XUSCNT(PID) W !,"Not running thru VA kernel." ;decimal job
|
|
;
|
|
;W !,"JOB #",PID," does not exist"
|
|
;Q " " ; bad job number so re-ask
|
|
Q PID
|
|
;
|
|
INTRPT(JOB) ;Send MUPIP intrpt
|
|
N $ET,$ES S $ET="D IRTERR^ZJOB"
|
|
; shouldn't interrupt ourself
|
|
I JOB=$JOB Q 0
|
|
;We need a LOCK to guarantee commands from two processes don't conflict
|
|
N X,OLDINTRPT,TMP,ZSYSCMD,ZPATH,%J
|
|
L +^XUTL("XUSYS","COMMAND"):10 Q:'$T 0
|
|
;
|
|
S ^XUTL("XUSYS","COMMAND")="EXAM",^("COMMAND",0)=$J_":"_$H
|
|
K ^XUTL("XUSYS",JOB,"JE")
|
|
S OLDINTRP=$ZINTERRUPT,%J=$J
|
|
S TMP=0,$ZINTERRUPT="S TMP=1"
|
|
;
|
|
I $ZV["VMS" S JOB=$$HEX(JOB),%J=$$HEX(%J)
|
|
S ZSYSCMD="mupip intrpt "_JOB ; interrupt other job
|
|
I $ZV["VMS" S ZPATH="@gtm$dist:" ; VMS path
|
|
;E S ZPATH="sudo $gtm_dist" ;$ztrnlnm("gtm_dist") ;Unix path
|
|
E S ZPATH="$gtm_dist/" ;Unix path
|
|
W !,"Send intrp to job. Any error means you don't have the privilege to intrpt.",!
|
|
ZSYSTEM ZPATH_ZSYSCMD ; System Request
|
|
;Now send to self
|
|
;
|
|
;ZSYSTEM ZPATH_"mupip intrpt "_%J
|
|
; wait is too long 60>>30
|
|
H 1 S TMP=1
|
|
; wait for interrupt, will set TMP=1
|
|
;F X=1:1:30 H 1 Q:TMP=1 ;ZINTERRUPT does not stop a HANG
|
|
; Restore old $ZINTERRPT
|
|
S $ZINTERRUPT=OLDINTRP
|
|
K ^XUTL("XUSYS","COMMAND") ;Cleanup
|
|
L -^XUTL("XUSYS","COMMAND")
|
|
Q TMP ;Report if we received interrupt
|
|
;
|
|
ITRERR ;Handle error during Interrupt
|
|
U $P W !,"Error: ",$ES
|
|
S $ET="Q:($ES&$Q) 0 Q:$ES S $EC="""" Q 0"
|
|
Q
|
|
;
|
|
DISPLAY(JOB,ACTION) ;Display Job info, L is always the default. No need to test for it.
|
|
; The "L" header is part of the "V" Option
|
|
;Send the interupt
|
|
I '$$INTRPT(JOB) W !,"Unable to Examine JOB, please retry later" Q
|
|
D DISPL ;Show Header
|
|
I ACTION="V" D DISPV ;Show symbol table
|
|
Q
|
|
;
|
|
DISPL ; ACTION="L" means single page info
|
|
; Show short job info
|
|
; Current Routine and Line Number ;Current Line Executing
|
|
D GETINFO
|
|
S HEXJOB="" I $ZV["VMS" S HEXJOB=$$HEX(JOB)
|
|
W !,"JOB #: "_JOB W:$L(HEXJOB) " ("_HEXJOB_")" W ?40,"Process Name: "_$G(^XUTL("XUSYS",JOB,"NM"))
|
|
W !,"Device: "_$P($G(^XUTL("XUSYS",JOB,"JE","D",1))," ")
|
|
W !,"Process State: "_PS W:$L(IMAGE) ?40,"IMAGE: "_IMAGE_" ("_INAME_")"
|
|
W !,"JOB Type: "_JTYPE,?25,"CPU Time: "_CTIME,?50,"Login time: "_LTIME
|
|
W !!,"Routine line: <"_$G(^XUTL("XUSYS",JOB,"INTERRUPT"))_">"
|
|
W !,CODELINE
|
|
Q
|
|
;
|
|
; No Symbol Residue from this module. The following are ephemeral
|
|
; S - Information Type
|
|
; I - Variable
|
|
DISPV ; ACTION="V" ; lookup how XTER is doing variable handling...
|
|
; print $ZGBLDIR and $ZROUTINES
|
|
N C,I,S
|
|
F S="Stack","Locks","Devices","Intrinsic Variables","Variables" D
|
|
. S C=$E(S),I=""
|
|
. D:$D(^XUTL("XUSYS",JOB,"JE",C)) W !
|
|
. . W !,"Section "_S
|
|
. . F S I=$O(^XUTL("XUSYS",JOB,"JE",C,I)) Q:I="" W !,^(I)
|
|
. . Q
|
|
. Q
|
|
Q
|
|
; ==============
|
|
GETINFO ; Identify the Target Process's state.
|
|
; Setup, process state > ps, Image name > iname, CPU time > ctime, Login time > ltime
|
|
S (PS,INAME,CTIME,LTIME,JTYPE,IMAGE,CODELINE)=""
|
|
S CODELINE=$G(^XUTL("XUSYS",JOB,"codeline"))
|
|
I $zv["VMS" D VSTATE Q
|
|
; Assume Unix as default
|
|
D USTATE
|
|
Q
|
|
;
|
|
VSTATE ; VMS get Process state
|
|
S TNAME=$ZGETJPI(JOB,"TERMINAL"),NM=$ZGETJPI(JOB,"prcnam")
|
|
S JTYPE=$ZGETJPI(JOB,"jobtype"),PS=$ZGETJPI(JOB,"state")
|
|
S LTIME=$$DATETIME($ZGETJPI(PID,"LOGINTIM")),CTIME=$$CPUTIME($ZGETJPI(JOB,"cputim"))
|
|
Q
|
|
;
|
|
DATETIME(HOROLOG) ;
|
|
Q $ZDATE(HOROLOG,"DD-MON-YY 24:60:SS","Jan,Feb,Mar,Apr,May,Jun,Jul,Aug,Sep,Oct,Nov,Dec")
|
|
;
|
|
CPUTIME(S) ; Calculate the VMS CPU time from first argument, S
|
|
N T,SS,M,H,D
|
|
S T=S#100,S=S\100 S:$L(T)=1 T="0"_T
|
|
S SS=S#60,S=S\60 S:$L(SS)=1 SS="0"_SS
|
|
S M=S#60,S=S\60 S:$L(M)=1 M="0"_M
|
|
S H=S#24,D=S\24 S:$L(H)=1 H="0"_H
|
|
Q D_" "_H_":"_M_":"_SS_"."_T
|
|
;
|
|
BLINDPID ;
|
|
N ZE S ZE=$ZS,$EC=""
|
|
I ZE["NOPRIV" S NOPRIV=1
|
|
Q
|
|
; MAY BE REDUNDANT OR WRONG
|
|
USTATE ;UNIX Process state.
|
|
N %FILE,%TEXT,U,%J,ZCMD,$ET,$ES
|
|
S $ET="D UERR^ZJOB",STATE="",U="^"
|
|
S %FILE="/tmp/_gtm_sy_"_$J_".tmp"
|
|
;S ZCMD="ps ef -C mumps >"_%FILE ;| grep "_JOB_">"_%FILE
|
|
S ZCMD="ps eo pid,tty,stat,time,etime,cmd -C mumps >"_%FILE ;| grep "_JOB_">"_%FILE
|
|
;W !,ZCMD
|
|
ZSYSTEM ZCMD
|
|
O %FILE:(readonly)
|
|
; Get only line of text from temp file
|
|
U %FILE
|
|
F EXIT=0:0 R %TEXT Q:%TEXT="" D Q:EXIT
|
|
. Q:+%TEXT'=JOB
|
|
. S %TEXT=$$VPE(%TEXT," ",U) ; parse each line of the ps output
|
|
. 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)
|
|
. S EXIT=1
|
|
.Q
|
|
;
|
|
U $P C %FILE:DELETE
|
|
S PS=$S(PS="S":"hib",PS="D":"lef",PS="R":"run",1:PS)
|
|
Q
|
|
; ================
|
|
UERR ;Error
|
|
S $EC=""
|
|
U $P W !,"Error: "_$ZS
|
|
Q:$Q -9
|
|
Q
|
|
;
|
|
HEX(D) ;Decimal to Hex
|
|
Q $$FUNC^%DH(D,8)
|
|
DEC(H) ;Hex to Decimal
|
|
Q $$FUNC^%HD(H)
|
|
;
|
|
VPE(%OLDSTR,%OLDDEL,%NEWDEL) ; $PIECE extract based on variable length delimiter
|
|
N %LEN,%PIECE,%NEWSTR
|
|
S %STRING=$G(%STRING)
|
|
S %OLDDEL=$G(%OLDDEL) I %OLDDEL="" S %OLDDEL=" "
|
|
S %LEN=$L(%OLDDEL)
|
|
; each %OLDDEL-sized chunk of %OLDSTR that might be delimiter
|
|
S %NEWDEL=$G(%NEWDEL) I %NEWDEL="" S %NEWDEL="^"
|
|
; each piece of the old string
|
|
S %NEWSTR="" ; new reformatted string to return
|
|
F Q:%OLDSTR="" D
|
|
. S %PIECE=$P(%OLDSTR,%OLDDEL)
|
|
. S $P(%OLDSTR,%OLDDEL)=""
|
|
. S %NEWSTR=%NEWSTR_$S(%NEWSTR="":"",1:%NEWDEL)_%PIECE
|
|
. F Q:%OLDDEL'=$E(%OLDSTR,1,%LEN) S $E(%OLDSTR,1,%LEN)=""
|
|
.Q
|
|
Q %NEWSTR
|
|
;
|