         DEF      OCPIO:
OCPIO:   EQU      %
         SYSTEM   SIG7FDP
         PCC      0
         DEF      OCPIO,OCPCU
         DEF      OCP:DOT
         DEF      OCPFLGS           DISPLACEMENT TO OCP FLAG TABLE
         DEF      BLKBIT            'BLOCKED BUFFER' INDICATOR
         DEF      BOOTBIT           'OCP INITIALIZED' INDICATOR
         DEF      OCPFEA            * FILE SIDE END ACTION
         DEF      OCPDVEA           * DEVICE SIDE END ACTION
         DEF      OCPSEND           * BLOCK SENDER
         DEF      OS%MLBFI          * MULTI BUFFER ENTRY
*
         PAGE
*    MAKE HANDLER BASE OCPIO
OCPIO    EQU      %
         B        OCPIO1
*
         PAGE
         REF      DCT1
         REF      DCT3
         REF      DCT7
         REF      DCT12
         REF      DCT13
         REF      DCT16
         REF      DCT17
         REF      DCT19             * AIO CC TABLE
         REF      DCT20             * TDV CC TABLE
         REF      DCT21             * TIO STATUS
         REF      DCT25             * SIO COUNTER TABLE
         REF      IOQ4              * ORIGINAL FUNCTION STEP
         REF      IOQ12             * SEEK INFORMATION
         REF      IOQ5
         REF      IOQ8
         REF      IOQ9
         REF      IOQ10
         REF      IOQ11
         REF      COMLIST
         REF      USECOM
         REF      IOSCU
         REF      RE:ENT
         REF      IOSERCK
         REF      TSTACK
         REF      TIME
         REF      ERRLOG
         REF      IOQ13
         REF      M3
         REF      M16
         REF      M19
         REF      M24               *=X'00FFFFFF'
         REF      Y01               * =X'01000000'
         REF      X4000             * =X'00004000'
         REF      SNDDX             *SYMTAB DCTX
         REF      SSIG              * SYMBIONT SIGNAL TABLE
         REF      BADDA2            * OUTSYM PABRT ENTRY
         REF      OSDEA0            * OUTSYM DEV E.A. SIG ENTRY
         REF      OSDEA00           * OUTSYM DEV E.A. REC ENTRY
         REF      OSDEA5            * OUTSYM DEV E.A. DEVIO ENTRY
         REF      OSDEA51           * OUTSYM DEV E.A. ALT. DEVIO
         REF      OSFEA             * OUTSYM FILE END ACTION ENTRY
         REF      OSFEA4            * OUTSYM FILE E.A. FILE NORM ENT
         REF      OS09A             * OUTSYM NXT FILE BLK ENTRY
         REF      OS1D              * OUTSYM NXT FILE BLK ENTRY.
         REF      OS%REG            * OUTSYM REGISTER RESTORE ENTRY
         REF      OS%EA             * OUTSYM REG. END ACTION - DISP
         REF      OSDEA0A           * OUTSYM DEV E.A. ..... ENTRY
         REF      OSDEA00A          * OUTSYM DEV E.A. ....  ENTRY
         REF      RELCB             * RELEASE CORE BUFFER SYMBIONT
*
         PAGE
*
*        REGISTER DEFINITIONS
*
R0       EQU      0
R1       EQU      1
R2       EQU      2
R3       EQU      3
R4       EQU      4
R5       EQU      5
R6       EQU      6
R7       EQU      7
SR1,R8   EQU      8
SR2,R9   EQU      9
SR3,R10  EQU      10
SR4,R11  EQU      11
D1,R12   EQU      12
D2,R13   EQU      13
D3,R14   EQU      14
D4,R15   EQU      15
*
*
         PAGE
*
*        :DOT TABLE FOR COMLIST
*
:DOT     CNAME
         PROC
LF       EQU      %-DOT
         GEN,8,8,8,8  BA(AF(1))-BA(DOT),AF(2),AF(3),AF(4)
         PEND
*
*        PROC FOR HANDLER BRANCH TABLES
*
T:SET    CNAME
*
*        T:SET ESTABLISHES VALUES FOR:
*  1. HANDLER FRONT END VECTOR
*  2. HANDLER BACK END VECTOR
*
FRONTEND%V,BACKEND%V  SET   0
DOT%X    SET      1
*
*
         PROC
         ERROR,15,(AF(1)-BASE:)>255    'PRE-PROCESSOR OUT OF RANGE'
         ERROR,15,(AF(2)-BASE:)>255    'POST-PROCESSOR OUT OF RANGE'
FRONTEND%V(DOT%X)   SET  AF(1)-BASE:
BACKEND%V(DOT%X)    SET  AF(2)-BASE:
DOT%X    SET      DOT%X+1
         PEND
*
         PAGE
*
DOT      SET      %
OCP:DOT  EQU      DOT
*
*        DEVICE OPERATION TABLE(DOT)
*
CONT:DOT :DOT     PC%,1,CONT:DOT
         T:SET    PRE%EXIT,POST%CON
RDFD:DOT :DOT     RF%,2,RDFD:DOT,RDBK:DOT
         T:SET    RD%FWD,POST%FWD
RDBK:DOT :DOT     RB%,2,RDBK:DOT,RDBK:DOT
         T:SET    PRE%EXIT,POST%BWD
RDFM:DOT :DOT     FM%,2,RDFM:DOT
         T:SET    PRE%EXIT,POST%FM
BOT:DOT  :DOT     DB%,1,BOT:DOT
         T:SET    PRE%EXIT,POST%BOT
*
DOT%X    SET      DOT%X-1           :DOT TABLE SIZE
*
         PAGE
*
*        COMMAND LIST TABLE(CLIST)
*
:CLST    CNAME
         PROC
LF       GEN,8    DA(AF(1))-DA(DOT)
         PEND
*
*
*
PC%      :CLST    PCCOM
RF%      :CLST    RFCOM
RB%      :CLST    RBCOM
FM%      :CLST    FMCOM
DB%      :CLST    DBCOM
*
         PAGE
*
*        DUMMY COMMANDS
*
:CDW     CNAME
         PROC
LF       EQU      WA(%)
         DO       AF(2)=4
         GEN,8,24 CF(2),WA(AF(1))
         ELSE
         GEN,8,24 CF(2),BA(AF(1))
         FIN
         GEN,8,8,8,8    CF(3),0,AF(2),AF(3)
         PEND
*
*
*
         BOUND    8
PCCOM    :CDW,CONTO,FLG    0,0
RFCOM    :CDW,RFO,FLG      0,2
RBCOM    :CDW,RBO,FLG      0,2
FMCOM    :CDW,FMO,FLG      0,0
DBCOM    :CDW,BOTO,FLG     0,0
*
         PAGE
*
*        ON-LINE SHAMROCK CONTROLLER ORDERS
*
CONTO    EQU      X'F'
RFO      EQU      X'D'
RBO      EQU      X'C'
FMO      EQU      3
BOTO     EQU      7
*
FLG      EQU      X'1E'
*
         PAGE
*
*        OCP TABLES ARE DEFINED AS CLIST EXTENSIONS
*        AND ACCESSED VIA WORD DISPLACEMENTS INTO
*        CLIST START ADDR(DCT7)
*
OCPFLGS  EQU      3                 COMMUNICATION BITS
RFCNT    EQU      4                 CURRENT READ FORWARD POSITION
RBCNT    EQU      5                 BACKUP COUNTER
MLBFC1   EQU      6                 *MULTI BUFF CONSTANT 1
MLBFC2   EQU      7                 *MULTI BUFF CONSTANT 2
*
*        OCP FLAG BITS IN OCPFLGS TABLE
*
BOOTBIT  EQU      1                 =1, OCP INITIALIZED
BLKBIT   EQU      2                 =0, SINGLE RECORD; =1, BLOCK
BKBIT    EQU      4                 =1, SINGLE-RECORD BACKUP MODE
LBLKBIT  EQU      8
*
*        OCP TDV STATUS BITS
*
RUNBIT   EQU      X'20'
REWBIT   EQU      X'10'
BACKBIT  EQU      8
*
*        OCPIO TYPE OF COMPLETION CODES
*
BACKTYC  EQU      2
ABORTYC1 EQU      3                 PROCESS ABORT: NOT BOOTED
ABORTYC2 EQU      4                 '           ': BAD BUFFER
ABORTYC3 EQU      5                 '           ': BACKUP THRU BOT
BOTTYC   EQU      6                 '           ': REWIND REQUESTED
*
XFF00    DATA     X'FF00'
*
         PAGE
*
*        PRE-PROCESSOR VECTOR TABLE
*
PRE%VEC  EQU      %
I        DO       DOT%X
         DATA,1   FRONTEND%V(I)
         FIN
         BOUND    4
*
         PAGE
*
*        POST PROCESSOR VECTOR TABLE
*
POST%VEC EQU      %
I        DO       DOT%X
         DATA,1   BACKEND%V(I)
         FIN
         BOUND    4
*
         PAGE
***********************************************************************
*****             PRE-HANDLER ENTRY                               *****
***********************************************************************
*        ENTER WITH: (R1)=PRI,0,DCTX 8,16,8
*                    (R2)=CITX
*                    (R3)=0,IOQX   24,8
*                    (R14)=0,DA FROM DCT10  16,16
*        R0,R4-R13 VOLATILE
*
OCPIO1   BAL,R6   LD%FLGS           GET COMMUNICATION BITS
         CI,D2    BOOTBIT           IS OCP BOOTED
         BANZ     OCPIO2            YES
         CI,D2    BLKBIT            BLOCKED OPERATION
         BAZ      OCPIO2            NO
         BAL,R9   NOBOOT            LOG ERROR
RE%QUE   LI,R12   ABORTYC1          OCP NOT BOOTED
         B        ABORT
OCPIO2   LB,R6    IOQ10,R3
         CB,R6    IOQ11,R3           RETRY PENDING
         BNE      PRE%EXIT           YES: JUST GO
         LB,R6    PRE%VEC,R5         ELSE ENTER FUNCTION-DEPENDENT,
         B        BASE:,R6           PRE-PROCESSING ROUTINE
*
         PAGE
*
*
*
***********************************************************************
*****             POST-HANDLER ENTRY                              *****
***********************************************************************
*        REGISTER SETUP SAME AS OCPIO ENTRY
*
OCPCU    EQU      %                 *
         SPACE    3
         RD,0     0                 *SAMPLE THE SSW'S
         B        OCPCU1            ***CHG ME TO A BCR,X TO GET THE
*                                   ***ERRLOG ALL FEATURE.
*        BCR,8    OCPCU1            ***SSW1=>X=8 FOR EXAMPLE.
         LCI      0                 * IF ERRL
         PSM,0    TSTACK            * . . SAVEM ALL
         BAL,R6   LD%FLGS           * MAK OCPIO HAPPY
         LD,D1    *R4               * PAST COMMAND PAIR
         CI,D1    RFO               * WAS THAT A SIM READ FWD
         BCS,0    %+3               * CHG TO BE OR BNE AS APROPO
         MTB,+1   R5                * SET SPCL CODE 1 TOO MUCH
         BAL,SR2  BADBUF            * CODE=7 BADBUF+1; AND ERRLOG
         LCI      0                 * GETEM BACK
         PLM,0    TSTACK            *
         SPACE    3
OCPCU1   LB,D1    DCT3,R1           *IOTABLE FLAG GROUP 1
         CI,D1    X'10'
         BANZ     TIME%OUT           OPERATION TIMED OUT
         BAL,R9   IOSERCK            CHECK FOR OTHER ERRORS
         B        IOSCU              RETRY(ERROR)
         BAL,R6   LD%FLGS           GET COMMUNICATION BITS
         LB,R6    POST%VEC,R5
         B        BASE:,R6           ENTER FUNCTION-DEPENDENT ROUTINE
*
         PAGE
*
*        ROUTINE TO PROCESS TIME-OUTS
*
TIME%OUT BAL,R6   LD%FLGS           GET COMMUNICATION BITS
         CI,R5    CONT:DOT          TIME OUT ON PUSH CONT
         BNE      TIME%1            NOPE
TIME%0   EQU      %                 *
         LW,D2    OCPFLGS,R4        * FETCH UP HAND FLAGS
         CI,D2    BLKBIT            * BLOCKED?
         BANZ     %+4               * YEP, THEN SUSP IF SYMB
         CI,D2    LBLKBIT           * LAST BLOCK THEN
         BAZ      %+2               * NOPE THEN SUSP CHK MOR
         B        TIME%01           * NEITHER SO NO SUSP
*
         LD,D1    IOQ13,R3          * IF SYMBIONT THIS IS THE EA INFO
         LB,R6    *D2               * GET SYMBX FROM CNTXT
*                   NOTE: CAREFUL HERE GHOST MUST USE APROPO EA INFO
         BEZ      TIME%01           *NONSYMB NO SUSP
         CB,R6    SNDDX             * IS SYMB?
         BGE      TIME%01           * NOPE. NO SUSP
         LI,D2    'S'               *  SUSPEND SIGNAL
         STB,D2   SSIG,R6           * . . . TO THAT SYMB
*
         MTW,+1   RBCNT,R4          * INC BAK BLK COUNT
*
         B        POST%BWD1         * TREAT AS +1 BAKUP
*
TIME%01  EQU      %
         AND,D2   OCPFLGS,R4        SAVE BOOTBIT ONLY
         XW,D2    OCPFLGS,R4        SET NEW - GET OLD
         LI,D1    0
         STW,D1   RBCNT,R4          ZAP BACK COUNT
         XW,D1    RFCNT,R4          AND FORWARD COUNT
         CI,D2    BLKBIT            ARE WE BLOCKED
         BANZ     RE%QUE            YES
         CI,D2    LBLKBIT           ARE WE IN LAST BLOCK
         BAZ      RE%QUE            NOPE
         B        POST%XIT          ASSUME WE ARE DONE
TIME%1   CI,R5    BOT:DOT           BEG-OF-TAPE
         BNE      TIME%2            NO
         LH,R6    DCT1,R1           YES-GET DEVICE ADD.
         HIO,0    0,R6              GET ITS ATTENTION
         LI,R12   BOTTYC            SET BOT TYC
         B        PST%XIT1          AND LEAVE
TIME%2   CI,D1    RUNBIT+REWBIT     RUN OR EWIND
         BAZ      TIME%3            NOPE
         MTB,0    IOQ11,R3          ANY RETRIES LEFT
         BNEZ     RETRY             YES
         BAL,R9   NOTIME            LOG ERROR
         B        TIME%0
TIME%3   LI,D1    CONT:DOT          NO - PUSH CONTINUE
         CI,R5    2                 * WAS THAT FUN A READ BAK
         BE       TIME%0            * . .THEN WRAP IT UP NO FOLLOW.
         B        SET%FOLW          AND SET FOLLOWON
*
         PAGE
*        OCPIO ERROR LOGGING ROUTINE
*        CONSTRUCTS DEVICE-ERROR TYPE ERRLOG ENTRY
*        WITH OCP-SPECIFIC INFO IN SEEK ADDR FIELD
*        ENTER WITH (R1)=DCTX, (R3)=IOQX
*                   (R4)=CLIST ADDR, (R5)=FUNCTION CODE
*                   (R9)=RETURN ADDRESS
*
         OPEN     I,J,AL,XL
*
*        XL IS A HELPER PROC TO FACILITATE THE BUILDING OF THE
*        TRANSLATE TABLE USED TO PACK THE ERRLOG INFORMATION. THUS
*        AS THE INFO IS LOADED INTO REGS(THE FIRST 255 BYTES OF
*        MEMORY) THE CODER SPECIFIES WHERE THE PARTICULAR BYTES
*        REALLY BELONG IN THE RESHUFLED COMPACT BLOCK.  XL AF(1)
*        IS THE SOURCE REGISTER AND IS RETURNED BY XL, XL AF(2-N)
*        ARE LISTS SPECIFYING WORD DISP AND BYTE DISP INTO THE BLOCK
*        AND ARE ENTERED APPROPRIATELY INTO THE TRANSLATE TABLE.
*
AL       SET      (0,0,0,0),(0,0,0,0),(0,0,0,0),(0,0,0,0)
*                  0 1 2 3   0 1 2 3   0 1 2 3   0 1 2 3    AF(N+1,2)
*                     0         1         2         3       AF(N+1,1)
*
*
XL       FNAME    0
         PROC
I        DO       NUM(AF)-1         *
AL(AF(I+1,1)+1,AF(I+1,2)+1)       SET AF(1)**2+4-I
         FIN                        * I *
         PEND     AF(1)
*
         DISP     AL
*
*
*
*
*                                   ***ERROR CODES***
BADBUF   MTH,1    R5               6:  ILLEGAL FORMAT, BLOCKED BUFFER
NOTIME   MTH,1    R5               5:  OCP TIMED OUT, 0 RETRIES
BADBACK  MTH,1    R5               4:  BACKUP BEYOND BOT
BADREW   MTH,1    R5               3:  UNEXPECTED REWIND REQUEST
NOBOOT   MTH,1    R5               2:  OCP NOT BOOTED, BLOCKED BUF
RDBACK   MTH,1    R5               1:  READ BACKWARDS REQUEST
*
         LCI      0                 *SAVE ALL REGS
         PSM,R6   TSTACK
         LW,R7    RFCNT,R4          CURRENT BLOCK NUMBER
         LW,R6    RBCNT,R4          BACKSPACE COUNT
         STB,R6   R7                BKCNT,-,BLKNO 8,16,8
         SCS,R7   -8                BLKNO,BKCNT,-  8,8,16
         LW,R6    R5                -,ERRCODE,-,FC  8,8,8,8
         SLD,R6   -16               -,ERRCD,-,FC,BLKNO,BKCNT 24,8,8,8,8,8
         STB,R6   R7                ERRCODE,FC,BLKNO,BKCNT  8,8,8,8
*                 *
         STW,R7   IOQ12,R3          * PARK THAT INFO
*
*                 CONSTRUCT 13 WORD ERRLOG ENTRY IN THE REGS.
*
*
*
*
*
         LCI      6
         LM,R8    XLTAB
*
*
         LB,XL(R0,(1,2)) IOQ4,R3    * ORIG FUN STEP
         LB,XL(R2,(1,3)) IOQ5,R3    * CURR FUN STEP
         LB,XL(R4,(3,1)) DCT19,R1   *
         LB,XL(R5,(3,2)) DCT20,R1   *
         LI,XL(R6,(0,0),(0,1)) X'150D'  *  ERRL CODE AND COUNT
         LH,XL(R7,(2,0),(2,1)) DCT21,R1 *
         LB,XL(R14,(2,2)) IOQ10,R3  * NRA
         LB,XL(R15,(2,3)) IOQ11,R3  * NRT LEFT
         LB,XL(R14,(2,2)) IOQ4,R3   * ORIG FUN STEP
         LB,XL(R15,(2,3)) IOQ5,R3   * CURR FUN STEP
*
         TBS,R12  0                 *  ARRANGE EM
*
         LD,R12   DCT13,R1          *  TDV INFO
         LW,R4    R12               * LAST CDW
         LD,R14   0,R4              *
         LW,R0    DCT12,R1          * AIO INFO
         XW,R0    R10               * . . . INTO ITS PLACE
*        LI,R2    0                 * NOT HERE YET
         LD,R4    IOQ13,R3          * EA INFO
         LW,R4    IOQ12,R3          * SEEK INFO
         INT,R5   8,R5              * CDA
         STH,R5   0                 *
         LW,R3    R9                * MOV OVER
*        LW,R9    TIME              * ERRLOG NOW DOES SOMETHING LIKE THIIS
*
*        R8-R15,R0-R4 NOW HAVE THE PROPER 13 WORD ERRLOG ENTRY ARRANGED
*
*
         LW,R1    DCT25,R1          * SIO COUNT
*
         LI,R6    R8                POINT TO ERRLOG MESSAGE
         BAL,R5   ERRLOG
*
         LCI      0                 *RESTORE ALL THE REGS.
         PLM,R6   TSTACK
         B        *R9
*
XLTAB    EQU      %                 THE TRANSLATE STUFF FOR ERRL ENTRY
I        DO       4
         GEN,8,8,8,8 AL(I,1),AL(I,2),AL(I,3),AL(I,4)
         FIN                        I
*
         GEN,8,24,8,24 0,BA(R0),4*4,BA(R8) * THE TRANSLATE DBL W PAIR
*
         CLOSE    I,J,AL,XL
*
         PAGE
*
*        ROUTINE TO EXAMINE TDV STATUS IN D1
*
CHKSTAT  CI,D1    REWBIT            REWIND REQUEST
         BAZ      STAT1             NO
         LI,D1    BOT:DOT           SIMULATE BOT
         B        SET%FOLW          AND SET FOLLOWON
STAT1    CI,D1    RUNBIT            IS RUN TRUE
         BAZ      TIME%3            DO A PUSH
         CI,D1    BACKBIT           YES-CHECK DIRECTION
         BAZ      0,R6              BACKWARDS
         B        1,R6              FORWARDS
*
         PAGE
*
*        THESE ROUTINES PART OF RDFWD EXIST HERE TO AVOID
*        EXCEEDING THE ALLOWED SIZE LIMIT ON ROUTINES FOLLOWNG
*        BASE:.
*
RD%FWD1  CI,D2    BLKBIT            IS BUFFER BLOCKED
         BAZ      PRE%EXIT          NO
         MTW,1    RFCNT,R4          BUMP COUNT FORWARD
*
*        CHECK FORMAT OF BLOCKED BUFFER.
*        INSURE EACH RECORD IS PRECEDED BY 4 BYTES CONSISTING OF
*        RECORD BYTE COUNT,0(16,16).  ADD BLOCK PREFIX TO FRONT
*        OF BUFFER(CLOBBERING 2 BYTES PRECEDING BUFFER START ADDR).
*
         LI,R10   0                * RCC AND SK ZAPPER.
         LI,R8    2                * +2 FOR BLOCK PREFIX.
         LI,R13   X'40'            *  EOSB RCC.
         LW,R9    IOQ8,R3          * CC,DC,BUFF BA 1,1,30.
         LCF,2    9                * IS IT CHAINED IN ANY SENSE.
         BCS,12   BADBUFF          * YEP--MUST BE BAD*********
         LW,R6    IOQ8,R3          * INDEX TO RECORD TO DO.
         MTW,-2   IOQ8,R3          * POINT WHERE BLOCK PREFIX BELONGS.
         AH,R9    IOQ9,R3          * + BC = END BUFFER BOUNDARY.
         B        CHECKIT          * ---DIVE IN.
CHKAGN   STB,R10  0,R6             * ZAP EOSB.
         SLS,R0   8                * -
         OR,R12   R0               * -MERGE RECORD BC.
         AW,R8    R12              * TOTALIZE.
         AI,R6    1                * -NEXT- (SKIP).
         LB,R0    0,R6             * GET SKIP.
         AND,R0   M3               * SKIP IS 3 BITS WIDE.
         BEZ      BADBUFF          * ZERO IS BAD**************
         BDR,R0   BADBUFF          * >1 IS BAD TOO************
         STB,R10  0,R6             * ZAP SKIP.
         AI,R6    1-4              * -NEXT- (MINUS THE 4 INCLUDED IN TOTBC)
         AW,R6    R12              * -NEXT- RECORD.
         CW,R6    R9               * OUTOFBOUNDS-
         BG       BADBUFF          * YEP-- THAT'S BAD TOO******
CHECKIT  LB,R0    0,R6             * BC HI-ORDER BYTE.
         AI,R6    1                * -NEXT-
         MTB,4    0,R6             * MAKE RECORD BC INCLUDE CONTROL STRING(ANS).
         BNC      CHKIT0           * --(MADE IT WITH NO CARRY).
         AI,R6    -1               * CARRY -BACKUP-
         MTB,1    0,R6             * ADD CARRY TO BUFFER.
         AI,R6    1                * -RESTORE-
         AI,0     1                * ADD CARRY TO TOTAL.
CHKIT0   LB,R12   0,R6             * BC LO-ORDER BYTE.
         AI,R6    1                * -NEXT-
         CB,R13   0,R6             * IS IT EOSB ALREADY-
         BNE      CHKAGN           * NO-- MOVE ON.
         STH,R8   IOQ9,R3          * YES, PLANT REAL BYTE COUNT.
         LI,R7    1                * DISP TO BLOCK PREFIX LO-ORDER.
         AW,R7    IOQ8,R3          *      TO BUFFER.
         STB,R8   0,R7             * PLANT LO-ORDER BLOCK PREFIX.
         AI,R7    -1               * DISP TO BLOCK PREFIX HI-ORDER.
         SLS,R8   -8               *                      HI-ORDER.
         STB,R8   0,R7             * PLANT HI-ORDER BLOCK PREFIX.
         B        PRE%EXIT         * TRANSMIT... ...
*
BADBUFF  LI,R12   ABORTYC2          LOG BAD BUFFER
         BAL,R9   BADBUF
         B        ABORT             AND ABORT
*
         PAGE
*
* LOAD COMMUNICATION BITS
*
*                 R4=CLIST ADDRESS
*                 R5=CURRENT FUNC STEP
*                 D1=TDV STATUS
*                 D2=OCPFLGS (COMMUNICATION BITS)
*
LD%FLGS  LD,D1    DCT13,R1          TDV INFO
         LB,D1    D2                TDV STATUS
         LH,R4    DCT7,R1
         SLS,R4   1                 CLIST ADDRESS
         LW,D2    OCPFLGS,R4        COMMUNICATION  BITS
         LB,R5    IOQ5,R3           FUNCTION STEP
         B        0,R6              RETURN
*
* SET FOLLOW ON
*
SET%FOLW LH,D2    DCT17,R1          CURRENT DOT LIST
         AND,D2   XFF00             ZAP FOLLOWON
         AW,D2    D1                SET NEW
         BAL,R0   RE:ENT            CHECK RE-ENTRANCY
         STH,D2   DCT17,R1          STORE NEW
         B        FOLLOWON          AND GO
*
         PAGE
*
*        BASE FOR FUNCTION DEPENDENT ROUNTINES
*
BASE:    EQU      %
*
*                 ON ENTRY: D2=OCPFLGS
*                           D1=TDV STATUS BITS
*                           R4=POINTER TO CURRENT COMMAND LIST
*
*        PRE PROCESSING ROUTINES
*
*
*                                   **READ FORWARD**
*
RD%FWD   MTH,0    IOQ9,R3           TAPE MARK
         BNEZ     RD%FWD0           NO
         LW,SR2   RDFM:DOT+DOT      YES
         LI,SR1   RDFM:DOT          SWITCH FUNCTION
SWITFCN  BAL,R0   RE:ENT            HAVE WE BEEN RE-ENTERED
         STH,SR2  DCT17,R1          NO
         STB,SR1  IOQ5,R3           SWITCH
         B        PRE%EXIT          AND GO
RD%FWD0  CI,D2    BKBIT             READ BACKWARDS
         BAZ      RD%FWD1           NO-GO
         LW,SR2   RDBK:DOT+DOT      SET READ BACKWARDS
         LI,SR1   RDBK:DOT
         B        SWITFCN           AND GO
*
         PAGE
*
*        POST PROCESSING ROUTINES
*
*                                   **READ FORWARD**
*
POST%FWD BAL,R6   CHKSTAT           CHECK STATUS
         B        PST%BK            SET READ BACKWARDS
         B        POST%XIT          RETURN NORMAL
PST%BK   LI,SR2   BKBIT
         STS,SR2  OCPFLGS,R4        SET  BACKWARDS
BACK%XIT CI,D2    BLKBIT            ARE WE BLOCKED
         BAZ      BK%XIT2           NO-SYMBIONTS BACK UP
         MTW,1    RBCNT,R4          YES-BUMP RECS BACKWARD
         MTW,-1   RFCNT,R4          DEC. RECS FORWARD
         BGZ      FOLLOWON          CONTINUE SENDING
         LI,SR4   X'FFFF'           SET REWIND
         STW,SR4  RBCNT,R4          BECAUSE WE FELL INTO BLOCK 1
         LW,SR4   OCPFLGS,R4        GET FLAGS
         MTB,1    SR4               TELL SYMB WE FAKED REWIND
         STW,SR4  OCPFLGS,R4        AND STORE IT
BK%XIT0  LI,SR4   0
         XW,SR4   RBCNT,R4          CLEAR AND LOAD
BK%XIT1  LI,R12   BACKTYC           SET BACKWARRD
         B        PST%XIT2          AND RETURN TO SYMBIONT
BK%XIT2  LI,SR4   1                 BACKUP 1 RECORD
         B        BK%XIT1
*
*                                   *READ BACKWARDS**
*
POST%BWD BAL,R6   CHKSTAT           CHECK STATUS
         B        BACK%XIT          STILL BACKWARDS
POST%BWD1 EQU     %                 *
         LI,SR1   0
         LI,SR2   BKBIT             SET RUN FOWARD
         STS,SR1  OCPFLGS,R4        IN OCPFLGS
         B        BK%XIT0           RETURN BACKWARDS
*
*                                   **TAPE MARK**
*
POST%FM  BAL,R6   CHKSTAT           CHECK STATUS
         B        PST%BK            SET BACKWARDS
         B        POST%XIT          EXIT
*
*                                   **BEGINNING OF TAPE**
*
POST%BOT BAL,R6   CHKSTAT           CHECK STATUS
         B        PST%BOT           BACKWARDS IS A NO-NO
         LI,SR2   -(BOOTBIT+1)
         LI,SR1   0
         STW,SR1  RFCNT,R4          CLEAR FORWARD COUNT
         STW,SR1  RBCNT,R4          CLEAR BACKWARD COUNT
         STS,SR1  OCPFLGS,R4        CLEAR ALL BUT BOOTBIT
         LI,SR4   X'FFFF'           SET REWIND
         LI,R12   BACKTYC
         B        PST%XIT2          RETURN
PST%BOT  LI,R12   ABORTYC3          BACK UP THRU BOT
         BAL,R9   BADBACK           LOG ERROR
         B        ABORT
*
*                                   **PUSH CONTINUE**
*
POST%CON BAL,R6   CHKSTAT           CHECK STATUS
         B        PST%BK            SET BACKWARDS
         B        BK%XIT2           RE-READ
*
         PAGE
*
* PRE HANDLER EXIT
*
PRE%EXIT LI,SR3   OCP:DOT           POINT TO OUR DOT TABLE
         LI,R4    0
         B        COMLIST           GO
*
* POST HANDLER EXIT
*
POST%XIT LI,R12   1                 NORMAL COMPLETTION
PST%XIT1 LI,SR4   0                 NORMAL RBC
PST%XIT2 LI,R13   0                 NO MESSAGES
         LI,R4    0                 NO DUAL CHANNEL
         B        IOSCU             GO
*
ABORT    EQU      PST%XIT1
*
*
FOLLOWON LI,R12   X'6000'           SET FOLLOWON , INTER OP
         B        PST%XIT1          GO
*
*
RETRY    LI,R12   X'C008'
         B        PST%XIT1          GO
*
         PAGE
         OPEN     R4                * FOR OUTSYM STUFF ONLY
R4       FNAME
         PROC
         DO1      1-SCOR(CF(2),R4)
*        ERROR,1  'ILLEGAL USE OF BASE REGISTER'
         PEND     4
*
*
LSBR     CNAME                      LOAD SYMBIONT BASE REGISTER
         PROC
         DO       SCOR(AF(1),EA)
LF       LW,4     *R14
         ELSE
LF       LW,4     *SR3
         FIN
         PEND
*
LSCP     CNAME                      LOAD SYMBIONT CONTEXT POINTER
         PROC
LF       LW,1     SR3
         PEND
*
PABRT    CNAME
         PROC
         DO       1
         LI,SR4   AF(1)+W
         DO       CF(2)<16
         BCR,CF(2) BADDA2
         FIN      CF(2)
         ELSE
         DO       CF(2)=0=0
         BCS,CF(2)&15 %PEND
         FIN      CF(2)
         BAL,R7   BADDA2
         GEN,8,8,8,8 S:UT(AF(2))
         FIN
*L(AF(1)-X'40F0') SET AF(1),AF(2),%,AF(3)
%PEND    SET      %
         PEND
*
LIEA     CNAME                      LOAD IMMEDIATE INTERNAL
OCP%C%IN%OS SET   0                 * OCP CODE IS NOT IN OUTSYM
         PROC                       END ACTION ADDRESS
         DO       OCP%C%IN%OS
LF       LI,CF(2) AF-SYMPPRTY       GET ABSOLUTE ADDRESS
         AW,CF(2) R4                AND BASE
         AND,CF(2) M17              DELETE SYMX
         ELSE
LF       LI,CF(2) AF                GET (REAL) END ACTION ADDRESS
         FIN      OCP%C%IN%OS
         PEND
*
         PAGE
         REF      SCGCO             *2*GRAN COUNTER(THIS FILE)
         REF      SCPCO             *  PAGE COUNTER(THIS FILE)
         REF      SCRCO             *  RECORD COUNTER(THIS FILE)
         REF      SCFLDA            * FORWRD LINK D A
         REF      SCBLDA            * BACK LINK D A
         REF      SCCDA             * CURRENT D A
         REF      SCDCDA            * DEV Q ARGS CDA.
         REF      SCFBUF            * FILE BUFFER POINTER
         REF      SCDBI             * DEV DATA BYTE INDEX
         REF      SCDBC             * DEV BYTE COUNT
         REF      SCDQARGS          * DEV QUEUE ARGUMENTS
         REF      SCFQARGS          * FILE QUEUE ARGUMENTS
         REF      SCTYC             * FILE/DEVICE TYPE OF COMPLETE
         REF      SCBESTDA          SYMBIONT CONTEXT BEST
*                                   ,  DISC ADDRESS
         REF      SCTOFDA           * LAST TOF DISC ADDR.
         REF      SCSVDGI           SYMBIONT CONTEXT SAVED
*                                   , GHOST INFORMATION
         REF      SCDEVTYP          * SYMB CNTXT DEVICE TYPE FLG
         REF      SCBSIZ            * SYMB CNTXT DISP TO BLK SIZ
         REF      SCXTRAB           * EXTRA BUFFER LIST
         REF      SCBUPPT           *BACKUP POINT
         REF      SCBUPPTS          *  ''     ''    SAVE
         REF      SCDQFC            * DEV Q FUN CODE LIST
         REF      SCRCVLST          *  DELETE GRAN RCVR LIST
         REF      SCSWIT            * RB SWITCH CNTXT POINT
         REF      SCFEA             * FILE SIDE END ACTION ADDRESS
         REF      SCDEA             * DEVICE SIDE END ACTION ADDRESS
         REF      M17               * X'1FFFF'
         REF      BT31TO0           * SINGLE BIT FLAG TABLE
         REF      NB31TO0           * COMPLEMENT OF BT31TO0
         REF      OS%UDAP           * UPDATE OS DISC ADDRESSES
         REF      QFACTP11          * WAIT ON ACT QUE (BIRD IN BUSH)
         REF      CHKDA             * CHECK A DISC ADDRESS
         REF      C:CSC             * COUNT OF SYMB DISC ACCESSES
         REF      DCT%MASK          * BIG DISC DCT MASK
         REF      REQCB             * STEAL AN SPOOL
         REF      S:SIBTU           * SYST CONST. SYMB IMAGE BUFS 2 USE
         REF      SCNCBT            * SYMB CNTXT NO BUFFERS TEMP
         REF      SRELBUF           * RELEASE SYMB BUFF- NO ACT QUE
*
         PAGE
*
*        VARIOUS OUTSYM PARTICULAR EQUATIONS
*
PGABRTTYC EQU     X'10'             * PAGE ABORT
HUTYC    EQU      2                 *HUNG UP COMPLETION
BUTOG    EQU      Y01               *BACKUP TOGGLE SIGNAL
NORMTYC  EQU      Y01               * NORMAL TYPE OF COMPLETION
1STDBI   EQU      4                 * 1ST DATA BYTE INDEX
RESTOREBIT EQU    X'100'            *
XTRABGETBIT EQU   X'400'            * SC FLAGS
SPILLBIT EQU      X'200'            *
W,WEIRD EQU       X'20000'  * OBSCURE STH CC MOD
EOSB     EQU      X'40'             *END OF SYMBIONT BLOCK RCC
1EOF%FLAG EQU     X'800'            *FLAG FORCES TERM AFTER 1
*                                      FILE IF SET
LIST     EQU      4                 *X'40' BIT IN TB:FLGS IS
*                                     LISTING DEVICE BIT
DELFLAG  EQU      Y008              * RELEASE GRANULES FLAG
         REF      Y008              * =X'00800000'
TYPMSK   EQU      X'FF'             *WIDTH OF SCDEVTYP TYPE FIELD
PAGE     EQU      4                 *CC2 FROM X'40' IN SKIP BYTE IS TOF
*                     (FOR TWO REASONS: POSS NOVFC&VARIABLE VFC CONVENTIONS)
RESSPLPFBIT EQU   X'1000'           * SCDEVTYP SAYS IS RESTORE OR SPOOL
IMRESPFBIT EQU    X'2000'           *               IS IMAGE OR RESTORE
ALGNBIT  EQU      BT31TO0+21    Y001
WEOFBIT  EQU      BT31TO0+23    Y004
CPYBIT   EQU      BT31TO0+22     Y002
NWEOFBT  EQU      NB31TO0+23
NCPYBT   EQU      NB31TO0+22
NALGNBT  EQU      NB31TO0+21
INHIB    EQU      X'37'             *INTERNAL MODE, ALL ON
UNINHIB  EQU      X'27'             *INTERNAL MODE, ALL OFF
*
*        MLBF     EQUATIONS  (FLAG BITS FOR CC'S)
*
WRR      EQU      1                 * WRITE IS ALWAYS ODD(1)
RDR      EQU      2                 *AND READ EVEN(2) IN IOSYSTEM.
FULL     EQU      4                 * THIS BUFFER IS FULL
BUSY     EQU      8                 *  ''     ''   IS IN USE.
*
EA       EQU      OS%EA             * USE AN EXPLICITE GLOBAL
*
         PAGE
*
* BRANCH TABLE FOR OCP DEVICE END ACTION
*
:BTBL    CNAME
         PROC
         DATA,1   AF-OCPTYCTB
         PEND
*                                   TYC
OCPTYCTB EQU      %
         :BTBL    OCPABTYC          0
         :BTBL    OCPNMTYC          1
         :BTBL    OCPBKUP           2
         :BTBL    OCPABRQ           3
         :BTBL    OCPABBB           4
         :BTBL    OCPABBT           5
         :BTBL    OCPBOTYC          6
*
         BOUND    4
*
MAXTYC   EQU      BOTTYC
*
*
         PAGE
*
* OCP FILE SIDE END ACTION - SET BY SACT
*
*
OCPFEA   LSBR     EA                RESTORE REGS
         BAL,SR2  OS%REG-EA
         LI,R8    BLKBIT            ASSUME WE ARE BLOCKED
         BAL,R2   OCPCHKFL          CHECK FIRST OR LAST BLOCK
         LI,R8    0                 WE ARE NOT BLOCKED
         BAL,R2   STBKUBK           SET BLOCK/UNBLOCK BIT
         PLW,R11  TSTACK            ADJUST THE STACK
         B        OSFEA             CONTINUE
*
*
* OCP DEVICE END ACTION - SET BY 'SACT'
*
OCPDVEA  LSBR     EA                GET BASE ADDRESS(R4)
         BAL,SR2  OS%REG-EA         AND THE OTHER REGS
         STW,R12  SCTYC,R1          SAVE TYC
         LB,R2    R12               R2=STATUS CODE
OCPDVEA0 CI,R2    MAXTYC            IS TYC RECOGNIZABLE
         BG       OCPABTYC          NOPE
         LB,R2    OCPTYCTB,R2       GET DISP
         B        OCPTYCTB,R2       AND GO
*
OCPNMTYC B        OSDEA0            NORMAL TYC
*
         PAGE
*
* PROCESS ABORT TYC
*
* FOUR TYPES CAN OCCUR
*
*        1. OCP NOT BOOTED
*        2. BAD SYMBIONT BUFFER
*        3. BACKUP THRU SIMULATED BEGINNING OF TAPE
*        4. UNRECOGNIZABLE TYC FROM HANDLER
*
*
OCPABBT  BAL,R2   OCPCLRFG          CLEAR FLAGS
         PABRT    '10','BKUP','OCP BACKUP THRU BOT'
OCPABBB  BAL,R2   OCPCLRFG          CLEAR FLAGS
         PABRT    '11','BBUF','OCP BAD BUFFER'
OCPABTYC BAL,R2   OCPCLRFG          CLEAR FLAGS
         PABRT    '12','BTYC','BAD TYC FROM HANDLER'
OCPABRQ  BAL,R2   OCPCLRFG          CLEAR FLAGS
         B        OSDEA0A           RE-QUE
OCPBOTYC BAL,R2   OCPCLRFG          CLEAR FLAGS
         LI,R2    1STDBI+1
         STW,R2   SCDBI,R1          SET TO RELEASE
         B        OCPSEND0          AND RELEASE
*
* CLEAR FLAGS IN HANDLER FOR ABORT
*
OCPCLRFG BAL,R9   GETCOMAD          GET COMMAND LIST ADD
         LI,R12   0
         LI,R13   -(BOOTBIT+1)
         STW,R12  RFCNT,R7          ZAP READ FORWARD COUNT
         STW,R12  RBCNT,R7          ZAP READ BACKWARD COUNT
         STS,R12  OCPFLGS,R7        ZAP ALL BUT BOOTBIT
         B        0,R2              RETURN
*
         PAGE
*
* OCP BACKUP
*
* THREE TYPES OF BACKUP CAN OCCUR
*
*        1. BACKUP ALL(REWIND)
*        2. BACKUP NONE(CONTINUE AS IF NORMAL)
*        3. BACKUP N RECORDS OR BLOCKS
*
OCPBKUP  INT,R15  R12               R15=COUNT
         CI,R15   X'FFFF'           REWIND
         BNE      OCPBKUP0          NO
         LI,R8    0
         BAL,R2   STBKUBK           SET NOT BLOCKED MODE
         LW,R8    SCBESTDA,R1       STARTING DISK ADDRESS
         B        OS09A             CONTINUE
OCPBKUP0 AI,R15   0
         BEZ      OSDEA0            CONTINUE
*
* WE ARE GOING TO BACK UP - SET THINGS UP
*
         STW,R15  SCTYC,R1          SAVE COUNT
         BAL,R2   CKBKUBK           BLOCKED OR RECORD
         B        OCPBKIT           RECORD
         BAL,R2   OCPCHKF0          GET BLINK
         B        OCPABBT           BACK UP THRU BOT
         LIEA,R15 OCPBKFIL
         STW,R15  SCFEA,R1          SET NEW END ACTION
         B        OCPBKEA0          READ PREVIOUS
*
         PAGE
*
* END ACTION FROM FILE BACKUP
*
OCPBKFIL LSBR     EA                RESTORE REGS
         BAL,SR2  OS%REG-EA
         BAL,R2   OCPCHKF0          GET BLINK
         B        OCPBKFI0          AIN'T NONE -GET OUT
         MTW,-1   SCTYC,R1          DECREMENT COUNT
         BGZ      OCPBKEA0
OCPBKFI0 LIEA,R2  OCPFEA            WE'RE DONE
         STW,R2   SCFEA,R1          RESTORE END ACTION ADD
         B        OSFEA4            AND PROCESS THIS BLOCK
OCPBKEA0 STW,R0   SCCDA,R1          BLINK=CURRENT
         B        OS1D              READ IT
*
         PAGE
*
* SET BACK UP RECORDS
*
OCPBKIT  LW,R2    SCDBI,R1          CURRENT POINTER
         STW,R2   SCTYC,R1
         LIEA,R2  OCPBKREC          SET END ACTION
         STW,R2   SCDEA,R1
         LI,R12   2
         STB,R12  R12               FAKE TYC
         PLW,R11  TSTACK            ADJUST THE STACK
*
* END ACTION FROM RECORD BACKUP
*
OCPBKREC LSBR     EA                RESTORE REGS
         BAL,SR2  OS%REG-EA
         LB,R2    R12               GET TYC
         CI,R2    2
         BL       OCPRES            DONE - RESTORE TRUE END AC
         BG       OCPDVEA0          ABORT
*
* BACK UP THRU BUFFER
*
         INT,R7   R12
         AI,R7    0                 IF COUNT WAS ZERO
         BEZ      OCPRES            THEN WE'RE FORWARD
         LW,R14   SCTYC,R1          GET OLD POINTER
         LW,R6    SCFBUF,R1         BUFFER ADDRESS
         LI,R2    1STDBI            INIT BYTE DISP
         CW,R14   R2                ARE WE AT BEGINNING
         BNE      OCPBKBK1          NO
         LI,R8    BLKBIT            SET BLOCKED
         BAL,R2   STBKUBK
         MTW,0    RFCNT,R7          COUNT BETTER BE >0
         BNEZ     OCPBKBK0          IT IS
         LI,R2    ABORTYC3          SET BACKUP THRU BOT
         B        OCPDVEA0          AND ABORT
OCPBKBK0 LIEA,R0  OCPDVEA
         STW,R0   SCDEA,R1          RESET END ACTION
         B        OCPSEND0          AND GO TO SYMB
OCPBKBK1 STW,R2   SCTYC,R1          SET NEW POINTER
         BAL,R7   OCPNEXTR          GET NEXT RECORD
         CW,R14   R2                ARE WE THERE
         BNE      OCPBKBK1          NOPE
OCPBKBK2 LW,R2    SCTYC,R1          GET POINTER
         STW,R2   SCDBI,R1          SET NEW INDEX
         B        OSDEA00           AND SEND IT
*
* DONE BACKING UP RECORDS - SET TO GO FORWARD AGAIN
*
OCPRES   LIEA,R2  OCPDVEA
OCPRES0  STW,R2   SCDEA,R1          RESTORE END AC
         B        OCPBKBK2
*
         PAGE
*
* SET BLOCK OR UNBLOCK BIT IN OCPFLAGS
*
STBKUBK  BAL,R9   GETCOMAD          GET COMMAND LIST ADDRESS
         LI,R9    BLKBIT+LBLKBIT
         STS,R8   OCPFLGS,R7        SET BLOCK/UNBLOCK
         B        0,R2              RETURN
*
* CHECK BLOCK/UNBLOCK SET IN OCPFLGS
*
CKBKUBK  BAL,R9   GETCOMAD          GET COMMAND LIST ADDRESS
         LI,R9    BLKBIT
         CW,R9    OCPFLGS,R7        IS BLOCK SET
         BAZ      0,R2              NO-RECORD
         B        1,R2              YES-BLOCK
*
* FIND COMMAND ADDRESS
*
GETCOMAD LB,R7    SNDDX,R3          R7 DCT X OF OCP
         LH,R7    DCT7,R7           R7 DBL ADD OF COMLIST
         SLS,R7   1                 TO WORDS
         B        *R9               RETURN
*
* CHECK IF THE CURRENT BLOCK IS THE FIRST OR LAST
* (FLINK=0 OR BLINK=0)
*
OCPCHKFL LI,R8    LBLKBIT           ASSUME LAST BLOCK
         LW,R6    SCFBUF,R1         BLOCK IN CORE
         LH,R0    *R6               FLINK
         BEZ      0,R2              FLINK=0
OCPCHKF0 LI,R8    BLKBIT            ASSUME BLOCKED
         LW,R6    SCBSIZ,R1         BLOCK BYTE COUNT
         SLS,R6   -2                TO WORDS
         AW,R6    SCFBUF,R1         R6 PNTR TO BLINK
         LW,R0    *M24,R6           GET IT
         BNEZ     1,R2              BLINK AIN'T ZERO
         LI,R8    0                 ASSUME RECORD
         B        0,R2              BLINK IS ZERO
*
* SEARCH ROUTINE TO LOOK THRU DATA BUFFER
*
OCPNEXTR LB,R0    *R6,R2            GET 1RST HALF OF BYTE COUNT
         AI,R2    1
         LB,R12   *R6,R2            GET SECOND HALF
         SLS,R0   8
         OR,R0    R12               PACK THEM
         AI,R2    3                 POINT TO RECORD
         AW,R2    R0                R2 POINTS TO NEXT FUNC
         B        0,R7              RETURN
*
         PAGE
*
* WE GET HERE FROM OSDEA00 WHEN IT IS DETERMINED
* THAT A RECORD IS TO BE SENT TO THE OCP.
*
OCPSEND  BAL,R2   OCPCHKFL          CHECK BLINK/FLINK
         BAL,R2   STBKUBK           SET BITS IN HANDLER FLAG
         CI,R8    BLKBIT            ARE WE BLOCKED
         BAZ      OCPCKREW          NOPE
OCPSEND0 LI,R12   EOSB              SET TO RELEASE
         LW,R2    SCDBI,R1          CURRENT DATA BYTE INDEX
         LW,D3    SCFBUF,R3         BUFFER ADDRESS
         CI,R2    1STDBI            IF THIS ISN'T FIRST TIME
         BNE      OSDEA00A          THEN RELEASE THE BLOCK
*
* R0 HAS THE MAXIMUM BYTE COUNT POSSIBLE. SINCE
* WE ARE BLOCKED THE HANDLER WILL LOOP THRU THE BLOCK
* AND FIGURE WHAT THE BYTE COUNT WILL BE.
*
         LW,R0    SCBSIZ,R1         R0 SIZE OF BLOCK
         AI,R0    -8                DELETE TWO WORDS
         B        OSDEA5            GO
*
* CHECK IF BACKUP (FROM FAKED REWIND ) IS TO BE DONE
*
OCPCKREW LW,R2    OCPFLGS,R7        GET FLAGS
         LB,R6    R2                WAS A REWIND FAKED
         BEZ      *R14              NOPE
         MTB,-1   R2                YES-RESET FLAG
         STW,R2   OCPFLGS,R7        PUT FLAGS BACK
         LI,R2    1STDBI            LOOK FOR END OF BLOCK
         LW,R6    SCFBUF,R1         BUFFER
OCPCKRW0 STW,R2   SCTYC,R1          SAVE CUURENT INDEX
         BAL,R7   OCPNEXTR          GET NEXT RECORD POINTER
         LI,R7    2
         AW,R7    R2                POINT TO FUNC CODE
         LB,R7    *R6,R7            GET IT
         CI,R7    EOSB              IS IT END OF BLOCK
         BNE      OCPCKRW0          NOPEE
         LIEA,R2  OCPBKREC          NEW END ACTION
         B        OCPRES0           AND GO
*
         PAGE
*
*
*        MLBFI  -   MULTI BUFFER INITIALIZER
*                 LNK=SR2;I=R1(SCP),SR3(SCP),R4(SBR)
*                 O=        CLEAN UP AN EXISTING MLBF LIST
*                           CREATE ONE IF NONE EXIST.
*                           ADD OR REMOVE BUFFS TO AGREE WITH S:SIBTU.
*                 NON-VOLATILE : R5-SR3(R5-R10)
*
OS%MLBFI EQU      %
*
MLBFIRS  EQU      7,R5              * NON-VOLATILE REGISTERS
*
         LCI      MLBFIRS(1)
         PSM,MLBFIRS(2)  TSTACK     * SAVEM
         LB,R7    SNDDX,R3          *-DCTX
         LH,R7    DCT7,R7           *-CLIST DW DISP
         SLS,R7   +1                *-...TO WA
*
         LW,D3    S:SIBTU           ***REQUESTED COUNT
         XW,D3    MLBFC2,R7         ***...BECOMES NEW OBJECT.REMEM OLD
*
         LW,R5    MLBFC1,R7         *FORMER CONTROL WORD
         BEZ      MLBFIB            * NONE THERE SO BUILD ONE
*
         STW,R5   SCXTRAB,R1        * REFRESH
         LB,SR4   R5                **NUMBER TO CLEAN
         LI,SR2   0                 **CLEANER
         LI,D2    SCXTRAB           ** DISP TO LIST
         BAL,D4   OS%LSTMGR         ** SET LINK AND POINT TO NEXT
         STB,SR2  *R5               ** ZAP HIS FLAGS
         BDR,SR4  OS%LSTMGR         ** DO NEXT; AND ALL
*
MLBFIA   EQU      %                 * THE TOP OF MLBF
         LB,R6    R5                * HOW MANY WE GOT
         CW,R6    MLBFC2,R7         * ENOUGH
         BG       MLBFIR            * TOO MANY...RELS SOME
         BL       MLBFIG            * NOT ENUF...GET  SOME
*                                   * JUST RIGHT
MLBFIX   EQU      %                 * GO BACK TO OUTSYM
         LCI      MLBFIRS(1)        *
         PLM,MLBFIRS(2) TSTACK      * RESTOREM
         B        *SR2              * XIT
*
MLBFIR   EQU      %                 * RELEASE ONE AND CHECK AGAIN
         MTB,-1   R5                * BACK OFF COUNT
         STW,R5   SCXTRAB,R1        * MARK IT
         STW,R5   MLBFC1,R7         * AND REMEMBER LOAD POINT
         LW,D3    *R6,R5            * GRAB LAST IN LIST
         BAL,SR4  SRELBUF           * ...RELEASE IT
         B        MLBFIA            * AND CHECK AGAIN
*
MLBFIB   EQU      %                 * BUILD THE 1ST LIST
         AI,R5    SCXTRAB           * LIST DISP
         AW,R5    R1                * ... REAL ADDR
         LI,R6    0                 * NONE THERE
*
MLBFIG   EQU      %                 * NOT ENUF SO GET ONE
         AI,R6    1                 * POINT AT HOLE
         MTB,+1   R5                * INC COUNT
         LCI      3                 * WATCH OUT FOR CORE QUEUE
         STM,R5   SCNCBT,R1         * ...NO RBBAT COMM AT THIS TIME
         LCI      MLBFIRS(1)        *
         PLM,MLBFIRS(2) TSTACK      * RESTOREM
         BAL,SR4  REQCB             * STEAL ONE
         LCI      MLBFIRS(1)        *
         PSM,MLBFIRS(2) TSTACK      * SAVEM
         LCI      3                 *
         LM,R5    SCNCBT,R1         * ...RESTORE WORK IN PROGRESS
         STW,D3   *R6,R1            * PARK THAT STOLEN ONE
         STW,R5   SCXTRAB,R1        * ...MARK NEW HEAD
         STW,R5   MLBFC1,R7         * ... AND NEW L.P.
         B        MLBFIA            * AND CONTINUE FROM THE TOP
*
*
OS%LSTMGR EQU     %                 * OUTSYM'S LIST MANAGER
*        LNK=D4;I=R1(SCP),D2(LIST DISP),D3(LIST SIZE)
*        O=  R5(LIST CONTROL WORD UPDATED)
*                 NUM AVAIL,ADDR OF NXT  8,24
*
         LW,R5    *D2,R1            ** FETCH UP CONTROL WORD
         MTB,-1   R5                ** DECR AVAIL COUNT
         BNEZ     %+3               ** NO WRAP YET
         SW,R5    D3                * WRAP SO START AT BASE
         STB,D3   R5                * SET MAX AVAIL
         AI,R5    1                 ** POINT AT NEXT AVAIL
         STW,R5   *D2,R1            ** PARK UPDATED CONTROL WORD
         B        *D4               ** RETURN TO CALLER
*
         PAGE
*
SHAMROCK%SGR SET  0                 * NO SYMB GRAN RELS FOR OCP
TYC%NO%GOOD SET   1                 * TYC FROM DISC HANDLERS IS NO GOOD
PTCHIN   SET      1                 * INCLUDE A PATCH AREA
*
         NOP
         LSBR     EA                * RESTORE BASE REG FOR OUTSYM
         BAL,SR2  OS%REG-EA         * FETCH UP OUTSYM REGISTERS
         PSW,SR4  TSTACK            * --BIRD TO BUSH--
         BAL,SR2  OS%UDAP           * UPDATE DISC ADDRESS POINTERS
         B        OSIBADDA1         * BLINK FAILURE.
*
*
         CW,R12   NORMTYC           * OPERATION DONE NORMALLY
         DO       TYC%NO%GOOD
         B        OCPFEAA           * SKIP IT CANT TELL
         FIN      TYC%NO%GOOD
         BLE      OCPFEAA           * YEP GO ON
         BAL,SR2  QFACTP11          * GET OFF THE FILE DEVICE IOQ
         PABRT    '12','FTYC','FILE SIDE TYC BAD-OCP'
*
OCPFEAA  EQU      %
         DO       SHAMROCK%SGR
         BAL,SR2  OS%RSG            * UPDATE DISC ADDRESS LIST
         REF      OS%RSG            *OUTSYM: RELEASE GRANULE
         FIN      SHAMROCK%SGR
*
         BAL,SR2  OS%REG            * AGAIN WITH THE REGISTERS
         LW,SR1   SCCDA,R1          * FETCH UP NEW CDA
         BAL,SR4  CHKDA             * CHEKIT
         LSBR                       * YEP HE BOMBED SBR
         PABRT,8  '13','FCDA','FILE SIDE CDA BAD-OCP'
         MTW,+1   C:CSC             * COUNT DISC ACCESSES
         WD,0     INHIB             ***INHIBIT***TO BLOCK READER
         NOP                        * SELECT NEXT BUFFE
         BAL,R2   OS%SCFQA          * GET THE Q ARGS
         NOP                        * RESTORE READERS BUFFER
         WD,0     UNINHIB           ***UNINHIBIT***ALLOW READER NOW
         B        OSDEA51           * GO READ NEXT BLOCK
*
*
OS%SCFQA EQU      %                 * SETUP OUTSYM Q ARGS
         LCI      5                 * THERE ARE 5
         LM,R12   SCFQARGS,R1       * ... ON THE FILE SIDE
         LH,R9    R15               * FILE DCTX IS HERE
         AND,R9   DCT%MASK          * SCRUB FUNNY BIG DISC BITS
         OR,R12   R9                * POINT Q AT IT
         SLS,R13  +2                * SCFBUF WA TO BA
         AND,R13  M24               * ... AND INSURE CLEAN ADDR.
         B        0,R2              * RETURN TO CALLER
*
*
OSIBADDA1 EQU     %                 * BLINK FAILURE IN BLOCK
         PABRT    '14','BLNK','BAD BLINK DA-OCP'
*
*
         DO       PTCHIN            * NEED A PATCH SPACE
         DEF      OCPPTCH           * EXTERNALIZE IT
OCPPTCH  EQU      %                 * HERE
         RES      50                * OUGHT TO DO
         FIN      PTCHIN
*
*
         LCI      RDR+BUSY          * SET IT READ AND OTHER BUSY
         LCI      WRR+BUSY          * SET IT WRITE AND OTHER BUSY
         LCI      FULL              * SET IT FULL
         LCI      0                 * SET IT EMPTY.
*
         STCF     *R5               * SET SELECTED BUFFER STATUS
*
         BCS,WRR+BUSY *D4           * XIT IF WRITER OR BUSY
         BCS,RDR+BUSY+FULL *D4      * XIT IF READER OR BUSY OR FULL.
         BCR,FULL *D4               * XIT IF NOT FULL.
*
         LCI      15-FULL-BUSY      * SET ALL BUT FULL AND BUSY
         STCF     SR2               * IN ARGUMENT UNION 1
         LI,SR1   0                 * CLEAR SELECTED BITS
         STS,SR1  *R5               * ...IN SELECTED BUFFER.
*
*
*
         CLOSE    R4                * FOR OUTSYM STUFF ONLY
*
*
*
*
*
         END

