%ZTM6 ;SEA/RDS-TaskMan: Manager, Part 8 (Load Balancing) ;07/01/08 15:46
;;8.0;KERNEL;**23,118,127,136,355,446**;JUL 10, 1995;Build 35
;Per VHA Directive 2004-038, this routine should not be modified.
;
BALANCE ;CHECK^%ZTM--determine whether cpu should wait for balance
;Return ZTOVERLD =1 if need to wait, 0 to run
;The TM with the largest value sets ^%ZTSCH("LOAD")=who^value^when p446
;If your value is greater or equal then you run.
;If your value is less you wait unless you set LOAD then you run.
;Tell sub-managers by setting ^%ZTSCH("LOADA",%ZTPAIR)=run^value^time^$J
;Use %ZTLKTM for lock timeout
S ZTOVERLD=0 ;p446 Default
TSTART
L +^%ZTSCH("LOAD"):(%ZTLKTM+1) E TROLLBACK Q ;p446 Keep working if can't get lock
N X,ZTIME,ZTLEFT,ZTPREV
N $ES,$ET S $ET="Q:$ES>0 D ERR^%ZTM6"
S ZTOVERLD=0,ZTPREV=+$P($G(^%ZTSCH("LOAD")),"^",2),ZTIME=$$H3($H)
S @("ZTLEFT="_%ZTPFLG("BAL"))
S ZTIME=$$H3($H),ZTOVERLD=$$COMPARE(%ZTPAIR,ZTLEFT,ZTPREV)
;If we are RUNNING have other submanagers wait
I 'ZTOVERLD D
. S X="" F S X=$O(^%ZTSCH("LOADA",X)) Q:X="" S $P(^(X),"^")=1 ;Have others wait
. S ^%ZTSCH("LOAD")=%ZTPAIR_"^"_ZTLEFT_"^"_ZTIME
;Now set a value that is used by our %ZTMS to run/wait also
S ^%ZTSCH("LOADA",%ZTPAIR)=ZTOVERLD_"^"_ZTLEFT_"^"_ZTIME_"^"_$J
L -^%ZTSCH("LOAD")
TCOMMIT
Q
;
STOPWT() ;See if we should stop Balance wait, Called from %ZTM.
L +^%ZTSCH("LOAD"):%ZTLKTM Q:'$T 1 ;Run if can't get lock
N I,J S I="",J=1
F S I=$O(^%ZTSCH("LOADA",I)) Q:I="" I '^(I) S J=0
L -^%ZTSCH("LOAD")
Q J ;Return: 1 stop waiting, 0 keep waiting. (Someone is in run state)
;
CHECK ;Called when job limit reached.
;If not doing balancing, remove node and quit
N I,J,K
I %ZTPFLG("BAL")="" K ^%ZTSCH("LOADA",%ZTPAIR) Q
L +^%ZTSCH("LOAD"):%ZTLKTM Q:'$T ;Get it next time
;If at job limit see if sub-managers should run
S I=$P($G(^%ZTSCH("LOAD")),"^",2),J=$P($G(^%ZTSCH("LOADA",%ZTPAIR)),"^",2)
S K=(J<I),$P(^%ZTSCH("LOADA",%ZTPAIR),"^",1)=K
L -^%ZTSCH("LOAD")
Q
;
COMPARE(ID,ZTLEFT,ZTPREV) ;
;BALANCE--compare our cpu capacity left to that of previous checker
;input: cpu name, cpu capacity left, cpu capacity of previous checker
;output: whether current cpu should wait, 0=run, 1=wait
N X
I ZTLEFT'<ZTPREV Q 0
S X=^%ZTSCH("LOAD")
I $P(X,"^",3)+(%ZTPFLG("BI")+5)<ZTIME Q 0
Q $P(X,"^")'[ID
;
ERR ;Clean up if error
S %ZTPFLG("EBAL")=1+$G(%ZTPFLG("EBAL")),ZTOVERLD=0
I $G(%ZTPFLG("EBAL"))>10 D ^%ZTER S %ZTPFLG("BAL")="" ;Only stop after 10 errors ;p446
S $EC=""
;TROLLBACK
L -^%ZTSCH("LOAD")
Q
;
H3(%) ;Convert $H to seconds
Q 86400*%+$P(%,",",2)
;
VXD(BIAS) ;--algorithm for VAX DSM
;Capacity Left=Available Jobs + BIAS
Q $$AVJ^%ZOSV()+$G(BIAS)
;
MSM4() ;Use MSMv4 LAT calcuation
N MAXJOB,CURJOB
X "S MAXJOB=$V($V(3,-5),-3,0),CURJOB=$V(168,-4,2)"
Q MAXJOB-CURJOB*255\MAXJOB
;
CACHE1(BIAS) ;Use available jobs
N CUR,MAX
Q $$AVJ^%ZOSV()+$G(BIAS)
;
CACHE2(%COM,%LOG) ;Cache, Pull metric data
N TMP,$ET
S $ETRAP="S $ECODE="""" Q ZTPREV"
S %LOG=$G(%LOG,"VISTA$METRIC")
I $L($G(%COM)) S TMP=$ZF(-1,%COM)
Q $ZF("TRNLNM",%LOG)
;
RNDRBN() ;Round Robin
;value^node^time
N R,R2
L +^%ZTSCH("RNDRBN"):$G(%ZTLKTM,1)
S R=$G(^%ZTSCH("RNDRBN"))
I $P(R,U,2)=%ZTPAIR S R2=+R G RX
I ZTIME<$P(R,U,3) S R2=R-1 G RX
S R2=R+2#512,^%ZTSCH("RNDRBN")=R2_U_%ZTPAIR_U_(ZTIME+%ZTPFLG("BI"))
RX L -^%ZTSCH("RNDRBN")
Q R2
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HZTM6 3470 printed Apr 09, 2024@21:11:12 Page 2
%ZTM6 ;SEA/RDS-TaskMan: Manager, Part 8 (Load Balancing) ;07/01/08 15:46
+1 ;;8.0;KERNEL;**23,118,127,136,355,446**;JUL 10, 1995;Build 35
+2 ;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
BALANCE ;CHECK^%ZTM--determine whether cpu should wait for balance
+1 ;Return ZTOVERLD =1 if need to wait, 0 to run
+2 ;The TM with the largest value sets ^%ZTSCH("LOAD")=who^value^when p446
+3 ;If your value is greater or equal then you run.
+4 ;If your value is less you wait unless you set LOAD then you run.
+5 ;Tell sub-managers by setting ^%ZTSCH("LOADA",%ZTPAIR)=run^value^time^$J
+6 ;Use %ZTLKTM for lock timeout
+7 ;p446 Default
SET ZTOVERLD=0
+8 TSTART
+9 ;p446 Keep working if can't get lock
LOCK +^%ZTSCH("LOAD"):(%ZTLKTM+1)
IF '$TEST
TROLLBACK
QUIT
+10 NEW X,ZTIME,ZTLEFT,ZTPREV
+11 NEW $ESTACK,$ETRAP
SET $ETRAP="Q:$ES>0 D ERR^%ZTM6"
+12 SET ZTOVERLD=0
SET ZTPREV=+$PIECE($GET(^%ZTSCH("LOAD")),"^",2)
SET ZTIME=$$H3($HOROLOG)
+13 SET @("ZTLEFT="_%ZTPFLG("BAL"))
+14 SET ZTIME=$$H3($HOROLOG)
SET ZTOVERLD=$$COMPARE(%ZTPAIR,ZTLEFT,ZTPREV)
+15 ;If we are RUNNING have other submanagers wait
+16 IF 'ZTOVERLD
Begin DoDot:1
+17 ;Have others wait
SET X=""
FOR
SET X=$ORDER(^%ZTSCH("LOADA",X))
if X=""
QUIT
SET $PIECE(^(X),"^")=1
+18 SET ^%ZTSCH("LOAD")=%ZTPAIR_"^"_ZTLEFT_"^"_ZTIME
End DoDot:1
+19 ;Now set a value that is used by our %ZTMS to run/wait also
+20 SET ^%ZTSCH("LOADA",%ZTPAIR)=ZTOVERLD_"^"_ZTLEFT_"^"_ZTIME_"^"_$JOB
+21 LOCK -^%ZTSCH("LOAD")
+22 TCOMMIT
+23 QUIT
+24 ;
STOPWT() ;See if we should stop Balance wait, Called from %ZTM.
+1 ;Run if can't get lock
LOCK +^%ZTSCH("LOAD"):%ZTLKTM
if '$TEST
QUIT 1
+2 NEW I,J
SET I=""
SET J=1
+3 FOR
SET I=$ORDER(^%ZTSCH("LOADA",I))
if I=""
QUIT
IF '^(I)
SET J=0
+4 LOCK -^%ZTSCH("LOAD")
+5 ;Return: 1 stop waiting, 0 keep waiting. (Someone is in run state)
QUIT J
+6 ;
CHECK ;Called when job limit reached.
+1 ;If not doing balancing, remove node and quit
+2 NEW I,J,K
+3 IF %ZTPFLG("BAL")=""
KILL ^%ZTSCH("LOADA",%ZTPAIR)
QUIT
+4 ;Get it next time
LOCK +^%ZTSCH("LOAD"):%ZTLKTM
if '$TEST
QUIT
+5 ;If at job limit see if sub-managers should run
+6 SET I=$PIECE($GET(^%ZTSCH("LOAD")),"^",2)
SET J=$PIECE($GET(^%ZTSCH("LOADA",%ZTPAIR)),"^",2)
+7 SET K=(J<I)
SET $PIECE(^%ZTSCH("LOADA",%ZTPAIR),"^",1)=K
+8 LOCK -^%ZTSCH("LOAD")
+9 QUIT
+10 ;
COMPARE(ID,ZTLEFT,ZTPREV) ;
+1 ;BALANCE--compare our cpu capacity left to that of previous checker
+2 ;input: cpu name, cpu capacity left, cpu capacity of previous checker
+3 ;output: whether current cpu should wait, 0=run, 1=wait
+4 NEW X
+5 IF ZTLEFT'<ZTPREV
QUIT 0
+6 SET X=^%ZTSCH("LOAD")
+7 IF $PIECE(X,"^",3)+(%ZTPFLG("BI")+5)<ZTIME
QUIT 0
+8 QUIT $PIECE(X,"^")'[ID
+9 ;
ERR ;Clean up if error
+1 SET %ZTPFLG("EBAL")=1+$GET(%ZTPFLG("EBAL"))
SET ZTOVERLD=0
+2 ;Only stop after 10 errors ;p446
IF $GET(%ZTPFLG("EBAL"))>10
DO ^%ZTER
SET %ZTPFLG("BAL")=""
+3 SET $ECODE=""
+4 ;TROLLBACK
+5 LOCK -^%ZTSCH("LOAD")
+6 QUIT
+7 ;
H3(%) ;Convert $H to seconds
+1 QUIT 86400*%+$PIECE(%,",",2)
+2 ;
VXD(BIAS) ;--algorithm for VAX DSM
+1 ;Capacity Left=Available Jobs + BIAS
+2 QUIT $$AVJ^%ZOSV()+$GET(BIAS)
+3 ;
MSM4() ;Use MSMv4 LAT calcuation
+1 NEW MAXJOB,CURJOB
+2 XECUTE "S MAXJOB=$V($V(3,-5),-3,0),CURJOB=$V(168,-4,2)"
+3 QUIT MAXJOB-CURJOB*255\MAXJOB
+4 ;
CACHE1(BIAS) ;Use available jobs
+1 NEW CUR,MAX
+2 QUIT $$AVJ^%ZOSV()+$GET(BIAS)
+3 ;
CACHE2(%COM,%LOG) ;Cache, Pull metric data
+1 NEW TMP,$ETRAP
+2 SET $ETRAP="S $ECODE="""" Q ZTPREV"
+3 SET %LOG=$GET(%LOG,"VISTA$METRIC")
+4 IF $LENGTH($GET(%COM))
SET TMP=$ZF(-1,%COM)
+5 QUIT $ZF("TRNLNM",%LOG)
+6 ;
RNDRBN() ;Round Robin
+1 ;value^node^time
+2 NEW R,R2
+3 LOCK +^%ZTSCH("RNDRBN"):$GET(%ZTLKTM,1)
+4 SET R=$GET(^%ZTSCH("RNDRBN"))
+5 IF $PIECE(R,U,2)=%ZTPAIR
SET R2=+R
GOTO RX
+6 IF ZTIME<$PIECE(R,U,3)
SET R2=R-1
GOTO RX
+7 SET R2=R+2#512
SET ^%ZTSCH("RNDRBN")=R2_U_%ZTPAIR_U_(ZTIME+%ZTPFLG("BI"))
RX LOCK -^%ZTSCH("RNDRBN")
+1 QUIT R2
