source: WorldVistAEHR/trunk/r/KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/_ZTMS2.m@ 623

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

initial load of WorldVistAEHR

File size: 4.9 KB
Line 
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
4PROCESS ;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 ;
17LOOKUP ;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 ;
31REJECT ;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 ;
37DEVICE ;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 ;
68IONQ ;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
74IOQX L Q ;Clear all Locks
75 ;
76SCHNQ ;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 ;
84SCHTM(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
87NEWH(%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 ;
92SYNCFLG(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 ;
115SYNCQ(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
120SCHSYNC(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
128TSKSTAT(CODE,MSG) ;Record status
129 S $P(^%ZTSK(ZTSK,.1),U,1,3)=$G(CODE)_U_$H_U_$G(MSG)
130 Q
131 ;
132POST ;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
Note: See TracBrowser for help on using the repository browser.