!09-09-85..statistics gathering for auscom !05-09-85..use tio in case mag tape off-line..sh %include "ercc07:ibmsup_comf370" %include "ercc07:ibmsup_page0f" %include "ercc07:ibmsup_dtform1s" %include "ercc07:IBMSUP_xaioform" %record %format PARMF(%integer DEST,SRCE,(%integer P1,P2,P3,P4,P5, P6 %or %string (23) TEXT)) %record %format PARMXF(%integer DEST,SRCE,P1,P2,P3,P4,P5,P6,LINK) %if VA MODE=YES %start %const %record (PARMXF) %array %name PARM=PARM0AD %finish %else %start !* %externalintegerspec parmad %own %record (PARMXF) %array %name PARM !* %ownrecord(parmxf)%arrayformat parmaf(0:128) %finish ! %external %integer %fn %spec REALISE(%integer VAD) %external %integer %fn %spec HSCH(%integer SLOTADDR) %external %integer %fn %spec TSCH(%integer SLOTADDR, %record (IRBF) %name IRB) %external %integer %fn %spec SSCH(%integer SLOTADDR,CCWA,KEY) %external %integer %fn %spec STSCH(%integer SLOTADDR, %record (SCHIBF) %name SCHIB) %external %integer %fn %spec MSCH(%integer SLOTADDR, %record (SCHIBF) %name SCHIB) %external %string %fn %spec HTOS(%integer N,P) %external %integer %fn %spec NEW PP CELL %external %routine %spec RETURN PP CELL(%integer CELL) %external %routine %spec PON(%record (PARMF) %name P) %external %routine %spec DUMPTABLE(%integer TABNO,ADDR,LEN) %external %routine %spec OPMESS(%string (63) S) %external %routine %spec PKMONREC(%string (23) TEXT, %record (PARMF) %name P) %if MULTI OCP=YES %start %external %routine %spec SEMALOOP(%integer %name SEMA) %finish ! !------------------------------------------------------------------------ ! %record %format SLOTF(%byte %integer SPB0,DEVTYPE,SPB1,SPB2, %integer SP1, SP2,DEV ENTA,ALT CUU,CUU,MNEM, %byte %integer SPB3,SPB4,SPB5,QSTATE) %record %format CQF(%integer ADSLOT,CCWA,P1,P2,P3,P4,P5,P6,LINK) ! %external %routine DEVIO(%record (PARMF) %name P) %const %string (3) VSN="12" %const %string (9) VDATE= " 31/08/86" %external %long %integer %spec KMON %routine %spec DUMP STATISTICS %routine %spec FAIL TRANSFER(%record (SLOTF) %name DSLOT) %integer %fn %spec FIND(%integer MNEM) %string %fn %spec MTOS(%integer M) %routine %spec Q REQUEST(%integer CCWA,NEWSTATE,COUNT) %routine %spec PSEUDO TERM(%record (SLOTF) %name DLOT, %integer CSW1,CSW2) %routine %spec TREPLY(%record (DTFORM) %name DEV, %integer P4) %routine %spec FIRE QUEUED(%integer CHAN) %integer %fn %spec FIRE(%record (SLOTF) %name DSLOT, %record (IRBF) %name IRB, %integer CCWA,KEY,COUNT,TIME) %record (CQF) %name CQ %record (SLOTF) %name DSLOT %record (DTFORM) %name DEV %record (PARMF) Q %own %integer SETUP=NO,DSLOT BASE,LAST SLOT %own %integer MON=0,MCHAN=0 %integer I,J,K,DACT,FLAG,SLOT,CCWA,KEY,FIRE CHAN,DUMMY %record (SCHIBF) SCHIB %record (IRBF) IRB %switch ACT(0:15),INTSW(0:6) %string(4)s %const %string (9) %array STATES(0:6)="not alloc", "ready","req fired","sns fired","queued","sens qu'd","discncted" %const %integer ATTN=x'80000000' %const %integer BUSY=x'10000000' %const %integer CHANEND=x'08000000' %const %integer CHAN ERR=x'000f0000' %const %integer CUEND=x'20000000' %const %integer DEVEND=x'04000000' %const %integer DEVIO DEST=x'300000' %const %integer DISCONNECTED=6 %const %integer ERR MASK=x'ffff0000'!!(ATTN!CHANEND!CUEND!DEVEND) %const %integer FE=14 %const %integer LOID=x'6e' %const %integer LP=6 %const %integer MT=5 %const %integer NOT ALLOCATED=0 %const %integer OK=0 %const %integer OP=8 %const %integer QUEUED=4 %const %integer READY=1 %const %integer REQUEST FIRED=2 %const %integer SENSE FIRED=3 %const %integer SENSE QUEUED=5 %const %integer SLOT SIZE=32 %const %integer SMOD=x'40000000' %const %integer TICK INTERVAL=1 %const %integer UNIT CHECK=x'02000000' %const %integer NOSTARTMASK=x'ffff0000'!!(BUSY!SMOD!CUEND) ! !statistics gathering %own %integer STATSDEV=x'050'; ! FE2 as default %own %integer SDVS=0 %const %integer SDVSTOP=100000; !stop statistics after 100000 %const %integer SDVMAX=100 %own %integer %array SDVTIMES(0:SDVMAX)=0(*) %own %integer liptr %own %record (parmf) %array lastints(0:7)=0(*) ! ! %if KMON>>48&1#0 %then PKMONREC("Devio:",P) DACT = P_DEST&255 ->ACT(DACT) ! ACT(0): !dump statistics DUMP STATISTICS %return ! ACT(2): ! initialise %return %unless SETUP=NO %if VA MODE=NO %then COM == RECORD(P_P3); ! in Chopsupe J = COM_SLDEVTAB AD INTEGER(J+8) = P_P2; ! process picture space %if MCHAN=0 %then MCHAN = INTEGER(J+16) %unless MCHAN=0 %then MON = 1 DSLOT BASE = J+INTEGER(J+4) LASTSLOT = COM_NSLDEVS-1 %for I = 0,1,LASTSLOT %cycle DSLOT == RECORD(DSLOT BASE+I*SLOT SIZE) DEV == RECORD(DSLOT_DEV ENTA) DEV_ISERV = DEVIO DEST!3 DEV_SLOT = I DSLOT_QSTATE = NOT ALLOCATED DEV_REPSNO = 0 %if XA=YES %start J = STSCH(DSLOT_DEV ENTA,SCHIB) %if J=0 %start SCHIB_FLAGS = SCHIB_FLAGS!x'0080'; ! make operable SCHIB_IP = DSLOT_DEV ENTA J = MSCH(DSLOT_DEV ENTA,SCHIB) %finish %if CCW Format=1 %start integer(dev_ua ad-8)=X'04200018'; ! sense to format1 integer(dev_ua ad-4)=realise(addr(dev_sense1)) %finish %finish %if DSLOT_DEVTYPE=OP %start K = DSLOT_MNEM&15 P = 0 P_DEST = x'30000b'; ! allocate P_SRCE = x'320002'!K<<8 P_P1 = DSLOT_MNEM P_P2 = x'320005'!K<<8 PON(P) %finish %else %if DSLOT_DEVTYPE=FE %start %if VA MODE=YES %then %start; !not for chopsupy..sh P = 0 P_DEST = x'30000b' P_SRCE = x'390002' P_P1 = DSLOT_MNEM P_P2 = x'390005' PON(P) %finish %finish %else %if DSLOT_DEVTYPE=MT %start P = 0 P_DEST = x'310004' P_SRCE = x'300000' P_P1 = DSLOT_MNEM PON(P) %finish %repeat PRINTSTRING("DEVIO ".VSN.VDATE) NEWLINE ! PRINTSTRING("DEVIO's tables:-") ! DUMPTABLE(0,COM_SLDEV TABAD,INTEGER(COM_SLDEV TABAD)) P_DEST = x'a0001'; ! clock tick P_SRCE = 0 P_P1 = x'300006' P_P2 = TICK INTERVAL PON(P) %return ! ACT(11): ! allocate %unless FIND(P_P1)<0 %start %if DSLOT_QSTATE=NOT ALLOCATED %start FLAG = 0 DSLOT_QSTATE = READY DEV_REPSNO = P_P2 P_P2 = LOID+SLOT P_P3 = ADDR(DEV) %if VA MODE=NO %then P_P4 = ADDR(COM); ! in Chopsupe P_P6 = DSLOT_MNEM %finish %else FLAG = 2 %finish %else FLAG = 1 ->ACK ! ACT(8): ! force allocate (call not pon) %unless FIND(P_P1)<0 %start %unless P_P1=m'LP' %and DSLOT_QSTATE=DISCONNECTED %start FLAG = 0 DSLOT_QSTATE = READY DEV_REPSNO = P_P2 P_P2 = LOID+SLOT P_P3 = DSLOT_DEV ENTA P_P6 = DSLOT_MNEM %finish %else FLAG = 2 %finish %else FLAG = 1 P_P1 = FLAG %return ! ACT(5): ! deallocate %unless P_P1=m'LP' %start %unless FIND(P_P1)<0 %start %if DSLOT_QSTATE=READY %start %if P_SRCE<<1>>17>63 %start; ! from user %if DEV_REPSNO>>16<64 %then FLAG = 4 %and ->FALL %finish DSLOT_QSTATE = NOT ALLOCATED P_P3 = DSLOT_DEV ENTA FLAG = 0 %finish %else FLAG = DSLOT_QSTATE<<16!3 %finish %else FLAG = 2 %finish %else FLAG = 1 FALL: ->ACK ! ACT(6): ! clock tick %for SLOT = 0,1,LASTSLOT %cycle DSLOT == RECORD(DSLOT BASE+SLOT*SLOT SIZE) %if DSLOT_QSTATE=REQUEST FIRED %or DSLOT_QSTATE=SENSE FIRED %start DEV == RECORD(DSLOT_DEV ENTA) DEV_STICK = DEV_STICK+TICK INTERVAL %if DEV_STICK>DEV_TIMEOUT %start OPMESS(MTOS(DSLOT_MNEM)." timed out") FAIL TRANSFER(DSLOT) %finish %finish %repeat ACT(14): FIRE QUEUED(-1); ! poke feps may be unnecessary %return ! ACT(3): ! interrupt ! ! parameters of the interrupt pon ! on non XA machines ! P_P1 = channel unit interupting ! P_P2 and P_P3 are the csw1&2 from page 0 ! P_P4 is the device slot via a chopsupe table ! ! on XA machines ! P_P1 is the IP which has the virtad of the device slot ! P_P2&P3 are words 1&2 of SCSW (very close to csw1&2) ! P_P4 is SCSW word 0 (no nonxa equivalent) ! P_P5 is the extended Subchannel status word ! lastints(liptr) = p; ! record last few ints to track funnies liptr = (liptr+1)&7 FIRE CHAN = 0; ! no channels freed by this term yet %if MON#0 %and 1<<(P_P1>>8)&MCHAN#0 %then PKMONREC("DEVIO int:",P) %if com_SCHANNELQ#0 %and P_SRCE=M'INT' {genuine int} %and (XA=YES %or %c P_P4=-1 %or P_P3&(CHANEND!CUEND)#0) %then FIRE CHAN = P_P1>>8 %if VAMODE=NO %then FIRE CHAN = -1; ! no clock tick in chopsupe %if P_P4=-1 %then ->INT END; ! channel available interrupt only %if XA=YES %start DEV == RECORD(P_P1) SLOT = DEV_SLOT DSLOT == RECORD(DSLOT BASE+SLOT*SLOT SIZE) %if DSLOT_DEVTYPE=OP %then P_P3 = P_P3&X'FEFFFFFF' %else SLOT = P_P4&x'7f' DSLOT == RECORD(DSLOT BASE+SLOT*SLOT SIZE) DEV == RECORD(DSLOT_DEV ENTA) %finish ! cuend is given when a controller ! of a sort controlling multiple devices ! comes free. It is always alleged to come from dev 0 ->INT END %if P_P3=CUEND %and (DSLOT_DEVTYPE=FE %or DSLOT_DEVTYPE=MT) ->INTSW(DSLOT_QSTATE) INTSW(SENSE QUEUED{5}): ! if a solitary device end or cuend comes separately ! from the rest of the termination DEV_CSW1 = DEV_CSW1!P_P2 DEV_CSW2 = DEV_CSW2!P_P3 ->INT END INTSW(QUEUED{4}): %if P_P3&ATTN#0 %start DEV_CSW1 = P_P2 DEV_CSW2 = P_P3 TREPLY(DEV,0); ! forward it to handler ->INT END %finish PRINTSTRING("DEVIO..interrupt while queued ") PKMONREC("Int rec:",P) NEWLINE INT END: ! exit from int sequence FIRE QUEUED(FIRE CHAN) %if FIRE CHAN#0 %return INTSW(READY{1}): ! assume charitably that this is an attentio ! and forward it to user. However sense ! must be done to clear down unsolici%c ted ! unit check (etc) INTSW(REQUEST FIRED{2}): DEV_CSW1 = P_P2 DEV_CSW2 = P_P3 %if P_P3&ERR MASK#0 %then %start; ! not normalterm DEV_STATS2 = DEV_STATS2+1; ! abterm so inc failure count %if DSLOT_DEVTYPE#FE %or p_p3&unit check#0 %start; ! lest we upset the DX11 ! I = REALISE(DEV_UA AD-8); ! do sense J = SSCH(DSLOT_DEV ENTA,I,X'80000000'); ! Flagged as a sense %if MON#0 %and 1<<(DSLOT_CUU>>8)&MCHAN#0 %and J#0 %then %c PRINTSTRING("Devio SENS nostart ".HTOS(J, 1)." Cuu ".HTOS(DSLOT_CUU,3)." ".HTOS(PAGE0_CSW2, 8)." ".HTOS(CCWA,8)." ") %if XA#YES %and (J=2 %or (J=1 %and PAGE0_CSW2&NOSTARTMASK=0)) %start KEY = 0 Q REQUEST(I,SENSE QUEUED,1) %return %finish DSLOT_QSTATE = SENSE FIRED DEV_STICK = 0 %if MON#0 %and 1<<(DSLOT_CUU>>8)&MCHAN#0 %then %c PRINTSTRING("DEVIO sense: ".HTOS(DSLOT_CUU,3)." ") %if J=0 %then %return %if J=1 %then %start %if xa=yes %then dummy = tsch(dslot_dev enta,irb) %else %c irb_csw1 = page0_csw1 %and irb_csw2 = page0_csw2 PSEUDOTERM(DSLOT,irb_CSW1,irb_CSW2) %finish %else PSEUDOTERM(DSLOT,DEV_CCWA,CHANERR!CHANEND!DEVEND!3) ->INT END %finish %finish TREPLY(DEV,0) DSLOT_QSTATE = READY %if DEV_CSW2&(CHANEND!DEVEND)#0 ->INT END INTSW(SENSE FIRED{3}): DEV == RECORD(DSLOT_DEV ENTA) %unless P_P3&(CHANEND!DEVEND)=CHANEND!DEVEND %then ->INTSW(SENSE QUEUED) ! check it really was sense ending %if P_P3&ERR MASK=0 %then J = 0 %else J = 1 TREPLY(DEV,J) DSLOT_QSTATE = READY ->INT END INTSW(*): PKMONREC("DEVIO int?:",P) %return ! ACT(12): ! execute request SLOT = P_P2&x'ffff'-LOID %unless 0<=SLOT<=LAST SLOT %then FLAG = 1 %and ->ACK DSLOT == RECORD(DSLOT BASE+SLOT*SLOT SIZE) %if MON#0 %and 1<<(DSLOT_CUU>>8)&MCHAN#0 %then %c PKMONREC("DEVIO req: ".HTOS(DSLOT_CUU,3),P) %and DUMPTABLE(0,P_P1,16) DEV == RECORD(DSLOT_DEV ENTA) CCWA = REALISE(P_P1); ! adddress KEY = P_P2>>28 %if byteinteger(p_p1)=x'04'{sense as first} %then key=key!X'80000000' %unless CCWA&7=0 %then FLAG = m'BCCW' %and P_P3 = P_P1 %and ->ACK %if DSLOT_QSTATE#READY %start FLAG = 2 P_P3 = ADDR(DEV) P_P6 = P_P4 ->ACK %finish DEV_CCWA = CCWA DEV_STICK = 0 DEV_ID = P_P4 DEV_STATS1 = DEV_STATS1+1; ! request count ! and drop thro' to fire the chain J = FIRE(DSLOT,IRB,CCWA,KEY,0,0) DSLOT_QSTATE = REQUEST FIRED %if J=0 %then %return %if J=2 %or (J=1 %and IRB_CSW2&NOSTARTMASK=0) %start; ! channel busy non xa only Q REQUEST(CCWA,QUEUED,1) %return %finish PSEUDOTERM(DSLOT,CCWA,IRB_CSW2); ! force a termination %return ! ACK: ! reply when transfer has not been started ! includes transfer rejections P_P1 = FLAG %if P_SRCE>0 %start P_DEST = P_SRCE P_SRCE = x'300000'!DACT PON(P) %if MON#0 %then PKMONREC("DEVIO ack:",P) %finish %return ! ACT(1): ! text %if P_TEXT="?" %start %for SLOT = 0,1,LASTSLOT %cycle DSLOT == RECORD(DSLOT BASE+SLOT*SLOT SIZE) dev==record(dslot_dev enta) %IF DEV_ALT CUU=0 %THEN S="none" %ELSE S=HTOS(DEV_ALT CUU,3) OPMESS(MTOS(DEV_MNEMONIC)." (".HTOS(DEV_CUU,3)."/".S.") ". %C STATES(DSLOT_QSTATE&15)) %repeat %finish %else %if P_TEXT="Q" %start J = COM_SCHANNELQ %while J>0 %cycle CQ == PARM(J) DSLOT == RECORD(CQ_ADSLOT) OPMESS(MTOS(DSLOT_MNEM)." ".STATES(DSLOT_QSTATE&15)) J = CQ_LINK %repeat %finish %else OPMESS("DEVIO ?? ".P_TEXT) %return ! ACT(10): %if VA MODE=NO %start; ! relocate tables for supervisor %for I = 0,1,LAST SLOT %cycle DSLOT == RECORD(DSLOT BASE+I*SLOT SIZE) DEV == RECORD(DSLOT_DEV ENTA) DSLOT_DEV ENTA = (DSLOT_DEV ENTA-P_P1)!COM SEG<>1))//SDVS; !rounded WRITE(KK,4); !percent KK = (SUBTOTAL*100+(SDVS>>1))//SDVS; !subtotal % rounded WRITE(KK,4); !subtotal percent NEWLINE %exit %if SUBTOTAL=SDVS; !rest must be zero %repeat %finish SDVS = 0; !clear statistics %cycle II = 0,1,SDVMAX SDVTIMES(II) = 0 %repeat %end ! %routine FAIL TRANSFER(%record (SLOTF) %name DSLOT) !*********************************************************************** !* a transfer or sense has been fired for too long * !* try and halt it and send a termination * !*********************************************************************** %IF XA=YES %THEN %START %CONSTSTRING(4) HDVNAME = "HSCH" %ELSE %CONSTSTRING(3) HDVNAME = "HIO" %FINISH %integer I DEV == RECORD(DSLOT_DEV ENTA) PSEUDOTERM(DSLOT,CHANEND!DEVEND!UNIT CHECK,-1 {timeout}) I = HSCH(DSLOT_DEV ENTA) PRINTSTRING(HDVNAME." on ".MTOS(DSLOT_MNEM)." CC = ".HTOS(I,1)." ") %if xa=no %and i=1 %then printstring("CSW=".htos(page0_csw2,8)." ") %end ! %integer %fn FIND(%integer FDEV) %integer PTR,MYSLOT AGN: PTR = DSLOT BASE %for MYSLOT = 0,1,LAST SLOT %cycle DSLOT == RECORD(PTR) DEV == RECORD(DSLOT_DEV ENTA) %if FDEV=MYSLOT %or FDEV=DSLOT_MNEM %or FDEV=DSLOT_CUU %or %c (FDEV=m'LP' %and DSLOT_MNEM>>8=m'LP' %and %c DSLOT_QSTATE=NOT ALLOCATED) %then %start SLOT = MYSLOT; !assign to global %result = 0 %finish PTR = PTR+SLOT SIZE %repeat %if FDEV=m'LP' %then FDEV = m'LP0' %and ->AGN %result = -1 %end ! %string %fn MTOS(%integer M) %integer I,J J = M<<8; I = 3 %result = STRING(ADDR(I)+3) %end ! %routine Q REQUEST(%integer CCWA,NEWSTATE,COUNT) !*********************************************************************** !* queues a request for later actioning. FEs & Senses at front * !* others at the rear * !*********************************************************************** %integer OLDLINK %integer %name LINK %long %integer CLOCK %integer MSEC *stck_clock; MSEC = CLOCK>>22&x'ffff' %if MULTI OCP=YES %start SEMALOOP(CHANNELQ SEMA) %finish LINK == COM_SCHANNELQ %if DSLOT_DEVTYPE#FE %and NEWSTATE#SENSE QUEUED %start %while LINK#0 %cycle CQ == PARM(LINK) LINK == CQ_LINK %repeat %finish OLDLINK = LINK LINK = NEW PP CELL %if MULTI OCP=YES %then CHANNELQ SEMA = -1 CQ == PARM(LINK) CQ = 0 CQ_LINK = OLDLINK CQ_ADSLOT = ADDR(DSLOT) DSLOT_QSTATE = NEWSTATE CQ_CCWA = CCWA CQ_P1 = P_P1; ! for info & dumpcracking only CQ_P2 = P_P2; ! for info & dumpcracking only CQ_P3 = P_P3; ! for info & dumpcracking only CQ_P4 = P_P4; ! for info & dumpcracking only CQ_P5 = MSEC; ! for info & dumpcracking only CQ_P6 = KEY<<28!COUNT; ! key and retry count %if MON#0 %and 1<<(DSLOT_CUU>>8)&MCHAN#0 %then %c PRINTSTRING("DEVIO CH Queued: ".HTOS(DSLOT_CUU,3)." ") DEV_STATS3 = DEV_STATS3+1; ! CH Q'ed count %end ! ! %routine FIRE QUEUED(%integer CHAN) !*********************************************************************** !* try any queued transfers that might work via channel "chan" * !* FE transfers are tried anyway as limitations in the FE hardware * !* may result in device busy indication unrelated to the 370 end * !* and which will not give caannel available * !*********************************************************************** %integer I,J,CELLNO %integer %name LINK %record (SLOTF) %name DSLOT %record (IRBF) IRB %record (CQF) %name CQ %record (DTFORM) %name DEV %return %if COM_SCHANNELQ=0; ! nothing queued %if MULTI OCP=YES %start SEMALOOP(CHANNELQ SEMA) %finish LINK == COM_SCHANNELQ %while LINK#0 %cycle CELLNO = LINK CQ == PARM(CELLNO) DSLOT == RECORD(CQ_ADSLOT) DEV == RECORD(DSLOT_DEV ENTA) %if DSLOT_DEVTYPE=FE %or XA=YES %or DEV_CUU>>8=CHAN %or %c DEV_ALT CUU>>8=CHAN %or CHAN=-1 %start %if MON#0 %and 1<<(DSLOT_CUU>>8)&MCHAN#0 %then %c PRINTSTRING("devio CH unQ: ".STATES(DSLOT_QSTATE).HTOS %c (DSLOT_CUU,3)." ") J = FIRE(DSLOT,IRB,CQ_CCWA,CQ_P6>>28,CQ_P6&x'ffff',CQ_P5) %if XA#YES %and (J=2 %or (J=1 %and IRB_CSW2&NOSTARTMASK=0)) %start %unless CQ_P6&x'ffff'>512 %start LINK == CQ_LINK; ! still busy leave till later CQ_P6 = CQ_P6+1 %continue %else irb_csw2 = irb_csw2!chanend!devend; ! ensure termination not awaited %finish %finish ! device has started OK (j=0) ! device has not started or passed limit ! frig up a ponned termination interrupt DSLOT_QSTATE = DSLOT_QSTATE-2 LINK = CQ_LINK RETURN PPCELL(CELLNO) %if J#0 %then PSEUDOTERM(DSLOT,j<<24!IRB_CSW1,IRB_CSW2) %continue %finish ! transfer not being tried this time LINK == CQ_LINK %repeat %if MULTI OCP=YES %then CHANNELQ SEMA = -1 %end %routine PSEUDOTERM(%record (SLOTF) %name DSLOT, %integer CSW1,CSW2) !*********************************************************************** !* sends a pseudo failure by ponning a termination int * !* rationale is that this very rare and simplifies the code * !* by putting all special sensing etc into a single sequence * !*********************************************************************** %record (PARMF) Q %record (IRBF) IRB %record (DTFORM) %name DEV DEV == RECORD(DSLOT_DEV ENT A) Q = 0; ! simulate I/O termination Q_DEST = DEVIO DEST!3 Q_SRCE = m'FRQD' Q_P1 = DSLOT_CUU %if XA#YES %start Q_P4 = DEV_SLOT %else J = TSCH(ADDR(DEV),IRB) Q_P1 = ADDR(DEV) Q_P4 = IRB_KEYCNTR Q_P5 = IRB_XSTATUSW %finish Q_P2 = CSW1; Q_P3 = CSW2 %if DSLOT_QSTATE=SENSE fired %or csw2&errmask#0 %then %c Q_P3 = Q_P3!CHANEND!DEVEND ! ensure the termination is recognised ! but must allow for solitary chanend ! which comes back with cc=1 on start of skiptm DEVIO(Q); ! recursive call to avoid device ends or attentions sneeking thro' %end %routine TREPLY(%record (DTFORM) %name DEV, %integer P4) !*********************************************************************** !* replies to requesting service when transfer ends * !* reply format :- * !* p_p1=dev idno<<24 ! ccw no (ie more useful form of csw1) * !* p_p2=csw2 * !* p_p3=address of device table entry * !* p_p4=0 if sense OK or not performed (no errors or FE type dev)* !* =1 if sense failed * !* p_p5= original form of CSW1 * !* p_P6= returned value of user supplied identifier * !*********************************************************************** %record (PARMF) Q %integer I I = 0 %if DEV_CSW2&CHAN ERR=0 %start I = DEV_CSW1&x'ffffff' %if I#0 %then I = (I-DEV_CCWA&x'ffffff')//8 %if i<0 %then i = 0 %finish Q_DEST = DEV_REPSNO Q_SRCE = DEVIO DEST!3 Q_P1 = (LOID+DEV_SLOT)<<24!I Q_P2 = DEV_CSW2 Q_P3 = ADDR(DEV) Q_P4 = P4 Q_P5 = DEV_CSW1 Q_P6 = DEV_ID %if MON#0 %and 1<<(DEV_CUU>>8)&MCHAN#0 %then PKMONREC("DEVIO reply:",Q) PON(Q) %end %integer %fn FIRE(%record (SLOTF) %name DSLOT, %record (IRBF) %name IRB, %integer CCWA,KEY,COUNT,TIME) !*********************************************************************** !* tries to the start the chain and returns the cc as result * !*********************************************************************** %record (DTFORM) %name DEV %integer J,TDVCC,SDVCC,dummy %long %integer CLOCK; %integer MSEC DEV == RECORD(DSLOT_DEV ENTA) TDVCC = 0; SDVCC = 0 %if DSLOT_DEVTYPE=MT %and DSLOT_QSTATE#SENSE QUEUED %then %start TDVCC = TSCH(DSLOT_DEV ENTA,IRB); !use tio first..in case mag tape off-line ! tio gives a solitary device end ! which is reset by sio (xa ??????) %if xa=yes %and tdvcc=1 %then tdvcc = tdvcc!!1 ! Ateempt to get the same effect on XA assuming ! the solitary dev end will cause the ! subchannel to be status pending %finish %if TDVCC=0 %then SDVCC = SSCH(DSLOT_DEV ENTA,CCWA,KEY) %if SDVCC!TDVCC=0 %start; ! device has starte DEV_STICK = 0 %if MON#0 %and 1<<(DSLOT_CUU>>8)&MCHAN#0 %then %c PRINTSTRING("devio started after ".HTOS(COUNT, 3)." cuu: ".HTOS(DSLOT_CUU,3)." ") %if DSLOT_CUU=STATSDEV %and SDVS#SDVSTOP %start SDVS = SDVS+1 %if COUNT#0 %start *stck_clock MSEC = CLOCK>>22&x'ffff' COUNT = (MSEC-TIME)&x'ffff' %finish COUNT = SDVMAX %if COUNT>SDVMAX SDVTIMES(COUNT) = SDVTIMES(COUNT)+1 %finish %result = 0 %finish J = SDVCC!TDVCC %if J=1 %start %if SDVCC=1 %start %if XA=YES %then dummy = TSCH(DSLOT_DEV ENTA,IRB) %else %c IRB_CSW1 = PAGE0_CSW1 %and IRB_CSW2 = PAGE0_CSW2 %finish %finish %if J=3 %then IRB_CSW1 = CCWA %and IRB_CSW2 = CHANERR!CHANEND!DEVEND!3 irb_csw1 = irb_csw1!j<<24; ! stick cc in deffered cc place %if MON#0 %and 1<<(DSLOT_CUU>>8)&MCHAN#0 %then %c PRINTSTRING("Devio nostart ".HTOS(J,1)." Cuu ".HTOS(DSLOT_CUU, 3)." ".HTOS(IRB_CSW2,8)." ".HTOS(CCWA,8)." ") %result = J %end %end %end %of %file