| 1 | %ZOSV ;ISF/STAFF - View commands & special functions (GT.M). ;4/12/07 16:47
|
|---|
| 2 | ;;8.0;KERNEL;**275,425**;Jul 10, 1995;Build 18
|
|---|
| 3 | ; for GT.M for VMS, version 4.3
|
|---|
| 4 | ;
|
|---|
| 5 | ACTJ() ; # active jobs
|
|---|
| 6 | ;Keep active count in global
|
|---|
| 7 | Q $G(^XUTL("XUSYS","CNT"))
|
|---|
| 8 | ;Long way that would work
|
|---|
| 9 | ;N %IMAGE S %IMAGE=$ZGETJPI($J,"IMAGNAME")
|
|---|
| 10 | ;N Y S Y=0
|
|---|
| 11 | ;N %PID S %PID=0
|
|---|
| 12 | ;F S %PID=$ZPID(%PID) Q:'%PID I $ZGETJPI(%PID,"IMAGNAME")=%IMAGE S Y=Y+1
|
|---|
| 13 | ;Q Y
|
|---|
| 14 | ;
|
|---|
| 15 | AVJ() ; # available jobs, Limit is in the OS.
|
|---|
| 16 | N V,J
|
|---|
| 17 | S V=^%ZOSF("VOL"),J=$O(^XTV(8989.3,1,4,"B",V,0)),J=$P($G(^XTV(8989.3,1,4,J,0),"^^1000"),"^",3)
|
|---|
| 18 | Q J-$$ACTJ ;Use signon Max
|
|---|
| 19 | ;
|
|---|
| 20 | PASSALL ;
|
|---|
| 21 | U $I:(PASTHRU) Q
|
|---|
| 22 | NOPASS ;
|
|---|
| 23 | U $I:(NOPASTHRU) Q
|
|---|
| 24 | ;
|
|---|
| 25 | GETPEER() ;Get the IP address of a connection peer
|
|---|
| 26 | N PEER
|
|---|
| 27 | S PEER=$ZTRNLNM("VISTA$IP")
|
|---|
| 28 | Q $S($L(PEER):PEER,$L($G(IO("GTM-IP"))):IO("GTM-IP"),1:"")
|
|---|
| 29 | ;
|
|---|
| 30 | PRGMODE ;
|
|---|
| 31 | N X,XUCI,XUSLNT
|
|---|
| 32 | W ! S ZTPAC=$P($G(^VA(200,+DUZ,.1)),"^",5),XUVOL=^%ZOSF("VOL")
|
|---|
| 33 | S X="" X ^%ZOSF("EOFF") R:ZTPAC]"" !,"PAC: ",X:60 D LC^XUS X ^%ZOSF("EON") I X'=ZTPAC W "??",$C(7) Q
|
|---|
| 34 | N XMB,XMTEXT,XMY S XMB="XUPROGMODE",XMB(1)=DUZ,XMB(2)=$I D ^XMB:$L($T(^XMB)) D BYE^XUSCLEAN K ZTPAC,X,XMB
|
|---|
| 35 | D UCI S XUCI=Y D PRGM^ZUA
|
|---|
| 36 | F BREAK
|
|---|
| 37 | HALT
|
|---|
| 38 | ;
|
|---|
| 39 | PROGMODE() ; In Application mode
|
|---|
| 40 | Q 0 ; This was used to control UCI switching, has no meaning in GT.M
|
|---|
| 41 | ;
|
|---|
| 42 | UCI ;
|
|---|
| 43 | S Y="VAH,"_^%ZOSF("VOL") Q
|
|---|
| 44 | ;
|
|---|
| 45 | UCICHECK(X) ;
|
|---|
| 46 | Q 1
|
|---|
| 47 | ;
|
|---|
| 48 | TEMP() ; Return path to temp directory
|
|---|
| 49 | ;N %TEMP S %TEMP=$P($$RTNDIR," "),%TEMP=$P(%TEMP,"/",1,$L(%TEMP,"/")-2)_"/t/"
|
|---|
| 50 | Q $G(^%ZOSF("TMP"),$G(^XTV(8989.3,1,"DEV"),"USER$:[TEMP]"))
|
|---|
| 51 | ;
|
|---|
| 52 | JOBPAR ;is job X valid on system, return UCI in Y.
|
|---|
| 53 | N $ES,$ET,J S $ET="Q:$ES>0 S Y="""" G JOBPX^%ZOSV"
|
|---|
| 54 | S Y=""
|
|---|
| 55 | S J=$ZGETJPI(X,"PRI")
|
|---|
| 56 | I $L(J) S Y=$P(^%ZOSF("PROD"),",")
|
|---|
| 57 | JOBPX S $EC=""
|
|---|
| 58 | Q
|
|---|
| 59 | ;
|
|---|
| 60 | SHARELIC(TYPE) ;Used by Cache implementations
|
|---|
| 61 | Q
|
|---|
| 62 | ;
|
|---|
| 63 | PRIORITY ;The VA has this disabled in general.
|
|---|
| 64 | Q
|
|---|
| 65 | ;
|
|---|
| 66 | PRIINQ() ;
|
|---|
| 67 | N PRI S PRI=$ZGETJPI($J,"PRI")
|
|---|
| 68 | Q $S(PRI=0:1,PRI=1:3,PRI=2:5,PRI=3:7,PRI=4:9,1:10)
|
|---|
| 69 | ;
|
|---|
| 70 | BAUD S X="UNKNOWN" Q
|
|---|
| 71 | ;
|
|---|
| 72 | LGR() Q $R ; Last global reference ($REFERENCE)
|
|---|
| 73 | ;
|
|---|
| 74 | EC() ; Error Code: returning $ZS in format more like $ZE from DSM
|
|---|
| 75 | N %ZE
|
|---|
| 76 | I $ZS="" Q ""
|
|---|
| 77 | S %ZE=$P($ZS,",",2)_","_$P($ZS,",",4)_","_$P($ZS,",")_",-"_$P($ZS,",",3)
|
|---|
| 78 | Q %ZE
|
|---|
| 79 | ;
|
|---|
| 80 | DOLRO ;SAVE ENTIRE SYMBOL TABLE IN LOCATION SPECIFIED BY X
|
|---|
| 81 | ;S Y="%" F S Y=$O(@Y) Q:Y="" D
|
|---|
| 82 | ;. I $D(@Y)#2 S @(X_"Y)="_Y)
|
|---|
| 83 | ;. I $D(@Y)>9 S %X=Y_"(",%Y=X_"Y," D %XY^%RCR
|
|---|
| 84 | S Y="%" F M:$D(@Y) @(X_"Y)="_Y) S Y=$O(@Y) Q:Y=""
|
|---|
| 85 | Q
|
|---|
| 86 | ;
|
|---|
| 87 | ORDER ;SAVE PART OF SYMBOL TABLE IN LOCATION SPECIFIED BY X
|
|---|
| 88 | N %
|
|---|
| 89 | S (Y,%)=$P(Y,"*",1) ;I $D(@Y)=0 F S Y=$O(@Y) Q:Y=""!(Y[Y1)
|
|---|
| 90 | Q:Y=""
|
|---|
| 91 | ;S %=$D(@Y) S:%#2 @(X_"Y)="_Y) I %>9 S %X=Y_"(",%Y=X_"Y," D %XY^%RCR
|
|---|
| 92 | ;F S Y=$O(@Y) Q:Y=""!(Y'[Y1) S %=$D(@Y) S:%#2 @(X_"Y)="_Y) I %>9 S %X=Y_"(",%Y=X_"Y," D %XY^%RCR
|
|---|
| 93 | F M:$D(@Y) @(X_"Y)="_Y) S Y=$O(@Y) Q:Y=""!(Y'[%)
|
|---|
| 94 | Q
|
|---|
| 95 | ;
|
|---|
| 96 | PARSIZ ;
|
|---|
| 97 | S X=3 Q
|
|---|
| 98 | ;
|
|---|
| 99 | NOLOG ;
|
|---|
| 100 | S Y=0 Q
|
|---|
| 101 | ;
|
|---|
| 102 | GETENV ;Get environment Return Y='UCI^VOL^NODE^BOX LOOKUP'
|
|---|
| 103 | N %V,%HOST S %HOST=$ZGETSYI("NODENAME"),%V=^%ZOSF("PROD")
|
|---|
| 104 | S Y=$TR(%V,",","^")_"^"_%HOST_"^"_$P(%V,",",2)_":"_%HOST
|
|---|
| 105 | Q
|
|---|
| 106 | ;
|
|---|
| 107 | VERSION(X) ;return OS version, X=1 - return OS
|
|---|
| 108 | Q $S($G(X):$P($ZV," V"),1:+$P($ZV," V",2))
|
|---|
| 109 | ;
|
|---|
| 110 | OS() ;
|
|---|
| 111 | Q "VMS"
|
|---|
| 112 | ;
|
|---|
| 113 | RTNDIR() ;primary routine source directory
|
|---|
| 114 | ;Assume dat1$:[gtm.o]/src=(dat1$:[gtm.r]),gtm$dist
|
|---|
| 115 | N % S %=$P($ZRO,",")
|
|---|
| 116 | I %["/SRC" S %=$P($P($P(%,"(",2),")",1),",")
|
|---|
| 117 | Q %
|
|---|
| 118 | ;
|
|---|
| 119 | SETNM(X) ;Set name, Trap dup's, Fall into SETENV
|
|---|
| 120 | N $ETRAP S $ETRAP="S $ECODE="""" Q"
|
|---|
| 121 | ;
|
|---|
| 122 | SETENV ;Set environment X='PROCESS NAME^ '
|
|---|
| 123 | ;workaround for GT.M
|
|---|
| 124 | S ^XUTL("XUSYS",$J,0)=$H,^("NM")=X,^("PID")=$$FUNC^%DH($J)
|
|---|
| 125 | Q
|
|---|
| 126 | ;
|
|---|
| 127 | SID() ;System ID
|
|---|
| 128 | N J1,T S T="~"
|
|---|
| 129 | S J1(1)=$ZROUTINES
|
|---|
| 130 | S J1(2)=$ZGBLDIR
|
|---|
| 131 | Q "1~"_J1(1)_T_J1(2)
|
|---|
| 132 | ;
|
|---|
| 133 | PRI() ;Check if a mixed OS enviroment.
|
|---|
| 134 | ;Default return 1 unless we are on the secondary OS.
|
|---|
| 135 | ;Only Cache on a VMS/Linux mix is supported now.
|
|---|
| 136 | Q 1
|
|---|
| 137 | ;
|
|---|
| 138 | T0 ; start RT clock
|
|---|
| 139 | Q
|
|---|
| 140 | ;
|
|---|
| 141 | T1 ; store RT datum, Obsolete
|
|---|
| 142 | Q
|
|---|
| 143 | ;
|
|---|
| 144 | ;Code moved to %ZOSVKR, Comment out if needed.
|
|---|
| 145 | LOGRSRC(OPT,TYPE,STATUS) ;record resource usage in ^XTMP("KMPR"
|
|---|
| 146 | Q:'$G(^%ZTSCH("LOGRSRC")) ; quit if RUM not turned on.
|
|---|
| 147 | ; call to RUM routine.
|
|---|
| 148 | D RU^%ZOSVKR($G(OPT),$G(TYPE),$G(STATUS))
|
|---|
| 149 | Q
|
|---|
| 150 | ;
|
|---|
| 151 | SETTRM(X) ;Turn on specified terminators.
|
|---|
| 152 | U $I:TERM=X
|
|---|
| 153 | Q 1
|
|---|
| 154 | ;
|
|---|
| 155 | DEVOK ;
|
|---|
| 156 | ;INPUT: X=Device $I, X1=IOT -- X1 needed for resources
|
|---|
| 157 | ;OUTPUT: Y=0 if available, Y=job # if owned
|
|---|
| 158 | ; Y=-1 if device does not exists.
|
|---|
| 159 | ; return Y=0 if not owned, Y=$J of owning job, Y=999 if dev cycling
|
|---|
| 160 | ;
|
|---|
| 161 | S Y=0,X1=$G(X1) Q:(X1="HFS")!(X1="MT")!(X1="CHAN")
|
|---|
| 162 | I X1="RES" G RESOK^%ZIS6
|
|---|
| 163 | S Y=0
|
|---|
| 164 | Q ;Let ZIS deal with it.
|
|---|
| 165 | ;
|
|---|
| 166 | Q
|
|---|
| 167 | LPC(X) ;ZCRC(X)
|
|---|
| 168 | N R,I
|
|---|
| 169 | S R=$ZBITSTR(8,0)
|
|---|
| 170 | F I=1:1:$L(X) S R=$ZBITXOR(R,$C(0)_$E(X,I))
|
|---|
| 171 | Q $A(R,2)
|
|---|
