%INCLUDE "ercc07:ibmsup_comf370" %INCLUDE "ercc07:ibmsup_page0f" %INCLUDE "ercc07:ibmsup_dtform1s" %INCLUDE "ercc07:ibmsup_xaioform" %RECORDFORMAT PARMF(%INTEGER DEST,SRCE,(%INTEGER P1,P2,P3,P4,P5,P6 %ORSTRING (23) TEXT)) %CONSTINTEGER PCELLSIZE=36,MARGIN=48 %RECORDFORMAT PDOPEF(%INTEGER CURRMAX,MAXMAX,FIRST UNALLOC,LAST UNALLOC,NEXTPAGE,S1,S2,S3,S4) %RECORDFORMAT PARMXF(%INTEGER DEST,SRCE,P1,P2,P3,P4,P5,P6,LINK) %CONSTRECORD (PARMXF) %ARRAYNAME PARM=PARM0AD %CONSTRECORD (PDOPEF) %NAME PARMDOPE=PARM0AD %RECORDFORMAT STOREF(%SHORTINTEGER FLAGS,USERS,LINK,BLINK,FLINK) %CONSTRECORD (STOREF) %ARRAYNAME STORE=STORE0AD ! %EXTERNALLONGINTEGER SEMATIME=0 %OWNINTEGER PARMASL=0 %EXTERNALINTEGER MAINQSEMA=-1 %EXTERNALINTEGERSPEC STORESEMA %OWNINTEGERARRAY GET NEW PAGE(0:14); ! parms for call of new epage ! %CONSTINTEGER LOCSN1=LOCSN0+MAXPROCS %RECORDFORMAT SERVF(%INTEGER P,L) ! L is link in circular chain of ! services which constitute a queue ! P is pointer to circular list ! of parameters for this service ! 2**31 bit of P is inhibit ! 2**30 of P is inter OCP lockout %CONSTRECORD (SERVF) %ARRAYNAME SERVA=SERVAAD ! Local controllers & user services inhibited initially %EXTERNALINTEGER KERNELQ=0, RUNQ1=0, RUNQ2=0 %RECORDFORMAT PROCF(%STRING (6) USER, %BYTEINTEGER INCAR,CATEGORY,WSN,RUNQ,ACTIVE, %INTEGER ACTW0,LSTAD,LAMTX,STACK,STATUS) %OWNRECORD (PROCF) %ARRAYFORMAT PROCAF(0:MAXPROCS) %OWNRECORD (PROCF) %ARRAYNAME PROCA %IF MONLEVEL&2#0 %THENSTART %EXTERNALLONGINTEGERSPEC KMON %FINISH ! ! ! %EXTERNALSTRINGFNSPEC STRHEX(%INTEGER N) %EXTERNALSTRINGFNSPEC STRINT(%INTEGER N) %EXTERNALSTRINGFNSPEC HTOS(%INTEGER VAL,PL) ! %EXTERNALROUTINESPEC OPMESS(%STRING (63) S) %EXTERNALROUTINESPEC ETOI(%INTEGER A,L) %EXTERNALROUTINESPEC DUMPTABLE(%INTEGER T,A,L) %EXTERNALROUTINESPEC PKMONREC(%STRING (23) TEXT, %RECORD (PARMF) %NAME P) %EXTERNALINTEGERFNSPEC REALISE(%INTEGER VAD) ! %IF MULTI OCP=YES %START %EXTERNALROUTINESPEC RESERVE LOG %EXTERNALROUTINESPEC RELEASE LOG %FINISH ! %CONSTLONGINTEGER DISAWAIT=x'2000000000000' %OWNLONGINTEGER PSW ! !------------------------------------------------------------------------ ! ! these are the xa routines for starting and halting i-o. When compiled with ! XA=NO they use the 370 instructions to get approximately the same effect ! %EXTERNALINTEGERFN SSCH(%INTEGER SLOTADDR,CCWRADDR,KEY) !*********************************************************************** !* start the device whose slot is at slotaddr and returns the cc * !* as the result. uses the alternate path where relevant * !* On non XA a busy condition mak persist if a sense after a * !* failure goes down the other channel so senses are flagged by * !* setting the top bit in KEY * !*********************************************************************** %CONSTINTEGER BUSY=x'10000000' %RECORD (ORBF) ORB %RECORD (DTFORM) %NAME DEVSLOT %INTEGER I,CC,CUU,ACC,sense sense=KEY>>31 DEVSLOT==RECORD(SLOTADDR) I=DEVSLOT_CUU %IF XA=YES %START ORB_IP=SLOTADDR ORB_KEYTAGS=x'0040ff00'!(CCWRADDR&x'80000000')>>8!(KEY<<28) ! format 1 chains have top bit set pro tem ORB_CPADDR=CCW RADDR&x'7fffffff' *l_1,i *ssch_orb *ipm_1 *srl_1,28 *st_1,cc %ELSE PAGE0_CAW=CCWRADDR!(KEY<<28) *l_1,i *sio_0(1) *balr_1,0 *sll_1,2 *srl_1,30 *st_1,cc %IF DEVSLOT_ALT CUU#0 %AND (CC>=2 %or (cc=1 %and %c (page0_csw2=x'50000000'{smod&busy} %or (sense#0 %and page0_csw2&x'10000000'#0)))) %START I=DEVSLOT_ALT CUU *l_1,i *sio_0(1) *balr_1,0 *sll_1,2 *srl_1,30 *st_1,acc %IF ACC=2) %START I=DEVSLOT_ALT CUU *l_1,i *tio_0(1) *balr_1,0 *sll_1,2 *srl_1,30 *st_1,acc %IF ACC=1 %THEN IRB_CSW1=PAGE0_CSW1 %AND IRB_CSW2=PAGE0_CSW2 %IF ACC %IF MONLEVEL&4#0 %START *stpt_cpt2 SEMATIME=SEMATIME+(CPT1-CPT2)>>12 %FINISH %RETURN REP: %REPEAT SEMA=-1; ! free sema before msg lest IOCP sema PRINTSTRING("Sema forced free at ".STRHEX(ADDR(SEMA))." ") %REPEAT %END %FINISH ! %EXTERNALROUTINE SYSERR(%INTEGER STK,IP) %END ! !------------------------------------------------------------------------ ! %EXTERNALROUTINE STOP %ALIAS "S#STOP" PSW=PSW0!DISAWAIT!x'd1ed' *lpsw_psw %END ! %EXTERNALROUTINE MONITOR(%STRING (63) S) PRINTSTRING(S) NEWLINE %MONITOR %STOP %END ! !----------------------------------------------------------------------- %ROUTINE PUTONQ(%INTEGER SERVICE) %RECORD (PROCF) %NAME PROC %RECORD (SERVF) %NAME SERV,SERVQ %INTEGERNAME RUNQ SERV==SERVA(SERVICE) %IF LOCSN0 PRAD=-1; ! no tlb purge needed OK: ! %UNLESS PRAD=-1 %START; ! tlb purge required %IF XA=AMDAHL %START *l_1,prad *ptlb_0(0);!*ppg_0(1) %FINISHELSEIF XA=YES %START I=INTEGER(SEGTAB VA+4*PAGE0 SEG); ! PTO *l_0,i; *l_1,rtvvad; *ipte_0,1 INTEGER(j) = INTEGER(J)&(\X'400'); ! make entry valid %ELSE *ptlb_0 %FINISH %FINISH ! J=SEGTAB VA+INTEGER(SEGTAB VA+4*PAGE0 SEG)&STMASK+PAGENO*PTE SIZE %IF PTE SIZE=2 %START %IF RAD=-1 %THEN RAD=0 %AND I=8 %ELSE I=0 SHORTINTEGER(J)<-RAD>>12<<4!I %ELSE %IF RAD=-1 %THEN RAD=0 %AND I=x'400' %ELSE I=0 INTEGER(J)=(RAD&(-4096))!I %FINISH ! %RESULT=RTV VAD!(RAD&4095) %END ! !------------------------------------------------------------------------ ! %EXTERNALINTEGERFN PPINIT(%INTEGERFN NEW EPAGE) %CONSTINTEGER INIT EPAGES=SERVASIZE//PAGESIZE+1 %INTEGERARRAY REALADS(0:INIT EPAGES) %INTEGER I,J,K,CELLS %LONGINTEGER L I=ADDR(GET NEW PAGE(0)); ! save FN parms *l_1,i; *l_15,64(10) *mvc_0(16,1),0(15) *l_15,12(1); *mvc_16(40,1),20(15) PROCA==ARRAY(COM_PROCAAD,PROCAF) %FOR J=INIT EPAGES,-1,0 %CYCLE I=NEW EPAGE REALADS(J)=I %REPEAT %IF MAXPROCS#COM_MAXPROCS %OR PAGESIZE#COM_PAGESIZE %OR STORE0AD#COM_STOREAAD %THEN %C PRINTSTRING("Incompatible components!!! ") ! page table at beginning of PPSEG %IF XA=NO %THEN J=INIT EPAGES %ELSE J=PARM PT SIZE//16-1 %UNLESS XA=YES %THEN J=J<<28 INTEGER(SEG TAB VA+4*PPSEG)=I!J I=RTV(I) %FOR J=0,1,PARM PT SIZE-1 %CYCLE %IF J<=INIT EPAGES %THEN K=REALADS(J) %ELSEIF PTE SIZE=2 %THEN K=x'800' %ELSE K=x'400' %IF PTE SIZE=2 %THEN SHORTINTEGER(I+J*PTE SIZE)<-K>>8 %ELSE INTEGER(I+J*PTE SIZE)=K %REPEAT I=RTV(-1) PARMDOPE_CURRMAX=PAGESIZE*(INITEPAGES+1)-PARMPTSIZE*PTE SIZE-SERVASIZE PARMDOPE_MAXMAX=PAGESIZE*PARMPTSIZE-PARMPTSIZE*PTE SIZE-SERVASIZE CELLS=PARMDOPE_CURRMAX//PCELLSIZE-1; ! no of cells now avaiable PARMDOPE_FIRSTUNALLOC=CELLS-MARGIN+1 PARMDOPE_LAST UNALLOC=CELLS PARMDOPE_NEXTPAGE=INIT EPAGES+1 CELLS=CELLS-MARGIN; ! margin of "MARGIN" cells for trying ! to obtain further epage %FOR I=1,1,CELLS-1 %CYCLE PARM(I)_LINK=I+1 %REPEAT PARM(CELLS)_LINK=1 PARMASL=CELLS COM_PARMASLA=ADDR(PARMASL) COM_KERNELQA=ADDR(KERNELQ) COM_RUNQ1A=ADDR(RUNQ1) COM_RUNQ2A=ADDR(RUNQ2) %RESULT=PARM0AD %END ! !------------------------------------------------------------------------ ! %ROUTINE MORE PPSPACE !*********************************************************************** !* Called when PARM ASL is empty and attemps to grab a free epage * !* and use to extend the (paged) parameter passing area * !* if no page available it tries to use one of the small no of cells* !* not formatted into the original list. This gives us a fair * !* chance of finding a free epage before disaster strikes * !*********************************************************************** %INTEGER I,J,REALAD,PTAD,CELLS,FIRST,CMAX CMAX=PARMDOPE_CURRMAX %IF CMAX>=PARMDOPE_MAXMAX %THEN ->FAIL I=ADDR(GET NEW PAGE(0)) *l_2,i *stm_4,14,16(11) *lm_12,15,0(2) *lm_5,10,16(2) *lr_1,14 *l_14,52(2) *basr_15,1 *st_1,realad %IF REALAD=-1 %THEN ->TRY MARGIN %IF XA=NO %START I=INTEGER(SEGTAB VA+4*PPSEG)>>28 I=I+1 INTEGER(SEGTAB VA+4*PPSEG)=INTEGER(SEGTAB VA+4*PPSEG)&x'0fffffff'!I<<28 %FINISH PTAD=PPSEG<>8 %ELSE INTEGER(PTAD)=REALAD ! ! Adjust param area descriptor and format up new bit of parmlist ! CMAX=CMAX+PAGESIZE PARMDOPE_CURRMAX=CMAX CELLS=CMAX//PCELLSIZE-1 FIRST=PARMDOPE_FIRST UNALLOC PARMDOPE_FIRST UNALLOC=CELLS-MARGIN+1 PARMDOPE_LAST UNALLOC=CELLS PARMDOPE_NEXTPAGE=PARMDOPE_NEXTPAGE+1 CELLS=CELLS-MARGIN %FOR I=FIRST,1,CELLS-1 %CYCLE PARM(I)_LINK=I+1 %REPEAT PARM(CELLS)_LINK=FIRST PARMASL=CELLS %RETURN TRY MARGIN: ! ! No epage available just now, use one of margin cells ! I=PARMDOPE_FIRST UNALLOC %IF I>PARMDOPE_LAST UNALLOC %THEN ->FAIL PARMDOPE_FIRST UNALLOC=I+1 PARM(I)_LINK=I PARMASL=I %RETURN FAIL: MONITOR("PARM ASL empty") %END ! !------------------------------------------------------------------------ ! %EXTERNALROUTINE PON(%RECORD (PARMF) %NAME P) %RECORD (SERVF) %NAME SERV,SERVQ %RECORD (PARMXF) %NAME ACELL,SCELL,NCELL %INTEGER SERVICE,NEWCELL,SERVP,I SERVICE=P_DEST>>16 %IF MONLEVEL&2#0 %AND (SERVICE>MAXSERV %OR SERVICE=0) %THEN %C PKMONREC("Invalid PON:",P) %ANDRETURN %IF MULTIOCP=YES %THENSTART *INCT_MAINQSEMA *JCC_8, SEMALOOP(MAINQSEMA,0) PSEMAGOT: %FINISH %IF PARMASL=0 %THEN MORE PPSPACE ACELL==PARM(PARMASL); ! ACELL =ASL HEADCELL NEWCELL=ACELL_LINK NCELL==PARM(NEWCELL); ! NCELL mapped onto NEWCELL %IF NEWCELL=PARMASL %THEN PARMASL=0 %ELSE ACELL_LINK=NCELL_LINK NCELL<-P; ! copy parameters in SERV==SERVA(SERVICE) SERVP=SERV_P&X'3FFFFFFF' %IF SERVP=0 %THEN NCELL_LINK=NEWCELL %ELSESTART SCELL==PARM(SERVP) NCELL_LINK=SCELL_LINK SCELL_LINK=NEWCELL %FINISH I=SERV_P&X'C0000000' SERV_P=I!NEWCELL %IF I=0 %AND SERV_L=0 %START; ! q if not xecuting or inhbtd %IF SERVICE>=LOCSN0 %THEN PUTONQ(SERVICE) %ELSESTART %IF KERNELQ=0 %THEN SERV_L=SERVICE %ELSESTART SERVQ==SERVA(KERNELQ) SERV_L=SERVQ_L SERVQ_L=SERVICE %FINISH KERNELQ=SERVICE %FINISH %FINISH %IF MULTIOCP=YES %START; *TDEC_MAINQSEMA; %FINISH %END ! !------------------------------------------------------------------------ ! %EXTERNALROUTINE FASTPON(%INTEGER CELL) !*********************************************************************** !* Can be used when record already in param table to avoid copy * !* cell is no of entry in PARM holding the record * !*********************************************************************** %INTEGER SERVICE,SERVP,I %RECORD (SERVF) %NAME SERV,SERVQ %RECORD (PARMXF) %NAME CCELL,SCELL CCELL==PARM(CELL) SERVICE=CCELL_DEST>>16 SERV==SERVA(SERVICE) %IF MULTIOCP=YES %THENSTART SEMALOOP(MAINQSEMA,0) %FINISH SERVP=SERV_P&x'3fffffff' %IF SERVP=0 %THEN CCELL_LINK=CELL %ELSESTART SCELL==PARM(SERVP) CCELL_LINK=SCELL_LINK SCELL_LINK=CELL %FINISH I=SERV_P&x'c0000000' SERV_P=I!CELL %IF I=0 %AND SERV_L=0 %THENSTART %IF SERVICE>=LOCSN0 %THEN PUTONQ(SERVICE) %ELSESTART %IF KERNELQ=0 %THEN SERV_L=SERVICE %ELSESTART SERVQ==SERVA(KERNELQ) SERV_L=SERVQ_L SERVQ_L=SERVICE %FINISH KERNELQ=SERVICE %FINISH %FINISH %IF MULTIOCP=YES %THEN MAINQSEMA=-1 %END !----------------------------------------------------------------------- %EXTERNALROUTINE DPON(%RECORD (PARMF) %NAME P, %INTEGER DELAY) !*********************************************************************** !* As for PON except for a delay of "DELAY" seconds. Zero delays * !* are allowed. ELAPSED INT is used to kick DPONPUTONQ * !*********************************************************************** %RECORD (PARMF) POUT %RECORD (PARMXF) %NAME ACELL,NCELL %INTEGER SERVICE,NEWCELL SERVICE=P_DEST>>16 %IF MONLEVEL&2#0 %AND SERVICE>MAXSERV %THEN %C PKMONREC("Invalid DPON:",P) %AND WRITE(DELAY,4) %ANDRETURN %IF DELAY<=0 %THEN PON(P) %ANDRETURN %IF MULTIOCP=YES %THENSTART SEMALOOP(MAINQSEMA,0) %FINISH %IF PARMASL=0 %THEN MORE PPSPACE ACELL==PARM(PARMASL) NEWCELL=ACELL_LINK NCELL==PARM(NEWCELL); ! onto cell in freelist %IF NEWCELL=PARMASL %THEN PARMASL=0 %ELSE ACELL_LINK=NCELL_LINK NCELL<-P %IF MULTIOCP=YES %THEN MAINQSEMA=-1 POUT_DEST=x'a0002' POUT_SRCE=0 POUT_P1=x'c0000'!NEWCELL POUT_P2=DELAY PON(POUT) %END !----------------------------------------------------------------------- %EXTERNALROUTINE DPONPUTONQ(%RECORD (PARMF) %NAME P) !*********************************************************************** !* Scond part of DPON. The delay has elapsed and P_DACT has the * !* number of a PPCELL set up ready for fastponning * !*********************************************************************** %IF MONLEVEL&2#0 %AND KMON&1<<12#0 %THEN PKMONREC("DPONPUTONQ:",P) FASTPON(P_DEST&x'ffff') %END ! !------------------------------------------------------------------------ ! %EXTERNALINTEGERFN NEWPPCELL %INTEGER NEWCELL %RECORD (PARMXF) %NAME ACELL %IF PARMASL=0 %THEN MORE PPSPACE ACELL==PARM(PARMASL) NEWCELL=ACELL_LINK %IF NEWCELL=PARMASL %THEN PARMASL=0 %ELSE ACELL_LINK=PARM(NEWCELL)_LINK %RESULT=NEWCELL %END ! !------------------------------------------------------------------------ ! !%EXTERNALROUTINE poff(%RECORD(parmf)%NAME p) !%RECORD(servf)%NAME serv !%RECORD(parmxf)%NAME acell,ccell,scell !%INTEGER service,cell,servp !service=p_dest>>16 !%UNLESS 0 SEMALOOP(MAINQSEMA,0) GOT: %FINISH %FOR I=0,1,3 %CYCLE %IF MASK&(1< SEMALOOP(MAINQSEMA,0) GOT: %FINISH %FOR I=0,1,3 %CYCLE %IF MASK&(1< SEMALOOP(MAINQSEMA,0) SSEMAGOT: %FINISH SERVP=SERV_P&X'3FFFFFFF' %IF SERVP=0 %START %IF MULTI OCP=YES %START; *TDEC_MAINQSEMA; %FINISH %RETURN %FINISH %IF MONLEVEL&2#0 %THENSTART %IF MULTIOCP=YES %START; *TDEC_MAINQSEMA; %FINISH; ! dont hold during o-p CELL=SERVP %UNTIL CELL=SERVP %CYCLE CELL=PARM(CELL)_LINK PKMONREC("PARM cleared:",PARM(CELL)) %REPEAT %IF MULTIOCP=YES %THENSTART *INCT_MAINQSEMA *JCC_8, SEMALOOP(MAINQSEMA,0) SSEMAGOT2: %FINISH %FINISH SERV_P=SERV_P&X'C0000000' %IF PARMASL#0 %THEN CELL=PARM(SERVP)_LINK %AND PARM(SERVP)_LINK=PARM(PARMASL)_LINK %AND %C PARM(PARMASL)_LINK=CELL PARMASL=SERVP %IF MULTIOCP=YES %START; *TDEC_MAINQSEMA; %FINISH %END !------------------------------------------------------------------------ %EXTERNALROUTINE ELAPSED INT(%RECORD (PARMF) %NAME P) !********************************************************************** !* * !* ELAPSED INTERVAL TIMER * !* * !* Act 0 = call from RTC interrupt handler (currently once per sec) * !* ACT 1 = Q/unQ nominee for kick every n seconds * !* ACT 2 = Q nominee for once-off kick in n seconds * !* * !* Where : P_P1 is routine to be kicked * !* : P_P2 is (a) seconds to elapse before kick (0ACT(I) %IF 0<=I<=2 %IF MONLEVEL&2#0 %AND I>2 %THEN PKMONREC("ELAPSED INT rejects:",P) %RETURN ACT(0): ! RTC interrupt %if p_srce#M'EINT' %then monitor("call of elapsed int?") P_SRCE=P_DEST I=HEAD %WHILE I>0 %CYCLE Q==PARM(I) I=Q_LINK %IF Q_DEST#0 %START Q_KLOKTIKS=Q_KLOKTIKS-1 %IF Q_KLOKTIKS&X'FFFF'=0 %START P_DEST=Q_DEST P_P1=Q_PARM ! ! Check user process has not logged off and if so cancel request ! PROCNO=Q_PROCNO %IF PROCNO=0 %OR Q_USER=PROCA(PROCNO)_USER %THEN PON(P) %ELSE Q_KLOKTIKS=0 %IF Q_KLOKTIKS=0 %THEN UNQUEUE(Q_DEST) %ELSE %C Q_KLOKTIKS=Q_KLOKTIKS!Q_KLOKTIKS>>16 %FINISH %FINISH %REPEAT %RETURN ACT(1): ! request timer interrupt %IF P_P2<0 %THEN UNQUEUE(P_P1) %ANDRETURN ACT(2): ! one time only %RETURNIF X'7FFF'>16-LOCSN0 %IF PROCNO<0 %THEN PROCNO=0 %ELSE PROCNO=PROCNO&(MAXPROCS-1) Q_PROCNO=PROCNO Q_USER=PROCA(PROCNO)_USER %IF PROCNO>0 %END %ROUTINE UNQUEUE(%INTEGER N) %INTEGER I %RECORD (QF) %NAME Q I=SLOT(N) %RETURNIF I=0; ! not Q'd Q==PARM(I) %IF Q_P6=0 %THEN HEAD=Q_LINK %ELSE PARM(Q_P6)_LINK=Q_LINK %IF Q_LINK#0 %THEN PARM(Q_LINK)_P6=Q_P6 RETURN PPCELL(I) %END %INTEGERFN SLOT(%INTEGER DEST) %INTEGER I,J I=HEAD %WHILE I>0 %CYCLE Q==PARM(I) %RESULT=I %IF Q_DEST=DEST I=Q_LINK %REPEAT %RESULT=0 %END %END %RECORDFORMAT PROPFORM(%INTEGER TRACKS,CYLS,PPERTRK,BLKSIZE,TOTPAGES,SP1,SP2,SP3,KEYLEN, SECTINDX) %RECORDFORMAT LABFORM(%BYTEINTEGERARRAY VOL(0:5), %BYTEINTEGER S1,S2,S3,S4,ACCESS, %BYTEINTEGERARRAY RES(1:20), %BYTEINTEGER C1,C2,AC1,AC2,TPC1,TPC2,BF1,BF2, %BYTEINTEGERARRAY POINTER(0:3),IDENT(1:14)) %RECORDFORMAT CCWF(%INTEGER CMDAD, %BYTEINTEGER FLAGS,SP, %SHORTINTEGER LEN) %RECORDFORMAT PQF(%INTEGER ADDT,CCWA,P1,P2,P3,P4,P5,P6,LINK) %CONSTINTEGER NORMALT=x'0c000000',ERRT=x'02000000',ATTNT=x'80000000' %CONSTINTEGER BUSY=x'10000000',OFFLINE=x'40000000',LOGGING=x'00001000' %constinteger smod=x'40000000' %constinteger cuend=x'20000000' %constinteger nostartmask=x'ffff0000'!!(smod!busy!cuend) %CONSTINTEGER DISCSNO=x'200000',PDISCSNO=x'210000' %CONSTINTEGER SCHEDSNO=x'30000' %OWNBYTEINTEGERARRAYFORMAT LVNF(0:99) %OWNBYTEINTEGERARRAYNAME LVN %OWNINTEGER DITADDR=0,NDISCS=0,CHANNELQ=0,CHANNELQ SEMA=-1 ! %ROUTINESPEC PDISC(%RECORD (PARMF) %NAME P) %EXTERNALROUTINE DISC(%RECORD (PARMF) %NAME P) %ROUTINESPEC CONSOLE ALARM %ROUTINESPEC READ DLABEL(%RECORD (DTFORM) %NAME DDT) %ROUTINESPEC READ LOG(%RECORD (DTFORM) %NAME DDT) %ROUTINESPEC LABREAD ENDS %ROUTINESPEC UNLOAD(%RECORD (DTFORM) %NAME DDT) %STRINGFNSPEC MTOS(%INTEGER M) %ROUTINESPEC SENSE(%RECORD (DTFORM) %NAME DDT) %ROUTINESPEC DREPORT(%RECORD (DTFORM) %NAME DDT, %RECORD (PARMF) %NAME P) %INTEGERFNSPEC FIRE CHAIN(%INTEGER CCWA,Q) %RECORD (DTFORM) %NAME DDT %RECORD (PROPFORM) %NAME PROP %RECORD (LABFORM) %NAME LABEL %RECORD (CCWF) %NAME CCW %RECORD (PQF) %NAME CQ %RECORD (SCHIBF) SCHIB %CONSTINTEGER DEAD=0,CONNIS=1,RLABIS=2,DCONNIS=3,AVAIL=4,PAGTIS=5 %CONSTINTEGER PAGSIS=6,INOP=7,RRLOG=8,RRLOGP=9,PAVAIL=10,PCLAIMD=11,PTRANIS=12 %CONSTINTEGER PSENIS=13,SPTRANIS=14,RLABSIS=15 %CONSTINTEGER RESPX=1<>32&1#0 %THEN PKMONREC("DISC:",P) %IF ACT>=64 %THEN ->ACT64 ->INACT(ACT) ! INACT(0): !initialisation %RETURNUNLESS NDISCS=0 NDISCS=COM_NDISCS DITADDR=COM_DITADDR LVN==ARRAY(COM_DLVNADDR,LVNF) %FOR I=0,1,99 %CYCLE LVN(I)=254 %REPEAT INITINH=1 %FOR J=0,1,NDISCS-1 %CYCLE DDT==RECORD(INTEGER(DITADDR+4*J)) DDT_ISERV=DISCSNO+3 DDT_SLOT=J %IF XA=YES %START I=STSCH(ADDR(DDT),SCHIB); ! get sub channel info %IF I#3 %START SCHIB_IP=ADDR(DDT) SCHIB_FLAGS=SCHIB_FLAGS!x'80'; ! enambled I=MSCH(ADDR(DDT),SCHIB); ! make operable %FINISH %FINISH READ DLABEL(DDT) LABREADS=LABREADS+1 DDT_STATE=RLABIS %REPEAT P_DEST=PDISCSNO PDISC(P) P_DEST=x'a0001' P_SRCE=0 P_P1=DISCSNO!5 P_P2=3 PON(P) %RETURN ! INACT(1): ! claim for dedicated use PTR=P_P3; I=PTR %UNLESS 0<=PTRHIT %IF PTR=DDT_MNEMONIC %OR DDT_LABEL=STRING(ADDR(P_P3)) %REPEAT ->CLAIM FAILS %FINISHELSE DDT==RECORD(INTEGER(DITADDR+4*I)) HIT: %IF P_P2>0 %START %IF DDT_STATE=PAVAIL %OR (DDT_STATE=AVAIL %AND DDT_DLVN<0) %START DDT_STATE=PCLAIMD DDT_REPSNO=P_P2 ->REPLY %FINISHELSE ->CLAIM FAILS %ELSE %IF DDT_STATE#PCLAIMD %THEN OPMESS("Duff dev returned") %ANDRETURN DDT_STATE=PAVAIL DDT_REPSNO=0 DDT_CURCYL=0 OPMESS(MTOS(DDT_MNEMONIC)." unused") %IF P_P2<0 %THEN SENSE(DDT) %AND DDT_STATE=CONNIS %RETURN %FINISH REPLY: P_P2=DISCSNO+64+I P_P3=I P_P4=DDT_MNEMONIC STRING(ADDR(P_P5))=DDT_LABEL SEND: P_DEST=P_SRCE P_SRCE=DISCSNO!1 PON(P) %RETURN CLAIM FAILS: P_P2=0 ->SEND ! INACT(2): ! paged request DDT==RECORD(P_P1) %IF DDT_STATE#AVAIL %OR P_SRCE&x'ffff0000'#PDISCSNO %THEN ->REJECT DDT_STATE=PAGTIS DDT_ID=P_P1 I=FIRE CHAIN(DDT_CCWA,YES) %RETURN ! ACT64: ! private chains SLOT=ACT&63 DDT==RECORD(INTEGER(DITADDR+4*SLOT)) %IF DDT_STATE#PCLAIMD %THEN ->REJECT DDT_REPSNO=P_SRCE DDT_ID=P_P1 %IF P_P2<0 %THEN DDT_STATE=SPTRANIS %ELSE DDT_STATE=PTRANIS I=FIRE CHAIN(DDT_CCWA,YES) %RETURN REJECT: %IF DDT_STATE=INOP %THEN ->REPLY INOP PKMONREC("DISC rejects:",P) P_DEST=P_SRCE P_P2=-1 P_SRCE=DISCSNO+64+SLOT PON(P) %RETURN ! INACT(4): ! lvn p_p1 cck'd I=P_P1 J=LVN(I) %IF J>=NDISCS %THENRETURN DDT==RECORD(INTEGER(DITADDR+4*J)) DDT_DLVN=DDT_DLVN&255 %RETURN ! INACT(5): ! clock tick CURRTICK=CURRTICK+1 %FOR J=0,1,NDISCS-1 %CYCLE DDT==RECORD(INTEGER(DITADDR+4*J)) %IF CURRTICK-DDT_STICK>=DDT_TIMEOUT %AND RESPX&1<TOUT %REPEAT ->wayout TOUT: ! timed out OPMESS(MTOS(DDT_MNEMONIC)." timed out") I=HSCH(ADDR(DDT)) P=0 P_DEST=DISCSNO+3 %IF XA=YES %THEN P_P1=ADDR(DDT) %ELSE P_P1=DDT_CUU P_P2=-1; ! timeout P_P3=ERRT P_P4=J PON(P) %RETURN ! INACT(6): ! print statistsics %RETURNUNLESS LOGREADS=0 %FOR J=0,1,NDISCS-1 %CYCLE; ! read logs DDT==RECORD(INTEGER(DITADDR+4*J)) %IF DDT_STATE=AVAIL %OR DDT_STATE=PAGTIS %START %IF DDT_STATE=AVAIL %THEN READ LOG(DDT) %ELSE DDT_STATE=RRLOGP LOGREADS=LOGREADS+1 %FINISH %REPEAT P_DEST=P_SRCE P_SRCE=DISCSNO!6 P_TEXT="DONE" PON(P) %RETURN ! PSTATS: %IF MULTI OCP=YES %THEN RESERVE LOG NEWLINE SPACES(45) PRINTSTRING("Disc logging information alt transfer transfer Q'ed for alt route") PRINTSTRING(" bytes overruns std CUU CUU requests fails chan used") PRINTSTRING(" read seeks cmd data id ") %FOR J=0,1,NDISCS-1 %CYCLE DDT==RECORD(INTEGER(DITADDR+4*J)) %CONTINUEUNLESS DDT_STATE=AVAIL %OR DDT_STATE=PAGTIS NEWLINE PRINTSTRING(" ".HTOS(DDT_CUU,3)) %IF DDT_ALT CUU=0 %THEN SPACES(11) %ELSE %C PRINTSTRING(" ".HTOS(DDT_ALT CUU,3)." ") WRITE(DDT_STATS2,8); WRITE(DDT_STATS1,9) WRITE(DDT_STATS4,11); WRITE(DDT_STATS3,12) I=ADDR(DDT_SENSE1) WRITE(INTEGER(I+8),14); ! bytes processed WRITE(INTEGER(I+14),8); ! seeks WRITE(BYTEINTEGER(I+19),6); ! cmd overruns WRITE(BYTEINTEGER(I+20),6); ! data overruns SPACES(2) %IF BYTEINTEGER(I+19)=0=BYTEINTEGER(I+20) %THEN SPACE %ELSE %C PRINTSTRING(HTOS(BYTEINTEGER(I+7)&7+2,1)) PRINTSTRING(" ".HTOS(BYTEINTEGER(I+21),2)) PRINTSTRING(" ".DDT_LABEL) %IF DDT_BASE>64 %THEN PRINTSTRING(" (IPL vol)") DDT_STATS1=0; DDT_STATS2=0; DDT_STATS3=0; DDT_STATS4=0 %REPEAT NEWLINES(3) %IF MULTI OCP=YES %THEN RELEASE LOG %RETURN ! INACT(9): ! for testing 'things' %IF P_P1=1 %START; ! display devs %FOR I=0,1,NDISCS-1 %CYCLE DDT==RECORD(INTEGER(DITADDR+4*I)) OPMESS(MTOS(DDT_MNEMONIC)." (".HTOS(DDT_CUU & X'FFFF', 3).") ".DDT_LABEL." ".STRINT(DDT_STATE)." ".STRINT(DDT_STATS2)." ".STRINT %C (DDT_STATS3)." ".STRINT(DDT_STATS4)) %REPEAT %FINISH %RETURN ! INACT(10): ! relocate tables for supervisor %IF VA MODE=NO %START %FOR I=0,1,NDISCS-1 %CYCLE DDT==RECORD(INTEGER(DITADDR+4*I)) INTEGER(DITADDR+4*I)=(INTEGER(DITADDR+4*I)-P_P1)!COM SEG<wayout %IF P_P4=-1; ! channel available interrupt only ACUU=P_P1; ! active CUU CSW1=P_P2 CSW2=P_P3 SLOT=P_P4 DDT==RECORD(INTEGER(DITADDR+4*SLOT)) %FINISH %IF CSW2&x'7fff0000'=NORMALT %THEN ->NINT(DDT_STATE) %if csw2=cuend %then ->wayout %IF CSW2&ATTNT#0 %START PKMONREC("DISC attention:",P) ->AINT(DDT_STATE) %FINISH ->FINT(DDT_STATE) wayout: %UNLESS CHANNELQ=0 %START; ! try waiting I/Os (non xa only) %IF MULTI OCP=YES %START SEMALOOP(CHANNELQ SEMA) %FINISH CQ==PARM(CHANNELQ) DDT==RECORD(CQ_ADDT) I=CHANNELQ CHANNELQ=CQ_LINK j=FIRE CHAIN(CQ_CCWA,yes) RETURN PP CELL(I) %IF MULTI OCP=YES %THEN CHANNELQ SEMA=-1 %FINISH %RETURN ! NINT(AVAIL): FINT(AVAIL): NINT(PAVAIL): FINT(PAVAIL): NINT(PCLAIMD): FINT(PCLAIMD): NINT(DEAD): FINT(DEAD): PRINTSTRING("DISC int (".HTOS(P_P1,3).") CSW: ".htos(csw1,8)." ".htos(csw2, 8)." state ".STRINT(DDT_STATE)." ??? ") ->wayout NINT(CONNIS): ! sense terminates READ DLABEL(DDT) LABREADS=LABREADS+1 DDT_STATE=RLABIS %RETURN ! NINT(RLABIS): ! label read LABREAD ENDS LABEL==RECORD(DDT_CCWA+40) ETOI(ADDR(LABEL),6) PREVLAB=DDT_LABEL %FOR I=0,1,5 %CYCLE BYTEINTEGER(ADDR(DDT_LABEL)+1+I)=LABEL_VOL(I) %REPEAT LENGTH(DDT_LABEL)=6 ! ! check label but note that VM does not allow a full 80 byte write (it seems) ! J=COM_OCPTYPE>>24; ! 255 if VM %IF ((J#255 %AND LABEL_ACCESS=x'c5') %OR J=255) %AND '0'<=LABEL_VOL(4)<='9' %AND %C '0'<=LABEL_VOL(5)<='9' %START %FOR I=0,1,3 %CYCLE BYTEINTEGER(ADDR(DDT_BASE)+I)=LABEL_POINTER(I) %REPEAT %IF J=255 %THEN DDT_BASE=x'800' S=" EMAS" I=(LABEL_VOL(4)&x'f')*10+LABEL_VOL(5)&x'f' %IF SLOT#LVN(I)<254 %THEN ->DUPLICATE LVN(I)=SLOT DDT_DLVN=I!x'80000000' DDT_STATE=AVAIL %ELSE DDT_BASE=0 DDT_STATE=PAVAIL DDT_DLVN=-1 S=" frgn" %FINISH DDT_STATS1=0 DDT_STATS2=0 LOAD MESS: OPMESS(MTOS(DDT_MNEMONIC)." loaded ".DDT_LABEL.S) ->wayout DUPLICATE: OPMESS("Duplicate disc lvn") OPMESS("Re-label disc on ".MTOS(DDT_MNEMONIC)) DDT_DLVN=-1 DDT_STATE=PAVAIL ->wayout ! FINT(CONNIS): ! sense fails DDT_STATE=DEAD ->wayout ! FINT(RLABIS): ! label read fails LABREAD ENDS DDT_CSW1=CSW1 DDT_CSW2=CSW2 DDT_STATE=RLABSIS SENSE(DDT) %RETURN ! NINT(RLABSIS): %IF DDT_SENSE1&OFFLINE=OFFLINE %START FINT(RLABSIS): ! sense after lab read OPMESS(MTOS(DDT_MNEMONIC)." offline thru ".HTOS(ACUU,3)) %UNLESS DDT_ALT CUU=0 %START; ! swap routes %UNLESS DDT_ALT CUU=ACUU %THEN DDT_CUU=DDT_ALT CUU DDT_ALT CUU=0 DDT_STATE=RLABIS READ DLABEL(DDT); ! try again LABREADS=LABREADS+1 %RETURN %FINISHELSE DDT_STATE=DEAD %and ->wayout %ELSE DDT_LABEL="nolabl" DDT_DLVN=-1 DDT_STATE=PAVAIL OPMESS(MTOS(DDT_MNEMONIC)." loaded no label") DDT_BASE=0 P_DEST=0 ->COM1 %FINISH ! NINT(DCONNIS): FINT(DCONNIS): ! unload complete DDT_STATE=DEAD UNLDED: OPMESS(MTOS(DDT_MNEMONIC)." unloaded") %IF DDT_DLVN#-1 %THEN LVN(DDT_DLVN&255)=255 ->wayout ! AINT(RLABIS): LABREAD ENDS AINT(DEAD): AINT(CONNIS): AINT(RLABSIS): PRINTSTRING("attntn while initng ".HTOS(P_P1,3)." ".STRHEX(CSW1).STRHEX(CSW2)." ") DDT_STATE=CONNIS SENSE(DDT) AINT(DCONNIS): %RETURN ! AINT(AVAIL): AINT(PAVAIL): AINT(PAGTIS): AINT(PAGSIS): AINT(RRLOGP): %RETURN ! AINT(INOP): %RETURN ! NINT(INOP): FINT(INOP): REPLY INOP: P_P3=ERRT P_P4=0 P_P5=NORMALT P_DEST=PDISCSNO!10 P_SRCE=DISCSNO DDT_ID=ADDR(DDT) DDT_SENSE1=OFFLINE ->COM2 ! FINT(SPTRANIS): NINT(PTRANIS): NINT(SPTRANIS): P_DEST=DDT_REPSNO P_SRCE=DISCSNO+64+SLOT P_P1=DDT_ID P_P2=0 P_P3=CSW1 P_P4=CSW2 PON(P) DDT_STATE=PCLAIMD ->wayout ! FINT(RRLOGP): ! read page fails DDT_STATE=PAGTIS; ! abandon pending read log FINT(PAGTIS): FINT(PTRANIS): DDT_CSW1=CSW1 DDT_CSW2=CSW2 DDT_STATE=DDT_STATE+1 SENSE(DDT) %RETURN ! NINT(RRLOGP): ! read log pending READ LOG(DDT) P_DEST=PDISCSNO!10 P_SRCE=DISCSNO!2 P_P1=DDT_ID P_P2=0 DPON(P,1); ! delay reply %RETURN ! NINT(PAGTIS): P_DEST=PDISCSNO!10 P_SRCE=DISCSNO!2 P_P1=DDT_ID P_P2=0 DDT_STATE=AVAIL PDISC(P) ->wayout ! FINT(PAGSIS): NINT(PAGSIS): P_DEST=PDISCSNO!10 P_SRCE=DISCSNO!2 DDT_STATE=AVAIL ->COM1 ! NINT(PSENIS): FINT(PSENIS): P_DEST=DDT_REPSNO P_SRCE=DISCSNO+64+SLOT DDT_STATE=PCLAIMD COM1: P_P3=DDT_CSW1 P_P4=DDT_CSW2 P_P5=CSW1 COM2: P_P1=DDT_ID P_P2=1 P_P6=DDT_SENSE1 %IF DDT_SENSE1&OFFLINE=OFFLINE %START OPMESS(MTOS(DDT_MNEMONIC)." offline thru ".HTOS(ACUU,3)) CONSOLE ALARM %UNLESS DDT_ALT CUU=0 %START; ! abandon route %IF DDT_ALT CUU#ACUU %THEN DDT_CUU=DDT_ALT CUU; ! swap routes DDT_ALT CUU=0 P_P6=P_P6&(\(OFFLINE)) %IF P_DEST&x'ffff0000'=PDISCSNO ! PDISC will retry %FINISHELSE DDT_STATE=INOP %FINISH DREPORT(DDT,P) PON(P) %UNLESS P_DEST=0 ->wayout ! NINT(RRLOG): ! buffered log read FINT(RRLOG): AINT(RRLOG): DDT_STATE=AVAIL LOGREADS=LOGREADS-1 ->PSTATS %IF LOGREADS=0; ! all finished ->wayout ! AINT(*): ! private atts P_DEST=DDT_REPSNO P_SRCE=DDT_SLOT+64 P_P1=0 P_P2=0 P_P3=CSW1 P_P4=CSW2 PON(P) %UNLESS P_DEST=0 %RETURN ! INACT(*): ! sink PKMONREC("DISC act?:",P) %RETURN ! %STRINGFN MTOS(%INTEGER M) !*********************************************************************** !* Turn integer m into a string * !*********************************************************************** %INTEGER I,J I=4; J=M %RESULT=STRING(ADDR(I)+3) %END ! %ROUTINE CONSOLE ALARM !*********************************************************************** !* Request OPER to light the alarm/sound the bell on the console * !*********************************************************************** %RECORD (PARMF) P P_DEST=x'320009' PON(P) %END ! %ROUTINE READ DLABEL(%RECORD (DTFORM) %NAME DDT) !*********************************************************************** !* Read 80 byte vol label from cyl/track/sector 0/0/0 * !*********************************************************************** %INTEGER I,RAD I=DDT_CCWA RAD=REALISE(I) INTEGER(I)=x'13000000'; ! recalibrate INTEGER(I+4)=x'60000001' INTEGER(I+8)=x'31000000'!(RAD+32); ! search id eq INTEGER(I+12)=x'60000005' INTEGER(I+16)=x'08000000'!(RAD+8); ! tic INTEGER(I+20)=0 INTEGER(I+24)=x'06000000'!(RAD+40); ! read data INTEGER(I+28)=x'20000050' INTEGER(I+32)=0; ! cchh = 0 INTEGER(I+36)=0; ! r0 I=FIRE CHAIN(I,YES) %END ! %ROUTINE LABREAD ENDS !*********************************************************************** !* Called when vol label read to uninhibit if required * !*********************************************************************** LABREADS=LABREADS-1 %IF INITINH=1 %AND LABREADS=0 %THEN INITINH=0 %AND UNINHIBIT(SCHEDSNO>>16) %END ! %ROUTINE READ LOG(%RECORD (DTFORM) %NAME DDT) !*********************************************************************** !* Read & reset buffered log * !*********************************************************************** %INTEGER I INTEGER(DDT_CCWA)=x'a4000000'!REALISE(ADDR(DDT_SENSE1)) INTEGER(DDT_CCWA+4)=24 DDT_STATE=RRLOG I=FIRE CHAIN(DDT_CCWA,YES) %END ! %ROUTINE Q REQUEST(%INTEGER CCWA) !*********************************************************************** !* All routes give channel busy so queue request for later retry * !*********************************************************************** %INTEGERNAME LINK %INTEGER I %IF MULTI OCP=YES %START SEMALOOP(CHANNELQ SEMA) %FINISH DDT_STATS4=DDT_STATS4+1 LINK==CHANNELQ %WHILE LINK#0 %CYCLE CQ==PARM(LINK) LINK==CQ_LINK %REPEAT LINK=NEW PP CELL %IF MULTI OCP=YES %THEN CHANNELQ SEMA=-1 CQ==PARM(LINK) CQ=0 CQ_ADDT=ADDR(DDT) CQ_CCWA=CCWA %END ! %ROUTINE SENSE(%RECORD (DTFORM) %NAME DDT) !*********************************************************************** !* Perform a sense either for initial status or because of an * !* abnormal termination. A sense CCW is always at ddt_ccwa-8. * !*********************************************************************** %INTEGER I I=FIRE CHAIN(DDT_CCWA-8,YES) %UNLESS I=0 %START; ! failed PRINTSTRING("DISC sense fails ".STRINT(I)." on ".MTOS(DDT_MNEMONIC)." CSW: ".HTOS %C (PAGE0_CSW1,8)." ".HTOS(PAGE0_CSW2,8)) NEWLINE DDT_SENSE1=OFFLINE %IF I=3; ! offline if inop %FINISH %END ! %INTEGERFN FIRE CHAIN(%INTEGER CCWA,Q) !*********************************************************************** !* Fire the CCW chain at ccwa. If all routes are busy and q=yes * !* then q the request until a channel becomes free * !*********************************************************************** %RECORD (PARMF) P %RECORD (IRBF) IRB %INTEGER I,J,CUU,RCCWA CUU=DDT_CUU DDT_STICK=CURRTICK %IF VA MODE=YES %START *l_1,ccwa; *lra_0,0(1); *st_0,rccwa %FINISHELSE RCCWA=CCWA I=SSCH(ADDR(DDT),RCCWA,0) %RESULT=0 %IF I=0; ! I/O fired %IF XA=YES %THEN J=TSCH(ADDR(DDT),IRB) %ELSESTART IRB=0 IRB_CSW1=PAGE0_CSW1 IRB_CSW2=PAGE0_CSW2 %FINISH %UNLESS I=2 %OR (I=1 %AND irb_CSW2&nostartmask=0) %START; ! unless busy with no errors %IF I=3 %START; ! CUU inop IRB_CSW2=ERRT %FINISH P_DEST=DISCSNO!3; ! pon abterm P_SRCE=m'FIRE' %IF XA=YES %THENSTART P_P1=ADDR(DDT) P_P2=IRB_CSW1 P_P4=IRB_KEYCNTR P_P5=IRB_XSTATUSW %ELSE P_P1=CUU p_P2=0; ! field not set on cc=1 etc P_P4=BYTEINTEGER(COM_STEER INT+P_P1) %FINISH P_P3=IRB_CSW2 PON(P) %RESULT=I %FINISH %IF Q=YES %THEN Q REQUEST(CCWA) %ANDRESULT=0 %ELSERESULT=1 %END ! %ROUTINE DREPORT(%RECORD (DTFORM) %NAME DDT, %RECORD (PARMF) %NAME P) !*********************************************************************** !* Print failure report * !*********************************************************************** %INTEGER I,J PRINTSTRING("&& disc transfer ".DDT_LABEL." on ".MTOS(DDT_MNEMONIC)." (".HTOS(ACUU, 3).") fails ".STRING(ADDR(COM_DATE0)+3)." ".STRING(ADDR(COM_TIME0)+3)) PRINTSTRING(" csw1 = ".STRHEX(P_P3)." csw2 = ".STRHEX(P_P4)." ccws (@ ".STRHEX(DDT_CCWA).") : ") I=DDT_CCWA %CYCLE NEWLINE PRINTSTRING(STRHEX(INTEGER(I))." ".STRHEX(INTEGER(I+4))) J=INTEGER(I) %UNLESS J>>24=8 %START %EXITIF INTEGER(I+4)&x'40000000'=0 %FINISH I=I+8 %REPEAT NEWLINE %IF DDT_SENSE1&LOGGING=LOGGING %START PRINTSTRING("Statistical usage/error log data present ") %FINISH PRINTSTRING("sense data :") %FOR I=0,1,SHORTINTEGER(DDT_CCWA-2)//4-1 %CYCLE PRINTSTRING(" ".STRHEX(INTEGER(ADDR(DDT_SENSE1)+4*I))) %REPEAT NEWLINE %END ! %END ! !------------------------------------------------------------------------ ! %EXTERNALROUTINE PDISC(%RECORD (PARMF) %NAME P) %CONSTINTEGERARRAY CMD(1:6)=x'06000000',x'05000000'(2),x'06000000'(2), x'05000000' %RECORDFORMAT REQFORM(%INTEGER DEST, %BYTEINTEGER FAULTS,FCCW,LCCWP1,REQTYPE, %INTEGER IDENT, CYLINK,COREADDR,CYL,TRKSECT,STOREX,REQLINK) %RECORD (DTFORM) %NAME DDT %RECORD (PROPFORM) %NAME PROP %RECORD (PARMXF) %NAME ACELL %RECORD (REQFORM) %NAME REQ,ENTRY %RECORD (PARMF) Q %CONSTINTEGER TRANOK=0,TRANWITHERR=1,TRANREJECT=2,NOTTRANNED=3 %CONSTINTEGER ABORTED=4,PTACT=5,POUTACT=6 %CONSTINTEGER RETRIES=7,MAXTRANS=5,MIN READ ADDR=x'c000' %ROUTINESPEC QUEUE(%INTEGERNAME QHEAD, %INTEGER REQ,CYL) %ROUTINESPEC PTREPLY(%RECORD (REQFORM) %NAME REQ, %INTEGER FAIL) %SWITCH PDA(0:11) %OWNINTEGER INIT=0,TRAP=0,TFSYS=0 %INTEGERNAME LINK %INTEGER SEMA %INTEGER I,J,K,ACT,UNIT,LUNIT,CYL,TRACK,SECT,CELL,SECSTAT %INTEGER CCWA,SEEKA,RSEEKA,SECTINDX,ERRCCW,NEXTCELL,SRCE,FAIL,FCCW %INTEGER STOREX,L,PRIO ! ACT=P_DEST&x'ffff' %IF KMON>>33&1#0 %THEN PKMONREC("pdisc:",P) ->PDA(ACT) ! PDA(0): ! initialise %RETURNIF INIT#0 %FOR I=0,1,NDISCS-1 %CYCLE DDT==RECORD(INTEGER(DITADDR+4*I)) DDT_QSTATE=0 DDT_LQLINK=0 DDT_UQLINK=0 DDT_TRLINK=0 DDT_CURCYL=0 %REPEAT INIT=1 %RETURN ! PDA(6): ! pageout request (write) PDA(5): ! pageturn request (read) ! P_P1 = amtx/epx ! P_P2 = discaddr ! P_P3 = storex ! P_P4 = priority (0=high,1=low) P_P6=P_P3; ! save storex P_P3=P_P3*PAGESIZE; ! store addr PDA(1): ! read PDA(2): ! write PDA(3): ! write + check PDA(4): ! check read ! p_p3 now real store addr SRCE=P_SRCE&x'7fffffff' %IF P_P3REJECT %FINISH UNIT=P_P2>>24 %IF UNIT>99 %THEN ->REJECT J=P_P2&x'ffffff' LUNIT=LVN(UNIT) ->REJECT %IF LUNIT>=NDISCS %IF JPROP_CYLS %THEN ->REJECT %IF PARMASL=0 %THEN MORE PPSPACE ACELL==PARM(PARMASL) CELL=ACELL_LINK REQ==PARM(CELL) %IF CELL=PARMASL %THEN PARMASL=0 %ELSE ACELL_LINK=REQ_REQLINK P_SRCE=ACT REQ<-P REQ_DEST=SRCE REQ_CYLINK=0 REQ_CYL=CYL REQ_TRKSECT=(TRACK<<8!SECT)<<8 REQ_REQLINK=0 %IF DDT_QSTATE=0 %OR CYL>=DDT_CURCYL %THEN QUEUE(DDT_UQLINK,CELL,CYL) %ELSE %C QUEUE(DDT_LQLINK,CELL,CYL) ! ! for callers of pdisc advisory information is returned in p_p6 ! -pages ontrack if the transfer has been initiated ! else the number of pages on the rest of the track ! %IF DDT_QSTATE=0 %THEN P_P6=sect-prop_ppertrk %AND ->INIT TRANSFER P_P6=PROP_PPERTRK-SECT %RETURN ! REJECT: PKMONREC("*** pdisc rejects",P) P_DEST=SRCE P_SRCE=PDISCSNO!ACT P_P2=TRANREJECT %IF ACT=PTACT %THEN PTREPLY(P,2) %ELSE PON(P) %RETURN ! INIT TRANSFER: CELL=DDT_UQLINK REQ==PARM(CELL) DDT_UQLINK=REQ_REQLINK CYL=REQ_CYL CCWA=DDT_CCWA SEEKA=CCWA+MAXTRANS*48-8 RSEEKA=REALISE(SEEKA) PROP==RECORD(DDT_PROPADDR) SECTINDX=PROP_SECTINDX FCCW=0; I=0 %CYCLE NEXTCELL=REQ_CYLINK %IF REQ_REQTYPE=POUTACT %AND STORE(REQ_STOREX)_USERS>0 %START REQ_CYLINK=ABORTED INTEGER(ADDR(REQ)+4)=PDISCSNO FASTPON(CELL) %ELSE INTEGER(CCWA)=x'07000000'!RSEEKA INTEGER(CCWA+4)=x'40000006' CCWA=CCWA+8 INTEGER(CCWA)=x'23000000'!(RSEEKA+7) INTEGER(CCWA+4)=x'40000001' CCWA=CCWA+8 INTEGER(CCWA)=x'31000000'!(RSEEKA+2) INTEGER(CCWA+4)=x'40000005' INTEGER(CCWA+8)=x'08000000'!REALISE(CCWA) INTEGER(CCWA+12)=0 CCWA=CCWA+16 INTEGER(CCWA)=CMD(REQ_REQTYPE&255)!REQ_COREADDR INTEGER(CCWA+4)=x'40000000'!PAGESIZE INTEGER(SEEKA)=CYL INTEGER(SEEKA+4)=REQ_TRKSECT!((REQ_TRKSECT>>8&255-1)*SECTINDX) CCWA=CCWA+8 SEEKA=SEEKA-8 RSEEKA=RSEEKA-8 I=I+1 REQ_REQLINK=DDT_TRLINK DDT_TRLINK=CELL REQ_FCCW=FCCW FCCW=(CCWA-DDT_CCWA)>>3 REQ_LCCWP1=FCCW %FINISH CELL=NEXT CELL %IF CELL=0 %THEN ->DECHAIN REQ==PARM(CELL) %EXITIF I=MAXTRANS %REPEAT REQ_REQLINK=DDT_UQLINK DDT_UQLINK=CELL ! DECHAIN: %IF I=0 %THEN ->DOMORE INTEGER(CCWA-4)=INTEGER(CCWA-4)&x'bfffffff' DDT_STATS2=DDT_STATS2+I Q_DEST=DISCSNO!2 Q_SRCE=PDISCSNO!10 Q_P1=ADDR(DDT) DDT_QSTATE=1 DDT_CURCYL=CYL DISC(Q) %RETURN ! PDA(10): DDT==RECORD(P_P1) CELL=DDT_TRLINK %IF P_P2=0 %START %WHILE CELL#0 %CYCLE REQ==PARM(CELL) J=REQ_REQLINK %IF REQ_REQTYPE=PTACT %THEN PTREPLY(REQ,0) %ELSESTART INTEGER(ADDR(REQ)+4)=PDISCSNO REQ_CYLINK=0 FASTPON(CELL) %FINISH CELL=J %REPEAT DDT_TRLINK=0 DOMORE: %IF DDT_UQLINK=0 %THEN DDT_UQLINK=DDT_LQLINK %AND DDT_LQLINK=0 ->INIT TRANSFER %IF DDT_UQLINK#0 DDT_QSTATE=0 %RETURN %FINISH pkmonrec("PDISC tranfail:",p) DDT_STATS1=DDT_STATS1+1 %IF P_P3=0 %THEN ERRCCW=0 %ELSE ERRCCW=(P_P3-realise(DDT_CCWA))>>3-1; ! p_p3 8 bytes on SEC STAT=P_P6 FAIL=NOT TRANNED CYL=DDT_CURCYL %WHILE CELL#0 %CYCLE REQ==PARM(CELL) DDT_TRLINK=REQ_REQLINK %IF REQ_LCCWP1<=ERRCCW %OR REQ_FAULTS>RETRIES %START %IF REQ_LCCWP1<=ERRCCW %THEN REQ_CYLINK=TRAN OK %ELSE REQ_CYLINK=FAIL %IF REQ_CYLINK#0 %START PKMONREC("pdisc transfer fails",REQ) %else printstring("transfer OKed") write(req_lccwp1,5); write(errccw,5) newline %FINISH %IF REQ_REQTYPE=PTACT %THEN PTREPLY(REQ,REQ_CYLINK) %ELSE %C INTEGER(ADDR(REQ)+4)=PDISCSNO %AND FASTPON(CELL) %ELSE REQ_CYLINK=0 %IF REQ_FCCW<=ERRCCWDOMORE ! PDA(11): DDT==RECORD(INTEGER(DITADDR+4*P_P1)) DDT_TRLINK=0 DDT_CURCYL=0 ->DOMORE ! PDA(7): ! special tests TRAP=P_P1; ! trap writes below this page %IF P_P2<0 %THEN TFSYS=0 %ELSE TFSYS=P_P2; ! fsys %RETURN ! ! PDA(*): PKMONREC("pdisc act??",P) %RETURN ! %ROUTINE QUEUE(%INTEGERNAME LINK, %INTEGER CELL,CYL) !*********************************************************************** !* Queues request in ascending page (ie cyl) order so seek times * !* are minimised. * !*********************************************************************** %RECORD (REQFORM) %NAME REQ,ENTRY,NEXTREQ %INTEGER NEXTCELL,AD REQ==PARM(CELL) NEXTCELL=LINK ENTRY==PARM(NEXTCELL) %IF NEXTCELL=0 %OR CYLQONCYL %IF CYL=ENTRY_CYL NEXTCELL=ENTRY_REQLINK %EXITIF NEXTCELL=0 NEXTREQ==PARM(NEXTCELL) %EXITIF NEXTREQ_CYL>CYL ENTRY==NEXTREQ %REPEAT REQ_REQLINK=NEXTCELL ENTRY_REQLINK=CELL %RETURN QONCYL: REQ_CYLINK=ENTRY_CYLINK ENTRY_CYLINK=CELL %END ! %ROUTINE PTREPLY(%RECORD (REQFORM) %NAME REQ, %INTEGER FAIL) !*********************************************************************** !* Replies to all local controllers waiting for a page transfer * !* usually one only but possibly several. This code will go inline * !* for the normal case when alltransfers in chain are errorfree * !*********************************************************************** %RECORD (PARMXF) %NAME REP %INTEGER L,J,STOREX STOREX=REQ_STOREX %IF FAIL=0 %START; ! remove the chnged and dirty bits set by transfer *l_2,storex; *sll_2,12; ! real address of page transfered %IF XA=YES %THENSTART *ISKE_0,2; ! MARKERS TO MARK *SRL_0,3; *SLL_0,3; ! MARKERS REMOVED *SSKE_0,2; ! STORE KEY RESET %FINISHELSEIF XA=AMDAHL %START; ! KEYS GANGED IN PAIRS *ISK_0,2; *SRL_0,3; *SLL_0,3 *SSK_0,2 %ELSE *ISK_0,2; ! KEY ON 1ST 2 K *LA_15,2048(2); ! 2ND SET OF MARKERS *SRL_0,3; *SLL_0,3; ! CLEAR THE MARKERS *SSK_0,2; *SSK_0,15; ! MARKERS RESET %FINISH %FINISH %IF FAIL>1 %THENSTART; ! clear the page J=RTV(REQ_COREADDR) *ipk_0; *st_2,l; *spka_0; ! key 0 *l_0,j; *l_1,pagesize *lr_2,0; *slr_3,3; *mvcl_0,2 *l_2,l; *spka_0(2); ! restore key J=RTV(-1) %FINISH %IF MULTIOCP=YES %THENSTART SEMALOOP(STORESEMA,0) %FINISH L=STORE(STOREX)_LINK STORE(STOREX)_FLAGS=STORE(STOREX)_FLAGS&x'ff3f'; ! clear i/o flag STORE(STOREX)_LINK=0; ! & link %IF MULTI OCP=YES %THEN STORESEMA=-1 %UNTIL L=0 %CYCLE REP==PARM(L) REP_P3=FAIL J=REP_LINK FASTPON(L) L=J %REPEAT RETURN PPCELL(CELL) %IF FAIL#2; ! headcell back to freelist %END ! %END ! %EXTERNALROUTINE SEMAPHORE(%RECORD (PARMF) %NAME P) %RECORDFORMAT SEMAF(%INTEGER DEST,SRCE,TOP,BTM,SEMA,TICK,P5,P6,LINK) %RECORD (SEMAF) %NAME SEMACELL %RECORD (PARMXF) %NAME WAITCELL %OWNINTEGERARRAY HASH(0:31)=0(32) %OWNINTEGER TICKS=0 %INTEGERFNSPEC NEWSCELL %INTEGERFNSPEC NEWWCELL %INTEGER SEMA,HASHP,NCELL,I,J,K,WCELL %INTEGERNAME CELLP %SWITCH ACT(1:4) %IF MONLEVEL&2#0 %AND KMON&1<<7#0 %THEN PKMONREC("Semaphore:",P) SEMA=P_P1 %IF P_DEST&15<3 %THEN HASHP=IMOD(SEMA-SEMA//31*31) %AND CELLP==HASH(HASHP) ->ACT(P_DEST&7) !----------------------------------------------------------------------- ACT(1): ! p operation %WHILE CELLP#0 %CYCLE SEMACELL==PARM(CELLP) %IF SEMA=SEMACELL_SEMA %THENSTART I=SEMACELL_BTM %IF I=0 %THENSTART; ! already had v operation SEMACELL_DEST=P_SRCE SEMACELL_SRCE=x'70001' FASTPON(CELLP) CELLP=0 %FINISHELSESTART; ! add to btm of queue WCELL=NEWWCELL PARM(I)_LINK=WCELL SEMACELL_BTM=WCELL %FINISH %RETURN %FINISH CELLP==SEMACELL_LINK %REPEAT ! ! no queue yet ! NCELL=NEWSCELL CELLP=NCELL WCELL=NEWWCELL SEMACELL_TOP=WCELL SEMACELL_BTM=WCELL %RETURN !----------------------------------------------------------------------- ACT(2): ! v operation %WHILE CELLP#0 %CYCLE SEMACELL==PARM(CELLP) %IF SEMA=SEMACELL_SEMA %THENSTART SEMACELL_TICK=TICKS; ! record v operation I=SEMACELL_TOP %IF I#0 %START; ! in case 2 v operations SEMACELL_TOP=PARM(I)_LINK PARM(I)_SRCE=P_SRCE; ! if a timeout P_SRCE = X'70004' ! this SRCE enables director to reset faulty SEMA J=SEMACELL_TOP; K=0 %WHILE J>0 %CYCLE K=K+1; J=PARM(J)_LINK %REPEAT PARM(I)_P1=K; ! return outstanding count to dir FASTPON(I) %FINISH %IF SEMACELL_TOP=0 %THENSTART; ! return headcell I=SEMACELL_LINK RETURN PP CELL(CELLP) CELLP=I %FINISH %RETURN %FINISH CELLP==SEMACELL_LINK %REPEAT ! ! p operation not here yet ! NCELL=NEWSCELL CELLP=NCELL %RETURN !----------------------------------------------------------------------- ACT(3): ! display semaphore queues %IF MONLEVEL&2#0 %THENSTART %FOR HASHP=0,1,31 %CYCLE CELLP==HASH(HASHP) %WHILE CELLP#0 %CYCLE SEMACELL==PARM(CELLP) SEMA=SEMACELL_SEMA I=SEMACELL_TOP %WHILE I#0 %CYCLE OPMESS("Sema x".HTOS(SEMA,8)." q :x".HTOS(PARM(I)_DEST>>16,3)) I=PARM(I)_LINK %REPEAT CELLP==SEMACELL_LINK %REPEAT %REPEAT %FINISH %RETURN !----------------------------------------------------------------------- ACT(4): ! ten second tick TICKS=TICKS+1 %FOR HASHP=0,1,31 %CYCLE CELLP==HASH(HASHP) %WHILE CELLP#0 %CYCLE SEMACELL==PARM(CELLP) %IF TICKS-SEMACELL_TICK>=12 %START; ! 2 mins since v oper OPMESS("Fsema timeout ".HTOS(SEMACELL_SEMA,8)) P_DEST=x'70002' P_SRCE=x'70004' P_P1=SEMACELL_SEMA PON(P) %FINISH CELLP==SEMACELL_LINK %REPEAT %REPEAT %RETURN %INTEGERFN NEWWCELL %INTEGER I I=NEWPPCELL WAITCELL==PARM(I) WAITCELL_DEST=P_SRCE WAITCELL_SRCE=x'70001' WAITCELL_LINK=0 %IF MONLEVEL&2#0 %THEN WAITCELL_P5=m'SEMA' %IF MONLEVEL&2#0 %THEN WAITCELL_P6=m'WAIT' %RESULT=I %END !----------------------------------------------------------------------- %INTEGERFN NEWSCELL %INTEGER I I=NEWPPCELL SEMACELL==PARM(I) SEMACELL=0 SEMACELL_SEMA=SEMA SEMACELL_TICK=TICKS %IF MONLEVEL&2#0 %THEN SEMACELL_P5=m'SEMA' %IF MONLEVEL&2#0 %THEN SEMACELL_P6=m'head' %RESULT=I %END %END %ENDOFFILE