! ! Chnages for IFAST22 ! ! 1) uses more chain space ! 2) Better queueing within cylinders for transfers ! 3) more selective use of seek ans set sector ! ! ! Changes for vsn 21 ! 1) New format for store array to allow for bigger AMT ! 2) Conditional compilation of Q REQUEST and other non xa rts ! %INCLUDE "ercc07:ibmsup_comf370" %INCLUDE "ercc07:ibmsup_page0f" %INCLUDE "ercc07:ibmsup_dtform2s" %INCLUDE "ercc07:ibmsup_xaioform" %RECORD %FORMAT PARMF(%INTEGER DEST,SRCE,(%INTEGER P1,P2,P3,P4,P5, P6 %OR %STRING (23) TEXT)) %CONST %INTEGER PCELLSIZE=36,MARGIN=48 %RECORD %FORMAT PDOPEF(%INTEGER CURRMAX,MAXMAX,FIRST UNALLOC,LAST UNALLOC,NEXTPAGE,S1, S2,S3,S4) %RECORD %FORMAT PARMXF(%INTEGER DEST,SRCE,P1,P2,P3,P4,P5,P6,LINK) %CONST %RECORD (PARMXF) %ARRAY %NAME PARM=PARM0AD %CONST %RECORD (PDOPEF) %NAME PARMDOPE=PARM0AD %RECORD %FORMAT STOREF(%SHORT %INTEGER FLAGS,USERS, %INTEGER LINK, %SHORT %INTEGER BLINK,FLINK) %CONST %RECORD (STOREF) %ARRAY %NAME STORE=STORE0AD ! %EXTERNAL %LONG %INTEGER SEMATIME=0 %OWN %INTEGER PARMASL=0 %EXTERNAL %INTEGER MAINQSEMA=-1 %EXTERNAL %INTEGER %SPEC STORESEMA %OWN %INTEGER %ARRAY GET NEW PAGE(0:14); ! parms for call of new epage ! %CONST %INTEGER LOCSN1=LOCSN0+MAXPROCS %OWN %INTEGER APONSTAT1=0,APONSTAT2=0; !APON STATISTICS..SH %RECORD %FORMAT 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 %CONST %RECORD (SERVF) %ARRAY %NAME SERVA=SERVAAD ! Local controllers & user services inhibited initially %EXTERNAL %INTEGER KERNELQ=0, RUNQ1=0, RUNQ2=0 %RECORD %FORMAT PROCF(%STRING (6) USER, %BYTE %INTEGER INCAR,CATEGORY,WSN,RUNQ,ACTIVE, %INTEGER ACTW0,LSTAD,LAMTX,STACK,STATUS) %OWN %RECORD (PROCF) %ARRAY %FORMAT PROCAF(0:MAXPROCS) %OWN %RECORD (PROCF) %ARRAY %NAME PROCA %IF MONLEVEL&2#0 %THEN %START %EXTERNAL %LONG %INTEGER %SPEC KMON %FINISH ! ! ! %EXTERNAL %STRING %FN %SPEC STRHEX(%INTEGER N) %EXTERNAL %STRING %FN %SPEC STRINT(%INTEGER N) %EXTERNAL %STRING %FN %SPEC HTOS(%INTEGER VAL,PL) ! %EXTERNAL %ROUTINE %SPEC OPMESS(%STRING (63) S) %EXTERNAL %ROUTINE %SPEC ETOI(%INTEGER A,L) %EXTERNAL %ROUTINE %SPEC DUMPTABLE(%INTEGER T,A,L) %EXTERNAL %ROUTINE %SPEC PKMONREC(%STRING (23) TEXT, %RECORD (PARMF) %NAME P) %EXTERNAL %INTEGER %FN %SPEC REALISE(%INTEGER VAD) ! %IF MULTI OCP=YES %START %EXTERNAL %ROUTINE %SPEC RESERVE LOG %EXTERNAL %ROUTINE %SPEC RELEASE LOG %ROUTINE %SPEC halt other ocp %ROUTINE %SPEC restart other ocp %FINISH ! %CONST %LONG %INTEGER DISAWAIT=x'2000000000000' %OWN %LONG %INTEGER 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 ! %EXTERNAL %INTEGER %FN 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 * !*********************************************************************** %CONST %INTEGER 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'!CCW Format<<23!(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 %C 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 %externalintegerfn getmyport !*********************************************************************** !* obtains id of current cpu * !*********************************************************************** %integer i i=0 *STAP_I %result=i>>16 %end %externalROUTINE halt other ocp !*********************************************************************** !* suspends all other OCPs normally only one but coded for more * !*********************************************************************** %integer i,status,cc,myport,hisport myport=getmyport %for i=1,1,COM_NOCPS %cycle hisport=com_ocp port(i) %if myport#hisport %Start *sr_0,0; *sr_1,1; *l_2,hisport *sigp_0,2,5(0); ! 5 for stop *st_0,status; ! status only if cc=1 *ipm_1; *srl_1,28(0); *st_1,cc %if cc#0 %start opmess("OCP".strint(i)." fails to stop ".htos(cc<<8!status,3)) %finish %finish %repeat %END %externalROUTINE restart other ocp !*********************************************************************** !* restarts all other OCPs normally only one but coded for more * !*********************************************************************** %integer i,status,cc,myport,hisport myport=getmyport %for i=1,1,COM_NOCPS %cycle hisport=com_ocp port(i) %if myport#hisport %Start *sr_0,0; *sr_1,1; *l_2,hisport *sigp_0,2,4(0); ! 4 for restart *st_0,status; ! status only if cc=1 *ipm_1; *srl_1,28(0); *st_1,cc %if cc#0 %start opmess("OCP".strint(i)." fails to restart ".htos(cc<<8!status,3)) %finish %finish %repeat %END %FINISH ! %EXTERNAL %ROUTINE SYSERR(%INTEGER STK,IP) %END ! !------------------------------------------------------------------------ ! %EXTERNAL %ROUTINE STOP %ALIAS "S#STOP" %IF multi ocp=yes %THEN halt other ocp PSW=PSW0!DISAWAIT!x'd1ed' *LPSW_psw %END ! %EXTERNAL %ROUTINE MONITOR(%STRING (63) S) PRINTSTRING(S) NEWLINE %MONITOR %STOP %END ! !----------------------------------------------------------------------- %ROUTINE PUTONQ(%INTEGER SERVICE) %RECORD (PROCF) %NAME PROC %RECORD (SERVF) %NAME SERV,SERVQ %INTEGER %NAME 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) %FINISH %ELSE %IF XA=YES %START I=INTEGER(SEGTAB VA+4*PAGE0 SEG); ! PTO *L_0,i; *L_1,rtvvad; *IPTE_0,1 %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 ! !------------------------------------------------------------------------ ! %EXTERNAL %INTEGER %FN PPINIT(%INTEGER %FN NEW EPAGE) %CONST %INTEGER INIT EPAGES=SERVASIZE//PAGESIZE+1 %INTEGER %ARRAY REALADS(0:INIT EPAGES) %INTEGER I,J,K,CELLS %LONG %INTEGER 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 %C STORE0AD#COM_STOREAAD %THEN PRINTSTRING("Incompatible components!!! ") ! page table at beginning of PPSEG %IF XA=NO %THEN J=INIT EPAGES %ELSE J=PARM PT SIZE//16-1 %IF XA=YES %THEN j=j!X'10'{Common segment bit} %ELSE 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) %ELSE %IF PTE SIZE=2 %THEN %C K=x'800' %ELSE K=x'400' %IF PTE SIZE=2 %THEN SHORTINTEGER(I+J*PTE SIZE)<-K>>8 %ELSE %C 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 ! !------------------------------------------------------------------------ ! %INTEGER %FN APON(%RECORD (PARMF) %NAME P) !*********************************************************************** !* ADDED MARCH-88, S.HAYES * !* HANDLES TERMINAL UPDATE MESSAGES, AND INT MESSAGES * !* If handled completely by APON, result=0. * !* If message needs to be queued as normal, result=1. * !* Only called for P_SRCE=X'0037000C' OR P_SRCE=X'00390005' * !* Ie update input and terminal INT messages * !* A precaution aginst fast workstations emulating terminals * !*********************************************************************** %RECORD (SERVF) %NAME SERV %RECORD (PARMXF) %NAME NCELL %INTEGER SERVICE,NEXTCELL,SERVP !* %IF P_SRCE#X'0037000C' %AND P_SRCE#X'00390005' %THEN ->DONE !* !IGNORE IF NOT INPUT UPDATE, OR INTERRUPT MESSAGE SERVICE=P_DEST>>16 SERV==SERVA(SERVICE) SERVP=SERV_P&X'3FFFFFFF' %IF SERVP=0 %THEN ->DONE; !NOTHING QUEUED NCELL==PARM(SERVP) %CYCLE NEXTCELL=NCELL_LINK NCELL==PARM(NEXTCELL) %IF NCELL_SRCE=P_SRCE %AND NCELL_P1=P_P1 %THEN %START ! SAME SRCE, SAME CONSOLE %IF P_SRCE=X'0037000C' %THEN %START !UPDATE INPUT POINTER NCELL_P2=P_P2 %IF APONSTAT1#X'7FFFFFFF' %THEN APONSTAT1=APONSTAT1+1 !KEEP STATISTICS %FINISH %ELSE %START !SRCE=X'00390005'..UPDATE INTERRUPT STRING !Check length before move..just in case %IF BYTEINTEGER(ADDR(P_P3))<=15 %THEN %C STRING(ADDR(NCELL_P3))=STRING(ADDR(P_P3)) %IF APONSTAT2#X'7FFFFFFF' %THEN APONSTAT2=APONSTAT2+1 !KEEP STATISTICS %FINISH %RESULT=0; !OK..message merged with previous %FINISH %EXIT %IF NEXTCELL=SERVP; !LAST ONE PROCESSED %REPEAT DONE: !SCAN COMPLETE %RESULT=1; !SIGNAL NORMAL PON QUEING REQUIRED %END ! !------------------------------------------------------------------------ ! %EXTERNAL %ROUTINE 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) %AND %RETURN %IF MULTIOCP=YES %THEN %START *basr_2,0; *using_2 *SLR_1,1; *LR_0,1; *BCTR_0,0; *CS_0,1,MAINQSEMA *BC_8,; *drop_2 SEMALOOP(MAINQSEMA) PSEMAGOT: %FINISH %IF SERVICE>LOCSN1 {LOCSNO+MAXPROCS} %AND (P_SRCE=X'0037000C' %OR %C P_SRCE=X'00390005') %THEN %START ! Message for process..may be asynch update message %IF APON(P)=0 %THEN ->FREESEMA !If APON has handled it, then nothing more to do ! If not handled by APON - use normal PON code. %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 %ELSE %START 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) %ELSE %START %IF KERNELQ=0 %THEN SERV_L=SERVICE %ELSE %START SERVQ==SERVA(KERNELQ) SERV_L=SERVQ_L SERVQ_L=SERVICE %FINISH KERNELQ=SERVICE %FINISH %FINISH FREESEMA: %IF MULTIOCP=YES %START; MAINQSEMA=-1; %FINISH %END ! !------------------------------------------------------------------------ ! %EXTERNAL %ROUTINE 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 %THEN %START SEMALOOP(MAINQSEMA) %FINISH SERVP=SERV_P&x'3fffffff' %IF SERVP=0 %THEN CCELL_LINK=CELL %ELSE %START 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 %THEN %START %IF SERVICE>=LOCSN0 %THEN PUTONQ(SERVICE) %ELSE %START %IF KERNELQ=0 %THEN SERV_L=SERVICE %ELSE %START SERVQ==SERVA(KERNELQ) SERV_L=SERVQ_L SERVQ_L=SERVICE %FINISH KERNELQ=SERVICE %FINISH %FINISH %IF MULTIOCP=YES %THEN MAINQSEMA=-1 %END !----------------------------------------------------------------------- %EXTERNAL %ROUTINE 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) %AND %RETURN %IF DELAY<=0 %THEN PON(P) %AND %RETURN %IF MULTIOCP=YES %THEN %START SEMALOOP(MAINQSEMA) %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 !----------------------------------------------------------------------- %EXTERNAL %ROUTINE 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 ! !------------------------------------------------------------------------ ! %EXTERNAL %INTEGER %FN NEWPPCELL %INTEGER NEWCELL %RECORD (PARMXF) %NAME ACELL %IF multiocp=yes %THEN %START semaloop(mainqsema) %FINISH %IF PARMASL=0 %THEN MORE PPSPACE ACELL==PARM(PARMASL) NEWCELL=ACELL_LINK %IF NEWCELL=PARMASL %THEN PARMASL=0 %ELSE ACELL_LINK=PARM(NEWCELL)_LINK %IF multi ocp=yes %THEN mainqsema=-1 %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; *drop_2 SEMALOOP(MAINQSEMA) GOT: %FINISH %FOR I=0,1,3 %CYCLE %IF MASK&(1<; *drop_2 SEMALOOP(MAINQSEMA) GOT: %FINISH %FOR I=0,1,3 %CYCLE %IF MASK&(1<; *drop_2 SEMALOOP(MAINQSEMA) SSEMAGOT: %FINISH SERVP=SERV_P&X'3FFFFFFF' %IF SERVP=0 %START %IF MULTI OCP=YES %START; MAINQSEMA=-1; %FINISH %RETURN %FINISH %IF MONLEVEL&2#0 %THEN %START %IF MULTIOCP=YES %START; MAINQSEMA=-1; %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 %THEN %START *basr_2,0; *using_2 *SLR_1,1; *LR_0,1; *BCTR_0,0; *CS_0,1,MAINQSEMA *BC_8,; *drop_2 SEMALOOP(MAINQSEMA) SSEMAGOT2: %FINISH %FINISH SERV_P=SERV_P&X'C0000000' %IF PARMASL#0 %THEN CELL=PARM(SERVP)_LINK %AND %C PARM(SERVP)_LINK=PARM(PARMASL)_LINK %AND PARM(PARMASL)_LINK=CELL PARMASL=SERVP %IF MULTIOCP=YES %START; MAINQSEMA=-1; %FINISH %END !------------------------------------------------------------------------ %EXTERNAL %ROUTINE 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) %AND %RETURN ACT(2): ! one time only %RETURN %IF 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) %RETURN %IF 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 %INTEGER %FN 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 %RECORD %FORMAT PROPFORM(%INTEGER TRACKS,CYLS,PPERTRK,BLKSIZE,TOTPAGES,SP1,SP2,SP3, KEYLEN,SECTINDX) %RECORD %FORMAT LABFORM(%BYTE %INTEGER %ARRAY VOL(0:5), %BYTE %INTEGER S1,S2,S3,S4, ACCESS, %BYTE %INTEGER %ARRAY RES(1:20), %BYTE %INTEGER C1,C2,AC1,AC2,TPC1,TPC2,BF1, BF2, %BYTE %INTEGER %ARRAY POINTER(0:3),IDENT(1:14)) %RECORD %FORMAT CCWF(%INTEGER CMDAD, %BYTE %INTEGER FLAGS,SP, %SHORT %INTEGER LEN) %RECORD %FORMAT PQF(%INTEGER ADDT,CCWA,P1,P2,P3,P4,P5,P6,LINK) %CONST %INTEGER NORMALT=x'0c000000',ERRT=x'02000000',ATTNT=x'80000000' %CONST %INTEGER BUSY=x'10000000',OFFLINE=x'40000000',LOGGING=x'00001000' %CONST %INTEGER smod=x'40000000' %CONST %INTEGER cuend=x'20000000' %CONST %INTEGER nostartmask=x'ffff0000'!!(smod!busy!cuend) %CONST %INTEGER DISCSNO=x'200000',PDISCSNO=x'210000' %CONST %INTEGER SCHEDSNO=x'30000' %OWN %BYTE %INTEGER %ARRAY %FORMAT LVNF(0:99) %OWN %BYTE %INTEGER %ARRAY %NAME LVN %OWN %INTEGER DITADDR=0,NDISCS=0,CHANNELQ=0,CHANNELQ SEMA=-1 ! %ROUTINE %SPEC PDISC(%RECORD (PARMF) %NAME P) %EXTERNAL %ROUTINE DISC(%RECORD (PARMF) %NAME P) %ROUTINE %SPEC CONSOLE ALARM %if XA#YES %start %ROUTINE %SPEC Fire Queued %finish %ROUTINE %SPEC READ DLABEL(%RECORD (DTFORM) %NAME DDT) %ROUTINE %SPEC READ LOG(%RECORD (DTFORM) %NAME DDT) %ROUTINE %SPEC LABREAD ENDS %ROUTINE %SPEC UNLOAD(%RECORD (DTFORM) %NAME DDT) %STRING %FN %SPEC MTOS(%INTEGER M) %ROUTINE %SPEC SENSE(%RECORD (DTFORM) %NAME DDT) %ROUTINE %SPEC DREPORT(%RECORD (DTFORM) %NAME DDT, %RECORD (PARMF) %NAME P) %INTEGER %FN %SPEC FIRE CHAIN(%RECORD (DTFORM) %NAME DDT, %INTEGER CCWA,Qcount) %RECORD (DTFORM) %NAME DDT %RECORD (PROPFORM) %NAME PROP %RECORD (LABFORM) %NAME LABEL %RECORD (CCWF) %NAME CCW %RECORD (PQF) %NAME CQ %RECORD (SCHIBF) SCHIB %CONST %INTEGER DEAD=0,CONNIS=1,RLABIS=2,DCONNIS=3,AVAIL=4,PAGTIS=5 %CONST %INTEGER PAGSIS=6,INOP=7,RRLOG=8,RRLOGP=9,PAVAIL=10,PCLAIMD=11,PTRANIS=12 %CONST %INTEGER PSENIS=13,SPTRANIS=14,RLABSIS=15,RESERVE=16,RELEASE=17 %CONST %INTEGER RESPX=1<>32&1#0 %THEN PKMONREC("DISC:",P) %IF ACT>=64 %THEN ->ACT64 ->INACT(ACT) ! INACT(0): !initialisation %RETURN %UNLESS 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 %IF CCW Format=1 %START integer(ddt_CCWA-8)=X'04200018' integer(DDT_CCWA-4)=realise(addr(DDT_SENSE1)) %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 %FINISH %ELSE 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 %FINISH %ELSE ->CLAIM FAILS %ELSE %IF DDT_STATE#PCLAIMD %THEN OPMESS("Duff dev returned") %AND %RETURN 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 %IF XA#YES %and Channelq#0 %THEN Fire Queued DDT==RECORD(P_P1) %IF multi ocp=yes %THEN %START semaloop(ddt_sema) %FINISH %IF DDT_STATE#AVAIL %OR P_SRCE&x'ffff0000'#PDISCSNO %THEN ->REJECT DDT_STATE=PAGTIS DDT_ID=P_P1 %IF multiocp=yes %THEN ddt_sema=-1 I=FIRE CHAIN(DDT,DDT_CCWA,99) %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,DDT_CCWA,99) %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 %THEN %RETURN 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<wayout !TOUT: ! timed out %RETURN ! INACT(6): ! print statistsics %RETURN %UNLESS 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)) %CONTINUE %UNLESS 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(2) PRINTSTRING("APON STATS UPDATE/INT:") WRITE(APONSTAT1,6) WRITE(APONSTAT2,6) APONSTAT1=0 APONSTAT2=0 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)) %IF DDT_ALT CUU=0 %THEN S="none" %ELSE S=HTOS(DDT_ALT CUU,3) OPMESS(MTOS(DDT_MNEMONIC)." (".HTOS(DDT_CUU, 3)."/".S.") ".DDT_LABEL." ".STRINT(DDT_STATE)." ".STRINT(DDT_STATS2). %C " ".STRINT(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: %IF XA#YES %and CHANNELQ#0 %THEN Fire Queued; ! try waiting I/Os (non xa only) %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)) %IF multi ocp=yes %THEN %START semaloop(ddt_sema) %FINISH %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 %IF multiocp=yes %THEN ddt_sema=-1 READ DLABEL(DDT); ! try again LABREADS=LABREADS+1 %RETURN %FINISH %ELSE 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 %FINISH %ELSE 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 ! NINT(RESERVE): NINT(RELEASE): %IF DDT_STATE=RESERVE %START OPMESS(MTOS(DDT_MNEMONIC)." accepted") READ DLABEL(DDT) LABREADS=LABREADS+1 DDT_STATE=RLABIS %FINISH %ELSE %START DDT_STATE=DEAD OPMESS(MTOS(DDT_MNEMONIC)." released") %FINISH ->WAYOUT FINT(RESERVE): FINT(RELEASE): AINT(RESERVE): AINT(RELEASE): %IF DDT_STATE=RESERVE %THEN S=" reserve" %ELSE S=" release" OPMESS(MTOS(DDT_MNEMONIC).S." fails") DDT_STATE=DEAD SENSE(DDT) ->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 ! %STRING %FN MTOS(%INTEGER M) !*********************************************************************** !* Turn integer m into a string * !*********************************************************************** %INTEGER I,J I=4; J=M %RESULT=STRING(ADDR(I)+3) %END ! %if XA#YES %START %ROUTINE Fire Queued !*********************************************************************** !* Tried an fire a io request that was held up by channel busy * !* Should not occurr when running under XA * !*********************************************************************** %INTEGER i,j %RECORD (PQF) %NAME CQ %RECORD (DTFORM) %NAME DDT %IF MULTI OCP=YES %START SEMALOOP(CHANNELQ SEMA) %FINISH CQ==PARM(CHANNELQ) DDT==RECORD(CQ_ADDT) I=CHANNELQ CHANNELQ=CQ_LINK j=FIRE CHAIN(DDT,CQ_CCWA,cq_p6-1) RETURN PP CELL(I) %IF MULTI OCP=YES %THEN CHANNELQ SEMA=-1 %END %finish %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) %IF CCW Format=0 %THEN %START 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' %ELSE integer(I)=X'13600001' integer(I+4)=0 integer(I+8)=X'31600005' integer(I+12)=RAD+32 integer(I+16)=x'08000000' integer(I+20)=RAD+8 integer(I+24)=X'06200050' integer(I+28)=RAD+40 %FINISH INTEGER(I+32)=0; ! cchh = 0 INTEGER(I+36)=0; ! r0 I=FIRE CHAIN(DDT,I,7) %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 %IF multi ocp=yes %THEN %START semaloop(ddt_sema) %FINISH %IF CCW Format=0 %START INTEGER(DDT_CCWA)=x'a4000000'!REALISE(ADDR(DDT_SENSE1)) INTEGER(DDT_CCWA+4)=24 %ELSE integer(DDT_CCWA)=X'A4000018' integer(DDT_CCWA+4)=realise(addr(DDT_SENSE1)) %FINISH DDT_STATE=RRLOG %IF multiocp=yes %THEN ddt_sema=-1 I=FIRE CHAIN(DDT,DDT_CCWA,7) %END ! %if XA#YES %start %ROUTINE Q REQUEST(%RECORD (DTFORM) %NAME DDT, %INTEGER CCWA,count) !*********************************************************************** !* All routes give channel busy so queue request for later retry * !*********************************************************************** %INTEGER %NAME 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 cq_P6=count %END %finish ! %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,DDT_CCWA-8,3) %UNLESS I=0 %START; ! failed PRINTSTRING("DISC sense fails ".STRINT(I)." on ".MTOS(DDT_MNEMONIC)." CSW: ". %C HTOS(PAGE0_CSW1,8)." ".HTOS(PAGE0_CSW2,8)) NEWLINE DDT_SENSE1=OFFLINE %IF I=3; ! offline if inop %FINISH %END ! %INTEGER %FN FIRE CHAIN(%RECORD (DTFORM) %NAME DDT, %INTEGER CCWA,Qcount) !*********************************************************************** !* 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 %FINISH %ELSE 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) %ELSE %START IRB=0 IRB_CSW1=PAGE0_CSW1 IRB_CSW2=PAGE0_CSW2 %FINISH %IF XA#YES %and QCOUNT>0 %AND (I=2 %OR (I=1 %AND irb_CSW2&nostartmask=0)) %THEN %C Q REQUEST(DDT,CCWA,Qcount) %AND %RESULT=0 ! unless busy with no errors %IF I=3 %THEN IRB_CSW2=ERRT; ! CUU inop %IF I=2 %THEN IRB_CSW2=ERRT!BUSY P_DEST=DISCSNO!3; ! pon abterm P_SRCE=m'FIRE' %IF XA=YES %THEN %START P_P1=ADDR(DDT) P_P2=IRB_CSW1 P_P4=IRB_KEYCNTR P_P5=IRB_XSTATUSW %ELSE P_P1=CUU p_P2=i<<24; ! field not set on cc=1 but fake dffrd CC P_P4=BYTEINTEGER(COM_STEER INT+P_P1) %FINISH P_P3=IRB_CSW2 PON(P) %RESULT=I %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 %C (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 %EXIT %IF 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 ! !------------------------------------------------------------------------ ! %EXTERNAL %ROUTINE PDISC(%RECORD (PARMF) %NAME P) %CONST %INTEGER %ARRAY CMD(1:6)=x'06000000',x'05000000'(2),x'06000000'(2), x'05000000' %RECORD %FORMAT REQFORM(%INTEGER DEST, %BYTE %INTEGER FAULTS,FCCW,LCCWP1,REQTYPE, %INTEGER IDENT,CYLINK,COREADDR,CYL, (%integer TRKSECT %or %short TRK,%byte sect,dontuse),%integer STOREX,REQLINK) %RECORD (DTFORM) %NAME DDT %RECORD (PROPFORM) %NAME PROP %RECORD (PARMXF) %NAME ACELL %RECORD (REQFORM) %NAME REQ,ENTRY %RECORD (PARMF) Q %CONST %INTEGER TRANOK=0,TRANWITHERR=1,TRANREJECT=2,NOTTRANNED=3 %CONST %INTEGER ABORTED=4,PTACT=5,POUTACT=6 %CONST %INTEGER RETRIES=7,MIN READ ADDR=x'c000',Chain space=760 %ROUTINE %SPEC QUEUE(%INTEGER %NAME QHEAD, %INTEGER REQ,CYL) %ROUTINE %SPEC PTREPLY(%RECORD (REQFORM) %NAME REQ, %INTEGER FAIL) %SWITCH PDA(0:11) %OWN %INTEGER INIT=0,TRAP=0,TFSYS=0 %INTEGER %NAME 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 %RETURN %IF 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 multi ocp=yes %THEN %START semaloop(mainqsema) %FINISH %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 %IF multiocp=yes %THEN mainqsema=-1 P_SRCE=ACT REQ<-P REQ_DEST=SRCE REQ_CYLINK=0 REQ_CYL=CYL REQ_TRKSECT=(TRACK<<8!SECT)<<8 REQ_REQLINK=0 %IF multi ocp=yes %THEN %START semaloop(ddt_sema) %FINISH %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 %IF multi ocp=yes %THEN ddt_sema=-1 %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+(Chainspace-8) RSEEKA=REALISE(SEEKA) PROP==RECORD(DDT_PROPADDR) SECTINDX=PROP_SECTINDX FCCW=0; I=0; track=-1; sect=-2 %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 %unless REQ_TRK=Track %start; ! Seek unless the same track %IF CCW Format=0 %START INTEGER(CCWA)=x'07000000'!RSEEKA INTEGER(CCWA+4)=x'40000006' %ELSE integer(CCWA)=X'07400006' integer(CCWA+4)=RSEEKA %FINISH CCWA=CCWA+8 %finish %unless req_sect=Sect+1 %start; ! RPS unless next record %IF CCW Format=0 %START INTEGER(CCWA)=x'23000000'!(RSEEKA+7) INTEGER(CCWA+4)=x'40000001' %ELSE integer(CCWA)=X'23400001' integer(CCWA+4)=RSEEKA+7 %FINISH CCWA=CCWA+8 %finish %IF CCW Format=0 %START INTEGER(CCWA)=x'31000000'!(RSEEKA+2) INTEGER(CCWA+4)=x'40000005' INTEGER(CCWA+8)=x'08000000'!REALISE(CCWA) INTEGER(CCWA+12)=0 %ELSE integer(CCWA)=X'31400005' integer(CCWA+4)=RSEEKA+2 integer(CCWA+8)=X'08000000' integer(CCWA+12)=realise(CCWA) %FINISH CCWA=CCWA+16 %IF CCW Format=0 %START INTEGER(CCWA)=CMD(REQ_REQTYPE&255)!REQ_COREADDR INTEGER(CCWA+4)=x'40000000'!PAGESIZE %ELSE integer(CCWA)=CMD(REQ_REQTYPE&255)!x'00400000'!pagesize integer(CCWA+4)=REQ_COREADDR %FINISH INTEGER(SEEKA)=CYL INTEGER(SEEKA+4)=REQ_TRKSECT!((REQ_SECT-1)*SECTINDX) CCWA=CCWA+8 SEEKA=SEEKA-8 RSEEKA=RSEEKA-8 I=I+1 Track=Req_Trk; Sect=Req_Sect 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) %EXIT %IF Seeka-ccwa<48; ! Not room for another transfer %REPEAT REQ_REQLINK=DDT_UQLINK DDT_UQLINK=CELL ! DECHAIN: %IF I=0 %THEN ->DOMORE %IF CCW Format=0 %THEN INTEGER(CCWA-4)=INTEGER(CCWA-4)&x'bfffffff' %ELSE %C integer(CCWA-8)=integer(CCWA-8)&X'FFBFFFFF' DDT_STATS2=DDT_STATS2+I Q_DEST=DISCSNO!2 Q_SRCE=PDISCSNO!10 Q_P1=ADDR(DDT) DDT_QSTATE=1 DDT_CURCYL=CYL %IF multi ocp=yes %THEN ddt_sema=-1 DISC(Q) %RETURN ! PDA(10): ! P_P2=0 for successfully chains ! P_P2=1 for unsuccessfull chains ! P_P2=-1 for time outs ! p_p3=csw1 or xa equivalent ! P_P6=secondary status DDT==RECORD(P_P1) %IF multi ocp=yes %THEN %START semaloop(ddt_sema) %FINISH 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) %ELSE %START INTEGER(ADDR(REQ)+4)=PDISCSNO REQ_CYLINK=0 FASTPON(CELL) %FINISH CELL=J %REPEAT DDT_TRLINK=0 %ELSE pkmonrec("PDISC tranfail:",p) DDT_STATS1=DDT_STATS1+1 %IF XA=Yes %THEN ccwa=p_p3&x'7fffffff' %ELSE ccwa=P_P3&X'FFFFFF' %IF ccwa=0 %THEN ERRCCW=0 %ELSE ERRCCW=((ccwa)-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 (P_P2#-1 {Not timeout} %AND REQ_LCCWP1<=ERRCCW) %OR %C 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<=ERRCCWINIT TRANSFER %IF DDT_UQLINK#0 DDT_QSTATE=0 %IF multi ocp=yes %THEN ddt_sema=-1 %RETURN ! PDA(11): DDT==RECORD(INTEGER(DITADDR+4*P_P1)) %IF multi ocp=yes %THEN %START semaloop(ddt_sema) %FINISH 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(%INTEGER %NAME 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 %EXIT %IF NEXTCELL=0 NEXTREQ==PARM(NEXTCELL) %EXIT %IF NEXTREQ_CYL>CYL ENTRY==NEXTREQ %REPEAT REQ_REQLINK=NEXTCELL ENTRY_REQLINK=CELL %RETURN QONCYL: ! ! This is a fast attempt to queue by sector within cylinder ! most transfers do come in order. To avoid searching the queu is ! restarter each time the maximum sectore is encountered ! %cycle next cell=entry_cylink %exit %if next cell=0 %or prop_ppertrk=req_sect next req==parm(next cell) %exit %if req_sect1 %THEN %START; ! 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 %THEN %START SEMALOOP(STORESEMA) %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 ! %EXTERNAL %ROUTINE SEMAPHORE(%RECORD (PARMF) %NAME P) %RECORD %FORMAT SEMAF(%INTEGER DEST,SRCE,TOP,BTM,SEMA,TICK,P5,P6,LINK) %RECORD (SEMAF) %NAME SEMACELL %RECORD (PARMXF) %NAME WAITCELL %OWN %INTEGER %ARRAY HASH(0:31)=0(32) %OWN %INTEGER TICKS=0 %INTEGER %FN %SPEC NEWSCELL %INTEGER %FN %SPEC NEWWCELL %INTEGER SEMA,HASHP,NCELL,I,J,K,WCELL %INTEGER %NAME 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 %THEN %START I=SEMACELL_BTM %IF I=0 %THEN %START; ! already had v operation SEMACELL_DEST=P_SRCE SEMACELL_SRCE=x'70001' FASTPON(CELLP) CELLP=0 %FINISH %ELSE %START; ! 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 %THEN %START 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 %THEN %START; ! 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 %THEN %START %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 %INTEGER %FN 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 !----------------------------------------------------------------------- %INTEGER %FN 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 %END %OF %FILE