| 1 | %ZTMS2 ;SEA/RDS-TaskMan: Submanager, Part 4 (Unload, Get Device) ;11/12/2003 12:59
|
---|
| 2 | ;;8.0;KERNEL;**2,18,23,36,67,118,127,163,167,175,199,275**;Jul 10, 1995
|
---|
| 3 | ;^%ZTSK(ZTSK),^%ZTSCH("DEV",IO) is locked on entry or return from GETNEXT
|
---|
| 4 | PROCESS ;SUBMGR--process task and all others waiting for same device
|
---|
| 5 | L +^%ZTSCH("TASK",ZTSK):1 I '$T Q ;Only allow one copy of a task at one time
|
---|
| 6 | D LOOKUP I $D(ZTREJECT) Q
|
---|
| 7 | D DEVICE
|
---|
| 8 | I POP L Q ;Release all locks
|
---|
| 9 | I ZTSYNCFL]"",'$$SYNCFLG("A",ZTSYNCFL,%ZTIO) D Q
|
---|
| 10 | . D SYNCQ(ZTSYNCFL,%ZTIO,ZTDTH,ZTSK),^%ZISC L ;Release all locks
|
---|
| 11 | . Q
|
---|
| 12 | ;Go run task
|
---|
| 13 | D TASK^%ZTMS3 I ZTYPE="C"!$D(ZTNONEXT) Q
|
---|
| 14 | D GETNEXT^%ZTMS7 I $D(ZTNONEXT)!$D(ZTQUIT) Q
|
---|
| 15 | G PROCESS
|
---|
| 16 | ;
|
---|
| 17 | LOOKUP ;PROCESS--unload task, switch ucis, and test entry routine
|
---|
| 18 | K (%ZTIME,%ZTIO,DT,IO,U,ZTCPU,ZTDEVN,ZTDTH,ZTNODE,ZTPAIR,ZTPFLG,ZTQUEUED,ZTSK,ZTUCI,ZTYPE)
|
---|
| 19 | D TSKSTAT(4,"")
|
---|
| 20 | S ZTREC=^%ZTSK(ZTSK,0),ZTREC02=^(.02)
|
---|
| 21 | S ZTREC2=^%ZTSK(ZTSK,.2),ZTREC21=^(.21),ZTREC25=^(.25)
|
---|
| 22 | S ZTSYNCFL=$P(ZTREC2,"^",7),DUZ=+$P(ZTREC,U,3),DUZ(0)="@"
|
---|
| 23 | S X=$P(ZTREC02,U)_","_$P(ZTREC02,U,2)
|
---|
| 24 | I $P(ZTREC02,U,4) S $P(X,",",2)=ZTCPU
|
---|
| 25 | ;should do a check to see if X is OK, Should check UCI mapping.
|
---|
| 26 | I X'=ZTUCI S ZTUCI=X D SWAP^%XUCI
|
---|
| 27 | S X=$P($P(ZTREC,U,2),"("),ZTRTN=$P(ZTREC,U,1,2)
|
---|
| 28 | I $E(X)'="%",$L(X) X ^%ZOSF("TEST") I X=""!'$T D REJECT S ZTREJECT=""
|
---|
| 29 | Q
|
---|
| 30 | ;
|
---|
| 31 | REJECT ;LOOKUP--entry routine isn't here; reject task
|
---|
| 32 | N Y X ^%ZOSF("UCI")
|
---|
| 33 | D TSKSTAT("B","No routine at destination "_Y_".")
|
---|
| 34 | I $D(ZTDEVN) D DEVLK^%ZTMS1(-1,%ZTIO) K ZTDEVN
|
---|
| 35 | L Q ;Clear all locks
|
---|
| 36 | ;
|
---|
| 37 | DEVICE ;PROCESS--prepare requested device; if can't, make task wait
|
---|
| 38 | ;First clean-up all IO variables that could influence the device
|
---|
| 39 | K %ZIS,IO,IOCPU,IOHG,IOPAR,IOUPAR,IOS
|
---|
| 40 | ;If don't need a device, Setup minimum.
|
---|
| 41 | S ZTIO=$P(ZTREC2,U),ZTIOT=$P(ZTREC2,U,3)
|
---|
| 42 | I ZTIO="" S (IO,IO(0),IOF,IOM,ION,IOS,IOSL,IOST,IOT)="",POP=0 Q
|
---|
| 43 | ;
|
---|
| 44 | ;setup call
|
---|
| 45 | S %ZIS="LRS0"_$S($P(ZTREC2,U,5)="DIRECT":"D",1:"")
|
---|
| 46 | S:ZTIOT="HFS" %ZIS("HFSIO")=$P(ZTREC2,U,6),%ZIS("IOPAR")=ZTREC25
|
---|
| 47 | S:ZTIOT="MT" %ZIS("IOPAR")=ZTREC25
|
---|
| 48 | S (IO,IO(0))=%ZTIO,IOP=ZTIO
|
---|
| 49 | S:'$D(^%ZTSCH("DEVTRY",$P(ZTIO,";"))) ^($P(ZTIO,";"))=%ZTIME ;Set problem device check
|
---|
| 50 | K ^XUTL("XQ",$J),IO("ERROR")
|
---|
| 51 | ;
|
---|
| 52 | S:$P(ZTREC2,U,4)["MINIOUT" %ZISLOCK="^%ZTSCH(""NETMAIL"",IO)" ;The hang is on the close
|
---|
| 53 | ;call
|
---|
| 54 | S %ZISTO=3 D ^%ZIS K %ZISTO,%ZISLOCK ;See that we use a timeout.
|
---|
| 55 | I %ZTIO]"" D DEVLK^%ZTMS1(-1,%ZTIO) K ZTDEVN
|
---|
| 56 | I 'POP K ^%ZTSCH("DEVTRY",IO),^($P(ZTIO,";")) ;Clear problem device check
|
---|
| 57 | ;Reset %ZTIO if IO doesn't match
|
---|
| 58 | I 'POP,%ZTIO]"",IO'=%ZTIO C %ZTIO K IO(1,%ZTIO),^%ZTSCH("DEVTRY",$P(%ZTIO,";")) S %ZTIO=IO
|
---|
| 59 | ;
|
---|
| 60 | ;results
|
---|
| 61 | I POP,(ZTYPE'="C"),(ZTIOT="TRM")!(ZTIOT="RES")!(ZTIOT="HG") D IONQ Q ;only add to IO queue if not type C.
|
---|
| 62 | I POP D SCHNQ Q
|
---|
| 63 | I IOT'="RES",IOT'="HG" U IO
|
---|
| 64 | S IO(0)=IO
|
---|
| 65 | I $P(^%ZIS(1,+IOS,0),U,7)="y" D ^%ZTMSH
|
---|
| 66 | Q
|
---|
| 67 | ;
|
---|
| 68 | IONQ ;DEVICE--put task on Device Waiting List
|
---|
| 69 | I $D(^%ZTSK(ZTSK,0))[0 D TSKSTAT("I",4) G IOQX
|
---|
| 70 | D TSKSTAT("A","")
|
---|
| 71 | N %ZTIO S %ZTIO=IO
|
---|
| 72 | S ZTIO(1)=$P(ZTREC2,U,5),ZTIOS=ZTREC21
|
---|
| 73 | D NQ^%ZTM4 ;Uses %ZTIO as the Device $I value
|
---|
| 74 | IOQX L Q ;Clear all Locks
|
---|
| 75 | ;
|
---|
| 76 | SCHNQ ;DEVICE--if HFS or SPL or TYPE'=C, reschedule task 10 min in future (try later)
|
---|
| 77 | S ZTH=$$NEWH($H,300)
|
---|
| 78 | D TSKSTAT(1,"rescheduled for busy device")
|
---|
| 79 | S $P(^%ZTSK(ZTSK,.2),U,8)=$P(^%ZTSK(ZTSK,.2),U,8)+1 ;ReQ count
|
---|
| 80 | D SCHTM(ZTH)
|
---|
| 81 | I $L($G(IO("ERROR"))) S $P(^%ZTSK(ZTSK,.12),U,2,9)=$H_U_IO("ERROR") ;May tell why couldn't get device
|
---|
| 82 | L Q ;Clear all locks
|
---|
| 83 | ;
|
---|
| 84 | SCHTM(ZTDTH) ;Set a new schedule time, See that task is updated
|
---|
| 85 | S $P(^%ZTSK(ZTSK,0),U,6)=$$H0^%ZTM(ZTDTH),^%ZTSK(ZTSK,.04)=ZTDTH,^%ZTSCH(ZTDTH,ZTSK)=""
|
---|
| 86 | Q
|
---|
| 87 | NEWH(%H,%Y) ;Build a new schedule time, Return $H3 time.
|
---|
| 88 | N %
|
---|
| 89 | I %H["," S %H=$$H3^%ZTM(%H)
|
---|
| 90 | Q (%H+%Y)
|
---|
| 91 | ;
|
---|
| 92 | SYNCFLG(ACT,FLAG,ZIO,STAT) ;Allocate/deallocate sync flag
|
---|
| 93 | N X,DA,SYNC
|
---|
| 94 | L +^%ZISL(14.8):30 E Q 0
|
---|
| 95 | S X=0,SYNC=FLAG_"~"_ZIO,DA=$O(^%ZISL(14.8,"B",SYNC,0))
|
---|
| 96 | I ACT["A" D
|
---|
| 97 | . I DA S X=0 Q
|
---|
| 98 | . ;I $D(^%ZTSCH("SYNC",ZIO,FLAG)) S X=0 Q
|
---|
| 99 | . S X=$P(^%ZISL(14.8,0),"^",3)+1 F Q:'$D(^%ZISL(14.8,X)) S X=X+1
|
---|
| 100 | . S $P(^(0),"^",3,4)=X_"^"_($P(^%ZISL(14.8,0),"^",4)+1),^%ZISL(14.8,X,0)=SYNC,^%ZISL(14.8,"B",SYNC,X)=""
|
---|
| 101 | . S X=1 Q
|
---|
| 102 | I ACT["D" D S X=1
|
---|
| 103 | . Q:DA'>0
|
---|
| 104 | . K ^%ZISL(14.8,DA),^%ZISL(14.8,"B",SYNC,DA)
|
---|
| 105 | . S $P(^(0),"^",3,4)=(DA-1)_"^"_($P(^%ZISL(14.8,0),"^",4)-1)
|
---|
| 106 | . Q
|
---|
| 107 | I ACT["S" D S X=1
|
---|
| 108 | . Q:DA'>0
|
---|
| 109 | . S ^%ZISL(14.8,DA,1)=$G(STAT)
|
---|
| 110 | . Q
|
---|
| 111 | I ACT["?" S X=(DA)!($D(^%ZTSCH("SYNC",ZIO,FLAG)))
|
---|
| 112 | L -^%ZISL(14.8)
|
---|
| 113 | Q X
|
---|
| 114 | ;
|
---|
| 115 | SYNCQ(FLAG,ZIO,ZTH,ZTSK) ;Put task on sync flag waiting list
|
---|
| 116 | L +^%ZTSCH("SYNC")
|
---|
| 117 | S ^%ZTSCH("SYNC",ZIO,FLAG,ZTSK)=ZTH
|
---|
| 118 | L -^%ZTSCH("SYNC")
|
---|
| 119 | Q
|
---|
| 120 | SCHSYNC(FLAG,ZIO) ;put a waiting task in IO queue
|
---|
| 121 | L +^%ZTSCH("SYNC") I $D(^%ZTSCH("SYNC",ZIO,FLAG)) N ZTH,ZTSK D
|
---|
| 122 | . S ZTSK=$O(^(FLAG,0)),ZTH=$G(^(+ZTSK)) Q:ZTSK="" S:$D(^%ZTSCH("IO",ZIO))[0 ^(ZIO)=IOT
|
---|
| 123 | . S ^%ZTSCH("IO",ZIO,ZTH,ZTSK)=""
|
---|
| 124 | . K ^%ZTSCH("SYNC",ZIO,FLAG,ZTSK)
|
---|
| 125 | . Q
|
---|
| 126 | L -^%ZTSCH("SYNC")
|
---|
| 127 | Q
|
---|
| 128 | TSKSTAT(CODE,MSG) ;Record status
|
---|
| 129 | S $P(^%ZTSK(ZTSK,.1),U,1,3)=$G(CODE)_U_$H_U_$G(MSG)
|
---|
| 130 | Q
|
---|
| 131 | ;
|
---|
| 132 | POST ;Post INIT cleanup for patch XU*8*167
|
---|
| 133 | N T S T=0
|
---|
| 134 | F S T=$O(^%ZTSCH(T)) Q:T'>0 I $D(^%ZTSCH(T,0)) K ^%ZTSCH(T,0)
|
---|
| 135 | Q
|
---|