%OWNLONGINTEGER VSN=X'5344495343205631';     ! M'SDISC V1'
! DRIVING DISCS VIA DCU WRITTEN BY PDS JAN 79
!
%RECORDFORMAT PARMF(%INTEGER DEST,SRCE,P1,P2,P3,P4,P5,P6)
!* COMMUNICATIONS RECORD FORMAT - EXTANT FROM CHOPSUPE 18D ONWARDS *
! Alterations from above-mentioned record format, for the S-series, are
! as follows:
!     GPCTABSIZE  ->   DCUTABSIZE
!     GPCA        ->   DCUA
!     SMACS       ->   SCUS
!     GPCCONFA    ->   DCUCONFA
%RECORDFORMAT COMF(%INTEGER OCPTYPE,IPLDEV,SBLKS,SEPGS,NDISCS,  %C
         DDTADDR,DCUTABSIZE,DCUA,SFCTABSIZE,SFCA,SFCK,DIRSITE,  %C
         DCODEDA,SUPLVN,KLOKCORRECT,DATE0,DATE1,DATE2,  %C
         TIME0,TIME1,TIME2,EPAGESIZE,USERS,PROCMON,DQADDR,  %C
         SACPORT,OCPPORT,ITINT,CONTYPEA,DCUCONFA,FPCCONFA,SFCCONFA, %C
         BLKADDR,DPTADDR,SCUS,TRANS,%LONGINTEGER KMON,  %C
         %INTEGER SPDRQ,SMACPOS,SUPVSN,PSTVA,SECSFRMN,SECSTOCD, %C
         SYNC1DEST,SYNC2DEST,ASYNCDEST,MAXPROCS,INSPERSEC,ELAPHEAD, %C
         COMMSRECA,STOREAAD,PROCAAD,SFCCTAD,DRUMTAD,SP0,SP1,SP2,SP3, %C
            SP4,SP5,SP6,SP7,SP8,SP9,  %C
         LSTL,LSTB,PSTL,PSTB,HKEYS,HOOT,SIM,CLKX,CLKY,CLKZ,  %C
         HBIT,SLAVEOFF,INHSSR,SDR1,SDR2,SDR3,  %C
         SDR4,SESR,HOFFBIT,S2,S3,S4,END)
%RECORDFORMAT TCBF(%INTEGER CMD,STE,DATA LEN,DATA AD,NEXT TCB, %C
   RESP,PRE0,PRE1,PRE2,PRE3,POST0,POST1,POST2,POST3,POST4,POST5, %C
      POST6,POST7)
%RECORDFORMAT INITF(%BYTEINTEGER MECH,CMASK,SMASK,MODE,FN,SEG, %C
      %HALFINTEGER CYL, %BYTEINTEGER HEAD,HDLIMIT, %HALFINTEGER SCYL, %C
      SHEAD, %BYTEINTEGER SECT,OFFSET,%HALFINTEGER DL)
%RECORDFORMAT DDTFORM(%INTEGER SER,PTS,PROPADDR,STATUS, %C
      CCA,GRCBAD,LASTT,LAST TCBAD,STATE,PAW,IW2,SENSE1,SENSE2,SENSE3,%C
      SENSE4,UASTE,BASE,ID,DLVN,MNEMONIC,%STRING(6)LAB, %BYTEINTEGER %C
      HWCODE,%INTEGER ENTSIZE,URCB AD,SENSDAT AD,LOGMASK,TRTABAD,%C
      UA SIZE,UA AD,TIMEOUT,PROPS0,PROPS1)
!
%RECORDFORMAT PROPFORM(%INTEGER TRACKS,CYLS,PPERTRK,BLKSIZE,TOTPAGES,%C
      RQBLKSIZE,LBLKSIZE,ALISTSIZE,KEYLEN,SECTINDX)
!
%RECORDFORMAT LABFORM(%BYTEINTEGERARRAY VOL(0:5),%BYTEINTEGER S1,%C
      S2,S3,S4,ACCESS,%BYTEINTEGERARRAY RES(1:20),%BYTEINTEGER C1,C2,%C
      AC1,AC2,TPC1,TPC2,BF1,BF2,%BYTEINTEGERARRAY POINTER(0:3), %C
      IDENT(1:14))
!
%RECORDFORMAT QFORM(%BYTEINTEGER QSLOT,STATE,SP1,SP2, %INTEGER %C
         CYLEPS,REQLINK,CURRPOS,PROPADDR,DDTADDR,SEMA,TRLINK)
%RECORDFORMAT REQFORM(%INTEGER FAULTS,SRCE,IDENT,DADDR,COREADDR,%C
      CTS,%BYTEINTEGER SECT,TRNO,SPARE,REQTYPE,%INTEGER REQLINK)
%CONSTINTEGER DCU SERV=X'300000',PST VA=X'80040000',%C
      DISCMSNO=X'00200000', TCB SIZE=4*18,IDATASIZE=18,%C
      PDISCSNO=X'210000'
%OWNINTEGER EPAGESIZE,TRANSIZE
%CONSTSTRINGNAME DATE=X'80C0003F'
%CONSTSTRINGNAME TIME=X'80C0004B'
%OWNBYTEINTEGERARRAY LVN(0:99)=254(100)
%OWNRECORDARRAYFORMAT QSPACEF(1:512)(QFORM)
%OWNRECORDARRAYNAME QSPACE(QFORM)
!
%EXTRINSICLONGINTEGER KMON
%CONSTLONGINTEGER LONGONE=1
%OWNINTEGER DDT ADDR,NDISCS
%EXTERNALROUTINESPEC DUMPTABLE (%INTEGER T,A,L)
%EXTERNALROUTINESPEC OPMESS(%STRING(63) S)
%SYSTEMROUTINESPEC ETOI(%INTEGER A,L)
%EXTERNALSTRING(8)%FNSPEC HTOS(%INTEGER VALUE,PLACES)
%EXTERNALSTRING(8)%FNSPEC STRHEX(%INTEGER N)
%EXTERNALSTRING(8)%FNSPEC STRINT(%INTEGER N)
%EXTERNALROUTINESPEC PON(%RECORDNAME P)
%ROUTINESPEC PDISC(%RECORDNAME P)
%EXTERNALROUTINESPEC INHIBIT(%INTEGER SERV)
%EXTERNALROUTINESPEC UNINHIBIT(%INTEGER SERV)
%EXTERNALROUTINESPEC PTREC(%RECORDNAME P)
%EXTERNALROUTINESPEC DCU(%RECORDNAME P)
%STRING(4)%FN MTOS(%INTEGER M)
%INTEGER I,J
      I=4; J=M
      %RESULT=STRING(ADDR(I)+3)
%END
%EXTERNALROUTINE DISCMINDER(%RECORDNAME P)
%RECORDSPEC P(PARMF)
%ROUTINESPEC READ DLABEL(%RECORDNAME DDT)
%ROUTINESPEC UNLOAD(%RECORDNAME DDT)
%ROUTINESPEC SENSE(%RECORDNAME DDT,%INTEGER VAL)
%RECORDNAME DDT(DDTFORM)
%RECORDNAME LABEL(LABFORM)
%RECORDNAME COM(COMF)
%RECORDNAME TCB(TCBF)
%RECORD Q(PARMF)
%OWNINTEGER INITINH,LABREADS
%INTEGER ACT,I,J,SLOT
%STRING(40)S
%SWITCH INACT(0:7),AINT,FINT,NINT(0:11)
      ACT=P_DEST&X'FFFF'
      %IF KMON&(LONGONE<<(DISCMSNO>>16))#0 %THEN PRINTSTRING("
DISCM: ") %AND PTREC(P)
      *LXN_P+4
      *LSQ_(%XNB+0)
      *LB_X'D15C'
      ->INACT(ACT)
INACT(0):                               ! INITIALISATION
                                        ! NOW NO PARAMETERS!
      COM==RECORD(X'80C00000');         ! ONTO COMMS SEGMENT
      EPAGESIZE=COM_EPAGESIZE
      TRANSIZE=EPAGESIZE*1024
      NDISCS=COM_NDISCS
      DDTADDR=COM_DDTADDR
      QSPACE==ARRAY(COM_DQADDR,QSPACEF)
      INITINH=1
      INHIBIT(PDISCSNO>>16)
      %CYCLE J=0,1,NDISCS-1
         DDT==RECORD(INTEGER(DDTADDR+4*J))
         DDT_UASTE=INTEGER(PSTVA+4+DDT_UAAD<<1>>19<<3)
         SENSE(DDT,0)
         DDT_STATE=1;               ! READ VOL LABELS
      %REPEAT
      P_DEST=PDISCSNO
      PDISC(P)
      %RETURN
INACT(1):                               ! ALLOCATE AS PER DCU
                                        ! REQUEST FORWARDED TO DCU
                                        ! THE DISC FIRST BEING DEALLOCATED
                                        ! IF NECESSARY
      %CYCLE I=0,1,NDISCS-1
         DDT==RECORD(INTEGER(DDTADDR+4*I))
         %IF P_P1=DDT_MNEMONIC %THEN ->HIT
         %REPEAT
ONTODCU:
      P_DEST=DCU SERV+4
      PON(P)
      %RETURN
HIT:
      Q_DEST=DCU SERV+5
      Q_SRCE=X'80000000'!DISCMSNO
      Q_P1=P_P1
      %IF DDT_STATE=4 %OR DDT_STATE=5 %START
         DDT_STATE=11
         DCU(Q)
      %FINISH
      ->ONTODCU
INACT(6):                               ! PCI(??) OR LOGGING REQ
      OPMESS("DISC MINDER ACT 6??")
      %RETURN
INACT(7):                               ! REPLY FROM DCU START DEV
      %IF P_P1#0 %THEN OPMESS("DISCM STARTDEV FAILS ".STRINT(P_P1))
      %RETURN
!
! A DISC MAY BE IN ANY ONE OF THE FOLLOWING STATES(HELD IN DDT_STATE):-
!     0 = DEAD (NOT ON LINE OR UNLOADED)
!     1 = CONNECT INTERFACE & SENSE ISSUED
!     2 = READ LABEL ISSUED
!     3 = DISCONNECT (IE UNLOAD) ISSUED. MUST RECONNECT ON TERMNTN
!
! IF THE LABEL WAS VALID  THE STATES THEN GO:=
!     4 = AVAILABLE FOR PAGED OR PRIVATE USE
!     5 = PAGED TRANSFER ISSUED
!     6-9 RESERVED FOR POSSIBLE ERROR RECOVERY
!
!     NONEXISTENT OR INVALD LABELS THEN GO
!     10 = AVAILABLE FOR PRIVATE USE
!     11 = CLAIMED FOR PRIVATE USE BY SER=DDT_STATUS
!     12 = PRIVATE CHAIN ISSUED
!
! NB ONLY STATES 0-3 & 10 CONCERN DISCMINDER. OTHERS ARE PDISC OR DCU
!
INACT(4):                               ! NOTE LVN P_P1 NOW CHECKED
      I=P_P1; J=LVN(I)
      %IF J>=NDISCS %THEN %RETURN;      ! CRAP LVN
      DDT==RECORD(INTEGER(DDTADDR+J*4))
      DDT_DLVN=DDT_DLVN&255
      %RETURN
!***********************************************************************
!*    DISC INTERRUPT HANDLING SEQUENCE                                 *
!***********************************************************************
INACT(2):                               ! NORMAL TERMINATION
      DDT==RECORD(P_P3)
      ->NINT(DDT_STATE)
INACT(3):                               ! ATTENTION
      DDT==RECORD(P_P3)
      ->AINT(DDT_STATE)
INACT(5):                               ! ABNORMAL TERMINATION
      DDT==RECORD(P_P3)
      ->FINT(DDT_STATE)
NINT(4):FINT(4):
NINT(10):FINT(10):
NINT(11):FINT(11):
NINT(0):FINT(0):                        ! DEAD DISC TERINATES?
      PRINTSTRING('INT STATE '.STRINT(DDT_STATE).' ?????
')
      %RETURN
NINT(1):                                ! SENSE TERMINATES
      TCB==RECORD(DDT_UAAD)
      DDT_SENSE1=TCB_POST0
      DDT_SENSE2=TCB_POST1
      DDT_SENSE3=TCB_POST2
      DDT_SENSE4=TCB_POST6
      %IF DDT_SENSE4<0 %THEN %START;    ! DISC IN AUTO
         READ DLABEL(DDT)
         LABREADS=LABREADS+1
         DDT_STATE=2
      %FINISH %ELSE DDT_STATE=0
      %RETURN
NINT(2):                                ! LABEL READ SUCCESSFULLY
      LABREADS=LABREADS-1
      %IF INITINH=1 %AND LABREADS=0 %THEN %C
         INITINH=0 %AND UNINHIBIT(PDISCSNO>>16)
      LABEL==RECORD(DDT_UA AD+2*TCB SIZE)
      ETOI(ADDR(LABEL),6)
      DDT_DLVN=-1
      %CYCLE I=0,1,5
         BYTEINTEGER(ADDR(DDT_LAB)+1+I)=LABEL_VOL(I)
      %REPEAT
      LENGTH(DDT_LAB)=6
      %IF LABEL_ACCESS= X'C5' %THEN %START
         %CYCLE I=0,1,3
            BYTEINTEGER(ADDR(DDT_BASE)+I)=LABEL_POINTER(I)
         %REPEAT
         S=' EMAS'
         DDT_STATE=4
!
! ARRAY LVN STORE SLOT NO INSTEAD OF ADDRESS TO SAVE SPACE
! SLOT NOT NOW NEEDED ELSEWHERE. SET UP HERE PRO TEM
!
         %CYCLE SLOT=0,1,NDISCS-1
            %IF INTEGER(DDTADDR+4*SLOT)=ADDR(DDT) %THEN %EXIT
         %REPEAT
         %IF '0'<=LABEL_VOL(4)<='9' %AND '0'<=LABEL_VOL(5)<='9' %START
            I=(LABEL_VOL(4)&X'F')*10+LABEL_VOL(5)&X'F'
            %IF LVN(I)>=254 %OR LVN(I)=SLOT %THEN %START
               LVN(I)=SLOT
               DDT_DLVN=I!X'80000000'
            %FINISH %ELSE %START
               OPMESS("DUPLICATE DISC LVN!")
               UNLOAD(DDT)
               DDT_STATE=3; %RETURN
            %FINISH
!
! CLAIM THE DISC FROM DCU ON BEHALF OF PDISC
!
            P_DEST=DCU SERV+7;          ! SPECIAL ALLOCATE
            P_SRCE=PDISCSNO+10
            P_P1=DDT_MNEMONIC
            P_P2=0;                     ! CALL NOT PON
            P_P3=10;                    ! ADD 10 TO STANDARD ACTS
            P_P4=PDISCSNO>>16;          ! FOR ATTENS
            PON(P)
         %FINISH
      %FINISH %ELSE %START
         DDT_BASE=0
         S=' FRGN'
         DDT_STATE=10
      %FINISH
      OPMESS(MTOS(DDT_MNEMONIC).' LOADED '.DDT_LAB.S)
      %RETURN
FINT(1):                                !SENSE FAILS
      DDT_STATE=0; %RETURN
FINT(2):                                ! READ LABEL FAILS
      LABREADS=LABREADS-1
      DDT_LAB='NOLABL'
      DDT_DLVN=-1
      DDT_STATE=10
      OPMESS(MTOS(DDT_MNEMONIC).' LOADED NO LABEL')
      DDT_BASE=0
      %RETURN
NINT(3):FINT(3):                        ! UNLOAD COMPLETE
      DDT_STATE=0
      OPMESS(MTOS(DDT_MNEMONIC).' UNLOADED')
      %IF DDT_DLVN#-1 %THEN LVN(DDT_DLVN&255)=255
      %RETURN
AINT(2):
      LABREADS=LABREADS-1
AINT(0):AINT(1):                        ! ATTENTION WHILE INITIALISING
      PRINTSTRING('ATTNTN WHILE INITNG '.MTOS(DDT_MNEMONIC))
      DDT_STATE=1
      SENSE(DDT,1);                     ! START SEQUENCE AGAIN
AINT(3):                                ! EXTRA ATTENTION CAUSED BY UNLOAD
      %RETURN
AINT(4):                                ! ATTENTION WHILE CLAIMED BY PDISC
      Q_DEST=DCU SERV+5
      Q_SRCE=DISCMSNO!X'80000000'
      Q_P1=DDT_MNEMONIC
      DCU(Q)
AINT(10):                               ! ATTENTION WHILE IDLE
                                        ! ATTENTION <<8 IN P_P1
      %IF P_P1>>8&1#0 %START;           ! HOLD BIT SET
         UNLOAD(DDT)
         DDT_STATE=3
         %RETURN
      %FINISH
      DDT_STATE=1
      SENSE(DDT,0)
      %RETURN
AINT(11):                               ! ATTENTION WHEN HANDING DISC
                                        ! BACK TO DCU FOR PRIVATE CHAINS
      DDT_STATE=0; %RETURN
%ROUTINE UNLOAD(%RECORDNAME DDT)
!***********************************************************************
!*    PERFORMS A DISCONNECT INTERFACE WHICH UNLOADS THE DISC           *
!***********************************************************************
%RECORDSPEC DDT(DDTFORM)
%RECORDNAME TCB(TCBF)
      TCB==RECORD(DDT_UA AD)
      TCB_CMD=X'2C004008';              ! UNLOAD IGNORE SHRT & LONG
      TCB_STE=DDT_UASTE
      TCB_DATA LEN=4
      TCB_DATA AD=ADDR(TCB_PRE0)
      TCB_NEXT TCB=0
      TCB_RESP=0
      P_DEST=DCU SERV+10
      P_SRCE=DISCMSNO+7
      P_P1=ADDR(TCB)
      P_P2=DDT_SER
      P_P4=M'UNLD'
      PON(P)
%END
%ROUTINE READ DLABEL(%RECORDNAME DDT)
!***********************************************************************
!*    READS SECTOR 0 HEAD 0 CYL 0 WHICH SHOULD BE 80 BYTE VOL LABEL    *
!***********************************************************************
%RECORDSPEC DDT(DDTFORM)
%RECORDNAME INIT TCB,TCB(TCBF)
%RECORDNAME INIT DATA(INITF)
%INTEGER I
      INIT TCB==RECORD(DDT_UA AD)
      TCB==RECORD(ADDR(INIT TCB)+TCB SIZE)
      INIT DATA==RECORD(ADDR(TCB)-IDATASIZE)
      INIT TCB=0
      TCB=0
      INIT TCB_CMD=X'2C404081'
      INIT TCB_NEXT TCB=ADDR(TCB)
      I=DDT_UASTE
      INIT TCB_STE=I
      TCB_STE=I
      INIT TCB_DATA LEN=IDATASIZE
      INIT TCB_DATA AD=ADDR(INIT DATA)
      INIT DATA_SMASK=X'FE';            ! MASK NOWT
      INIT DATA_FN=X'20';               ! RESTORE
      TCB_CMD=X'20404012'
      TCB_DATA LEN=80
      TCB_DATA AD=DDT_UA AD+2*TCBSIZE
      P_DEST=DCUSERV+10
      P_SRCE=DISCMSNO+7
      P_P1=ADDR(INIT TCB)
      P_P2=DDT_SER
      P_P4=M'RLAB'
      PON(P)
%END
%ROUTINE SENSE(%RECORDNAME DDT,%INTEGER VAL)
!***********************************************************************
!*    PERFORM A SENSE ON DEVICE WHOSE DDT SLOT IS DDT.VAL=0 FOR INITIAL*
!*    SENSE SENSE TO BE PRECEEDED BY A CONNECT STREAM                  *
!***********************************************************************
%RECORDSPEC DDT(DDTFORM)
%RECORDNAME TCB(TCBF)
      TCB==RECORD(DDT_UA AD)
      TCB_CMD=X'2C004004';              ! SENSE IGNORE SHRT & LONG
      TCB_STE=DDT_UASTE
      TCB_DATA LEN=32
      TCB_DATA AD=ADDR(TCB_POST0)
      TCB_NEXT TCB=0
      TCB_RESP=0
      P_DEST=DCU SERV+10
      P_SRCE=DISCMSNO+7
      P_P1=ADDR(TCB)
      P_P2=DDT_SER
      P_P4=M'SNSE'
      PON(P)
%END
%END
%ROUTINE DREPORT(%RECORDNAME DDT,FTCB)
!***********************************************************************
!*    PRINTS OUT A FAILURE REPORT IN A READABLE FORM                   *
!***********************************************************************
%CONSTINTEGER TCBPSIZE=40;              ! BYTES OF TCB TO BE DUMPED
%RECORDSPEC DDT(DDTFORM)
%CONSTSTRING(8)%ARRAY SENSEM(0:7)="S0T1T2T3","T4T5T6T7",
                  "T8T9TAC0","C1C2C3C4","C5C6M0M1",
                  "M2M3M4M5","M6M7M8M9","MAXXXXXX";
%RECORDSPEC FTCB(TCBF)
%INTEGER I,J,N
      PRINTSTRING("DISC TRANSFER ".DDT_LAB." ON ". %C
         MTOS(DDT_MNEMONIC)." (".HTOS(DDT_PTS,6).") FAILS "%C
         .DATE." ".TIME)
      PRINTSTRING("
TCB RESPONSE =".HTOS(FTCB_RESP,8)."
SENSE DATA
")
      %CYCLE I=0,1,7
         PRINTSTRING(SENSEM(I)." ".STRHEX(INTEGER(DDT_SENSDAT AD+4*I)))
         NEWLINE
      %REPEAT
      PRINTSTRING("
COMPLETE CHAIN OF TCBS BEFORE FAILURE
")
      N=(ADDR(FTCB)-DDT_UA AD)//TCBSIZE
      %CYCLE J=0,4,TCBPSIZE-4
         %CYCLE I=0,1,N
            PRINTSTRING(HTOS(INTEGER(DDT_UAAD+I*TCBSIZE+J),8))
            %IF J=0 %AND I#N %THEN PRINTSTRING("->") %ELSE SPACES(2)
         %REPEAT
         NEWLINE
      %REPEAT
      NEWLINE
%END
%EXTERNALROUTINE PDISC(%RECORDNAME P)
!***********************************************************************
!*    RECEIVES PAGED DISC TRANSFERS. ORGANISES ALL QUEUING AND         *
!*    GENERATES THE CCWS WHICH ARE THE PASSED TO DISC FOR EXECUITION   *
!***********************************************************************
%RECORDSPEC P(PARMF)
%RECORDNAME DDT(DDTFORM)
%RECORDNAME PROP(PROPFORM)
%RECORDNAME INIT TCB,TCB(TCBF)
%RECORDNAME INIT DATA(INITF)
%RECORDNAME QHEAD(QFORM)
%RECORDNAME REQ(REQFORM)
%CONSTINTEGERARRAY CMD(1:4)=X'20404012',
                  X'20400413'(2),X'20404212';
%CONSTINTEGER PDISCSNO=X'210000';          ! PDISC SERVICE NO(33)
%CONSTINTEGER RETRIES=21,MAXTRANS=7
%CONSTINTEGER TRANOK=0,TRANWITHERR=1,TRANREJECT=2,NOTTRANNED=3
%OWNINTEGER NEXT
%INTEGERFNSPEC GETREC
%ROUTINESPEC PUTREC(%INTEGER REC)
%ROUTINESPEC QUEUE(%RECORDNAME QHEAD,%INTEGER REQ)
!
! ERROR RECOVERY CONSISTS OF MAKING RETRIES WITH STROBE NORMAL,EARLY
! AND LATE AND THE FOLLOWING HEAD OFFSETS:-
!           0,+12,-12,+24,-24,+36,-36
! THIS GIVES 21 ADDITIONAL READS. THE FIRST RETRY IN NORMAL AS ADVISED
! THE ARRAY CORRN CONTAINS MODE,FUNCTION&OFFSET BYTES IN BTM 24 BITS
!
%CONSTINTEGERARRAY CORRN(0:22)=0,
                                        X'001C00',X'204C00',X'104C00',
                                        X'004C0C',X'204C0C',X'104C0C',
                                        X'004C8C',X'204C8C',X'104C8C',
                                        X'004C18',X'204C18',X'104C18',
                                        X'004C98',X'204C98',X'104C98',
                                        X'004C24',X'204C24',X'104C24',
                                        X'004CA4',X'204CA4',X'104CA4',
                                        X'008C00';
%SWITCH PDA(0:15)
%OWNINTEGER INIT
%INTEGER I,ACT,J,TCBA,UNIT,LUNIT,CYL,TRACK,SECT,CELL,FTRNO,K,FAIL, %C
         NEXT SEEK
      ACT=P_DEST&X'FFFF'
      %IF KMON&(LONGONE<<(PDISCSNO>>16))#0 %THEN PRINTSTRING("
PDISC: ") %AND PTREC(P)
      ->PDA(ACT)
PDA(0):                                 ! INITIALISE
      %IF INIT#0 %THEN %RETURN;         ! IN CASE !
      %CYCLE I=0,1,NDISCS-1
         QHEAD==QSPACE(I+1)
         DDT==RECORD(INTEGER(DDTADDR+I*4))
         QHEAD=0;                       ! ZERO WHOLE RECORD
         QHEAD_QSLOT=I+1
         QHEAD_PROPADDR=DDT_PROPADDR
         PROP==RECORD(QHEAD_PROPADDR)
         QHEAD_CYLEPS=PROP_PPERTRK*PROP_TRACKS
         QHEAD_DDTADDR=ADDR(DDT)
         QHEAD_SEMA=-1
      %REPEAT
!
! SET UP REMAINDER OF QSPACE AS A FREE LIST FOR REQUESTS
!
      J=ADDR(QSPACE(1))>>18&255;        ! PUBLIC SEG NO
      J=INTEGER(X'80040000'+8*J)&X'3FF80'+X'80'-160
      I=NDISCS+1
      %UNTIL K>=J %CYCLE
         K=ADDR(QSPACE(I))
         INTEGER(K)=NEXT
         NEXT=I
         I=I+1
         K=K&X'3FFFF'
      %REPEAT
      INIT=1
      %RETURN
PDA(1):                                 ! READ REQUEST
PDA(2):                                 ! WRITE REQUEST
PDA(3):                                 ! WRITE + CHECK(TREATED AS WRITE)
PDA(4):                                 ! CHECK READ
                                        ! ALL HAVE _P2=DISCADDR AND
                                        ! _P3 =COREADDR
      %IF NEXT=0 %THEN PON(P) %AND %RETURN;! INCONVENIENT DIRECT CALL
      P_SRCE=P_SRCE&X'7FFFFFFF'
      UNIT=P_P2>>24
      J=P_P2&X'FFFFFF';                 ! FSYS RELATIVE PAGE
      LUNIT=LVN(UNIT)
      ->REJECT %IF LUNIT>=NDISCS
      QHEAD==QSPACE(LUNIT+1)
!      PROP==RECORD(QHEAD_PROPADDR)
!      I=J//PROP_PPERTRK
!      SECT=J-I*PROP_PPERTRK+1
!      CYL=I//PROP_TRACKS
!      TRACK=I-CYL*PROP_TRACKS
      *LCT_QHEAD+4
      *LXN_(%CTB+4);                    ! XNB TO PROPS RECORD
      *LSS_J
      *IMDV_(%XNB+2);                   ! _PPERTRK
      *IMDV_(%XNB+0);                   ! PROP_TRACKS
      *ST_CYL
      *LB_%TOS
      *STB_TRACK
      *LB_%TOS
      *ADB_1
      *STB_SECT
      *ICP_(%XNB+1);                    ! PROP_CYLS
      *JCC_2,<REJECT>
!      DDT==RECORD(QHEAD_DDTADDR)
!      CYL=CYL+DDT_BASE
!      %IF CYL>PROP_CYLS %THEN ->REJECT
!
!      CELL=GETREC
      CELL=NEXT
      NEXT=INTEGER(ADDR(QSPACE(CELL)))
      %IF NEXT=0 %THEN INHIBIT(PDISCSNO>>16)
      REQ==QSPACE(CELL)
      REQ<-P
      REQ_FAULTS=0
      REQ_CTS=CYL<<16!TRACK
      REQ_SECT=SECT
      REQ_REQTYPE=ACT
      QUEUE(QHEAD,CELL)
      ->INIT TRANSFER %IF QHEAD_STATE=0; ! UNIT IDLE
      %RETURN
REJECT:                                 ! REQUEST INVALID
      PRINTSTRING('*** PDISC REJECTS ')
      PTREC(P)
      P_DEST=P_SRCE
      P_SRCE=PDISCSNO+ACT
      P_P2=TRANREJECT;                  ! REJECTED
      PON(P)
      %RETURN
PDA(10):                                ! REPLY FROM DCU CLAIMDISC
      %RETURN
INIT TRANSFER:                          ! SET UP CHAIN AND HAND TO DISC
      DDT==RECORD(QHEAD_DDTADDR)
      REQ==QSPACE(QHEAD_REQLINK)
      CYL=REQ_CTS>>16
      J=CYL*QHEAD_CYLEPS
      %IF J=QHEAD_CURRPOS %THEN NEXT SEEK=X'C' %ELSE NEXT SEEK=X'1C'
      QHEAD_CURRPOS=J
      TCBA=DDT_UA AD
      %CYCLE I=1,1,MAXTRANS
         INIT TCB==RECORD(TCBA)
         TCBA=TCBA+TCBSIZE
         TCB==RECORD(TCBA)
         INIT DATA==RECORD(TCBA-IDATASIZE)
         TCBA=TCBA+TCBSIZE
         INIT TCB=0; TCB=0;             ! CLEAR ALL(INCLD INIT DATA)
         INIT DATA_SMASK=X'FE';         ! MASK NO 2NDRY STATUS
         INIT DATA_FN=NEXT SEEK;        ! SEEK CYL HD &SEG
         J=REQ_SECT
         INIT DATA_SECT=J
         INIT DATA_SEG=20*EPAGESIZE*(J-1)
         J=REQ_CTS&255
         INIT DATA_HEAD=J
         INIT DATA_SHEAD=J
         INIT DATA_CYL=CYL
         INIT DATA_SCYL=CYL
         %IF REQ_FAULTS#0 %START;       ! ARE RETRYING NOT TRANSFERING
            J=CORRN(REQ_FAULTS)
            INIT DATA_MODE<-J>>16
            INIT DATA_FN<-J>>8
            INIT DATA_OFFSET<-J
            NEXT SEEK=X'8C';            ! CLEAR OFFSET
         %FINISH
         INIT TCB_CMD=X'2C404081'
         INIT TCB_STE=DDT_UASTE
         INIT TCB_NEXT TCB=ADDR(TCB)
         INIT TCB_DATA AD=ADDR(INIT DATA)
         INIT TCB_DATA LEN=IDATASIZE
         TCB_CMD=CMD(REQ_REQTYPE&255)
         TCB_STE=INTEGER(PST VA+4+REQ_COREADDR<<1>>19<<3)
         TCB_NEXT TCB=TCBA
         TCB_DATA AD=REQ_CORE ADDR
         TCB_DATA LEN=TRANSIZE
!
! MOVE THE CELL FROM THE REQUEST QUEU TO TRANSFERINPROGRESS QUEU
!
         J=REQ_REQLINK
         REQ_REQLINK=QHEAD_TRLINK
         REQ_TRNO=I
         QHEAD_TRLINK=QHEAD_REQLINK
         QHEAD_REQLINK=J
!
! SEE IF THERE ANY MORE TRANSFERS AND IF THE ARE ON THE SAME CYL
!
         %IF J=0 %THEN %EXIT
         CELL=J
         REQ==QSPACE(CELL)
         %IF REQ_CTS>>16#CYL %THEN %EXIT
      %REPEAT
      TCB_NEXT TCB=0;                   ! DE CHAIN TCBS
      TCB_CMD=TCB_CMD&X'FFBFFFFF';      ! INT ON LAST TCB
      P_DEST=DCU SERV+10
      P_SRCE=PDISCSNO+X'8000000B'
      P_P1=DDT_UA AD
      P_P2=DDT_SER
      P_P4=QHEAD_QSLOT
      QHEAD_STATE=1
      DDT_STATE=5
      DCU(P)
PDA(11):                                ! REPLY FROM DCU IF PONNED
                                        ! DEVICE STARTED OK
      %RETURN %UNLESS P_P1#0
      OPMESS("PDISC STARTDEV FAILS ".STRINT(P_P1))
      %RETURN
PDA(12):                                ! REPLY FORM DCU NORMAL TERMNTN
      QHEAD==QSPACE(P_P6)
      DDT==RECORD(P_P3)
      ->NOT BUSY %UNLESS DDT_STATE=5
      CELL=QHEAD_TRLINK
      P_SRCE=PDISCSNO
      J=NEXT
      %WHILE CELL#0 %CYCLE
         REQ==QSPACE(CELL)
         P_DEST=REQ_SRCE
         P_P1=REQ_IDENT
         PON(P)
         INTEGER(ADDR(QSPACE(CELL)))=NEXT
         NEXT=CELL
         CELL=REQ_REQLINK;           ! HAIRY BUT OK AFTER CELL RETURNED
      %REPEAT
      QHEAD_TRLINK=0;                ! NO TRANSFERS IN PROGRESS
      %IF J=0 %THEN UNINHIBIT(PDISCSNO>>16)
      ->INIT TRANSFER %IF QHEAD_REQLINK#0
      QHEAD_STATE=0
      DDT_STATE=4
      %RETURN
PDA(13):                                ! ATTENTIONS
      DDT==RECORD(P_P3)
      %IF DDT_STATE=5 %THEN %START
         OPMESS(MTOS(DDT_MNEMONIC)." IS STILL IN USE!")
         %RETURN
      %FINISH
      P_DEST=3
      DISC MINDER(P);                         ! PASS TO DISC MINDER
      %RETURN
PDA(15):                                ! ABNORMAL TERMNTN
      QHEAD==QSPACE(P_P6)
      DDT==RECORD(P_P3)
      ->NOT BUSY %UNLESS DDT_STATE=5
      TCB==RECORD(P_P5)
      DREPORT(DDT,TCB);                 ! FOR ERA
      FTRNO=(P_P5-DDT_UA AD)//(2*TCBSIZE)+1
      FAIL=NOT TRANNED
      %IF TCB_POST0=X'10000000' %AND TCB_POST1>>24=X'80' %C
         %THEN FAIL=TRANWITH ERR;       ! CYCLIC CHECK ONLY
      CELL=QHEAD_TRLINK
      %WHILE CELL#0 %CYCLE
         REQ==QSPACE(CELL)
         QHEAD_TRLINK=REQ_REQLINK
         %IF REQ_TRNO<FTRNO %OR REQ_FAULTS>RETRIES %START
            P_DEST=REQ_SRCE
            P_SRCE=PDISCSNO+REQ_REQTYPE&15
            P_P1=REQ_IDENT
            %IF REQ_TRNO<FTRNO%THEN P_P2=TRAN OK %ELSE P_P2=FAIL
            PON(P)
            %IF P_P2#0 %THEN %START
               PRINTSTRING("PDISC TRANSFER FAILS :-")
               PTREC(P)
            %FINISH
            PUTREC(CELL)
         %FINISH %ELSE %START
            REQ_FAULTS=REQ_FAULTS+1 %IF REQ_TRNO=FTRNO
            QUEUE(QHEAD,CELL);             ! REQUEUE FAULTY ONE  & LATERS
         %FINISH
         CELL=QHEAD_TRLINK
      %REPEAT
      ->INIT TRANSFER %IF QHEAD_REQLINK#0
      QHEAD_STATE=0
      DDT_STATE=4
      %RETURN
NOT BUSY:
      OPMESS("SPUR INT ON ".MTOS(DDT_MNEMONIC))
      %RETURN
%INTEGERFN GETREC
%INTEGER I
!***********************************************************************
!*    PRODUCE A CELL TO QUEUE A REQUEST. INHIBITS WHEN QUEUES FULL     *
!***********************************************************************
      %IF NEXT=0 %THEN OPMESS('Q SPACE????')
      I=NEXT
      NEXT=INTEGER(ADDR(QSPACE(I)))
      %IF NEXT=0 %THEN INHIBIT(PDISCSNO>>16)
      %RESULT=I
%END
%ROUTINE PUTREC(%INTEGER REC)
!***********************************************************************
!*    RETURNS A QUEUE CELL AND ARRANGES ANY UNIHIBITING NEEDED         *
!***********************************************************************
      %IF NEXT=0 %THEN UNINHIBIT(PDISCSNO>>16)
      INTEGER(ADDR(QSPACE(REC)))=NEXT
      NEXT=REC
%END
%ROUTINE QUEUE(%RECORDNAME QHEAD,%INTEGER NEWREQ)
!***********************************************************************
!*    QUEUES REQUEST IN ASCENDING PAGE(IE CYL) ORDER SO SEEK TIMES     *
!*    ARE MINIMISED                                                    *
!***********************************************************************
%RECORDSPEC QHEAD(QFORM)
%RECORDNAME NEW,ENTRY,NEXT(REQFORM)
%CONSTINTEGER QSIZE=32
%INTEGER POSN,CELL,NEXTCELL,AD
      NEW==QSPACE(NEWREQ)
      CELL=QHEAD_REQLINK
      %IF CELL=0 %THEN %START;          ! NOTHING QUEUEING
         QHEAD_REQLINK=NEWREQ
         NEW_REQLINK=0
         %RETURN
      %FINISH
      POSN=NEW_DADDR;                   ! PAGE ADDR OF NEW REQUEST
!      ENTRY==QSPACE(CELL);              ! FIRST ON THE QUEUE
!      NEXTCELL=ENTRY_REQLINK
!
!      %WHILE NEXTCELL#0 %CYCLE
!         NEXT==QSPACE(NEXTCELL)
!         %EXIT %IF ENTRY_DADDR<=POSN<=NEXT_DADDR
!         ENTRY==NEXT
!         NEXTCELL=ENTRY_REQLINK
!      %REPEAT
!
!      ENTRY_REQLINK=NEWREQ
      *LSS_QSPACE+4; *ISB_QSIZE; *ST_AD;! KEEP ADDR(QSPACE(0))
      *LSS_POSN;                        ! POSN IN ACC THRO LOOP
      *LB_CELL; *MYB_QSIZE
      *ADB_AD; *LXN_%B;                 ! B TO RECORD ENTRY
      *LB_(%XNB+7); *STB_NEXTCELL
      *JAT_12,<XIT>;                    ! JUMP ON ZERO B
AGN:  *MYB_QSIZE; *ADB_AD; *LCT_%B;     ! CTB TO RECORD NEXT
      *ICP_(%XNB+3);                    ! POSN IN ACC (STILL)
      *JCC_4,<ON>;                      ! POSN < ENTRY_DADDR
      *ICP_(%CTB+3); *JCC_12,<XIT>;     ! POSN <= NEXT_DADDR
ON:   *LXN_%B;                          ! ENTRY==NEXT
      *LB_(%XNB+7); *STB_NEXTCELL
      *JAF_12,<AGN>
XIT:  *LSS_NEWREQ; *ST_(%XNB+7);        ! ENTRY_REQLINK=NEWREQ
      NEW_REQLINK=NEXTCELL
%END
%END
! BULK MOVER WRITTEN BY PDS 18TH NOV 76
!
%EXTERNALROUTINE MOVE(%RECORDNAME P)
!***********************************************************************
!*       CALLED ON SERVICE 36 TO TRANSFERS GROUPS OF PAGES BETWEEN     *
!*       FAST DEVICES. REPLIES ARE ON SERVICE 37.                      *
!*       FAST DEVICE TYPES ARE:-                                       *
!*       DEV=1 DRUM     (SPECIFIED AS SERVICE & PAGE IN AMEM )         *
!*       DEV=2 DISCFILE (SPECIFIED AS [MNEMONIC OR LVN] & PAGE)        *
!*       DEV=3 ARCHTAPE (SPECIFIED AS SERVICE(PREPOSND BY VOLUMS))     *
!*       DEV=4 TAPE     (SPECIFIED AS STRING(6)LAB,BYTE CHAP NO)       *
!*       DEV=5 FUNNY    (READS GIVE ZERO PAGE,WRITES IN HEX TO LP)     *
!*                                                                     *
!*       CAN HANDLE UP TO FOUR MOVES AT A TIME. EACH MOVE USES         *
!*       ONE BUFFER AND APART FROM CLEARS ONLY HAS ONE TRANSFER        *
!*       OUTSTANDING AT ANY ONE TIME TIME.                             *
!*       ALL WRITES ARE CHECKED BY RE-READING                          *
!***********************************************************************
%INTEGERFNSPEC CHECK(%INTEGERNAME MNEM,PAGE,%INTEGER RTYEP)
%RECORDFORMAT BME(%INTEGER DEST,SRCE,STEP,COUNT,FDEV,TODEV,L,%C
      FDINF1,FDINF2,TODINF1,TODINF2,IDENT,CORE,CDEX,UFAIL,WTRANS, %C
      FVL1,FVL2,TVL1,TVL2)
!
%OWNRECORDARRAY BMS(1:4)(BME)
%RECORDNAME BM(BME)
%RECORDSPEC P(PARMF)
%OWNINTEGER MASK
%CONSTINTEGER TAPE POSN=9,FILE POSN=8,WRITE=2,READ PAGE=1
%CONSTINTEGER WRITETM=10,MAX TRANS=16,REWIND=17
%CONSTINTEGER REQSNO=X'240000',PRIVSNO=X'250000',MAXMASK=X'1E', %C
               GETPAGE=X'50000',RETURNPAGE=X'60000', %C
               CLAIM TAPE=X'31000C',RELEASE TAPE=X'310007', %C
               COMREP=X'3E0001'
!
%INTEGER I,INDEX,PAGE,FILE,SNO,FAIL
%SWITCH STEP(1:12)
!
      %IF KMON&(LONGONE<<(P_DEST>>16))#0 %THEN PRINTSTRING("
MOVE: ") %AND PTREC(P)
      %IF P_DEST>>16=PRIVSNO>>16 %START;   !NAME MNEM,PAGEREPLY
         INDEX=P_DEST&255
         %IF 1<<INDEX&MASK=0 %THEN %START;   ! THIS SLOT NOT IN USE!
            PRINTSTRING('MOVE REJECTS :- ')
            PTREC(P); %RETURN
         %FINISH
         BM==BMS(INDEX)
         FAIL=P_P2
         ->STEP(BM_STEP)
      %FINISH
!
! THIS THE THE ENTRY FOR A NEW REQUEST
!
      %CYCLE INDEX=1,1,4
        %IF MASK&1<<INDEX=0 %THEN %EXIT
      %REPEAT
      BM==BMS(INDEX)
      MASK=MASK!1<<INDEX
      %IF MASK=MAXMASK %THEN INHIBIT(REQSNO>>16);! ALL BUFFERS IN USE
      BM_DEST=P_DEST
      BM_SRCE=P_SRCE
      BM_FDEV=P_P1>>24
      BM_TODEV=P_P1>>16&255
      BM_L=P_P1&X'FFFF'
      BM_FDINF1=P_P2
      BM_FDINF2=P_P3
      BM_TODINF1=P_P4
      BM_TODINF2=P_P5
      BM_IDENT=P_P6
      BM_COUNT=0; BM_STEP=0
      BM_UFAIL=0; BM_FVL1=0; BM_FVL2=0
      BM_WTRANS=0; BM_TVL1=0; BM_TVL2=0
      %IF BM_FDEV=2 %AND CHECK(BM_FDINF1,BM_FDINF2,READPAGE)#0 %C
         %THEN ->REQFAIL
      %IF BM_TODEV=2 %AND CHECK(BM_TODINF1,BM_TODINF2,WRITE)#0%C
         %THEN ->REQFAIL
      %IF BM_TODEV=3 %AND (BM_TODINF2>2 %OR BM_TODINF2<0) %C
            %THEN ->REQFAIL;            ! 0,1,OR 2 TMARKS ONLY ALLOWED
      P_DEST=GETPAGE;                  ! REQUEST ONE (EXTENDED) PAGE
      BM_STEP=0
PONIT:P_SRCE=PRIVSNO!INDEX
      BM_STEP=BM_STEP+1
      PON(P)
      %RETURN
STEP(1):                               ! CORE PAGE FROM CORE ALLOT
      BM_CDEX=P_P2;                     ! CORE INDEX NO(FOR RETURNING)
      BM_CORE=P_P4
      %IF BM_FDEV=5 %THEN %START
         %CYCLE I=BM_CORE,8,BM_CORE+TRANSIZE-8
            LONGINTEGER(I)=0
         %REPEAT
      %FINISH
CORE GOT:                              ! BY HOOK OR BY CROOK
      ->FDEVPOSD %UNLESS BM_FDEV=4; ! UNLESS A MAG TAPE
!
! CODE HERE TO CLAIM THE INPUT TAPE AND PUT ITS SERVICE NO IN INF1
!
      %IF BM_FDINF1>>24#0 %START;       ! TAPE LABEL NOT SERVICE NO
         P_DEST=CLAIM TAPE
         P_P2=X'00040001';              ! TAPE FOR READING
         P_P3=BM_FDINF1; P_P4=BM_FDINF2
         BM_FVL1=BM_FDINF1; BM_FVL2=BM_FDINF2;! REMEMBER FOR RELEASE
         BM_STEP=1; ->PONIT
STEP(2):                                ! REPLY FROM CLAIM TAPE
         %IF P_P2#0 %THEN ->POSFAIL
         BM_FDINF1=P_P3;                ! SERVICE NO FOR TAPE
         BM_FDINF2=BM_FDINF2&255;       ! CHAPTER NO OF FILE
      %FINISH
      SNO=BM_FDINF1
      BM_STEP=2
      FILE=BM_FDINF2&255
TAPEPOS:                               ! TAPE POSITION TO 'FILE' 
      P_DEST=SNO
      P_P1=FILE;                       ! IDENT FOR LATER
      P_P2=REWIND
      ->PONIT;                      ! SKIP BACK TO BT
STEP(3):                               ! FROM TAPE AT BT
STEP(6):                               ! TO TAPE AT BT
      ->POSFAIL %UNLESS FAIL=4 %OR FAIL=0
      P_DEST=P_SRCE
      P_P2=P_P1<<16!1<<8!TAPE POSN
      ->PONIT;                      ! SKIP FORWARD N FILES
STEP(4):                               ! FROMTAPE AT RIGHT FILE
      ->POSFAIL %UNLESS FAIL=0
!
! THIS BULK MOVER MOVES TAPE CHAPTERS ONLY
!
FDEVPOSD:
      ->POSCOMPLETE %UNLESS BM_TODEV=4;     ! OPUT TAPE NEEDS POSITIONING
!
! CODE HERE TO CLAIM THE OUTPUT TAPE
!
      %IF BM_TODINF1>>24#0 %START;      ! TAPE GIVEN AS LABEL NOT SNO
         P_DEST=CLAIM TAPE
         P_P2=X'00040002';              ! TAPE FOR WRITING
         P_P3=BM_TODINF1; P_P4=BM_TODINF2
         BM_TVL1=BM_TODINF1; BM_TVL2=BM_TODINF2
         BM_STEP=4; ->PONIT
STEP(5):                                ! REPLY FROM CLAIM OUTPUT TAPE
         %IF P_P2#0 %THEN ->POSFAIL
         BM_TODINF1=P_P3
         BM_TODINF2=BM_TODINF2&255;     ! CHAPTER NO
      %FINISH
      SNO=BM_TODINF1
      FILE=BM_TODINF2&255
      BM_STEP=5
      ->TAPEPOS
STEP(7):                               ! BOTH DEVICES POSITONED
      ->POSFAIL %UNLESS FAIL=0
POSCOMPLETE:
READ PG:
      BM_COUNT=BM_COUNT+1
      %IF BM_FDEV#5 %THEN %START;   ! NOT FROM A ZERO PAGE
         P_DEST=BM_FDINF1
         P_P3=BM_CORE
         %IF BM_FDEV=3 %OR BM_FDEV=4 %THEN %START
            P_P2=TRANSIZE<<16!READ PAGE
         %FINISH %ELSE %START
            P_P2=BM_FDINF2-1+BM_COUNT
         %FINISH
         BM_STEP=7
         P_P1=BM_COUNT
         ->PONIT
      %FINISH %ELSE FAIL=0
STEP(8):                               ! PAGE READ
      ->READ FAIL %UNLESS FAIL=0
      %IF BM_TODEV#5 %THEN %START
         %CYCLE
            P_DEST=BM_TODINF1
            P_SRCE=PRIVSNO!INDEX
            BM_STEP=8
            P_P3=BM_CORE
            %IF BM_TODEV=4 %OR BM_TODEV=3 %THEN %START
                  P_P2=TRANSIZE<<16!WRITE
            %FINISH %ELSE %START
               P_P2=BM_TODINF2-1+BM_COUNT
            %FINISH
            P_P1=BM_COUNT
            PON(P)
            BM_STEP=9
            BM_WTRANS=BM_WTRANS+1
            %RETURN %IF BM_FDEV#5 %OR BM_WTRANS>=MAX TRANS %OR %C
               BM_COUNT>=BM_L
            BM_COUNT=BM_COUNT+1
         %REPEAT
      %FINISH %ELSE DUMPTABLE(34,BM_CORE,TRANSIZE)
STEP(9):                               ! PAGE WRITTEN
      BM_WTRANS=BM_WTRANS-1 %UNLESS BM_TODEV=5
      ->WRITEFAIL %UNLESS FAIL=0
      ->READ PG %IF BM_COUNT<BM_L %AND BM_UFAIL=0
      %RETURN %UNLESS BM_WTRANS=0
!
STEP(10):                              !FIRST TM WRITE
      P_DEST=BM_TODINF1
      P_P1=M'BMTM'
      P_P2=WRITE TM
      %IF BM_TODEV=3 %AND BM_TODINF2#0 %START;! ARCH TAPE NEEDS TM?
         BM_STEP=BM_STEP+2-BM_TODINF2;  ! ONE OR TWO TMS
         ->PONIT
      %FINISH
      ->PONIT %IF BM_TODEV=4
STEP(11):                              !BOTH TMS WRITTEN
WAYOUT:                                !DEALLOCATE CORE
      %RETURN %UNLESS BM_WTRANS=0
      P_DEST=RETURN PAGE
      P_SRCE=0;                        ! REPLY NOT WANTED
      P_P2=BM_CDEX
      PON(P);                       !RETURN CORE
      P_DEST=RELEASE TAPE
      P_SRCE=COMREP
      %IF BM_FDEV=4 %AND BM_FVL1#0 %START
         P_P2=X'00040000'!BM_FDINF1&X'FFFF'
         P_P3=BM_FVL1; P_P4=BM_FVL2; P_P5=1
         PON(P);                        ! RELEASE FROM TAPE
      %FINISH
      %IF BM_TODEV=4 %AND BM_TVL1#0 %START
         P_P2=X'00040000'!BM_TODINF1&X'FFFF'
         P_P3=BM_TVL1; P_P4=BM_TVL2; P_P5=1
         PON(P);                        ! RELEASE OUTPUT TAPE
      %FINISH
REPLY:                                 !SET UP REPLY
      P_DEST=BM_SRCE
      P_SRCE=REQSNO
      P_P1=BM_UFAIL
      P_P2=BM_IDENT
      PON(P);                       !REPLY TO REQUEST
      %IF MASK=MAXMASK %THEN UNINHIBIT(REQSNO>>16)
      MASK=MASK!!1<<INDEX
      %RETURN
REQFAIL:                               ! FAULT WITH REQUEST
      BM_UFAIL=-2
      ->REPLY
POSFAIL:                               ! UNABLE TO POS TAPE
      BM_UFAIL=-3
      ->WAYOUT
READFAIL:                              ! UNABLE TO READ
      %IF BM_UFAIL=0 %THEN %C
         BM_UFAIL=READPAGE<<24!P_P1!FAIL<<16
      ->WAYOUT
WRITEFAIL:                             ! UNABLE TO WRITE PAGE
      %IF BM_UFAIL=0 %THEN %C
         BM_UFAIL=WRITE<<24!P_P1!FAIL<<16
      ->WAYOUT
!
%INTEGERFN CHECK(%INTEGERNAME MNEM,PAGE,%INTEGER RTYPE)
!***********************************************************************
!*    CHECKS A DISC ID VOR VALIDITY & AVAILABILITY                     *
!***********************************************************************
%RECORDNAME DDT(DDTFORM)
%INTEGER I,L,V1,V2
      L=6; V1=MNEM; V2=PAGE
      %CYCLE I=0,1,NDISCS-1
         DDT==RECORD(INTEGER(DDTADDR+I*4))
         %IF (DDT_MNEMONIC=MNEM %OR STRING(ADDR(L)+3)=DDT_LAB%OR %C
            MNEM=DDT_DLVN) %AND 4<=DDT_STATE<=7 %THEN %START
            MNEM=PDISCSNO!RTYPE
            %IF STRING(ADDR(L)+3)=DDT_LAB %THEN PAGE=PAGE&X'FFFF'
            PAGE=PAGE!DDT_DLVN<<24
            %RESULT=0
         %FINISH
      %REPEAT
      %RESULT=1
      %END
      %END
%ENDOFFILE