          IDENT  E2X5680
          CIPPU
          MEMSEL 4
          TITLE  IOM$5680 - 5680-1X CARTRIDGE TAPE SUBSYSTEM (CTS/CCC).
          COMMENT  *SMD* LVL=01
          COMMENT  COPYRIGHT FIDES INFORMATION SERVICES. 2003
          SPACE  2
 PRGNAM   MICRO  1,4,'A680'  1ST 4 CHARACTERS OF OVERLAY NAME
          EJECT

          SPACE  4
***       IOM$5680.
*
*         THIS IS THE PP DRIVER FOR THE 5680-1X CARTRIDGE TAPE SUBSYSTEM/CCC
*         (CTS/CCC) THAT RUNS ON I2 AND I4X IOU-S. THIS DRIVER SUPPORTS BOTH
*         CIO AND NIO 170 CHANNELS. THIS DRIVER ALWAYS RUNS AS A DUAL PP
*         DRIVER AND USES OVERLAYS.
*
*         THE CIP MODULE NAME          = E2X5680
*         THE NOS/VE DECK NAME         = IOM$5680
*         THE NOS/VE IOU PROGRAM NAMES = E2A5680 (CIO)
*                                      = E2C5680 (NIO)
          SPACE  4
**        THE FOLLOWING EQUATE IS FOR OFF-LINE CMSE TESTING.

 OFFLINE  EQU    0           NZ=OFFLINE, 0=ONLINE NOS/VE
          SPACE  4
**        THE FOLLOWING EQUATES CONTROL LISTING OPTIONS, 1=LIST 0=NOLIST.

 LSTIM    EQU    1           LIST IODMAC1 THRU IODMAC5

 LSTRD    EQU    1           LIST CPU AND PP RECORD DESCRIPTORS
          SPACE  4
 .A       IFEQ   LSTIM,0     LSTIM LISTING CONTROL
          LIST   -$
 .A       ENDIF              LSTIM LISTING CONTROL
          TITLE  SYSTEM DEFINED MACRO IODMAC1.
*COPYC IODMAC1
          TITLE  SYSTEM DEFINED MACRO IODMAC2.
*COPYC IODMAC2
          TITLE  SYSTEM DEFINED MACRO IODMAC3.
*COPYC IODMAC3
          TITLE  SYSTEM DEFINED MACRO IODMAC4.
*COPYC IODMAC4
          TITLE  SYSTEM DEFINED MACRO IODMAC5.
*COPYC IODMAC5
          SPACE  4
          LIST   B,L,N,R
 .B       IFEQ   LSTRD,0     LSTRD LISTING CONTROL
          LIST   -$
 .B       ENDIF              LSTRD LISTING CONTROL
          TITLE  CPU RECORD DESCRIPTIONS.
*         PP INTERFACE TABLE.

 PIT      RECORD PACKED

* CM WORD 1
          ALIGN  0,64
 PPNO     PPWORD             PP NUMBER
 FLU      PPWORD             FIRST LOGICAL UNIT
 UNITC    PPWORD             NUMBER OF UNITS

* CM WORD 2
          ALIGN  0,64
 INT      RMA                INTERRUPT WORD (RMA)
 CHAN     RMA                CHANNEL TABLE (RMA)

* CM WORD 3
          ALIGN  16,64
 CBUFL    PPWORD             COMMUNICATION BUFFER LENGTH
 CBUF     RMA                COMMUNICATION BUFFER (RMA)

* CM WORD 4
          ALIGN  0,64
 LOCK     BOOLEAN            PP REQUEST QUEUE LOCK
          ALIGN  48,64
 LOCKPP   PPWORD             PP REQUEST QUEUE LOCK OWNER

* CM WORD 5
          ALIGN  16,64
 PPQPVA   STRUCT 6           NEXT QUEUED PP REQUEST (PVA)

* CM WORD 6
          ALIGN  32,64
 PPQ      RMA                NEXT QUEUED PP REQUEST (RMA)

* CM WORDS 7-8
          ALIGN  16,64
 RSPVA    STRUCT 14          RESPONSE BUFFER (PVA)

* CM WORD 9
          ALIGN  32,64
 RSBUF    RMA                RESPONSE BUFFER (RMA)

* CM WORD 10
          ALIGN  48,64
 IN       PPWORD             IN POINTER

* CM WORD 11
          ALIGN  48,64
 OUT      PPWORD             OUT POINTER

* CM WORD 12
          ALIGN  48,64
 LIMIT    PPWORD             LIMIT POINTER

 PIT      RECEND
          EJECT
*         UNIT DESCRIPTOR (CM).

 UD       RECORD PACKED

* CM WORD 1
          ALIGN  0,64
 LU       PPWORD             LOGICAL UNIT
 UQTPVA   STRUCT 6           UNIT INTERFACE TABLE (PVA)

* CM WORD 2
          ALIGN  0,64
 CHAN     SUBRANGE 0,377B    CHANNEL NUMBER
 CNTRLR   SUBRANGE 0,377B    CONTROLLER NUMBER
 UNIT     PPWORD             PHYSICAL UNIT NUMBER
 UQT      RMA                UNIT INTERFACE TABLE (RMA)

 UD       RECEND
          SPACE 5
*         PP UNIT DESCRIPTOR (ONLY SECOND CM WORD OF UNIT DESCRIPTOR).

 PUD      RECORD PACKED

          ALIGN  0,64
 CHAN     SUBRANGE 0,377B    CHANNEL NUMBER
 CNTRLR   SUBRANGE 0,377B    CONTROLLER NUMBER
 UNIT     PPWORD             PHYSICAL UNIT NUMBER
 UQT      RMA                UNIT INTERFACE TABLE (RMA)

 PUD      RECEND
          EJECT
*         PP COMMUNICATION BUFFER.

 CB       RECORD PACKED

* CM WORD 1
          ALIGN  31,64
 SLAVE    BOOLEAN            NONZERO IF SLAVE PP
 PARTNR   RMA                PARTNERS PIT (RMA)

* CM WORD 2
          ALIGN  0,64
 CONTRL   STRUCT 8           LOAD CONTROLWARE COMMAND

* CM WORD 3
          ALIGN  0,64
 CMCMD    STRUCT 8           SLAVE COMMAND        (NOT USED)

* CM WORD 4
          ALIGN  0,64
 ODP      STRUCT 8           OVERLAY DIRECTORY RMA

* CM WORD 5-9
          ALIGN  0,64
 FILL1    STRUCT 40          UNUSED

* CM WORDS 10-11
          ALIGN  0,64
 COMM     STRUCT 16          MASTER/SLAVE COMMUNICATION AREA

* CM WORDS 12-13
          ALIGN  0,64
 SCRAT    STRUCT 16          SCRATCH AREA

* CM WORDS 14-28
          ALIGN  0,64
 ZEROES   STRUCT 120         120 BYTES (15 CM WORDS) OF ZERO
          SPACE  3
          MASKP  SLAVE
 K.SLAVE  EQU    MSK

 CB       RECEND
          EJECT
*         UNIT INTERFACE TABLE.

 UIT      RECORD PACKED

* CM WORD 1
          ALIGN  0,64
 LU       PPWORD             LOGICAL UNIT
 DSABLE   BOOLEAN            UNIT IS ENABLED/DISABLED. (SET = DISABLED)
          ALIGN  32,64
 UTYPE    PPWORD             UNIT TYPE
                               = 22B, 5680-1X

* CM WORD 2
          ALIGN  16,64
 UBUFL    PPWORD             UNIT COMMUNICATION BUFFER LENGTH
 UBUF     RMA                UNIT COMMUNICATION BUFFER (RMA)

* CM WORD 3
          ALIGN  0,64
 ULOCK    BOOLEAN            UNIT IS RESERVED FOR EXCLUSIVE USE
          ALIGN  48,64
 ULOCKP   PPWORD             UNIT LOCK OWNER

* CM WORD 4
          ALIGN  0,64
 QLOCK    BOOLEAN            UNIT QUEUE LOCK
          ALIGN  48,64
 QLOCKP   PPWORD             UNIT QUEUE LOCK OWNER

* CM WORD 5
          ALIGN  16,64
 NEXTPV   STRUCT 6           NEXT REQUEST ON UNIT QUEUE (PVA)

* CM WORD 6
          ALIGN  32,64
 NEXT     RMA                NEXT REQUEST ON UNIT QUEUE (RMA)

          MASKP  DSABLE
 K.DSABLE EQU    MSK

 UIT      RECEND
          EJECT
*         UNIT COMMUNICATION AREA.

 UCA      RECORD PACKED

* CM WORD 1
          ALIGN  16,64
 SYNC     STRUCT 6           SYNCHRONIZE PVA OF AN OUTSTANDING WRITE WHEN
                              NO MORE DATA IS POSSIBLE OR A FORCED WRITE.
                              THE PP NEVER UPDATES THIS CM WORD.

* CM WORD 2
          ALIGN  0,64
 ACTCNT   PPWORD             ACTIVE COUNT OF BUFFERED WRITE REQUESTS

**        NOTE - THE REMAINDER OF THE UCA IS INVALID IF ACTCNT = 0.

 INP      PPWORD             UCA RESPONSE BUFFER IN POINTER
 OUTP     PPWORD             UCA RESPONSE BUFFER OUT POINTER
 TPF      PPWORD             TAPE POSITION FLAG

* CM WORD 3
          ALIGN  32,64
 PRMA     RMA                PREVIOUS REQUEST RMA

* CM WORD 4
          ALIGN  16,64
 CPVA     STRUCT 6           CURRENT REQUEST PVA

* CM WORD 5
          ALIGN  32,64
 CRMA     RMA                CURRENT REQUEST RMA

* CM WORDS 6-19
          ALIGN  0,64
 URB1     STRUCT 112         FIRST UCA RESPONSE BUFFER

* CM WORDS 20-33
          ALIGN  0,64
 URB2     STRUCT 112         NEXT UCA RESPONSE BUFFER

* CM WORDS 34-47
          ALIGN  0,64
 URB3     STRUCT 112         NEXT UCA RESPONSE BUFFER

* CM WORDS 48-54
          ALIGN  0,64
 ERRSTA   STRUCT 56          ERROR STATUS ON WRITES

* CM WORDS 55-64
          ALIGN  0,64
 FILL1    STRUCT 80          RESERVED

 UCA      RECEND
          EJECT
*         URB RESPONSE BUFFER.

 URB      RECORD PACKED

* CM WORD 1
          ALIGN  0,64
 CONF     PPWORD             CONNECT FUNCTION FOR THIS REQUEST
 WRTCNT   PPWORD             WRITE RECORD COUNTER THIS REQUEST
 UCMDA    PPWORD             SAVED CMDADDR FOR THIS REQUEST
 FILL1    PPWORD             RESERVED

* CM WORD 2
          ALIGN  0,64
 SBID     STRUCT 4           STARTING BLOCK ID OF REQUEST
 EBID     STRUCT 4           ENDING BLOCK ID OF REQUEST

* CM WORDS 3-14
          ALIGN  0,64
 RESP     STRUCT 96          RESPONSE SAVED FOR ACTIVE REQUEST

 URB      RECEND
          EJECT
*         REQUEST QUEUE.

 RQ       RECORD PACKED

* CM WORD 1
          ALIGN  16,64
 NEXTPV   STRUCT 6           NEXT REQUEST ON UNIT QUEUE (PVA)

* CM WORD 2
          ALIGN  32,64
 NEXT     RMA                NEXT REQUEST ON UNIT QUEUE (RMA)

* CM WORD 3
          ALIGN  0,64
 LEN      PPWORD             REQUEST LENGTH
 LU       PPWORD             LOGICAL UNIT
 RECOV    SUBRANGE 0,3       ERROR RECOVERY OPTIONS
                               0 - ENABLE CU RECOVERY.
                               1 - DISABLE CU RECOVERY.
 INT      BOOLEAN            INTERRUPT CPU (IF SET)
 PORT     SUBRANGE 0,37B     MEMORY PORT USED FOR INTERRUPTS
          ALIGN  40,64
 PRIOR    SUBRANGE 0,377B    PRIORITY
          ALIGN  48,64
 ALRTM    PPWORD             ALERT MASK (SEE *RS* ALERT CONDITIONS)

* CM WORD 4
          ALIGN  0,64
 SECADR   INTEGER            SECONDARY ADDRESS

* CM WORD 5-64               COMMANDS
          ALIGN  0,64
 CMND     INTEGER            COMMANDS

 RQ       RECEND
          SPACE  3
*         COMMANDS.

 CM       RECORD PACKED

* CM WORD OF 5-64 IN THE REQUEST QUEUE
          ALIGN  0,64
 CODE     SUBRANGE 0,377B    COMMAND CODE
 FILL1    BOOLEAN            UNUSED
 INDIR    BOOLEAN            INDIRECT ADDRESS (IF SET)
          ALIGN  16,64
 LEN      PPWORD             LENGTH OF CM AREA (EITHER DATA AREA OR
                             LENGTH/ADDRESS WORD PAIR LIST)
 RMA      RMA                ADDRESS OF CM AREA
          MGEN   N.CODE
 M.CODE   EQU    MASK$

 CM       RECEND
          EJECT
*         PP RESPONSE.

 RS       RECORD PACKED

* CM WORD 1
          ALIGN  16,64
 PVA      STRUCT 6           PVA OF REQUEST

* CM WORD 2
          ALIGN  32,64
 REQ      RMA                RMA OF REQUEST

* CM WORD 3
          ALIGN  0,64
 RESPL    PPWORD             RESPONSE LENGTH  (8-BIT BYTES)
 LU       PPWORD             LOGICAL UNIT
 RECOV    SUBRANGE 0,3       ERROR RECOVERY OPTIONS (FROM REQUEST)
 INT      BOOLEAN            INTERRUPT CPU (IF SET)
 PORT     SUBRANGE 0,37B     MEMORY PORT USED FOR INTERRUPTS
          ALIGN  40,64
 PRIOR    SUBRANGE 0,377B    PRIORITY
          ALIGN  48,64
 ALRTM    PPWORD             ALERT MASK (SEE ALERT CONDITIONS)

* CM WORD 4
          ALIGN  0,64        ABNORMAL STATUS
 ABALRT   BOOLEAN            ABNORMAL ALERT CONDITION DETECTED
 INTERR   BOOLEAN            LOGICIAL INTERFACE ERROR
 FILL2    BOOLEAN            UNUSED
 FILL3    BOOLEAN            UNUSED
 FILL4    BOOLEAN            UNUSED
 FILL5    BOOLEAN            UNUSED
 HDWR     BOOLEAN            HARDWARE ERROR DETECTED
          ALIGN  16,64
 FILL6    PPWORD             UNUSED
 RC       SUBRANGE 0,3       RESPONSE CODE
                               0 - UNSOLICITED RESPONSE
                               1 - INTERMEDIATE RESPONSE
                               2 - NORMAL REQUEST TERMINATION
                               3 - ABNORMAL REQUEST TERMINATION
 RCON     SUBRANGE 0,3       ADDITIONAL RESPONSE CONDITIONS
                             (= 0 FOR UNSOLICITED RESPONSE)
                               0 - NO ADDITIONAL CONDITION
          ALIGN  40,64
 URC      SUBRANGE 0,377B    UNSOLICITED RESPONSE CODE (UNUSED)

          ALIGN  48,64       ALERT CONDITIONS
 LNGBLK   BOOLEAN            LONG INPUT BLOCK
 FILL7    BOOLEAN            UNUSED
 PDLIM    BOOLEAN            PHYSICAL DELIMITER ENCOUNTERED (EOT OR BOT)
 LDLIM    BOOLEAN            LOGICAL DELIMITER ENCOUNTERED (TAPE MARK)
 FILL8    BOOLEAN            UNUSED
 DUNIT    BOOLEAN            UNIT WAS DISABLED BY PP

* CM WORD 5
          ALIGN  0,64
 XFER     STRUCT 4           TRANSFER COUNT
 LASTC    RMA                LAST COMMAND (RMA)

* CM WORD 6
          ALIGN  0,64
*         GENERAL STATUS WORD 1
 GS1      SUBRANGE 0,17B     UNUSED BITS

 ALERT    BOOLEAN            ALERT CONDITION
 CONT     BOOLEAN            SEND CONTINUE FUNCTION
 ONE      BOOLEAN            ALWAYS SET
 T18      BOOLEAN            18 TRACK DEVICE
 WRTEN    BOOLEAN            WRITE ENABLED
 WFC      BOOLEAN            WAIT FOR *CONT* STATUS
 CHRF     BOOLEAN            CHARACTER FILL
 TM       BOOLEAN            TAPE MARK
 EOT      BOOLEAN            END OF TAPE (LOGICIAL)
 BOT      BOOLEAN            BEGINNING OF TAPE (LOGICIAL)
 BSY      BOOLEAN            BUSY
 RDY      BOOLEAN            READY

                             SPECIAL GS1 WORDS WHEN GS2 = 0000
                             OCTAL
                             7777 = AUTOLOAD FUNCTION TIMEOUT
                             7776 = OUTPUT CHANNEL ERROR FLAG SET
                             7775 = INPUT CHANNEL ERROR FLAG SET
                             7774 = CY170 CIO CHANNEL ADAPTER ERROR
                             7773 = CIO CHANNEL FUNCTION ERROR FLAG SET
                             7772 = STATUS FUNCTION TIMEOUT AFTER AUTOLOAD
                             7771 = INCOMPLETE TRANSFER DURING AUTOLOAD
                             5XXX = AUTOLOAD ERROR CODE

*         GENERAL STATUS WORD 2
 GS2      SUBRANGE 0,17B     UNUSED BITS

 ADPTC    BOOLEAN            ADAPTER CHECK
 UNITC    BOOLEAN            UNIT CHECK
 EQUIPC   BOOLEAN            EQUIPMENT CHECK
 DATAC    BOOLEAN            DATA CHECK
 DFRDC    BOOLEAN            DEFERRED UNIT CHECK

 EC       SUBRANGE 0,177B    ERROR CODE

          ALIGN  32,64
 LGBID    STRUCT 4           LAST GOOD BLOCK-ID

* CM WORD 7
          ALIGN  0,64
 REID     PPWORD             RESPONSE ERROR ID
 LSTF     PPWORD             LAST FUNCTION CODE ISSUED
 LSTNSF   PPWORD             LAST NON STATUS FUNCTION CODE ISSUED
 CESR     PPWORD             CIO CHANNEL ERROR STATUS REGISTER

* CM WORDS 8-12
          ALIGN  0,64
 DSB      STRUCT 40          DETAILED STATUS (112) WORDS 1-26 (12-BIT) PACKED

* CM WORDS 13-18
          ALIGN  0,64
 ELB      STRUCT 48          ERROR LOG (312) WORDS 1-32 (12-BIT) PACKED
          SPACE  4
*         RESPONSE HEADER EQUATES
          MASKP  INT
 K.INT    EQU    MSK
          MGEN   N.PORT
 M.PORT   EQU    MASK$
          MASKP  ABALRT
 K.ABALRT EQU    MSK
          MASKP  HDWR
 K.HDWR   EQU    MSK
          MASKP  INTERR
 K.INTERR EQU    MSK
          MASKP  LNGBLK
 K.LNGBLK EQU    MSK
          MASKP  PDLIM
 K.PDLIM  EQU    MSK
          MASKP  LDLIM
 K.LDLIM  EQU    MSK
          MASKP  DUNIT
 K.DUNIT  EQU    MSK
          SPACE  3
*         GENERAL STATUS WORD 1 EQUATES
          MASKP  ALERT
 K.ALERT  EQU    MSK
          MASKP  CONT
 K.CONT   EQU    MSK
          MASKP  T18
 K.T18    EQU    MSK
          MASKP  WRTEN
 K.WRTEN  EQU    MSK
          MASKP  WFC
 K.WFC    EQU    MSK
          MASKP  CHRF
 K.CHRF   EQU    MSK
          MASKP  TM
 K.TM     EQU    MSK
          MASKP  EOT
 K.EOT    EQU    MSK
          MASKP  BOT
 K.BOT    EQU    MSK
          MASKP  BSY
 K.BSY    EQU    MSK
          MASKP  RDY
 K.RDY    EQU    MSK
          SPACE  3
*         GENERAL STATUS WORD 2 EQUATES
          MASKP  ADPTC
 K.ADPTC  EQU    MSK
          MASKP  UNITC
 K.UNITC  EQU    MSK
          MASKP  EQUIPC
 K.EQUIPC EQU    MSK
          MASKP  DATAC
 K.DATAC  EQU    MSK
          MASKP  DFRDC
 K.DFRDC  EQU    MSK

          MGEN   N.EC
 M.EC     EQU    MASK$


 RS       RECEND
          EJECT
*         DETAILED STATUS.

 DS       RECORD PACKED

 SBS      STRUCT 32          32 SENSE BYTES
 FILL1    STRUCT 1           UNUSED
 REV      SUBRANGE 0,7B      CCC MICROCODE REVISION NUMBER
 FUN      SUBRANGE 0,777B    LAST CCC FUNCTION CODE
 C170     SUBRANGE 0,7777B   C170-DI STATUS
 FSC      SUBRANGE 0,7777B   FSC-DI STATUS
 FILL2    SUBRANGE 0,3B      UNUSED
 SN       SUBRANGE 0,1777B   CCC SERIAL NUMBER
 FILL3    STRUCT 1           UNUSED


                             DSB+00 = XX (SB00), XX (SB01)
                             DSB+01 = XX (SB02), XX (SB03)
                             DSB+02 = XX (SB04), XX (SB05)
                             DSB+03 = XX (SB06), XX (SB07)
                             DSB+04 = XX (SB08), XX (SB09)
                             DSB+05 = XX (SB10), XX (SB11)
                             DSB+06 = XX (SB12), XX (SB13)
                             DSB+07 = XX (SB14), XX (SB15)
                             DSB+08 = XX (SB16), XX (SB17)
                             DSB+09 = XX (SB18), XX (SB19)
                             DSB+10 = XX (SB20), XX (SB21)
                             DSB+11 = XX (SB22), XX (SB23)
                             DSB+12 = XX (SB24), XX (SB25)
                             DSB+13 = XX (SB26), XX (SB27)
                             DSB+14 = XX (SB28), XX (SB29)
                             DSB+15 = XX (SB30), XX (SB31)
                             DSB+16 = 0 (8 BITS), REV (3 BITS)
                              THRU  = FUN (9 BITS), C170-DI (12 BITS)
                                    = FSC-DI (12 BITS), 0 (2 BITS)
                             DSB+19 = S/N (10 BITS), 0 (8 BITS)


 DS       RECEND
          EJECT
*         BUFFERED ERROR LOG.

 BEL      RECORD PACKED

 TRDC     STRUCT 2           READ DATA CHECKS
 TRBDC    STRUCT 2           READ BACKWARD DATA CHECKS
 TWDC     STRUCT 2           WRITE DATA CHECKS
 RBC      STRUCT 2           READ BLOCKS CORRECTED

 WBC      STRUCT 2           WRITE BLOCKS CORRECTED
 TCUE     STRUCT 2           CU ERRORS
 RBYP     STRUCT 4           READ BYTES PROCESSED

 WBYP     STRUCT 4           WRITE BYTES PROCESSED
 RBLP     STRUCT 2           READ BLOCKS PROCESSED
 WBLP     STRUCT 2           WRITE BLOCKS PROCESSED

 TWCW     STRUCT 2           WRITE DATA CHECKS WITHOUT HARDWARE BIT
 TRCW     STRUCT 2           READ DATA CHECKS WITHOUT HARDWARE BIT
 EG       STRUCT 2           ERASE GAP COUNTS
 TDE      STRUCT 2           DRIVE ERRORS

 CUECL    SUBRANGE 0,3B      CU EC LEVEL
 FILL1    SUBRANGE 0,1B      UNUSED
 CUSNH    SUBRANGE 0,37B     CU S/N HIGH ORDER BITS
 FILL2    STRUCT 1           UNUSED
 CUSNL    STRUCT 2           CU S/N LOW ORDER BITS
 RRRC     STRUCT 1           READ RECOVERY RETRY COUNT
 FILL3    STRUCT 1           UNUSED
 FILL4    STRUCT 2           UNUSED

 FILL5    STRUCT 8           UNUSED


 BEL      RECEND
          SPACE  4
          LIST   B,L,N,R     END OF LISTING CONTROL
          TITLE  LOCAL EQUATES.
*         REQUEST COMMANDS.
 FUNCCMD  EQU    40B         PHYSICAL COMMAND - FUNCTION (20 HEX)
 PWRTCMD  EQU    43B         PHYSICAL COMMAND - OUTPUT 8-BIT DATA (23 HEX)
 IDLCMD   EQU    4           PP IDLE COMMAND (04 HEX)
 RSUMCMD  EQU    5           PP RESUME COMMAND (05 HEX)
 LCREAD   EQU    101B        LOCICAL READ RECORD OF 8-BIT DATA (41 HEX)
 LCSTC    EQU    141B        LOGICAL COMMAND STORE TRANSFER COUNT (61 HEX)
 LCLB     EQU    231B        LOGICIAL COMMAND LOCATE BLOCK (99 HEX)
          SPACE  2
*         COMMAND FLAGS.
 INDFLG   EQU    100B        INDIRECT ADDRESSING FLAG
          SPACE  2
*         RESPONSE CODES.
 R.UNS    EQU    0           UNSOLICITED RESPONSE
 R.INT    EQU    40000B      INTERMEDIATE RESPONSE
 R.NRM    EQU    100000B     NORMAL REQUEST TERMINATION
 R.ABN    EQU    140000B     ABNORMAL REQUEST TERMINATION
          SPACE  2
*         RESPONSE LENGTHS.
 NORMRES  EQU    /RS/C.DSB*8  LENGTH OF NORMAL RESPONSE BUFFER IN BYTES
 NRESW    EQU    NORMRES/8    LENGTH OF NORMAL RESPONSE BUFFER IN WORDS
 ABNRES   EQU    /RS/C.ELB*8  LENGTH OF ABNORMAL RESPONSE BUFFER IN BYTES
 UNLRES   EQU    B.RS         LENGTH OF UNLOAD RESPONSE BUFFER IN BYTES
          SPACE  2
*         RESPONSE ERROR ID-S.
 REIZERO  EQU    0           NO ERROR ID
 REIIND   EQU    1           INDETERMINATE
 REIICP   EQU    2           INPUT CHANNEL PARITY
 REIOCP   EQU    3           OUTPUT CHANNEL PARITY
 REICF    EQU    4           COUPLER FAILURE
 REICUF   EQU    5           CONTROL UNIT FAILURE
 REIUF    EQU    6           UNIT FAILURE
 REIUNR   EQU    7           UNIT NOT READY
 REIFT    EQU    8           FUNCTION TIMEOUT OR RETRY/CONTINUE LIMIT
 REITMF   EQU    9           TAPE MEDIUM FAILURE
 REIIPE   EQU    10          IOU PARITY ERROR
 REIIOP   EQU    11          INDETERMINATE OUTPUT PARITY
 REIUWI   EQU    12          UNABLE TO WRITE ID MARK
 REIURI   EQU    13          UNABLE TO READ ID MARK
 REIHC    EQU    14          HARDWARE CORRECTIONS
 REIMLE   EQU    15          MICROCODE LOAD ERRORS
 REIBII   EQU    16          BLOCK ID INVALID
 REIRCI   EQU    17          RESIDUAL WORD COUNT INPUT ERROR
 REIRCO   EQU    18          RESIDUAL WORD COUNT OUTPUT ERROR
 REIFE    EQU    19          READ OR WRITE FLAG ERROR
 REISPP   EQU    20          SINGLE PP I/F ERROR
 REIWUT   EQU    21          WRONG UNIT TYPE I/F ERROR
 REINSC   EQU    22          NON-SUPPORTED COMMAND I/F ERROR
 REIBLE   EQU    23          PP OR UNIT COMMUNICATION BUFFER LENGTH ERROR
 REIICS   EQU    24          INVALID COMMAND SEQUENCE WHILE WRITING
          SPACE  2
*         I/O CHANNEL NUMBER.
 TP       EQU    37B         CHANNEL NUMBER
          SPACE  2
*         CIO CHANNEL FUNCTION CODES.
 F.MCLEAR EQU    100000B     MASTER CLEAR CIO ADAPTER BOARD
 F.WRCR   EQU    111000B     WRITE CONTROL REGISTER OF CIO ADAPTER
 F.RDESR  EQU    112000B     READ ERROR STATUS REGISTER OF CIO ADAPTER
          SPACE  2
*         UNIT TYPE.
 T5680    EQU    22B         UIT UNIT TYPE FOR 5680-1X CTS/CCC
          SPACE  2
*         CCC FUNCTION CODES.
 F.CLR    EQU    000B        CLEAR UNIT  (NOT USED)
 F.REL    EQU    001B        RELEASE UNIT
 F.CNT    EQU    002B        CONTINUE
 F.SYN    EQU    003B        SYNCHRONIZE UNIT
 F.REW    EQU    010B        REWIND
 F.UNL    EQU    110B        UNLOAD
 F.SRS    EQU    011B        SELECTIVE RESET UNIT  (NOT USED)
 F.GS     EQU    012B        GENERAL STATUS
 F.DS     EQU    112B        DETAILED STATUS
 F.RBID   EQU    212B        READ BLOCK-ID
 F.RBEL   EQU    312B        READ BUFFERED ERROR LOG
 F.FSB    EQU    013B        FORESPACE BLOCK
 F.BSB    EQU    113B        BACKSPACE BLOCK
 F.FTM    EQU    015B        FORESPACE TAPE MARK
 F.BTM    EQU    115B        BACKSPACE TAPE MARK
 F.LB     EQU    016B        LOCATE BLOCK
 F.SEL    EQU    020B        SELECT UNIT (X2U)
 F.RDF    EQU    040B        READ FORWARD
 F.RDR    EQU    140B        READ REVERSE  (NOT USED)
 F.WRT    EQU    050B        WRITE FORWARD
 F.SWRT   EQU    250B        SHORT WRITE FORWARD
 F.WTM    EQU    051B        WRITE TAPE MARK
 F.ERS    EQU    052B        ERASE
 F.DSE    EQU    252B        DATA SECURITY ERASE  (NOT USED)
 F.MC     EQU    414B        MASTER CLEAR OR AUTOLOAD
          SPACE  2
*         CCC ERROR CODES.
 EC00     EQU    00B         NO ERROR
 EC01     EQU    01B         CONNECT REJECTED, OFF-LINE OR POWER OFF
 EC03     EQU    03B         PHYSICAL END OF TAPE
 EC04     EQU    04B         FUNCTION REJECT, UNIT NOT READY
 EC05     EQU    05B         UNIT DROPPED READY
 EC06     EQU    06B         WRITE REJECT, UNIT NOT WRITE ENABLED
 EC07     EQU    07B         NOT CAPABLE OF READING TAPES DENSITY
 EC10     EQU    10B         BLANK TAPE (TAPE VOID)
 EC12     EQU    12B         UNABLE TO WRITE FROM BOT
 EC30     EQU    30B         BACKWARD MOTION AT BOT
 EC32     EQU    32B         TAPE UNIT BUSY
 EC33     EQU    33B         CONNECT REJECT, CONTROL UNIT BUSY
 EC50     EQU    50B         UNRECOGNIZED FUNCTION CODE
 EC51     EQU    51B         NO TAPE UNIT CONNECTED
 EC52     EQU    52B         NO FUNCTION PARAMETERS SENT
 EC53     EQU    53B         ILLEGAL FUNCTION DURING CMD RETRY IDLE
 EC54     EQU    54B         CONTINUE FUNCTION SENT WHEN NOT IN CMD RETRY IDLE
 EC55     EQU    55B         ILLEGAL FUNCTION SENT DURING BUSY RETRY
                             ERROR CODES 150-177B CCC SPECIFIC.
          SPACE  2
*         MISC.
 CNTLBL   EQU    60*4        CONTROLWARE BUFFER LENGTH IN PP WORDS
 DUALBUFL EQU    480         LENGTH OF PP I/O BUFFER IN PP WORDS
 ENDMEM   EQU    7777B       LARGEST PP MEMORY ADDRESS
 F.FU67   EQU    4B          ATS FORMAT FUNCTION CODE
 HSHAKC   EQU    377B        HAND SHAKE COMMAND
 MAXIND   EQU    5           MAX INDIRECT LIST LENGTH
 MAXREQ   EQU    65          MAX REQUEST LENGTH IN CM WORDS
 NCCOMD   EQU    376B        NEW CHANNEL COMMAND
 RBIDU    EQU    0#0100      REWIND (BOT) BLOCK ID UPPER
 RBIDL    EQU    0#0000      REWIND (BOT) BLOCK ID LOWER
 WDCOUNT  EQU    640         640 CHANNEL WORDS = 960 BYTES
          SPACE  2
*         LDN EQUATES.
 ZERO     EQU    0           VALUE 0
 ONE      EQU    1           VALUE 1
 TWO      EQU    2           VALUE 2
 THREE    EQU    3           VALUE 3
 FOUR     EQU    4           VALUE 4
          SPACE  2
*         PLUGGED INSTRUCTIONS.
 PSNI     EQU    2400B       PSN INSTRUCTION
 INPNI    EQU    102600B     INPN INSTRUCTION
          SPACE  2
*         DRIVER ERROR CODES.
 ERC101   EQU    1           PP REQUEST QUEUE LOCKWORD TIMEOUT
 ERC102   EQU    ERC101+1    UNIT REQUEST QUEUE LOCKWORD TIMEOUT
 ERC103   EQU    ERC102+1    UNIT LOCKWORD TIMEOUT
 ERC104   EQU    ERC103+1    CHANNEL LOCKWORD TIMEOUT
 ERC105   EQU    ERC104+1    BUFFER POOL LOCKWORD TIMEOUT
 ERC106   EQU    ERC105+1    UNIT HARDWARE RESERVE TIMEOUT
 ERC201   EQU    1           RESERVED FIELD OF PP INT TBL HEAD NOT 0
 ERC202   EQU    ERC201+1    RMA OF UNIT ACTIVITY MASK NOT A WORD BOUNDARY
 ERC203   EQU    ERC202+1    RMA OF PP COMM BUF NOT A WORD BOUNDARY
 ERC204   EQU    ERC203+1    RESERVED FIELD OF PP COMM DESCRIPTOR NOT 0
 ERC205   EQU    ERC204+1    RESERVED FIELD OF QUEUE DESCRIPTOR NOT 0
 ERC206   EQU    ERC205+1    RMA OF NEXT PP NOT A WORD BOUNDARY
 ERC207   EQU    ERC206+1    RESERVED FIELD OF RESP BUF DESCRIPTOR NOT 0
 ERC208   EQU    ERC207+1    LOGICAL UNIT OUT OF RANGE
 ERC209   EQU    ERC208+1    RMA OF UIT NOT A WORD BOUNDARY
 ERC301   EQU    1           LOGICAL UNIT NUMBER MISMATCH
 ERC302   EQU    ERC301+1    RMA OF UNIT COMM BUF NOT A WORD BOUNDARY
 ERC303   EQU    ERC302+1    RESERVED FIELD OF UNIT COMM BUF DESCRIPTOR NOT 0
 ERC304   EQU    ERC303+1    RMA OF NEXT UNIT REQUEST NOT WORD BOUNDARY
 ERC305   EQU    ERC304+1    RESERVED FIELD OF QUEUE DESCRIPTOR NOT 0
 ERC306   EQU    ERC305+1    RESERVED FIELD IN HEADER NOT ZERO
 ERC401   EQU    1           RMA OF NEXT REQUEST NOT A WORD BOUNDARY
 ERC402   EQU    ERC401+1    REQUEST LENGTH NOT A MULTIPLE OF 8 BYTES
 ERC403   EQU    ERC402+1    REQUEST LENGTH IS LESS THAN FOURTY BYTES
 ERC404   EQU    ERC403+1    LOGICAL UNIT NO .NE. UNIT NO IN INTERFACE TBL
 ERC405   EQU    ERC404+1    RESERVED LINKAGE FIELD IS NOT ZERO
 ERC406   EQU    ERC405+1    INVALID RECOVERY/INTERFACE SELECTIONS
 ERC407   EQU    ERC406+1    INVALID PRIORITY SELECTION
 ERC408   EQU    ERC407+1    INVALID SECONDARY ADDRESS
 ERC409   EQU    ERC408+1    INVALID ALERT CONDITION
 ERC501   EQU    1           INVALID COMMAND CODE
 ERC502   EQU    ERC501+1    INVALID FLAG SELECTION
 ERC503   EQU    ERC502+1    INVALID FUNCTION
 ERC504   EQU    ERC503+1    FUNCTION NOT SUPPORTED BY HARDWARE
 ERC505   EQU    ERC504+1    INVALID LENGTH SPECIFICATION IN COMMAND
 ERC506   EQU    ERC505+1    INVALID ADDRESS SPECIFICATION IN COMMAND
 ERC507   EQU    ERC506+1    INVALID LENGTH SPECIFICATION IN INDIRECT LIST
 ERC508   EQU    ERC507+1    INVALID ADDRESS SPECIFICATION IN INDIRECT LIST
 ERC509   EQU    ERC508+1    PP COMMAND NOT ALLOWED IN REQUEST TO A UNIT
 ERC50A   EQU    ERC509+1    INVALID SEQUENCE OF COMMANDS
 ERC50B   EQU    ERC50A+1    INVALID PARAMETER SPECIFICATION
          TITLE  LOCAL MACROS.
**        SUBR - DEFINE SUBROUTINE ENTRY/EXIT.
*
*NAME     SUBR
*         DECLARE *NAME* TO BE THE ENTRY POINT TO A PP SUBROUTINE
*         WHICH IS ENTERED VIA *RJM* TO *NAME*.
*
*         THE FOLLOWING CODE IS GENERATED.
*NAMEX    LJM    *
*NAME     EQU    *-1

          PURGMAC  SUBR

          MACRO  SUBR,A
 A_X      LJM    *
 A        EQU    *-1
          ENDM
          TITLE  PP DIRECT CELLS.
 T0       CON    INIT-1      START OF ON-LINE DRIVER

 T1       BSSZ   1           SCRATCH CELLS
 T2       BSSZ   1
 T3       BSSZ   1
 T4       BSSZ   1
 T5       BSSZ   1
 T6       BSSZ   1
 T7       BSSZ   1
 AREG     BSSZ   1           I/O A REGISTER RESIDUAL
 BYTCNT   BSSZ   1           NUMBER OF BYTES TO TRANSFER THIS I/O
 CHTYPE   BSSZ   1           CHANNEL TYPE  0=NIO  1=CIO
 CM.CHAN  BSSZ   3           CM ADDRESS OF CHANNEL TABLE
 CM.COM   BSSZ   3           CM ADDRESS OF PP COMMUNICATION BUFFER (MASTERS)
 CM.INT   BSSZ   3           CM ADDRESS OF INTERRUPT TABLE
 CM.PIT   BSSZ   3           CM ADDRESS OF PP INTERFACE TABLE (MASTERS)
 CM.RS    BSSZ   3           CM ADDRESS OF RESPONSE BUFFER
 CM.UCA   BSSZ   3           CM ADDRESS OF UNIT COMMUNICATION AREA
 CM.UIT   BSSZ   3           CM ADDRESS OF UNIT INTERFACE TABLE
 CMADR    BSSZ   3           CENTRAL MEMORY ADDRESS
 CMDADR   BSSZ   1           ADDRESS OF ACTIVE COMMAND
 CMDNO    BSSZ   1           NO OF REMAINING COMMANDS
 CONFLG   BSSZ   1           UNIT CONNECTED FLAG
 FRELF    BSSZ   1           FORCE RELEASE FLAG
 IOCNT    BSSZ   1           NUMBER OF PP WORDS TO TRANSFER THIS I/O
 LIM      BSSZ   1           LIMIT OF RESPONSE BUFFER
 LMCFLG   BSSZ   1           LOAD MICROCODE FLAG
 LONG     BSSZ   1           LONG INPUT BLOCK FLAG
 MOTION   BSSZ   1           TAPE MOTION FLAG
 P1       BSSZ   1           PARAMETER CELLS
 P2       BSSZ   1
 P3       BSSZ   1
 P4       BSSZ   1
 P5       BSSZ   1
 TRNCNT   BSSZ   4           TOTAL TRANSFER COUNT IN BYTES
 UDPNT    BSSZ   1           UNIT DESCRIPTOR POINTER
 UNITP    BSSZ   1           UNIT POINTER
 WC       BSSZ   1           CM WORD COUNT

 ENDDIR   EQU    *-1         END OF CELLS TO CLEAR ON RESUME COMMAND

 ON       CON    ONE         CONSTANT ONE (DO NOT CHANGE THIS CELL)
 TW       CON    TWO         CONSTANT TWO (DO NOT CHANGE THIS CELL)
 DSRTP    CON    0,0         REAL MEMORY WORD-ADDRESS OF PIT (PLUGGED)
 IDLFLG   BSSZ   1           PP IDLE FLAG, 0=RUNNING, 1=IDLE, 2=RESUME
 CHLOCK   BSSZ   1           CHANNEL LOCK FLAG
 PPNO     CON    5           LOGICAL PP NUMBER
 ID       CON    177777B     IDENTIFICATION (DM=MASTER, DS=SLAVE)

          ERRNZ  DSRTP-72B   MUST BE AT LOCATION 72, PLUGGED WHEN LOADED
          TITLE  ID, OFF-LINE ENTRY POINT AND WORKING MEMORY.
          SPACE  4
**        IDENTIFICATION.

          DATA   H*5680*     IDENTIFICATION NAME
          SPACE  4
**        OFF-LINE ENTRY POINT OF DRIVER.

 START    LJM    INIT        GO INITIALIZE DRIVER
          ERRNZ  START-102B  MUST BE AT 102B
          SPACE  4
**        WORKING MEMORY.

 UITHDR   BSSZ   8           UIT HEADER, FIRST TWO CM WORDS

 UCAHDR   BSSZ   /UCA/P.CRMA+2  UCA HEADER TABLE (CM WORDS THRU CRMA)
          TITLE  MASTER PP MAIN IDLE LOOP.
          SPACE 4
**        NOTE - THIS IS THE START OF THE SLAVE CODE OVERLAY BUFFER.
          SPACE  2
 BSCOBUF  BSS    0
          SPACE  4
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
*                                                                     *
**        PP MONITOR (MASTER ONLY).                                   *
*                                                                     *
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
          SPACE  2
 MAIN     RJM    CHKPR       CHECK FOR ANY PP REQUESTS
          ZJN    MAIN20      IF NO PP REQUESTS

 MAIN10   LJM    DORQ        PROCESS THE PP/UNIT REQUEST

**        *DORQ* RETURNS DIRECTLY TO *MAIN*.

 MAIN20   LDDL   IDLFLG      GET IDLE FLAG
          NJN    MAIN        IF IDLE FLAG SET, RELOOP

          RJM    CHKUR       CHECK FOR ANY UNIT REQUESTS
          NJN    MAIN10      IF THERE IS A UNIT REQUEST

          RJM    CHKCH       CHECK AND PROCESS CHANNEL REQUESTS

          UJN    MAIN        LOOP
          TITLE  MASTER PP REQUEST ROUTINES.
** NAME - CHKPR  (MASTER ONLY)
*
** PURPOSE - TO CHECK IF THERE ARE ANY PP REQUESTS TO PROCESS.  IF THERE
*            ARE, THE FIRST ONE IS COPIED INTO PP MEMORY.
*
** OUTPUT - A=0 IF NO PP REQUESTS.
*           A .NE. 0 IF THERE IS A PP REQUEST TO PROCESS.
*           IF THERE IS A REQUEST, (CMDNO) = NUMBER OF COMMANDS.
*
          SPACE  2
 CHKPR10  LDN    PPLK+40B    UNLOCK PP REQUEST QUEUE
          RJM    SCLK

 CHKPR20  LDK    ZERO        SET EXIT FOR NO REQUESTS FOUND

 CHKPR    SUBR               ENTRY/EXIT

          LOADC  CM.PIT      LOAD A AND R FOR PIT
          ADN    /PIT/C.PPQ
          CRDL   T1          READ REQUEST RMA FROM PIT
          LDDL   T3          HALF 1 OF REQUEST RMA
          ADDL   T4          HALF 2 OF REQUEST RMA
          ZJN    CHKPRX      IF NO REQUEST QUEUED
          LDN    PPLK        LOCK PP REQUEST QUEUE
          RJM    SCLK
          NJK    CHKPR20     RETURN IF PP REQUEST QUEUE ALREADY LOCKED
          LOADC  CM.PIT      CM ADDRESS TO A AND R FOR READ
          ADN    /PIT/C.PPQPVA
          CRML   UCAHDR+/UCA/P.CPVA-1,TW  READ IN REQUEST PVA/RMA FROM PIT
          LDML   UCAHDR+/UCA/P.CRMA  GET HALF 1 OF RMA OF 1ST REQUEST
          ADML   UCAHDR+/UCA/P.CRMA+1
          ZJK    CHKPR10     IF RMA = 0 NO PP REQUEST QUEUED
          LDK    /RQ/C.CMND  LENGTH OF REQUEST HEADER
          STDL   WC
          LOADF  UCAHDR+/UCA/P.CRMA  CM ADDRESS OF REQUEST TO A AND R
          CRML   REQBUF,WC   READ PP REQUEST HEADER
          LDML   REQBUF+/RQ/P.LEN  REQUEST LENGTH IN BYTES
          SHN    -3          REQUEST LENGTH IN CM WORDS
          SBN    /RQ/C.CMND  SUBTRACT HEADER LENGTH
          STDL   CMDNO       NUMBER OF COMMANDS THIS REQUEST
          LDDL   CMADR+2     READ COMMANDS FROM CM
          ADN    /RQ/C.CMND
          LMC    400000B
          CRML   CMDBUF,CMDNO
          LOADC  CM.PIT      SET A AND R TO PP INTERFACE TABLE
          ADN    /PIT/C.PPQPVA  SET A AND R TO PVA IN PP INTERFACE TABLE
          CWML   REQBUF+/RQ/P.NEXTPV-1,TW  RESET PVA AND RMA TO NEXT PVA/RMA
          LDN    PPLK+40B    UNLOCK PP REQUEST QUEUE
          RJM    SCLK
          RJM    RESPSU      SET UP RESPONSE BUFFER
          LDK    ONE         SET GOT REQUEST FLAG
          UJK    CHKPRX      EXIT
          EJECT
** NAME - CHKUR  (MASTER ONLY)
*
** PURPOSE - TO CHECK IF THERE ARE ANY REQUESTS ON THE UNIT QUEUES.
*
** OUTPUT - A = 0 IF THERE ARE NO UNIT REQUESTS.
*           A .NE. 0 IF THERE IS A UNIT REQUEST TO PROCESS,
*           REQBUF = REQUEST, (CMDNO) = NUMBER OF COMMANDS, AND
*           UCA INITIALIZED BUT NOT UPDATED IN CM.
*
** NOTE - THE UIT UNIT REQUEST QUEUE LOCKWORD IS NOT OBTAINED BY THE PP
*         WHEN CHECKING FOR REQUESTS. THE REQUEST IS TO BE DELINKED
*         WHEN COMPLETED, THEN THE LOCKWORD MUST BE OBTAINED BY THE PP.
          SPACE  2
 CHKUR10  LDK    ZERO        SET NO UNIT REQUESTS

 CHKUR    SUBR               ENTRY/EXIT

          LDML   UNITC       GET NUMBER OF ACTIVE UNITS
          STML   CHKURA      SAVE FOR LOOP CONTROL

 CHKUR20  SOML   CHKURA      DECREMENT LOOP CONTROL COUNTER
          MJK    CHKUR10     EXIT IF ALL UNITS CHECKED AND NO FINDS
          AODL   UNITP       INCREMENT UNIT POINTER
          SBML   UNITC       SUBTRACT MAX ACTIVE UNIT POINTER
          MJN    CHKUR30     SKIP IF NO WRAP AROUND
          LDK    ZERO        RESET POINTER TO START OF UNIT LIST
          STDL   UNITP

 CHKUR30  LDDL   UNITP       GET UNIT POINTER
          SHN    2           MULT BY 4 SINCE PUD DESCRIPTOR IS 4 PP WORDS LONG
          STDL   UDPNT       SAVE POINTER INTO UNIT DESCRIPTOR

**        PRESET HAS TAKEN NULL UNIT DESCRIPTORS OUT OF THE PP COPY OF THE
*         UNIT DESCRIPTORS FOR THIS PIT.

**        CHECK IF REQUEST IS QUEUED.

          LOADF  UNITD+/PUD/P.UQT,UDPNT  REFORMAT AND LOAD CM ADDRESS OF UIT
          STDL   CM.UIT+2    SAVE CM ADDRESS OF UIT
          SRD    CM.UIT
          ADN    /UIT/C.NEXT
          CRDL   T1          READ NEXT REQUEST RMA
          LDDL   T3          HALF 1 OF REQUEST RMA
          ADDL   T4          HALF 2 OF REQUEST RMA
          ZJK    CHKUR20     IF NO REQUEST QUEUED

**        CHECK IF UNIT IS DISABLED.

          LOADC  CM.UIT      SET A AND R TO UIT
          CRML   UITHDR,TW   READ UIT HEADER WORDS
          LDML   UITHDR+/UIT/P.DSABLE  GET UNIT STATUS
          SHN    18-16+/UIT/L.DSABLE
          MJK    CHKUR20     IF UNIT DISABLED

**        CHECK IF OUTSTANDING REQUESTS ON UCA.

          REFAD  UITHDR+/UIT/P.UBUF,CM.UCA  REFORMAT AND SAVE UCA ADDRESS
          ADN    /UCA/C.ACTCNT
          CRML   UCAHDR+/UCA/P.ACTCNT,TW  READ UCA HEADER WORDS 2 AND 3
          LDML   UCAHDR+/UCA/P.ACTCNT  CHECK ACTIVE COUNT
          NJN    CHKUR35     IF ACTIVE REQUEST IS OUTSTANDING

**        PROCESS FIRST REQUEST.

          LOADC  CM.UIT      LOAD A AND R FOR UIT
          ADN    /UIT/C.NEXTPV  OFFSET TO NEXT PVA/RMA
          CRML   UCAHDR+/UCA/P.CPVA-1,TW  READ NEXT PVA AND RMA
          UJN    CHKUR50     CONTINUE

**        CHECK FOR OUTSTANDING COMPLETIONS.

 CHKUR35  SHN    -1          CHECK FOR 2 OR MORE OUTSTANDING
          ZJN    CHKUR40     IF NOT
          RJM    CHKWRT      CHECK FOR PREVIOUS COMPLETION
          MJN    CHKUR47     IF ABNORMAL ON ANY COMPLETIONS

**        CHECK IF CHAINED REQUEST IS ACTIVE.

 CHKUR40  LOADF  UCAHDR+/UCA/P.PRMA  SET A AND R TO PREVIOUS REQUEST
          STDL   T5          SAVE A ADDRESS
          ADN    /RQ/C.NEXT  OFFSET TO NEXT RMA FIELD
          CRDL   T1          READ THE NEXT RMA
          LDDL   T3          CHECK IF ACTIVE
          ADDL   T4
          ZJN    CHKUR45     IF NOT ACTIVE
          LDDL   T5          RESTORE A ADDRESS
          LMC    400000B
          CRML   UCAHDR+/UCA/P.CPVA-1,TW  GET NEXT PVA/RMA
          UJN    CHKUR50     PROCESS THE NEXT REQUEST

 CHKUR45  RJM    CHKWRT      ELSE  CHECK FOR PREVIOUS WRITE COMPLETIONS

 CHKUR47  UJK    CHKUR20     GO TO NEXT UNIT

**        READ IN THE REQUEST HEADER.

 CHKUR50  LDK    /RQ/C.CMND  LENGTH OF REQUEST HEADER
          STDL   WC          SAVE LENGTH FOR CM READ
          LOADF  UCAHDR+/UCA/P.CRMA  SET A AND R TO ADDR OF REQUEST
          CRML   REQBUF,WC   READ REQUEST HEADER
          LDML   REQBUF+/RQ/P.LEN  REQUEST LENGTH IN BYTES
          SHN    -3          REQUEST LENGTH IN CM WORDS
          SBN    /RQ/C.CMND  SUBTRACT HEADER LENGTH
          STDL   CMDNO       NUMBER OF COMMANDS THIS REQUEST
          ZJN    *           IF NO COMMANDS HANG

**        READ IN THE REQUEST COMMANDS.

          LDDL   CMADR+2     SET A FOR CM ADDRESS
          ADN    /RQ/C.CMND  ADJUST TO COMMANDS
          LMC    400000B
          CRML   CMDBUF,CMDNO  READ THE COMMANDS

**        SET PREVIOUS REQUEST RMA FROM CURRENT REQUEST RMA

          LDML   UCAHDR+/UCA/P.CRMA
          STML   UCAHDR+/UCA/P.PRMA
          LDML   UCAHDR+/UCA/P.CRMA+1
          STML   UCAHDR+/UCA/P.PRMA+1

**        PRESET THE RESPONSE AND EXIT WITH REQUEST FLAG SET.

          RJM    RESPSU      SET UP RESPONSE BUFFER
          LDK    ONE         SET GOT REQUEST FLAG
          UJK    CHKURX      RETURN
          SPACE  2
 CHKURA   DATA   0           LOOP CONTROL
          EJECT
** NAME - DOPPRQ  (MASTER ONLY)
*
** PURPOSE - PERFORM A PP REQUEST.
*
** INPUT - (T2) = COMMAND, REQUEST ALREADY DELINKED.
*
** OUTPUT - RESPONSE SENT AND COMMAND PROCESSED.
*
** NOTE - THE ONLY PP REQUESTS CURRENTLY SUPPORTED ARE IDLE AND RESUME.
*         THERE CAN ONLY BE 1 PP COMMAND PER REQUEST.
*
          SPACE  2
 DOPPRQ   BSS                ENTRY

          RJM    CCLOCK      RELEASE CONNECTED UNIT AND CLEAR CHANNEL LOCK
          LDK    R.NRM       SET NORMAL REQUEST COMPLETION
          STML   RESBUF+/RS/P.RC
          LDDL   T2          GET COMMAND
          SBN    RSUMCMD
          ZJN    DOPPRQ10    IF RESUME COMMAND
          LDK    ONE         SET PP IDLE
          STDL   IDLFLG
          RJM    RESP        SEND THE RESPONSE
          UJK    MAIN        GO TO MAIN LOOP

 DOPPRQ10 LDK    TWO         SET PP RESUME IN PROGRESS
          STDL   IDLFLG
          RJM    RESP        SEND THE RESPONSE
          LJM    INIT        REINITIALIZE THE DRIVER
          EJECT
** NAME - DORQ  (MASTER ONLY)
*
** PURPOSE - PERFORM THE REQUIRED REQUEST.
*
** INPUT - REQUEST IN REQBUF.
*          (CMDNO) = NUMBER OF COMMANDS IN REQUEST.
*
** OUTPUT - REQUEST PROCESSED AND RESPONSE PLACED IN RESPONSE BUFFER.
*
          SPACE  2
 DORQ     BSS                ENTRY

          LDK    CMDBUF      ADDRESS OF FIRST COMMAND IN REQUEST
          STDL   CMDADR      INITIALIZE COMMAND ADDRESS
          LDK    ZERO
          STDL   TRNCNT+3    INITIALIZE TRANSFER COUNT
          STDL   TRNCNT+2
          STDL   MOTION      INITIALIZE MOTION FLAG
          STDL   LONG        INITIALIZE LONG INPUT BLOCK FLAG
          STML   GETSTAC     CLEAR RETRY/CONTINUE LIMIT COUNTER
          STML   DOUTCNT     CLEAR OUTPUT CONTINUE FLAG

 DORQ10   LDIL   CMDADR      GET COMMAND AND FLAGS
          SHN    -8          SHIFT OFF FLAGS
          STDL   T2          SAVE COMMAND
          LDK    ZERO        INITIALIZE TABLE INDEX
          STDL   T1

 DORQ20   LDML   DORQB,T1    COMPARE TABLE ENTRY WITH CURRENT COMMAND
          LMDL   T2
          ZJN    DORQ30      IF FOUND REQUESTED COMMAND
          LDK    TWO         INCREMENT INDEX
          RADL   T1
          LMN    DORQBL
          NJN    DORQ20      IF NOT END OF TABLE
          RJM    NSC         REPORT NON-SUPPORTED COMMAND  (NO RETURN)

 DORQ30   LDML   DORQB+1,T1  GET PROCESSOR ADDRESS
          STML   DORQA

**        EXIT TO COMMAND PROCESSOR ROUTINE WITH THE FOLLOWING -
*
*         (T2) = COMMAND.
*         ((CMDADR)) = COMMAND AND FLAGS. (BEGINNING OF CURRENT COMMAND)
*         (CMDNO) = NUMBER OF COMMANDS, INCLUDING CURRENT ONE, LEFT
*                   IN THE CURRENT REQUEST.

          LJM    *           PROCESS COMMAND  (PLUGGED)
 DORQA    EQU    *-1

**        AFTER COMMAND IS PROCESSED, THE COMMAND PROCESSOR ROUTINE WILL
*         RETURN TO *CMDONE* IF STATUS CHECKING IS REQUIRED OR TO *NOSTAT*
*         IF STATUS CHECKING IS NOT REQUIRED.
          EJECT
**        PROCESS COMMAND COMPLETION.

 CMDONE   LDDL   P2          FETCH FATAL ERROR FLAG FROM ERRCHK
          NJK    FAIL        IF STATUS BAD, GO TO FAIL

 NOSTAT   SODL   CMDNO       DECREMENT COMMAND COUNTER BY 1
          ZJN    REQDNE      IF NONE LEFT  GO TO REQUEST DONE
          LDK    FOUR        POINT TO THE NEXT COMMAND
          RADL   CMDADR
          UJK    DORQ10      RELOOP TO PERFORM NEXT COMMAND
          SPACE  4
**        PROCESS NORMAL REQUEST COMPLETION.

 REQDNE   RJM    GETBID      GET ENDING BLOCK ID
          PJN    REQDNE05    IF OK
          LDIL   CMDADR      CHECK FOR STORE TRANSFER AS LAST COMMAND
          SHN    -8          REMOVE FLAGS
          LMC    LCSTC
          NJN    FAIL        IF NOT STORE TRANSFER COUNT
          LCN    4           ADJUST POINTER BACK TO READ COMMAND
          RADL   CMDADR
          UJN    FAIL        FAIL THE REQUEST

 REQDNE05 LDML   BIDBUF      PUT HOST BLOCK ID IN RESPONSE
          STML   RESBUF+/RS/P.LGBID
          LDML   BIDBUF+1
          STML   RESBUF+/RS/P.LGBID+1
          LDML   URBHDR+/URB/P.WRTCNT  CHECK IF OUTSTANDING WRITE REQUEST
          ADML   UCAHDR+/UCA/P.ACTCNT
          ZJN    REQDNE10    IF NOT
          LJM    WRDONE      PROCESS WRITE COMPLETION

 REQDNE10 LDK    R.NRM
          STML   RESBUF+/RS/P.RC  SET NORMAL REQUEST TERMINATION INDICATOR
          LJM    IODONE      GO TERMINATE REQUEST
          SPACE  4
**        PROCESS ABNORMAL COMMAND/REQUEST COMPLETION.

 FAIL     LDML   RESBUF+/RS/P.EC  CHECK IF BUSY ERROR
          LPK    /RS/M.EC    MASK THE ERROR CODE
          SBN    EC32        CHECK FOR TAPE UNIT BUSY
          ZJN    FAIL05      IF YES  THEN CHECK SPECIAL CONDITIONS
          SBN    EC33-EC32   CHECK FOR CONTROL UNIT BUSY ON CONNECT
          ZJN    FAIL10      IF YES  PROCESS THE BUSY
          UJN    FAIL20      ELSE PROCESS OTHER ERROR

 FAIL05   LDDL   CMDADR      CHECK IF FIRST COMMAND
          LMK    CMDBUF
          NJK    FAIL30      IF NOT REPORT THE BUSY ERROR

*         CHECK IF IT WAS GOING TO BE A REWIND REQUEST.
          LDDL   CMDNO       CHECK IF MORE THAN 1 COMMAND IN REQUEST
          SBN    1
          ZJN    FAIL30      IF NOT
          LDML   CMDBUF+4    GET COMMAND TYPE
          SHN    -8          POSITION COMMAND CODE
          SBN    0#20
          NJN    FAIL10      IF NOT PHYSICAL FUNCTION COMMAND
          LDML   CMDBUF+7    CHECK IF REWIND FUNCTION CODE
          SBN    F.REW
          ZJN    FAIL30      IF REWIND REQUEST  REPORT THE BUSY ERROR

 FAIL10   UJK    FAIL50      GO PROCESS BUSY CONTROL UNIT OR TAPE UNIT

 FAIL20   LDML   RESBUF+/RS/P.ABALRT  CHECK ABNORMAL STATUS
          LPK    -/RS/K.ABALRT
          NJN    FAIL30      IF OTHER THAN ABNORMAL ALERT
          RJM    GETBID      GET ENDING BLOCK ID
          MJN    FAIL30      IF ERROR OCCURED
          LDML   BIDBUF      PUT HOST BLOCK ID IN RESPONSE
          STML   RESBUF+/RS/P.LGBID
          LDML   BIDBUF+1
          STML   RESBUF+/RS/P.LGBID+1

 FAIL30   LDML   URBHDR+/URB/P.WRTCNT  CHECK IF WRITE REQUEST
          ADML   UCAHDR+/UCA/P.ACTCNT
          ZJN    FAIL40      IF NOT
          RJM    WFAIL       PROCESS WRITE REQUEST FAILURE
          LJM    IODONE20    CHECK IF RELOAD MICROCODE IS REQUIRED

 FAIL40   RJM    DSABLE      CHECK FOR DISABLE UNIT
          LDK    R.ABN       SET ABNORMAL REQUEST TERMINATION
          STML   RESBUF+/RS/P.RC
          LJM    IODONE      GO TERMINATE REQUEST

*         PROCESS BUSY CONTROL UNIT OR TAPE UNIT.
 FAIL50   LDDL   CONFLG      GET THE UNIT NUMBER
          LPN    17B         MASK UNIT NUMBER
          STDL   T1          SET INDEX
          AOML   SCRBUF+8,T1  INCREMENT UNIT BUSY COUNTER
          SHN    1           POSITION CARRY BIT
          MJN    FAIL30      CHECK IF LIMIT (ABOUT 70 SECS) EXCEEDED
          RJM    REL         RELEASE THE BUSY UNIT
          UJK    MAIN        IGNORE THE BUSY THIS TIME
          SPACE  5,25
**        THE FOLLOWING TABLE CONTAINS ONE ENTRY FOR EACH SUPPORTED COMMAND
*         OF THE TAPE SUBSYSTEM.  THE SECOND WORD OF EACH ENTRY IS THE ADDRESS
*         OF THE COMMAND PROCESSOR ROUTINE.
          SPACE  2
 DORQB    BSS    0

**        UNIT COMMANDS.

          CON    FUNCCMD,FUNC     PHYSICAL COMMAND - FUNCTION
          CON    PWRTCMD,DOUT     PHYSICAL COMMAND - OUTPUT 8-BIT DATA
          CON    LCREAD,DREAD     LOGICAL COMMAND - READ FORWARD
          CON    LCSTC,DSTRTC     LOCIGAL COMMAND - STORE TRANSFER COUNT
          CON    LCLB,LOCBLK      LOCIGAL COMMAND - LOCATE BLOCK

**        PP COMMANDS.

          CON    IDLCMD,DOPPRQ    IDLE PP COMMAND
          CON    RSUMCMD,DOPPRQ   RESUME COMMAND

 DORQBL   EQU    *-DORQB     LENGTH OF TABLE
          EJECT
** NAME - DOUT  (MASTER ONLY)
*
** PURPOSE - TO PERFORM THE LOGICAL COMMAND OUTPUT 8-BIT DATA FOR DUAL PP.
*
** INPUT - (CMDADR) = ADDRESS OF COMMAND.
*
          SPACE  2
 DOUT     BSS                ENTRY

          AOML   URBHDR+/URB/P.WRTCNT  INCREMENT WRITE COUNTER
          STML   DOUTCNT     SET OUTPUT CONTINUE FLAG

 DOUT10   LDDL   MOTION      CHECK IF INIBUF ALREADY DONE
          NJN    DOUT20      IF YES
          LDDL   CMDADR      SET LENGTH/ADDRESS PAIR TO CURRENT COMMAND + 1
          STDL   T4
          RJM    INIBUF      INITIALIZE BUFFER POINTERS

 DOUT20   LDN    0           CLEAR MOTION FLAG
          STDL   MOTION
          RJM    GETCM       READ DATA FROM CM FOR FIRST CHUNK
          LDC    0           GET FUNCTION CODE TO USE
 DOUTF    EQU    *-1
          RJM    DOFUNC      PROCESS FUNCTION CODE
          ACN    TP          ACTIVATE CHANNEL
          SCF    FLAGERR,TP  TEST AND SET THE CHANNEL FLAG (TO START MASTER)
          LDK    ZERO
          STDL   AREG        CLEAR MASTER RESIDUAL COUNTER
          STML   DOUTF       CLEAR FUNCTION CODE USED
          LDML   EODATA      CHECK TO SEE IF THE SLAVE MUST BE CALLED
          NJN    DOUT30      IF SLAVE NOT NEEDED
          LDDL   CMDADR      GET THE COMMAND ADDRESS AND SEND THE
          STML   DOUTA        COMMAND TO THE SLAVE
          LOADC  CM.COM      LOAD R AND A OF PP COMMUNICATION BUFFER
          ADN    /CB/C.COMM
          CWML   *,ON        SEND THE COMMAND TO THE SLAVE
 DOUTA    EQU    *-1
          UJN    DOUT40      CONTINUE

 DOUT30   LOADC  CM.COM      CLEAR LAST SLAVE RESIDUAL COUNT
          ADN    /CB/C.COMM
          CWML   ZEROWD,ON

 DOUT40   LDDL   IOCNT       NUMBER OF 12 BIT CHANNEL WORDS

 DOUT50   FCJM   DOUT50,TP   WAIT FOR CHANNEL FLAG TO BE SET BY SLAVE
          OAPM   DIOBUF,TP   WRITE SOME TAPE
          CCF    *+2,TP      CLEAR CHANNEL FLAG TO START THE SLAVE

          ZJN    DOUT60      IF NO RESIDUAL LEFT
          STDL   AREG        SAVE RESIDUAL A REGISTER

 DOUT60   LDML   EODATA      END OF DATA FLAG (SET BY GETCM)
          NJN    DOUT80      ENDED HERE - EXIT
          LDML   ENTHERE     IF IT ENDS IN THE SLAVE, WAIT
          NJN    DOUT70
          RJM    GETCM       GET MORE DATA TO WRITE
          IJM    DOUT80,TP   IF CHANNEL WENT INACTIVE (POSSIBLE RETRY)
          UJN    DOUT40

 DOUT70   IJM    DOUT80,TP   IF CHANNEL WENT INACTIVE (POSSIBLE RETRY)
          FCJM   DOUT70,TP   WAIT FOR SLAVE TO FINISH

 DOUT80   FJM    *,TP        WAIT FOR CHANNEL EMPTY
          PAUSE  10          DELAY 10 MICROSECONDS
          DCN    40B+TP
          SFM    OUTCPE,TP   CHECK AND CLEAR CHANNEL PARITY ON OUTPUT
          RJM    WSC         WAIT FOR SLAVE TO COMPLETE
          LDDL   T1          CHECK FOR SLAVE DETECTED ERRORS
          NJK    SLVERR      IF YES
          LDDL   T4          MERGE SLAVE RESIDUAL WITH MASTERS
          RADL   AREG
          LDDL   CMDNO       CHECK IF ANOTHER WRITE CMD
          SBN    1
          STDL   MOTION      SET MOTION FLAG
          ZJN    DOUT85      IF NOT
          LDDL   CMDADR      SET CMD ADDRESS FOR INIBUF
          ADN    8           INCREMENT TO NEXT CMD
          STDL   T4
          RJM    INIBUF      INITIALIZE NEXT BUFFER POINTERS

 DOUT85   RJM    GETSTA      WAIT FOR END OF OPERATION
          MJN    DOUT100     IF RETRY OCCURED
          LDN    0           CLEAR WRITE CONTINUE FLAG
          STML   DOUTCNT
          RJM    ERRCHK      CHECK FOR ERROR OR TERMINATION CONDITION
          NJN    DOUT90      IF ERROR OR TERMINATION CONDITION
          LDDL   AREG        CHECK IF ANY RESIDUAL WORD COUNT
          NJK    RCNZO       IF YES  PROCESS RESIDUAL WORD COUNT

 DOUT90   UJK    CMDONE      PROCESS WRITE COMPLETION

 DOUT100  LDK    F.CNT       PROCESS CONTINUE (RETRY) FUNCTION
          STML   DOUTF
          LDN    0           CLEAR MOTION FLAG
          STDL   MOTION
          UJK    DOUT10      GO RETRY THE FUNCTION

 DOUTCNT  CON    0           WRITE CONTINUE FLAG
          SPACE  4
 ZEROWD   BSSZ   4           ZERO CM WORD FOR CLEARING RESIDUAL COUNT
          EJECT
** NAME - DREAD  (MASTER ONLY)
*
** PURPOSE - PROCESS LOGICAL READ COMMAND FOR DUAL PP.
*
** INPUT - (CMDADR) = ADDRESS OF COMMAND.
*
          SPACE  2
 DREAD    BSS                ENTRY

          LDML   URBHDR+/URB/P.WRTCNT  CHECK OUTSTANDING WRITES
          ADML   UCAHDR+/UCA/P.ACTCNT
          NJK    ICS         IF YES REPORT INVALID CMD SEQUENCE

          LDDL   MOTION      CHECK TAPE MOTION FLAG
          NJN    DREAD20     IF TAPE ALREADY MOVING
          LDK    F.RDF       ISSUE READ FUNCTION
          RJM    DOFUNC

 DREAD10  ACN    TP          ACTIVATE CHANNEL

 DREAD20  LDK    ZERO        CLEAR TRANSFER COUNTERS
          STDL   TRNCNT+2
          STDL   TRNCNT+3
          STDL   MOTION      CLEAR MOTION FLAG
          STDL   LONG        CLEAR LONG INPUT BLOCK FLAG
          LDDL   CMDADR      SET CURRENT COMMAND ADDRESS
          STDL   T4
          STML   DREADA      MODIFY THE WRITE INSTRUCTION
          RJM    INIBUF      INITIALIZE POINTERS TO CM BUFFERS
          SCF    FLAGERR,TP  TEST AND SET THE CHANNEL FLAG (TO START MASTER)
          LOADC  CM.COM      LOAD R AND A OF PP COMMUNICATION BUFFER
          ADN    /CB/C.COMM
          CWML   *,ON        COMMAND GOES TO THE SLAVE
 DREADA   EQU    *-1

 DREAD30  LDK    WDCOUNT     ALWAYS TRY TO READ A FULL BUFFER

 DREAD40  FCJM   DREAD40,TP  WAIT FOR THE SLAVE TO SET THE FLAG
          IAPM   DIOBUF,TP   INPUT DATA FROM TAPE
          CCF    *+2,TP      CLEAR THE CHANNEL FLAG TO START SLAVE

          STDL   AREG        SAVE THE CONTENTS OF THE A REGISTER
          NJN    DREAD50     SHORT READ PROCESSING
          RJM    WRITCM      WRITE THE DATA TO CM
          LDK    DUALBUFL*2  UPDATE THE TRANSFER COUNT
          RADL   TRNCNT+3
          SHN    -16
          RADL   TRNCNT+2
          IJM    DREAD60,TP  IF CHANNEL WENT INACTIVE
          UJN    DREAD30     DO IT ALL OVER AGAIN

 DREAD50  LDK    WDCOUNT     COMPUTE THE ACTUAL BYTE COUNT
          SBDL   AREG        NUMBER OF 12 BIT CHANNEL WORDS MOVED
          STDL   T5          STORE THIS VALUE
          SHN    1           MULTIPLY BY 3/2 TO GET BYTE COUNT
          ADDL   T5
          SHN    -1          DONE - NOTE ROUNDED DOWN ON PURPOSE
          STML   SHBYTEC     STORE SHORT BYTE COUNT
          ZJN    DREAD60     IF COUNT = 0
          RADL   TRNCNT+3    UPDATE THE TRANSFER COUNT
          SHN    -16
          RADL   TRNCNT+2    UPDATE THE TRANSFER COUNT
          RJM    WRITCM      WRITE SHORT BUFFER TO CM

 DREAD60  DCN    40B+TP      DISCONNECT THE CHANNEL
          SFM    INCPE,TP    CHECK AND CLEAR CHANNEL PARITY ON INPUT
          RJM    WSC         WAIT FOR SLAVE TO COMPLETE COMMAND
          LDDL   T1          CHECK FOR SLAVE DETECTED ERROR
          NJK    SLVERR      IF YES
          LDDL   T4          INCREMENT MASTERS TRANSFER COUNT
          RADL   TRNCNT+3
          SHN    -16
          ADDL   T3
          RADL   TRNCNT+2
          LDDL   T2          MERGE SLAVE LONG INPUT BLOCK FLAG
          RADL   LONG
          SHN    -16
          ZJN    DREAD70     IF NOT OVERFLOW
          LDK    TWO         ENSURE COUNT NOT 0 OR 1
          STDL   LONG

 DREAD70  RJM    GETSTA      WAIT FOR END OF OPERATION
          MJK    DREAD10     IF RETRY OCCURED
          RJM    CKFL        CHECK FOR CHARACTER FILL
          LDDL   LONG        CHECK FOR LONG INPUT OF 1 BYTE
          SBN    1
          NJN    DREAD80     IF NOT 1 BYTE TOO LONG
          LDML   RESBUF+/RS/P.CHRF  CHECK FOR CHARACTER FILL
          LPK    /RS/K.CHRF
          ZJN    DREAD80     IF NO CHARACTER FILL
          LDK    ZERO        INDICATE NOT LONG INPUT BLOCK
          STDL   LONG

 DREAD80  RJM    ERRCHK      CHECK FOR ERRORS OR TERMINATION CONDITION
          NJN    DREAD100    IF ERRORS OR TERMINATION CONDITION
          LDDL   CMDNO       COMMANDS REMAINING
          SBN    2
          ZJN    DREAD90     IF NO MORE POSSIBLE READ COMMANDS
          LDK    F.RDF       START TAPE FOR NEXT BLOCK
          RJM    DOFUNC
          ACN    TP          ACTIVATE CHANNEL
          AODL   MOTION      SET TAPE MOTION FLAG

 DREAD90  UJK    CMDONE      PROCESS NEXT COMMAND

 DREAD100 LOADF  6,CMDADR    RETURN TRANSFER COUNT OF ERROR BLOCK
          CWDL   TRNCNT
          UJN    DREAD90     EXIT
          EJECT
** NAME - DSTRTC  (MASTER ONLY)
*
** PURPOSE - PERFORM LOGICAL COMMAND STORE TRANSFER COUNT FOR DUAL PP.
*
** INPUT - (CMDADR) = ADDRESS OF COMMAND.
*
          SPACE  2
 DSTRTC   BSS                ENTRY

          LOADF  2,CMDADR    CM ADDRESS TO A AND R
          CWDL   TRNCNT      SEND TRANSFER COUNT TO CM
          LDK    ZERO        CLEAR TRANSFER COUNT
          STDL   TRNCNT+2
          STDL   TRNCNT+3
          UJK    NOSTAT      GO TO DO NEXT COMMAND
          EJECT
** NAME - FUNC  (MASTER ONLY)
*
** PURPOSE - TO PERFORM THE PHYSICAL COMMAND FUNCTION.
*
** INPUT -  (CMDADR) = ADDRESS OF COMMAND.
*
** OUTPUT - FUNCTION ISSUED IF NOT WRITE OR FORMAT.
*
          SPACE  2
 FUNC     BSS                ENTRY

          LDML   3,CMDADR    GET HARDWARE FUNCTION TO BE ISSUED
          LPN    77B         MASK MAJOR FUNCTION CODE BITS

**        CHECK FOR FORMAT UNIT FUNCTION CODE.
          SBN    F.FU67
          NJN    FUNC10      IF NOT
          LJM    FORMU       PROCESS FORMAT UNIT FUNCTION

**        CHECK FOR REWIND OR UNLOAD FUNCTION CODES.
 FUNC10   SBN    F.REW-F.FU67
          NJN    FUNC30      IF NOT
          LDML   3,CMDADR    NOW CHECK FOR UNLOAD
          STDL   FRELF       SET THE FORCE RELEASE FLAG
          SHN    17-6
          PJN    FUNC20      IF NOT UNLOAD
          LJM    UNLD        PROCESS UNLOAD

*         PROCESS REWIND.
 FUNC20   LDML   RESBUF+/RS/P.GS1  CHECK IF AT BOT
          LPK    /RS/K.BOT   MASK BOT BIT
          ZJN    FUNC40      IF NOT GO ISSUE REWIND FUNCTION

*         CHECK IF BID (FROM CONNECT) IS 0100 0000(HEX).
          LDML   URBHDR+/URB/P.SBID+1  GET LOWER HALF OF BID
          NJN    FUNC40      IF NOT AT BOT GO ISSUE REWIND FUNCTION
          LDML   URBHDR+/URB/P.SBID  GET UPPER HALF OF BID
          ADC    -RBIDU
          NJN    FUNC40      IF NOT AT BOT GO ISSUE REWIND FUNCTION
          UJN    FUNC60      AT BOT  GO PROCESS NEXT COMMAND

**        CHECK FOR WRITE FUNCTION CODE.
 FUNC30   SBN    F.WRT-F.REW
          NJN    FUNC40      IF NOT
          LDML   3,CMDADR    GET WRITE FUNCTION CODE TO USE
          STML   DOUTF       SET IT
          UJN    FUNC60      GO DO NEXT CMD

**        PROCESS THE FUNCTION CODE.
 FUNC40   LDML   URBHDR+/URB/P.WRTCNT  CHECK OUTSTANDING WRITES
          ADML   UCAHDR+/UCA/P.ACTCNT
          NJK    ICS         IF YES REPORT INVALID CMD SEQUENCE
          LDML   3,CMDADR
          RJM    DOFUNC      SEND FUNCTION

 FUNC50   RJM    GETSTA      GET STATUS
          MJN    FUNC50      IF RETRY OCCURED
          RJM    ERRCHK      CHECK FOR ERRORS
          UJK    CMDONE      COMMAND COMPLETE

 FUNC60   UJK    NOSTAT      EXECUTE NEXT COMMAND
          EJECT
** NAME - LOCBLK  (MASTER ONLY)
*
** PURPOSE - PERFORM LOGICAL COMMAND LOCATE BLOCK.
*
** INPUT - (CMDADR) = ADDRESS OF COMMAND.
*
          SPACE  2
 LOCBLK   BSS                ENTRY

          LDML   URBHDR+/URB/P.WRTCNT  CHECK OUTSTANDING WRITES
          ADML   UCAHDR+/UCA/P.ACTCNT
          NJK    ICS         IF YES REPORT INVALID CMD SEQUENCE
          LDML   2,CMDADR    GET LOCATE BLOCK PARAMETERS
          STML   LOCBLKA
          LDML   3,CMDADR
          STML   LOCBLKB
          LDK    F.LB        LOCATE BLOCK FUNCTION
          RJM    DOFUNC      SEND FUNCTION CODE
          LDK    THREE       LENGTH OF PARAMETERS IN 12-BIT WORDS
          ACN    TP          ACTIVATE CHANNEL
          OAPM   LOCBLKA,TP  OUTPUT THE PARAMETERS
          FJM    *,TP        WAIT UNTIL CHANNEL EMPTY
          DCN    40B+TP      DEACTIVATE CHANNEL
          NJK    RCNZO       PROCESS NON-ZERO RESIDUAL WORD COUNT ERROR
          SFM    OUTCPE,TP   CHECK AND CLEAR CHANNEL ERROR FLAG

 LOCBLK10 RJM    GETSTA      GET STATUS
          MJN    LOCBLK10    IF RETRY OCCURED
          RJM    ERRCHK      CHECK FOR ERRORS
          UJK    CMDONE      COMMAND DONE
          SPACE  4
 LOCBLKA  DATA   0#FFFF      LOCATE BLOCK PARAMETERS (PLUGGED)
 LOCBLKB  DATA   0#FFFF
          CON    0           END FILLER
          EJECT

          SPACE  4
 CONCHM   BSS    0           MASTER PP CHANNEL INSTRUCTIONS
 TTP+40B  HERE
 T40B+TP  HERE
 TTP      HERE
          CON 0              END OF TABLE
          SPACE 4
**        NOTE - THIS IS THE END OF THE SLAVE CODE OVERLAY BUFFER.

 ESCOBUF  EQU    *-5         LEAVE SPACE FOR 1 EXTRA CM OVERLAY WORD
          TITLE  COMMON ROUTINES AND SUBROUTINES.
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
*                                                                     *
**        NOTE - ROUTINES AND TABLES FROM HERE TO *OVLBUF*            *
*                MAY BE USED BY BOTH THE MASTER AND SLAVE PP.         *
*                                                                     *
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
          SPACE  5,20
** NAME - BUMPIT
*
** PURPOSE - INCREMENT THE LENGTH/ADDRESS RMA.
*
** OUTPUT - CBUFRMA POINTS TO NEW BUFFER ADDRESS FOR THIS PP.  SPACE IS
*           SET APPROPRIATELY.
*
          SPACE  2
 BUMPIT   SUBR               ENTRY/EXIT

          LDK    DUALBUFL*4
          STDL   T4
          LDML   SPACE       THIS IS THE SPACE LEFT IN THE CURRENT
                              BUFFER PRIOR TO THE LAST OPERATION.
          SBDL   T4          SUBTRACT FOR LAST OPERATION AND THE SPACE
                              USED BY THE PARTNER.
          ZJN    BUMPIT20    IF NOT ENOUGH SPACE IN CURRENT RMA
          MJN    BUMPIT20    IF NOT ENOUGH SPACE IN CURRENT RMA
          STML   SPACE

 BUMPIT10 LDDL   T4          INCREMENT THE CURRENT RMA
          RAML   CBUFRMA+1
          SHN    -16         TAKE CARE OF OVERFLOW
          RAML   CBUFRMA
          UJN    BUMPITX     EXIT

 BUMPIT20 LDDL   T4          COMPUTE HOW MUCH SPACE IS NEEDED FROM NEXT
          SBML   SPACE         RMA (IF ANY)
          STDL   T4
          LDML   NUMBUF      ARE THERE ANY BUFFERS LEFT
          NJN    BUMPIT40    AT LEAST ONE LEFT

 BUMPIT30 AOML   ENTHERE     INDICATE IT ENDS IN THE PARTNER
          LDK    ZERO        SET NO SPACE FOR THIS PP NEXT TIME
          STML   SPACE
          UJK    BUMPITX     EXIT

 BUMPIT40 LDML   INDLST+8    MOVE LENGTH/ADDRESS PAIR TO CURRENT
          STML   INDLST+4      L/A PAIR
          LDML   INDLST+9
          STML   INDLST+5
          LDML   INDLST+10
          STML   INDLST+6
          LDML   INDLST+11
          STML   INDLST+7
          RJM    GNEWPR      GET NEXT LENGTH/ADDRESS PAIR
          LDDL   T4          IS THERE ENOUGH ROOM IN THIS BUFFER
          SBML   SPACE       THIS IS THE SPACE IN THE NEW BUFFER
          PJN    BUMPIT30    ENDS IN PARTNER
          LDML   SPACE       DECREMENT NEW SPACE BY WHAT IS NEEDED
          SBDL   T4
          STML   SPACE
          LJM    BUMPIT10    ADJUST THE RMA AND EXIT
          SPACE  5,20
** NAME - CBYTE
*
** PURPOSE - CONVERT 8-BIT BYTE COUNT TO 12-BIT CHANNEL WORD COUNT.
*
** INPUT - (BYTCNT) = 8-BIT BYTE COUNT.
*
** OUTPUT - (IOCNT) = 12-BIT CHANNEL WORD COUNT.
*
** NOTE - MULTIPLY BYTE COUNT BY 2/3 AND ROUND UP.
*
          SPACE  2
 CBYTE10  LDK    WDCOUNT     SET FULL BLOCK CHANNEL WORD COUNT
          STDL   IOCNT

 CBYTE    SUBR               ENTRY/EXIT

          LDDL   BYTCNT      CHECK FOR FULL BLOCK
          ADC    -DUALBUFL*2
          ZJN    CBYTE10     IF FULL BLOCK
          LDK    ZERO
          STDL   IOCNT       INITIALIZE CHANNEL COUNT
          LDDL   BYTCNT      CHECK BYTE COUNT
          ZJK    CBYTEX      IF ZERO BYTE COUNT
          STDL   T1          SET DIVIDEND IN T1 (BYTE COUNT)
          LDK    THREE       SET DIVISOR IN T2  (3)
          SHN    14
          STDL   T2

 CBYTE20  LDDL   IOCNT       DIVIDE LOOP
          SHN    1
          STDL   IOCNT
          LDDL   T1
          SBDL   T2
          MJN    CBYTE30
          STDL   T1
          AODL   IOCNT       INCREMENT CHANNEL COUNT

 CBYTE30  LDDL   T2
          SHN    -1
          STDL   T2
          NJN    CBYTE20     THIS CHECK WILL MULTIPLY BY 2
          LDDL   T1
          ZJK    CBYTEX      IF NO NEED TO ROUND UP
          AODL   IOCNT       ROUND UP IF REMAINDER
          UJK    CBYTEX      EXIT
          SPACE  5,20
** NAME-- CCLOCK
*
** PURPOSE-- CLEARS THE CHANNEL LOCK IN THE CM CHANNEL TABLE.
*            IF A UNIT IS CONNECTED IT WILL BE RELEASED FIRST.
*
** OUTPUT-- THE CHANNEL THAT THIS PP HAD LOCKED, WILL BE UNLOCKED.
*
          SPACE  2
 CCLOCK   SUBR               ENTRY/EXIT

          LDDL   CONFLG
          ZJN    CCLOCK10    IF NO UNIT CURRENTLY CONNECTED
          RJM    REL         RELEASE UNIT

 CCLOCK10 LDDL   CHLOCK      CHECK IF CHANNEL LOCKED
          ZJN    CCLOCKX     IF CHANNEL NOT LOCKED
          LDN    CHLK+40B    CLEAR CHANNEL LOCKWORD
          RJM    SCLK
          LDK    ZERO        CLEAR CHANNEL LOCK FLAG
          STDL   CHLOCK
          UJK    CCLOCKX     EXIT
          SPACE  5,20
** NAME - CHFUNC
*
** PURPOSE - ISSUE A FUNCTION TO THE CIO CHANNEL ADAPTER.
*
** INPUT - (A) = FUNCTION CODE TO ISSUE.
*
** OUTPUT - (A) = 0 IF FUNCTION REJECT.
*
          SPACE  2
 CHFUNC   SUBR               ENTRY/EXIT

          DCN    40B+TP
          FAN    TP          ISSUE FUNCTION CODE
          LCN    ZERO        SET TIMEOUT VALUE

 CHFUNC10 IJM    CHFUNCX,TP  IF RESPONSE  EXIT
          SBN    1
          NJN    CHFUNC10    IF NOT TIMEOUT
          DCN    40B+TP
          UJN    CHFUNCX     RETURN WITH (A) = 0
          SPACE  5,20
** NAME - CHGCH
*
** PURPOSE - CHANGE CHANNEL NUMBER IN CHANNEL INSTRUCTIONS.
*
** INPUT - (CURCH) = CHANNEL NUMBER.
*          (A) = CHANNEL TABLE ADDRESS.
*
** OUTPUT - ALL CHANNEL INSTRUCTIONS MODIFIED.
*
          SPACE  2
 CHGCH    SUBR               ENTRY/EXIT

          STDL   T1          SET ADDRESS MODIFICATION LIST ADDRESS

 CHGCH10  LDIL   T1          READ LIST WORD
          ZJN    CHGCHX      IF END OF LIST
          STDL   T2          SET INSTRUCTION ADDRESS
          LDIL   T2          READ INSTRUCTION WORD
          SCN    37B         CLEAR CHANNEL BITS
          LMML   CURCH       REPLACE WITH NEW CHANNEL
          STIL   T2
          AODL   T1          INCREMENT TO NEXT INSTRUCTION
          UJN    CHGCH10     LOOP
          SPACE  5,20
** NAME - CHKWRT
*
** PURPOSE - CHECK FOR PREVIOUS WRITE REQUEST COMPLETIONS.
*
** INPUT - (UCAHDR) HAS BEEN READ INTO THE PP AND OUTSTANDING REQUESTS
*          ARE ACTIVE.
*          (A) = 0, DO SYNCHRONIZE CHECK.
*          (A) <> 0, BYPASS SYNCHRONIZE CHECK.
*
** OUTPUT - IF THIS UNIT HAS COMPLETED A WRITE REQUEST THEN A RESPONSE
*           WILL BE GENERATED AND SENT.
*          (A) = +, NO ABNORMAL COMPLETIONS.
*          (A) = -, ABNORMAL COMPLETION OCCURED.
*
          SPACE  2
 CHKWRT10 LDN    0           CLEAR CHECK WRITE FLAG
          STML   CHKWRTF     RETURN A=+

 CHKWRT   SUBR               ENTRY/EXIT

          STML   CHKWRTA     SAVE ENTRY PARAMETER
          LDN    1           SET CHECK WRITE FLAG
          STML   CHKWRTF
          LDN    0           CLEAR SYNCHRONIZE SENT FLAG
          STML   CHKWRTS
          STML   RESBUF+/RS/P.ABALRT  CLEAR PREVIOUS ERROR STATUS
          STML   RESBUF+/RS/P.LNGBLK
          RJM    RURBH       READ URB HEADER INTO PP
          LDML   URBHDR+/URB/P.CONF  GET CONNECT FUNCTION TO USE
          RJM    CONNU       CONNECT TO THE UNIT
          MJN    CHKWRT30    IF ERROR
          NJN    CHKWRT20    IF NOT PREVIOUSLY CONNECTED
          LDML   CHKWRTA
          NJN    CHKWRT40    IF BYPASS SYNCHRONIZE IS SET

 CHKWRT20 RJM    GETBID      GET THE CURRENT TAPE POSITION BLOCK ID
          PJN    CHKWRT40    IF NOT ERROR

 CHKWRT30 RJM    WFAIL       GO PROCESS WRITE FAILURE
          LDN    0           CLEAR CHECK WRITE FLAG
          STML   CHKWRTF
          LCN    1           RETURN A=-
          UJK    CHKWRTX     RETURN

*         CHECK IF FIFO REQUEST IS NOW DONE.
 CHKWRT40 LDML   URBHDR+/URB/P.EBID  GET REQUEST UPPER ENDING BLOCK ID
          LPC    0#FF        MASK OUT PHYSICAL REFERENCE
          STDL   T1          SAVE IT
          LDML   BIDBUF+3    GET CURRENT TAPE POSITION UPPER BLOCK ID
          LPC    0#FF        MASK OUT PHYSICAL REFERENCE
          SBDL   T1          COMPARE THEM
          MJK    CHKWRT50    IF REQUEST HAS NOT COMPLETED
*         IF BIDBUF EBID UPPER GT URB EBID UPPER, BID MAY HAVE SURPASSED 16 BITS
          NJN    CHKWRT42    JIF BIDBUF EBID WRAPPED PAST 16 BITS
          LDML   BIDBUF+4    COMPARE LOWER BLOCK ID-S
          SBML   URBHDR+/URB/P.EBID+1
          MJN    CHKWRT50    IF REQUEST HAS NOT COMPLETED

*         PROCESS NORMAL REQUEST COMPLETION.
 CHKWRT42 RJM    RURBR       READ URB RESPONSE FIELD BACK INTO PP
          RJM    DELINK      DELINK THE REQUEST
          LDK    R.NRM       SET NORMAL RESPONSE COMPLETION
          STML   RESBUF+/RS/P.RC
          RJM    RESP        SEND THE RESPONSE
          RJM    UINP        UPDATE IN POINTER OF UCAHDR IN CM
          LDML   CHKWRTS     CHECK IF SYNCHRONIZE SENT
          ZJN    CHKWRT45    IF NOT RETURN
          LDML   UCAHDR+/UCA/P.ACTCNT  CHECK IF ANY MORE ACTIVE REQUESTS
          ZJN    CHKWRT45    IF NONE LEFT  RETURN
          RJM    RURBH       READ NEXT URB HEADER
          UJK    CHKWRT40    GO CHECK IF THIS ONE IS COMPLETE

 CHKWRT45 RJM    REL         RELEASE THE UNIT
          UJK    CHKWRT10    PREPARE TO RETURN

*         CHECK IF CPU HAS SET THE SYNCHRONIZE PVA FLAG,
*         FOR THE OLDEST OUTSTANDING REQUEST.

 CHKWRT50 LDML   CHKWRTA     CHECK ENTRY PARAMETER
          NJN    CHKWRT45    IF BYPASS SYNCHRONIZE CHECK
          LOADC  CM.UCA      LOAD A AND R WITH UCA CM ADDRESS
          CRDL   T4          READ UCA CPU SYNC WORD

 OFL2     IFEQ   OFFLINE,1
          LDDL   T7          CHECK FOR OFFLINE SYNC FLAG
          ZJN    CHKWRT45    IF NOT SET
 OFL2     ELSE
          LDDL   T4          CHECK IF SWAPOUT SYNCHRONIZE IS SET
          NJN    CHKWRT57    IF YES
          LDN    2           SET COMPARE LOOP COUNTER
          STDL   T4

 CHKWRT55 LDML   RESBUF+/RS/P.PVA,T4  GET OLDEST REQUEST PVA
          LMML   T5,T4       COMPARE WITH CPU SYNC PVA WORD
          NJN    CHKWRT45    IF NOT THE SAME RETURN
          SODL   T4          DECREMENT LOOP COUNTER
          PJN    CHKWRT55    IF NOT DONE COMPARING
 OFL2     ENDIF

*         CHECK ACTIVE COUNT OF BUFFERED WRITE REQUESTS.
 CHKWRT57 LDML   UCAHDR+/UCA/P.ACTCNT
          SBN    1           CHECK FOR 1 OUTSTANDING REQUEST
          ZJN    CHKWRT60    IF YES THEN DO SYNCHRONIZE IMMEDIATELY

*         CHECK IF TAPE IS ALREADY MOVING.
          LDML   UCAHDR+/UCA/P.TPF  GET LAST TAPE POSITION FLAG
          SBML   BIDBUF+4    COMPARE WITH CURRENT TAPE POSITION
          ZJN    CHKWRT60    IF STILL AT THE SAME POSITION
          LDML   BIDBUF+4    UPDATE TAPE POSITION FLAG
          STML   UCAHDR+/UCA/P.TPF
          LOADC  CM.UCA
          ADN    /UCA/C.ACTCNT
          CWML   UCAHDR+/UCA/P.ACTCNT,ON  UPDATE TPF IN CM
          UJK    CHKWRT45    RETURN

*         PROCESS SYNCHRONIZE.
 CHKWRT60 LDK    F.SYN       SYNCHRONIZE FUNCTION
          STML   CHKWRTS     SET SYNCHRONIZE SENT FLAG
          RJM    DOFUNC      SEND FUNCTION

 CHKWRT70 RJM    GETSTA      GET STATUS
          MJN    CHKWRT70    IF RETRY OCCURED
          SHN    17-11       POSITION ALERT BIT
          PJK    CHKWRT20    IF NOT ALERT, PROCESS COMPLETION
          LDML   RESBUF+/RS/P.DSB+1   FETCH ERPA CODE FROM DETAILED STATUS
          LPK    0#FF                 MASK OFF THE ERPA CODE
          LMK    0#48                 IS IT ERPA CODE 48
          ZJK    CHKWRT20             TREAT ERROR AS INFORMATIVE
          LDK    /RS/K.HDWR  SET HARDWARE FAILURE
          STML   RESBUF+/RS/P.HDWR
          UJK    CHKWRT30    PROCESS WRITE FAILURE
          SPACE  2
 CHKWRTA  DATA   0           BYPASS SYNCHRONIZE FLAG
 CHKWRTF  DATA   0           CHECK WRITE FLAG
 CHKWRTS  DATA   0           SYNCHRONIZE SENT FLAG
          SPACE  5,20
** NAME-- CHKCH
*
** PURPOSE-- CHECK IF CHANNEL IS REQUESTED BY MALET.  IF SO, RELEASE
*            ANY CONNECTED UNIT AND CHANNEL.
*
          SPACE  2
 CHKCH    SUBR               ENTRY/EXIT

          LOADC  CM.CHAN     ADDRESS OF CHANNEL TABLE
          ADML   CURCH       CHANNEL IS INDEX INTO TABLE
          CRDL   T1          READ CHANNEL CM ENTRY
          LDDL   T2          OBTAIN MAINTENANCE BYTES OF CHANNEL WORD
          SHN    17-0        ALIGN MAINTENANCE BIT REQUEST TO SIGN BIT
          PJN    CHKCHX      IF CHANNEL NOT REQUESTED
          RJM    CCLOCK      CLEAR CHANNEL LOCK
          UJN    CHKCHX      RETURN
          SPACE  5,20
** NAME - CKFL
*
** PURPOSE - CHECK FOR CHARACTER FILL.  IF SET, DECREMENT
*            BYTE COUNT BY 1.
*
** INPUT - RESPONSE HEADER ALREADY SETUP.
*
          SPACE  2
 CKFL     SUBR               ENTRY/EXIT

          LDML   RESBUF+/RS/P.CHRF  CHECK IF CHARACTER FILL IS SET
          LPK    /RS/K.CHRF
          ZJK    CKFLX       IF NO CHARACTER FILL
          LDDL   TRNCNT+3
          ADDL   TRNCNT+2
          ZJN    CKFLX       IF NO DATA READ (PROBABLY TAPE MARK)
          SODL   TRNCNT+3    DECREMENT TRANSFER COUNT
          PJN    CKFLX       IF NOT UNDERFLOW
          LDK    177777B     CORRECT 1-S COMPLEMENT RESULT
          STDL   TRNCNT+3
          SODL   TRNCNT+2    ADJUST MOST SIGNIFICIANT BITS
          UJK    CKFLX
          SPACE  5,20
** NAME-- CLOCK
*
** PURPOSE-- CLEAR A LOCKWORD IN CENTRAL MEMORY.
*
** ENTRY--
*         T7 = THE ADDRESS OF THE 3 DIRECT CELLS WHICH CONTAIN
*              THE REFORMATED ADDRESS OF THE CENTRAL MEMORY
*              INTERFACE TABLE.
*         T5 = THE CENTRAL MEMORY WORD OFFSET WITHIN THE
*              INTERFACE TABLE OF THE LOCKWORD.
*
** EXIT--
*         A REGISTER = 0, IF THE LOCK WAS CLEARED.
*         A REGISTER .NE. O, IF THE LOCK WAS NOT CLEARED.
*
** ALGORITHM
*         1. WRITE THE INTERMEDIATE VALUE OF FFFF FFFF 0000 0000,
*            USING A RDSL INSTRUCTION.
*            (SET T1 - T4 = FFFF FFFF 0000 0000,
*            RDSL   T1)
*
*         2. AFTER EXECUTION OF 'RDSL T1',
*            IF T1 - T2 = FFFF FFFF,
*            THEN GO BACK AND EXECUTE STEP 1,
*            ELSE GO TO STEP 3.
*
*         3. IF T4 .NE. PPNO, THIS LOCKWORD IS RESERVED TO A
*            DIFFERENT PROCESSOR.
*            RESTORE THE CONTENTS OF THIS CENTRAL MEMORY LOCATION
*            AS IT EXISTED BEFORE THE VALUE FFFF FFFF XXXX XXXX
*            WAS WRITTEN.
*            CWDL   T1.
*            SET THE A REGISTER .NE. 0, AND EXIT.
*
*         4. IF T4 = PPNO, THEN CLEAR THE LOCKWORD IN CENTRAL MEMORY.
*            SET T1 - T4 = 0000 0000 0000 0000.
*            CWDL   T1.
*            SET THE A REGISTER = 0, AND EXIT.
*
          SPACE  2
 CLOCK    SUBR               ENTRY/EXIT

**        WRITE INTERMEDIATE VALUE OF FFFF FFFF 0000 0000.

 CLOCK10  LCN    ZERO        SET INTERMEDIATE VALUE
          STDL   T1
          STDL   T2
          LDK    ZERO
          STDL   T3
          STDL   T4
          LOADR  0,T7        UNIT/PP INTERFACE TABLE ADDRESS
          ADDL   T5          ADD LOCKWORD OFFSET, SAVE CM ADDRESS
          STDL   T6          SAVE CM ADDRESS
          RDSL   T1          WRITE INTERMEDIATE VALUE

**        CHECK IF RDSL INSTRUCTION WAS SUCCESSFUL.
*
**        CHECK FOR LOCKWORD = FFFF FFFF XXXX XXXX(16).

          LDDL   T1
          ADDL   T2
          ADC    -177777B-177777B
          ZJK    CLOCK10     IF THIS PP WAS NOT FIRST TO WRITE THE
                              INTERMEDIATE VALUE, REPEAT RDSL INSTRUCTION

          LDDL   T4          CHECK PP NUMBER
          SBDL   PPNO
          ZJN    CLOCK30     IF THIS PP HAS THE LOCK SET

**        RESTORE THE ORIGINAL CONTENTS.

          LDDL   T6          CM ADDRESS OF UNIT LOCK.
          LMC    400000B
          CWDL   T1          RESTORE THE ORIGINAL CONTENTS
          LDK    ONE

 CLOCK20  UJK    CLOCKX      EXIT, A REGISTER NONZERO

**        CLEAR THE LOCKWORD.

 CLOCK30  LDK    ZERO
          STDL   T1
          STDL   T2
          STDL   T3
          STDL   T4
          LDDL   T6          CM ADDRESS OF UNIT LOCK.
          LMC    400000B
          CWDL   T1          CLEAR THE LOCKWORD
          LDK    ZERO
          UJK    CLOCK20     EXIT, A REGISTER = 0
          SPACE  5,20
** NAME - CONNU
*
** PURPOSE - TO CONNECT A TAPE UNIT AND CHECK STATUS,
*            CHANNEL LOCK OBTAINED IF NECESSARY.
*
** INPUT - (A) = CONNECT CODE TO USE.
*
** OUTPUT - CHANNEL LOCK SET IF NOT ALREADY SET.
*           (CONFLG) = CURRENT CONNECT FUNCTION CODE OF UNIT.
*           (A) = +  NO ERROR.
*           (A) = -  ERROR, RESPONSE GENERATED.
*           (A) = 0  UNIT IS ALREADY CONNECTED.
*
          SPACE  2
 CONNU    SUBR               ENTRY/EXIT

          STML   CONNUA      SAVE ENTRY PARAMETER
          LDDL   CHLOCK      CHECK IF CHANNEL ALREADY LOCKED
          NJN    CONNU30     IF CHANNEL LOCK SET

 CONNU10  LDN    CHLK        SET CHANNEL LOCKWORD
          RJM    SCLK
          NJN    CONNU10     IF CHANNEL LOCK NOT OBTAINED
          AODL   CHLOCK      SET CHANNEL CURRENTLY LOCKED
          RJM    INICH       INITIALIZE CHANNEL
          ZJN    CONNU30     IF NO ERROR
          LPN    7           MASK ERROR CODE
          SBN    3           CHECK FOR CHANNEL ERROR FLAG ERROR
          NJN    CONNU20     IF NOT
          LJM    OUTCPE      GO PROCESS CHANNEL ERROR FLAG ERROR

 CONNU20  RJM    FTO         GO PROCESS FUNCTION TIMEOUT  (NO RETURN)

 CONNU30  LDK    7777B       FUNCTION CODE  (PLUGGED)
 CONNUA   EQU    *-1
          LMDL   CONFLG      CHECK IF ALREADY CONNECTED IN CORRECT MODE
          ZJN    CONNUX      IF YES, RETURN
          LDDL   CONFLG      CHECK IF PREVIOUS UNIT IS STILL CONNECTED
          ZJN    CONNU40     IF NOT
          RJM    REL         RELEASE PREVIOUS UNIT

 CONNU40  LDML   CONNUA      UPDATE CONNECT FLAG
          STDL   CONFLG
          RJM    DOFUNC      SEND FUNCTION CODE

 CONNU50  RJM    GETSTA      GET STATUS
          MJN    CONNU50     IF RETRY OCCURED
          SHN    17-11       CHECK FOR ALERT
          MJN    CONNU65     IF SET

 CONNU60  UJK    CONNUX      EXIT

 CONNU65  LDML   RESBUF+/RS/P.EC        Get second general status word
          LPK    /RS/M.EC               Mask the error code
          SBN    EC33                   Check control unit busy
          ZJN    CONNU40                If yes, retry connect

 CONNU70  LDK    /RS/K.HDWR  PROCESS ALERT
          STML   RESBUF+/RS/P.HDWR  SET RESPONSE
          LDML   RESBUF+/RS/P.GS1  GET GENERAL STATUS
          SHN    17-11       POSITION ALERT
          UJK    CONNU60     ABNORMAL TERMINATE EXIT
          SPACE  5,20
** NAME - DELINK
*
** PURPOSE - TO DELINK THE FIRST REQUEST ON THE QUEUE,
*            AND TO CLEAR THE UNIT BUSY COUNTER.
*
** INPUT - REQUEST HAS BEEN PROCESSED TO COMPLETION.
*
** OUTPUT - THE FIRST REQUEST ON THE UIT QUEUE IS DELINKED.
*
** NOTE - THE UIT REQUEST QUEUE LOCKWORD IS OBTAINED TO
*         DELINK THE REQUEST.
*
          SPACE  2
 DELINK   SUBR               ENTRY/EXIT

 DELINK10 LDN    QULK        LOCK UIT REQUEST QUEUE
          RJM    SCLK
          NJN    DELINK10    IF NOT SET TRY AGAIN
          LOADC  CM.UIT      SET R AND A TO UIT
          ADN    /UIT/C.NEXT  OFFSET TO FIRST REQUEST RMA
          CRDL   T1          READ FIRST REQUEST RMA
          LOADF  T3          REFORMAT RMA OF FIRST REQUEST
          CRML   SCRBUF,TW   READ IN NEXT REQUEST PVA AND RMA
          LOADC  CM.UIT      RESET R AND A TO UIT
          ADN    /UIT/C.NEXTPV  OFFSET TO NEXT PVA
          CWML   SCRBUF,TW   DELINK FIRST REQUEST
          LDN    QULK+40B    UNLOCK UIT REQUEST QUEUE
          RJM    SCLK
          LDDL   CONFLG      CHECK IF UNIT IS CONNECTED

 DELINK20 ZJN    DELINKX     IF NOT RETURN
          LPN    17B         MASK UNIT NUMBER
          STDL   T1          SET INDEX
          LDN    0           CLEAR UNIT BUSY COUNTER
          STML   SCRBUF+8,T1
          UJN    DELINK20    RETURN
          SPACE  5,20
** NAME - DOFUNC
*
** PURPOSE - PROCESS A FUNCTION WITH A CONTROLLER.
*
** INPUT - (A) = FUNCTION CODE TO ISSUE.
*
** OUTPUT - RETURN IF NO ERRORS OCCURED.
*
          SPACE  2
 DOFUNC   SUBR               ENTRY/EXIT

          STML   RESBUF+/RS/P.LSTF  SAVE LAST FUNCTION CODE
          LPN    77B         MASK LOWER 6 BITS
          SBN    F.CNT
          ZJN    DOFUNC10    IF CONTINUE FUNCTION
          SBN    F.GS-F.CNT
          ZJN    DOFUNC10    IF STATUS REQUEST  (X12)
          LDML   RESBUF+/RS/P.LSTF
          STML   RESBUF+/RS/P.LSTNSF  SAVE LAST NON STATUS FUNCTION

 DOFUNC10 LDML   RESBUF+/RS/P.LSTF  GET FUNCTION CODE
          AJM    DOFUNC20,TP  JUMP IF CHANNEL ACTIVE
          FAN    TP          ISSUE THE FUNCTION
          CFM    DOFUNC30,TP  CONTINUE IF CHANNEL ERROR FLAG IS CLEAR

*         PROCESS CHANNEL ERROR FLAG
 DOFUNC20 DCN    40B+TP      DISCONNECT CHANNEL
          LDML   RESBUF+/RS/P.LSTF  GET FUNCTION CODE
          LMN    F.REL

 DOFUNC25 ZJN    DOFUNCX     IF ERROR OCCURRED ON RELEASE FUNCTION
          LJM    OUTCPE      PROCESS OUTPUT CHANNEL ERROR FLAG

*         WAIT FOR FUNCTION REPLY.
 DOFUNC30 LDN    30          TIMEOUT 3 SECONDS ON ALL FUNCTIONS
          STML   DOFUNCA

 DOFUNC40 LDK    100000      SET FOR MAXIMUM DELAY OF 100 MSEC.

 DOFUNC50 IJM    DOFUNCX,TP  EXIT IF CHANNEL INACTIVE
          SBN    1
          NJN    DOFUNC50    CONTINUE LOOPING UNTIL 100 MSEC EXPIRES
          SOML   DOFUNCA     DECREMENT TIMEOUT COUNTER
          NJN    DOFUNC40    RELOOP UNTIL TIMEOUT

*         PROCESS FUNCTION TIMEOUT.
          DCN    40B+TP      DISCONNECT CHANNEL
          LDML   RESBUF+/RS/P.LSTF  GET FUNCTION CODE
          LMN    F.REL
          ZJN    DOFUNC25    IF TIMEOUT OCCURRED ON RELEASE FUNCTION
          RJM    FTO         PROCESS FUNCTION TIMEOUT  (NO RETURN)
          SPACE  2
 DOFUNCA  DATA   0           FUNCTION TIMEOUT COUNTER
          SPACE  5,20
** NAME - DSABLE
*
** PURPOSE - TO DISABLE A UNIT IF NECESSARY.
*
** INPUT - ABNORMAL RESPONSE GENERATED.
*
** OUTPUT - IF REQUIRED UNIT IS DISABLED IN UIT STATUS
*           AND RESPONSE STATUS.
*
          SPACE  2
 DSABLE   SUBR               ENTRY/EXIT

          LDML   RESBUF+/RS/P.ALRTM   CHECK ALERT MASK IF TO DISABLE UNIT
          SHN    18-16+/RS/L.DUNIT    DISABLE UNIT BIT TO SIGN POSITION
          PJN    DSABLEX              IF NOT  RETURN
          LDK    /RS/K.DUNIT          SET UNIT DISABLED BIT IN RESPONSE
          RAML   RESBUF+/RS/P.LNGBLK  SET RESPONSE ALERT CONDITIONS
          LDK    /UIT/K.DSABLE        SET UNIT DISABLED IN UIT STATUS
          RAML   UITHDR+/UIT/P.DSABLE
          LOADC  CM.UIT
          CWML   UITHDR,ON            UPDATE FIRST WORD OF UIT
          UJN    DSABLEX              RETURN
          SPACE  5,20
** NAME - ERRCHK
*
** PURPOSE - SET ALERT CONDITIONS AND ABNORMAL STATUS FIELDS FOR TAPE.
*
** OUTPUT - (P2) = 0 IF NO ABNORMAL CONDITION.
*           (P2) NON-ZERO IF ERROR DETECTED.
*           (A) = 0 IF NO ERRORS OR TERMINATION CONDITION.
*
          SPACE  2
 ERRCHK   SUBR               ENTRY/EXIT

          LDK    ZERO
          STDL   T1          CLEAR ALERT CONDITIONS
          STDL   P2          CLEAR ABNORMAL STATUS

*         CHECK IF ANY ERRORS OCCURED.

          LDML   RESBUF+/RS/P.GS1
          STDL   T4          SAVE GS1
          LDML   URBHDR+/URB/P.WRTCNT  CHECK IF WRITE OPERATION
          ZJN    ERRCHK10    IF NOT WRITE OPERATION
          LDDL   T4          DONT INCLUDE BOT IN PHYSICAL DELIMETER CHECK
          LPC    /RS/K.ALERT+/RS/K.TM+/RS/K.EOT
          UJN    ERRCHK20

 ERRCHK10 LDDL   T4          INCLUDE BOT IN PHYSICAL DELIMETER CHECK
          LPC    /RS/K.ALERT+/RS/K.TM+/RS/K.EOT+/RS/K.BOT

 ERRCHK20 ADML   RESBUF+/RS/P.GS2
          ADDL   LONG
          ZJN    ERRCHKX     IF NO ERRORS TO LOOK AT

*         CHECK IF LONG BLOCK ERROR.

          LDDL   LONG
          ZJN    ERRCHK30    IF NOT LONG INPUT BLOCK
          LDK    /RS/K.LNGBLK  SET LONG INPUT BLOCK CONDITION
          RADL   T1

*         CHECK FOR PHYSICAL DELIMETERS OF BOT AND EOT.

 ERRCHK30 LDDL   T4          WORD ONE OF GENERAL STATUS
          LPN    /RS/K.EOT+/RS/K.BOT  MASK PHYSICAL DELIMITERS
          ZJN    ERRCHK50    SKIP IF NEITHER EOT OR BOT SET
          LDML   URBHDR+/URB/P.WRTCNT  CHECK IF WRITE OPERATION
          ZJN    ERRCHK40    IF NOT
          LDDL   T4          CHECK FOR EOT ONLY ON WRITE OPERATIONS
          LPN    /RS/K.EOT
          ZJN    ERRCHK50    IF NOT EOT ON WRITE

 ERRCHK40 LDK    /RS/K.PDLIM  SET PHYSICAL DELIMITER
          RADL   T1

*         CHECK FOR LOGICIAL DELIMETER OF TAPE MARK.

 ERRCHK50 LDDL   T4          WORD ONE OF GENERAL STATUS
          LPN    /RS/K.TM    MASK TAPE MARK INDICATOR
          ZJN    ERRCHK60    SKIP IF TAPE MARK NOT INDICATED
          LDK    /RS/K.LDLIM  SET LOGICAL DELIMITER

*         PROCESS ALERT CONDITIONS.

 ERRCHK60 RADL   T1
          LPML   RESBUF+/RS/P.ALRTM  MASK ALERTS WITH ALERT MASK
          STML   RESBUF+/RS/P.LNGBLK  SET ALERT CONDITIONS IN RESPONSE
          ZJN    ERRCHK70    SKIP IF NO ALERT CONDITIONS ENCOUNTERED
          LDK    /RS/K.ABALRT  SET ABNORMAL ALERT INDICATOR
          STDL   P2

 ERRCHK70 LDML   RESBUF+/RS/P.GS2  CHECK GS WORD 2
          ZJN    ERRCHK80    SKIP IF NO ERRORS ARE INDICATED
          LDK    /RS/K.HDWR  SET HARDWARE ERROR

 ERRCHK80 RADL   P2
          STML   RESBUF+/RS/P.ABALRT  SET ABNORMAL STATUS FIELD IN RESPONSE
          UJK    ERRCHKX     RETURN
          SPACE  5,20
** NAME-- FLAGERR
*
** PURPOSE-- TO PROCESS READ/WRITE CHANNEL FLAG ERRORS.
*
** INPUT-- CHANNEL FLAG WAS FOUND TO BE IN THE WRONG STATE.
*
** OUTPUT-- ERROR RESPONSE GENERATED.
*
          SPACE  2
 FLAGERR  BSS                ENTRY

          DCN    40B+TP      DEACTIVATE THE CHANNEL
          CCF    *+2,TP      UNCONDITIONALY CLEAR THE CHANNEL FLAG
          LDK    REIFE       SET RESPONSE ERROR ID
          STML   RESBUF+/RS/P.REID
          STDL   LMCFLG      SET RELOAD MICROCODE FLAG
          LDK    /RS/K.HDWR  SET HARDWARE ERROR
          STML   RESBUF+/RS/P.ABALRT
          UJK    FAIL
          SPACE  5,20
** NAME-- FORMA
*
** PURPOSE-- FORMAT A CM REAL MEMORY ADDRESS.
*
** CALLING SEQUENCE-- LDC    ADDRESS
*                     RJM    FORMA
*
** INPUT-- - A REGISTER- IS THE ADDRESS OF A 2-WORD CM BYTE ADDRESS.
*
** OUTPUT-- -CMADR- IS THE ADDRESS OF THE RESULTING 3-WORD REFORMATED
*                CM ADDRESS.  THE FORMAT CAN BE USED BY THE LOADC MACRO.
*           -ADDRESS-, WORD 0, BITS 0-13 AND
*                      WORD 1, BITS 3-15, ARE REFORMATTED TO-
*           -CMADR-,   WORD 0, BITS 0-9,
*                      WORD 1, BITS 0-11,
*                      WORD 2, BITS 0-5.
*
** USES-- T1,CMADR,CMADR+1,CMADR+2
*
          SPACE  2
 FORMA    SUBR               ENTRY/EXIT

          STDL   T1          SAVE ENTRY PARAMETER

**        REFORMAT THE CM ADDRESS.

          LDML   1,T1
          LPN    7
          NJN    *           RMA ADDRESS ERROR, HALT
          LDIL   T1
          LPN    37B
          SHN    16
          LMML   1,T1
          SHN    9
          STDL   CMADR+1
          SHN    6
          LPN    77B
          STDL   CMADR+2
          LDIL   T1
          SHN    -5
          STDL   CMADR
          LRD    CMADR
          LDDL   CMADR+2
          LMC    400000B
          UJK    FORMAX      EXIT
          SPACE  5,20
** NAME - FORMU
*
** PURPOSE - TO PROCESS A FORMAT UNIT FUNCTION.
*            CONNECT A TAPE UNIT AND GET CURRENT BLOCK ID.
*
** INPUT - (UDPNT) = CURRENT UD POINTER FOR UNIT.
*
** OUTPUT - URBHDR IS INITIALIZED FOR THIS REQUEST.
*            URBHDR+/URB/P.CONF = CONNECT FUNCTION FOR THIS REQUEST,
*            URBHDR+/URB/P.SBID = STARTING BLOCK ID,
*            ALL OTHER FIELDS ARE CLEARED.
*
          SPACE  2
 FORMU    BSS                ENTRY

          LOADC  CM.COM      LOAD R AND A FOR PP COMMUNICATION BUFFER
          ADN    /CB/C.ZEROES  OFFSET TO ZEROES FIELD
          CRML   URBHDR,TW   CLEAR URB HEADER
          LDML   UNITD+/PUD/P.UNIT,UDPNT  GET UNIT NUMBER
          LPN    17B         MASK 4 BITS
          ADK    F.SEL       SELECT FUNCTION CODE
          STML   URBHDR+/URB/P.CONF  SAVE FUNCTION CODE
          LDML   REQBUF+/RQ/P.RECOV  CHECK FOR RECOVERY ENABLED
          SHN    3
          PJN    FORMU10     IF YES
          LDK    100B        SET RECOVERY DISABLED
          RAML   URBHDR+/URB/P.CONF

 FORMU10  LDML   URBHDR+/URB/P.CONF  GET CONNECT FUNCTION CODE
          RJM    CONNU       CONNECT THE UNIT
          ZJN    FORMU15     IF UNIT PREVIOUSLY CONNECTED
          MJN    FORMU20     IF ERROR  (RESPONSE ALREADY GENERATED)
          RJM    GETBID      GET CURRENT BLOCK ID
          MJN    FORMU20     IF ERROR  (RESPONSE ALREADY GENERATED)
 FORMU15  LDML   BIDBUF      SET STARTING BLOCK ID
          STML   URBHDR+/URB/P.SBID
          LDML   BIDBUF+1
          STML   URBHDR+/URB/P.SBID+1
          UJK    NOSTAT      EXIT OK

 FORMU20  UJK    FAIL        REPORT ERROR
          SPACE  5,20
** NAME - FTO
*
** PURPOSE - PROCESS FUNCTION TIMEOUT ERRORS.
*
** OUTPUT - FUNCTION TIMEOUT ERROR RESPONSE GENERATED.
*
          SPACE  2
 FTO      BSS    1           **ENTRY ONLY** NO EXIT

          SFM    OUTCPE,TP   CHECK AND CLEAR CHANNEL ERROR FLAG
          LDK    REIFT       SET RESPONSE ERROR ID
          STML   RESBUF+/RS/P.REID
          STDL   LMCFLG      SET RELOAD MICROCODE FLAG
          LDK    /RS/K.HDWR  SET HARDWARE ERROR
          STML   RESBUF+/RS/P.ABALRT
          RJM    GETHS       TRY TO GET HARDWARE STATUS
          UJK    FAIL        REPORT ERROR
          SPACE  5,20
** NAME - GETBID
*
** PURPOSE - GET CURRENT BLOCK ID-S.
*
** INPUT - UNIT ALREADY CONNECTED.
*
** OUTPUT - (BIDBUF) FIRST 32 BITS = HOST POSITION BLOCK ID,
*                     NEXT 16 BITS = UNUSED,
*                     NEXT 32 BITS = MEDIA POSITION BLOCK ID,
*                     LAST 16 BITS = UNUSED.
*
*           (A) = +NON-ZERO  NO ERROR.
*           (A) = -NON-ZERO  ERROR, RESPONSE GENERATED.
*
** NOTE - IF THE UNIT IS NOT READY OR IS BUSY THE BLOCK ID WILL
*         BE SET TO ALL ZEROES AND (A) WILL BE +ZERO ON RETURN.
*
          SPACE  2
 GETBID   SUBR               ENTRY/EXIT

          LDML   RESBUF+/RS/P.GS1  CHECK FOR READY AND NOT BUSY
          LPK    /RS/K.BSY+/RS/K.RDY  MASK THE STATUS
          SBN    /RS/K.RDY
          NJK    GETBID30    IF UNIT IS NOT READY OR BUSY
          LDK    F.RBID      ELSE  READ BLOCK ID FUNCTION CODE
          RJM    DOFUNC      SEND THE FUNCTION

 GETBID10 ACN    TP          ACTIVATE THE CHANNEL
          LDK    8           12-BIT WORD COUNT
          IAPM   BIDBUF,TP   INPUT THE BLOCK ID-S
          DCN    40B+TP      DEACTIVATE THE CHANNEL
          STDL   AREG        SAVE RESIDUAL WORD COUNT IF ANY
          SFM    INCPE,TP    CHECK AND CLEAR CHANNEL ERROR FLAG
          RJM    GETSTA      GET STATUS
          MJN    GETBID10    IF RETRY OCCURED
          LDML   RESBUF+/RS/P.GS1
          SHN    17-11       POSITION ALERT BIT
          PJN    GETBID50    IF NO ERROR
          LDK    /RS/K.HDWR  SET HARDWARE ERROR
          STML   RESBUF+/RS/P.ABALRT

*         PREPARE TO RETURN.
 GETBID20 LDML   RESBUF+/RS/P.GS1  GET STATUS WORD
          SHN    17-11       POSITION ALERT BIT
          UJK    GETBIDX     EXIT  (A) = + OR -

*         PROCESS NOT READY OR A BUSY UNIT.
 GETBID30 LDK    ZERO        CLEAR THE BLOCK ID BUFFER
          STDL   T1          INITIALIZE THE INDEX

 GETBID40 LDK    ZERO        CLEAR A BUFFER CELL
          STML   BIDBUF,T1
          AODL   T1          INCREMENT THE INDEX
          SBN    6           CHECK FOR DONE (16-BIT WORDS)
          NJK    GETBID40    IF NOT  LOOP
          UJK    GETBID20    EXIT (A)=0

*         CHECK FOR RESIDUAL INPUT WORD COUNT.
 GETBID50 LDDL   AREG        GET RESIDUAL WORD COUNT
          NJK    RCNZI       PROCESS NON-ZERO RESIDUAL WORD COUNT ERROR
          UJK    GETBID20    PREPARE TO RETURN
          SPACE  5,20
** NAME - GETBL
*
** PURPOSE - DETERMINE THE RMA(S) OF THE CM BUFFER(S) THAT THIS PP
**           WILL USE DURING A TAPE READ.
*
** INPUT - INIBUF CALLED.
*
** OUTPUT - 6 PP WORD TABLE (CMTABLE)
*
          SPACE  2
 GETBL    SUBR               ENTRY/EXIT

          LDK    ZERO
          STML   SPACE1      INITIALIZE RMA(S) AND LENGTHS FOR THIS READ
          STML   SPACE2
          STML   RMA2.1
          STML   RMA2.2
          LDML   CBUFRMA     RMA OF THE CURRENT CENTRAL BUFFER
          STML   RMA1.1
          LDML   CBUFRMA+1
          STML   RMA1.2
          LDML   NADAMAS     CHECK FOR ZERO SPACE LEFT
          NJN    GETBLX      EXIT - NO SPACE LEFT
          LDML   SPACE       SPACE IN CURRENT BUFFER
          ADC    -DUALBUFL*2
          MJN    GETBL30     IF NOT ENOUGH SPACE IN CURRENT BUFFER
          LDK    DUALBUFL*2
          STML   SPACE1      LENGTH TO BE USED IN BUFFER AT RMA1

 GETBL10  RJM    BUMPIT      RESET THE RMA(S) FOR THE NEXT TIME.

 GETBL20  LJM    GETBLX      EXIT

 GETBL30  LDML   SPACE       SET SPACE THIS RMA.
          STML   SPACE1
          LDK    DUALBUFL*2  DETERMINE HOW MUCH IS NEEDED FROM THE
          SBML   SPACE         NEXT (IF ANY) RMA.
          STDL   T1          T1 = HOW MUCH IS NEEDED
          LDML   NUMBUF      SEE IF THERE ARE ANY MORE BUFFERS
          NJN    GETBL40     THERE IS AT LEAST 1 BUFFER MORE
          AOML   NADAMAS     SET THE -NO MORE SPACE- FLAG
          UJN    GETBL20     EXIT

 GETBL40  LDML   NXSPACE     SPACE AVAILABLE IN THE NEXT BUFFER
          SBDL   T1          SUBTRACT HOW MUCH IS NEEDED
          ZJN    GETBL70     IF EQUAL
          MJN    GETBL80     IF STILL NOT ENOUGH

 GETBL50  LDDL   T1          MORE THAN ENOUGH
          STML   SPACE2      PUT THIS AMOUNT IN THE CMTABLE

 GETBL60  LDML   NBUFRMA     PUT THE SECOND RMA IN THE TABLE
          STML   RMA2.1
          LDML   NBUFRMA+1
          STML   RMA2.2
          LJM    GETBL10     UPDATE THE RMA(S) AND EXIT

 GETBL70  AOML   NADAMAS     SET END OF BUFFERS FLAG
          UJN    GETBL50     SET THE TABLE AND EXIT

 GETBL80  LDML   NXSPACE     NOT ENOUGH WITH 2 RMA-S
          STML   SPACE2      SET IT TO WHAT WE HAVE
          AOML   NADAMAS     SET END OF BUFFERS
          UJN    GETBL60     SET THE RMA AND EXIT
          SPACE  5,20
** NAME - GETCM
*
** PURPOSE - GET DATA FROM CENTRAL MEMORY FOR A TAPE WRITE.
*
** DESCRIPTION - THE IDEA IS TO BUFFER INTO THE PP A -CHUNK- OF DATA
*                FROM CENTRAL MEMORY.  THE PP WORD LABELED -SPACE- HAS
*                THE NUMBER OF BYTES REMAINING IN THIS CM BUFFER.  WORD
*                -NUMBUF- IS THE NUMBER OF CM BUFFERS (INCLUDING THE
*                CURRENT ONE).  THE NEXT BUFFER WILL BE AT -CBUFRMA-
*                PLUS 10B (BUFFERS ARE WORD ALIGNED).  SINCE THIS IS A
*                DUAL PP DRIVER, EACH PP USES EVERY OTHER CHUNK (IE. GET
*                A CHUNK, SKIP A CHUNK).
*
          SPACE  2
 GETCM    SUBR               ENTRY/EXIT

          LDK    DUALBUFL*2  LENGTH OF THE BUFFER IN BYTES
          SBML   SPACE       SUBTRACT SPACE REMAINING IN THIS BUFFER
          PJN    GETCM10     IF NOT ENOUGH DATA IN THIS CM BUFFER
          LJM    GETCM40     READ DATA FROM CM

 GETCM10  LDML   SPACE
          STDL   T6          KEEP TRACK OF ACTUAL BYTE COUNT
          ADN    7           ROUND UP JUST IN CASE
          SHN    -3          READ IN WHAT REMAINS OF THIS BUFFER
          STDL   T5          CM WORD COUNT
          LOADF  CBUFRMA     CM BUFFER ADDRESS
          CRML   DIOBUF,T5
          LDML   NUMBUF      CHECK THE BUFFER COUNT
          NJN    GETCM20     MORE BUFFERS IN CM
          AOML   EODATA      SET END OF DATA FLAG
          LDML   SPACE       CONVERT BYTES TO CHANNEL WORDS
          STDL   BYTCNT      SAVE FOR CBYTE ROUTINE
          RJM    CBYTE       CONVERT TO CHANNEL WORDS
          LJM    GETCMX      EXIT

 GETCM20  LDK    DUALBUFL*2  NUMBER OF BYTES IN TOTAL BUFFER
          SBML   SPACE       NUMBER OF BYTES UNREAD
          STDL   T3          SAVE THIS NUMBER
          LDML   SPACE       SAVE OFFSET INTO BUFFER
          STDL   T4
          LDML   NXSPACE     BYTES AVAILABLE FROM NEW CM BUFFER
          SBDL   T3          SUBTRACT THE BYTES NEEDED TO FILL PP BUFFER
          SBN    1           TAKE CARE OF THE ZERO CASE
          PJN    GETCM30     ENOUGH TO FILL PP BUFFER
          LDML   NXSPACE     USE WHAT IS IN CM.  NO MORE THAN 2
                              RMA-S ARE EVER USED TO FILL PP BUFFER.
          STDL   T3
          AOML   EODATA      THIS WILL BE THE LAST ONE

 GETCM30  LDDL   T3
          RADL   T6          BYTE COUNT
          LDDL   T3
          ZJN    GETCM50     IF NO MORE DATA TO FETCH FROM CENTRAL
          ADN    7           CONVERT BYTE COUNT TO CM WORDS
          SHN    -3
          STDL   T5
          LDDL   T4          COMPUTE OFFSET INTO BUFFER
          SHN    -1          BYTES TO PP WORD CONVERSION
          ADC    DIOBUF      ADD BEGINNING OF THE BUFFER
          STML   GETCMA
          LOADF  NBUFRMA
          CRML   *,T5        READ DATA TO PP BUFFER
 GETCMA   EQU    *-1

          UJN    GETCM50     PREPARE TO EXIT

 GETCM40  LDK    DUALBUFL*2  BYTES USED THIS CM BUFFER
          STDL   T6          USED FOR TRANSFER COUNT
          SHN    -3
          STDL   T5          STORE CM WORD COUNT
          LOADF  CBUFRMA     LOAD A/R REGISTERS FOR CM READ
          CRML   DIOBUF,T5   READ THE DATA FROM CENTRAL

 GETCM50  LDDL   T6          CONVERT BYTE COUNT TO CHANNEL WORD COUNT
          STDL   BYTCNT      INPUT TO CBYTE ROUTINE
          RJM    CBYTE
          LDML   EODATA      SKIP BUMPIT AT END
          NJN    GETCM60     IF END OF DATA
          RJM    BUMPIT      ADJUST CBUFRMA

 GETCM60  LJM    GETCMX      EXIT
          SPACE  5,20
** NAME - GETHS
*
** PURPOSE - LOAD AND EXECUTE GETHSO OVERLAY.
*

 GETHS    SUBR               ENTRY/EXIT

          LOADOVL MRO        LOAD THE MISC ROUTINES OVERLAY
          LDK    CONCHMR     SET CHANNEL NUMBERS
          RJM    CHGCH
          RJM    GETHSO      EXECUTE THE OVERLAY ROUTINE
          UJN    GETHSX      RETURN
          SPACE  5,20
** NAME - GETHSC
*
** PURPOSE - GET HARDWARE STATUS (CHANNEL) ON IOU FAILURES.
*
** INPUT - (CHTYPE) = 0 IF NIO CHANNEL OR 1 IF CIO CHANNEL.
*
** OUTPUT - (A) = ZERO IF NO ERROR,
*                 NON-ZERO IF ERROR OCCURED.
*
** NOTE - ERRORS DURING PROCESSING WILL NOT GENERATE ANY NEW
*         ERROR RESPONSE BECAUSE THIS ROUTINE IS BEING USED TO
*         PROCESS AN EXISTING ERROR.
*
          SPACE  2

 GETHSC10 LDK    ONE         EXIT BAD

 GETHSC   SUBR               ENTRY/EXIT

          LDDL   CHTYPE      CHECK IF CIO CHANNEL PRESENT
          ZJK    GETHSCX     IF NOT EXIT
          LDK    F.RDESR     READ ERROR STATUS REGISTER
          RJM    CHFUNC
          ZJK    GETHSC10    IF FUNCTION TIMEOUT
          ACN    TP          INPUT ERROR STATUS REGISTER
          IAN    TP
          DCN    40B+TP
          STML   RESBUF+/RS/P.CESR  RETURN REGISTER IN RESPONSE BUFFER
          LDK    ZERO
          UJK    GETHSCX     EXIT OK
          SPACE  5,20
** NAME - GETSTA
*
** PURPOSE - TO GET AND PROCESS GENERAL STATUS.
*
** OUTPUT - A = GENERAL STATUS WORD 1 IN BITS 11-0,
*           OR
*           A = NEGATIVE IF RETRY OCCURED.
*
** NOTES- 1. GET BOTH WORDS OF GENERAL STATUS.
*         2. IF *ALERT* NOT SET  RETURN.
*         3. IF *CONTINUE* IS SET SEND CONTINUE FUNCTION AND
*            RETURN A = NEGATIVE.
*         4. IF *WAIT FOR CONTINUE* IS SET DELAY AWHILE AND
*            GO TO STEP 1.
*         5. GET DETAILED STATUS.
*         6. RETURN.
*
          SPACE  2
 GETSTA10 LDN    0           CLEAR RETRY AND CONTINUE COUNTERS
          STML   GETSTAC
          STML   GETSTAD
          STML   GETSTAE
          LDML   RESBUF+/RS/P.GS1  EXIT WITH GS1

 GETSTA   SUBR               ENTRY/EXIT

*         SET WAIT END-OF-OPERATION FOR ABOUT 2.5 MINUTES
          LDK    60          WAIT EOP OUTER LOOP TIMER
          STDL   T2

 GETSTA20 LCN    ZERO        WAIT EOP INNER LOOP TIMER
          STDL   T1

 GETSTA30 LDK    F.GS        GET GENERAL STATUS FUNCTION
          RJM    DOFUNC      ISSUE GENERAL STATUS FUNCTION
          ACN    TP          ACTIVATE CHANNEL
          LDK    10          WAIT 10 USEC ON 4X PPU SPEED

 GETSTA40 FJM    GETSTA50,TP  JUMP WHEN 1ST WORD IS AVAILABLE
          SBN    1
          NJN    GETSTA40    IF NOT TIMEOUT
          DCN    TP+40B      DISCONNECT THE CHANNEL
          SODL   T1          DECREMENT WAIT TIME
          NJN    GETSTA30    RELOOP TO REISSUE THE STATUS FUNCTION
          SODL   T2          DECREMENT OUTER LOOP TIME
          NJN    GETSTA20    IF NOT TIMEOUT
          RJM    FTO         PROCESS FUNCTION TIMEOUT ERROR  (NO RETURN)

 GETSTA50 LDK    TWO         INPUT BOTH GENERAL STATUS WORDS
          IAM    RESBUF+/RS/P.GS1,TP  INPUT TO RESPONSE BUFFER
          DCN    TP+40B
          NJK    RCNZI       PROCESS NON-ZERO RESIDUAL WORD COUNT ERROR
          SFM    INCPE,TP    CHECK AND CLEAR CHANNEL PARITY ON INPUT
          LDML   RESBUF+/RS/P.ALERT  CHECK IF ALERT IS SET
          SHN    17-11
          PJK    GETSTA10    IF NOT SET  EXIT
          SHN    17-10-17+11  CHECK FOR CONTINUE BIT 2**10
          PJN    GETSTA60    IF NOT SET
          AOML   GETSTAC     INCREMENT CONTINUE COUNTER
          SHN    1           CHECK FOR LIMIT
          MJN    GETSTA55    IF LIMIT REACHED
          LDML   DOUTCNT     CHECK IF WRITE CONTINUE FLAG IS SET
          NJN    GETSTA52    IF YES, LET WRITE ROUTINE SEND CONTINUE FUNCTION
          LDK    F.CNT       CONTINUE FUNCTION CODE
          RJM    DOFUNC      SEND CONTINUE FUNCTION CODE

 GETSTA52 LDN    0           CLEAR RETRY COUNTERS
          STML   GETSTAD
          STML   GETSTAE
          LCN    ONE         MAKE A = NEGATIVE
          UJK    GETSTAX     EXIT

 GETSTA55 LDK    REIFT       PROCESS RETRY OR CONTINUE LIMIT ERROR
          STML   RESBUF+/RS/P.REID  SET RESPONSE ERROR ID
          STDL   LMCFLG      SET RELOAD MICROCODE FLAG
          LDK    /RS/K.HDWR  SET HARDWARE ERROR
          STML   RESBUF+/RS/P.ABALRT
          UJK    FAIL        REPORT ERROR

 GETSTA60 SHN    4           CHECK FOR RETRY IN PROGRESS BIT 2**6
          PJN    GETSTA70    IF NOT SET
          AOML   GETSTAE     INCREMENT RETRY COUNTER
          SHN    -16
          RAML   GETSTAD
          SHN    9           CHECK FOR LIMIT
          MJN    GETSTA55    IF LIMIT REACHED
          PAUSE  50          DELAY AWHILE
          UJK    GETSTA20    GET STATUS AGAIN

 GETSTA70 LDK    F.DS        DETAILED STATUS FUNCTION
          RJM    DOFUNC      SEND FUNCTION
          LDK    ABNRES      SET ABNORMAL RESPONSE LENGTH
          STML   RESBUF+/RS/P.RESPL
          LDK    26          WORD COUNT
          ACN    TP          ACTIVATE CHANNEL
          IAPM   RESBUF+/RS/P.DSB,TP  INPUT THE DETAILED STATUS
          DCN    40B+TP
          NJK    RCNZI       PROCESS NON-ZERO RESIDUAL WORD COUNT ERROR
          SFM    INCPE,TP    CHECK AND CLEAR CHANNEL ERROR FLAG
          LDML   RESBUF+/RS/P.GS2  CHECK GS WORD 2
          LPC    /RS/M.EC    MASK ERROR CODE FIELD
          ZJN    GETSTA80    IF NOT SET
          SHN    -6          POSITION 1XX(8) BIT OF ERROR CODE
          LPN    1           MASK IT
          ZJN    GETSTA80    IF NOT SET
          STDL   LMCFLG      SET RELOAD MICROCODE FLAG

 GETSTA80 UJK    GETSTA10    EXIT

 GETSTAC  DATA   0           CONTINUE COUNTER
 GETSTAD  DATA   0           RETRY COUNTER UPPER
 GETSTAE  DATA   0           RETRY COUNTER LOWER
          SPACE  5,20
** NAME - GNEWPR
*
** PURPOSE - GET THE NEXT LENGTH/ADDRESS PAIR FROM THE INDIRECT
*            LIST.
*
** INPUT - NUMBUF = NUMBER OF THE BUFFER AT NBUFRMA.
*          BUFLSTPT = RMA OF PAIR AT NBUFRMA.
*
** OUTPUT - NEW LENGTH/ADDRESS PAIR READ OR NBUFRMA ZEROED.
*
          SPACE  2
 GNEWPR   SUBR               ENTRY/EXIT

          SOML   NUMBUF      DECREMENT THE NUMBER OF BUFFERS
          NJN    GNEWPR10
          STML   NBUFRMA     NONE LEFT - ZERO RMA
          STML   NBUFRMA+1
          STML   NXSPACE
          UJN    GNEWPRX     EXIT

 GNEWPR10 LDK    10B         INCREMENT THE BUFFER POINTER
          RAML   BUFLSTPT+1
          SHN    -16
          RAML   BUFLSTPT
          LOADF  BUFLSTPT    FORMAT THE ADDRESS IN A AND R
          CRML   INDLST+8,ON   READ IT INTO THE INDIRECT LIST BUFFER
          UJN    GNEWPRX     EXIT
          SPACE  5,20
**  NAME - ICS
*
**  PURPOSE - REPORT INVALID COMMAND SEQUENCE WHILE WRITES REQUESTS
*             ARE STILL OUTSTANDING.
*
          SPACE  2
 ICS      BSS                ENTRY

          LDK    REIICS      SET RESPONSE ERROR ID
          STML   RESBUF+/RS/P.REID
          LDK    /RS/K.INTERR  SET INTERFACE ERROR
          STML   RESBUF+/RS/P.ABALRT
          UJK    FAIL        PROCESS FAILURE
          SPACE  5,20
**  NAME - INIBUF
*
**  PURPOSE - ESTABLISH THE VALUES THAT WILL BE USED BY THE
*             GETCM AND GETBL SUBROUTINES.
*
**  INPUT - (T4) = ADDR OF LENGTH/ADDR PAIR FOR READ/WRITE TO INITIALIZE.
*
**  OUTPUT - SPACE = THE AMOUNT OF SPACE LEFT IN THE CURRENT CM
*                    BUFFER.
*            CBUFRMA = THE RMA OF THE CURRENT BUFFER.
*            NBUFRMA = THE RMA OF THE NEXT BUFFER.
*            BUFLSTPT = THE RMA POINTER TO THE CM ADDRESS OF THE LAST
*                      LENGTH/ADDRESS PAIR CURRENTLY IN PP MEMORY.
*            NUMBUF = THE NUMBER OF LENGTH/ADDRESS PAIRS ASSOCIATED
*                     WITH THIS COMMAND.
*
          SPACE  2
 INIBUF   SUBR               ENTRY/EXIT

          LDK    ZERO        INITIALIZE SOME FLAGS
          STML   EODATA
          STML   ENTHERE
          STML   NADAMAS
          LDK    DUALBUFL*2  INITIALIZE SHORT BYTE COUNT
          STML   SHBYTEC
          LDIL   T4          GET COMMAND AND FLAGS
          LPC    INDFLG      GET THE INDIRECT FLAG (BIT 6)
          ZJN    INIBUF20    IF DIRECT LIST

**        PROCESS INDIRECT LIST.
          LDML   1,T4        INDIRECT BUFFER LENGTH
          SHN    -3          LENGTH OF BUFFER LIST IS IN BYTES
          SBN    1
          STML   NUMBUF      SET NUMBER OF BUFFERS
          LDML   2,T4        INITIALIZE BUFLSTPT
          STML   BUFLSTPT    THIS WILL BE THE CM ADDRESS (RMA) OF THE LAST
          LDML   3,T4          LENGTH/ADDRESS PAIR CURRENTLY IN PP MEMORY.  IT
          ADN    10B           IS INCREMENTED IN ROUTINE *GNEWPR*
          STML   BUFLSTPT+1
          SHN    -16
          RAML   BUFLSTPT
          LOADF  2,T4        SET UP ADDRESS OF THE INDIRECT LIST
          CRML   INDLST+4,TW  READ THE FIRST TWO LENGTH/
                               ADDRESS PAIRS.  NOTE - CBUFRMA IS EQUATED
                               TO INDLST+6.  SPACE IS EQUATED TO INDLST+5.

**        PREPARE TO EXIT.
 INIBUF10 CCF    *+2,TP      UNCONDITIONALLY CLEAR CHANNEL FLAG
          UJK    INIBUFX     EXIT

**        PROCESS DIRECT LIST.
 INIBUF20 LDML   2,T4        THERE IS ONLY ONE BUFFER
          STML   CBUFRMA     POINT TO THE BUFFER
          LDML   3,T4        RMA'S ARE 2 PP WORDS LONG
          STML   CBUFRMA+1   STORE BOTH HALVES
          LDML   1,T4        GET THE LENGTH
          STML   SPACE       STORE IT AWAY FOR FUTURE USE
          LDK    ZERO        SET NUMBER OF BUFFERS - 1
          STML   NUMBUF      SET THE BUFFER COUNT
          UJK    INIBUF10    PREPARE TO EXIT
          SPACE  5,20
** NAME - INICH
*
** PURPOSE - INITIALIZE THE CHANNEL.
*
** INPUT - (CHTYPE) = 0 IF NIO  OR  1 IF CIO CHANNEL.
*
** OUTPUT - (A) = ZERO IF NO ERROR,
*                 NON-ZERO IF ERROR OCCURED.
*
          SPACE  2
 INICH    SUBR               ENTRY/EXIT

          DCN    40B+TP      DEACTIVATE THE CHANNEL
          SFM    *+2,TP      CLEAR CHANNEL ERROR FLAG
          LDDL   CHTYPE      CHECK IF CIO CHANNEL PRESENT
          ZJK    INICHX      IF NOT EXIT
          LDK    F.MCLEAR    MASTER CLEAR ADAPTER AND CHANNEL
          STML   RESBUF+/RS/P.LSTF  SAVE LAST FUNCTION
          STML   RESBUF+/RS/P.LSTNSF  SAVE LAST NON STATUS FUNCTION
          RJM    CHFUNC
          ZJN    INICH30     IF ERROR ON FUNCTION
          LDK    F.WRCR      WRITE CONTROL REGISTER
          STML   RESBUF+/RS/P.LSTF  SAVE LAST FUNCTION
          STML   RESBUF+/RS/P.LSTNSF  SAVE LAST NON STATUS FUNCTION
          RJM    CHFUNC
          ZJN    INICH30     IF ERROR ON FUNCTION
          ACN    TP
          LDML   INICHA      GET PARAMETER WORD
          OAN    TP
          FJM    *,TP        WAIT FOR EMPTY
          DCN    40B+TP
          CFM    INICHX,TP   EXIT IF CHANNEL ERROR FLAG IS CLEAR

 INICH10  RJM    GETHSC      TRY TO GET HARDWARE STATUS (CHANNEL)
          CFM    *+2,TP      CLEAR CHANNEL ERROR FLAG
          LDK    7773B       REPORT CIO CHANNEL ERROR FLAG WAS SET

 INICH20  UJK    INICHX      EXIT

 INICH30  SFM    INICH10,TP  CHECK AND CLEAR CHANNEL ERROR FLAG
          LDK    7774B       REPORT FUNCTION TIMEOUT ERROR
          UJK    INICH20

 INICHA   CON    400B        PARAMETER FOR WRITE CONTROL REGISTER
          SPACE  5,20
** NAME - IODONE
*
** PURPOSE - TO TERMINATE THE REQUEST.
*
** INPUT - RESPONSE GENERATED.
*
** OUTPUT - REQUEST DELINKED RESPONSE SENT AND
*           UNIT RELEASED IF NECESSARY.
*
** NOTE - ALTERNATE ENTRY POINT AT (IODONE20).
*
          SPACE  2
 IODONE   BSS                ENTRY

          RJM    DELINK      DELINK REQUEST
          RJM    RESP        SEND RESPONSE TO CPU
          LDDL   FRELF       CHECK IF FORCE RELEASE FLAG IS SET
          NJN    IODONE10    IF YES
          LDML   RESBUF+/RS/P.RC  CHECK IF NORMAL RESPONSE
          ADC    -R.NRM
          ZJN    IODONE30    IF YES
          LDDL   CONFLG      CHECK IF UNIT CONNECTED
          ZJN    IODONE20    IF NOT

 IODONE10 LDN    0           CLEAR THE FORCE RELEASE FLAG
          STDL   FRELF
          RJM    REL         RELEASE THE UNIT

*         CHECK IF MICROCODE RELOAD IS REQUIRED.
 IODONE20 BSS                WRITE FAILURE ENTRY POINT
          LDDL   LMCFLG      CHECK LOAD MICROCODE FLAG
          ZJN    IODONE30    IF NOT SET
          RJM    LMC         RELOAD THE MICROCODE

 IODONE30 RJM    CHKCH       CHECK IF CHANNEL REQUESTED BY MALET
          UJK    MAIN        GO TO MAIN LOOP
          SPACE  5,20
** NAME - LMC
*
** PURPOSE - LOAD AND EXECUTE LOAD MICROCODE OVERLAY IF NECESSARY.
*
** INPUT - (LMCFLG) = NZ - LOAD MICROCODE
*                     Z  - BYPASS LOADING MICROCODE
*
** OUTPUT - UNSOLICITED RESPONSE SENT IF MICROCODE LOADED OK.
*           UNSOLICITED RESPONSE SENT IF MICROCODE LOAD ERROR
*           ON THE LAST RETRY .
*
          SPACE  2
 LMC      SUBR               ENTRY/EXIT

          LDDL   LMCFLG      CHECK IF LOAD REQUIRED
          ZJN    LMCX        IF NOT  RETURN
          STML   LASTRLD     SAVE LAST RELOAD FLAG

 OFL3     IFEQ   OFFLINE,1   CHECK TESTING ENVIRONMENT
          LDN    0           BYPASS LOAD MICROCODE IN OFFLINE MODE
          STDL   LMCFLG
          UJN    LMCX        RETURN
 OFL3     ENDIF

          LDN    2           SET RETRY LOOP COUNTER
          STML   LMCRC

*         LOAD THE LOAD MICROCODE OVERLAY.
 LMC1     LOADOVL LMO        LOAD THE OVERLAY

*         MODIFY CHANNEL INSTRUCTIONS OF OVERLAY.
          LDK    CONCHL
          RJM    CHGCH       CHANGE CHANNEL INSTRUCTIONS

*         EXECUTE THE LOAD MICROCODE OVERLAY.
          RJM    LMCO        EXECUTE IT

          SHN    17-11       CHECK IF GOOD LOAD
          PJN    LMC2        IF YES
          SOML   LMCRC       DECREMENT RETRY COUNTER
          PJN    LMC1        TRY AGAIN IF NOT EXHAUSTED

 LMC2     UJN    LMCX        EXIT
          SPACE  2
 LMCRC    DATA   0           RETRY COUNTER
          SPACE  5,15
**        REFORMATTED RMA OF OVERLAY DIRECTORY.

 DH       BSSZ   3

*COPYC IODMAC6
          SPACE  5,20
** NAME-- LOCK
*
** PURPOSE-- SET A LOCKWORD IN CENTRAL MEMORY.
*
** ENTRY--
*         T7 = THE ADDRESS OF THE 3 DIRECT CELLS WHICH CONTAIN
*              THE REFORMATED ADDRESS OF THE CENTRAL MEMORY
*              INTERFACE TABLE.
*         T5 = THE CENTRAL MEMORY WORD OFFSET WITHIN THE
*              INTERFACE TABLE OF THE LOCKWORD.
*
** EXIT--
*         A REGISTER = 0, IF THE LOCK WAS SET.
*         A REGISTER .NE. O, IF THE LOCK COULD NOT BE SET.
*
** ALGORITHM
*         1. WRITE THE INTERMEDIATE VALUE OF FFFF FFFF 0000 0000,
*            USING A RDSL INSTRUCTION.
*            (SET T1 - T4 = FFFF FFFF 0000 0000,
*            RDSL   T1)
*
*         2. AFTER EXECUTION OF 'RDSL T1',
*            IF T1 - T2 = FFFF FFFF,
*            THEN GO BACK AND EXECUTE STEP 1,
*            ELSE GO TO STEP 3.
*
*         3. IF T1 = 0, WRITE THE PP LOCKWORD TO CENTRAL MEMORY,
*            AS DESCRIBED IN THIS STEP.  ELSE IF T1 .NE. 0, GO TO
*            STEP 4.
*            TO WRITE THE PP LOCKWORD ID:
*            SET T1 - T4 = 8000 0000 0000 PPNO, WHERE PPNO IS THE
*            LOGICAL PP NUMBER OF THIS PP.
*            CWDL   T1.
*            SET THE A REGISTER = 0, AND EXIT.
*
*         4. IF T1 = 8000 AND T4 = PPNO, THIS LOCKWORD WAS ALREADY
*            RESERVED TO THIS PP.
*            RESTORE THE CENTRAL MEMORY LOCATION  (CWDL   T1).
*            SET THE A REGISTER = 0, AND EXIT.
*
*         5. IF T4 .NE. PPNO, THEN THIS LOCKWORD IS RESERVED TO
*            A DIFFERENT PROCESSOR.
*            SET BIT 16 OF THE LOCKWORD THAT WAS READ WITH THE
*            RDSL INSTRUCTION, AND WRITE THE CONTENTS BACK TO
*            CENTRAL MEMORY.
*            THE PURPOSE OF SETTING BIT 16 IS TO REQUEST THE
*            OTHER PROCESSOR TO GIVE UP THE LOCKWORD.
*            LDDL   T2
*            LPC    77777B
*            ADC    100000B
*            STDL   T2
*            CWDL   T1.
*            SET THE A REGISTER .NE. 0, AND EXIT.
*
          SPACE  2
 LOCK     SUBR               ENTRY/EXIT

**        WRITE INTERMEDIATE VALUE OF FFFF FFFF 0000 0000.

 LOCK10   LCN    ZERO        SET INTERMEDIATE VALUE
          STDL   T1
          STDL   T2
          LDK    ZERO
          STDL   T3
          STDL   T4
          LOADR  0,T7        UNIT/PP INTERFACE TABLE ADDRESS
          ADDL   T5          ADD LOCKWORD OFFSET, SAVE CM ADDRESS
          STDL   T6          SAVE CM ADDRESS
          RDSL   T1          WRITE INTERMEDIATE VALUE

**        CHECK IF RDSL INSTRUCTION WAS SUCCESSFUL.

          LDDL   T1
          ADDL   T4
          ZJN    LOCK40      IF LOCK CAN BE SET

**        CHECK FOR LOCKWORD = FFFF FFFF XXXX XXXX(16).

          LDDL   T1
          ADDL   T2
          ADC    -177777B-177777B
          ZJK    LOCK10      IF THIS PP WAS NOT FIRST TO WRITE THE
                              INTERMEDIATE VALUE, REPEAT RDSL INSTRUCTION

**        SET BIT 16 IN THE ORIGINAL CONTENTS OF CENTRAL MEMORY AND
*         WRITE IT BACK TO CENTRAL MEMORY.

          LDDL   T2          SET THE 'REQUEST LOCKWORD' FLAG
          LPC    77777B
          ADC    100000B
          STDL   T2
          LDDL   T6          CM ADDRESS OF UNIT LOCK.
          LMC    400000B
          CWDL   T1          RESTORE THE LOCKWORD

          LDDL   T4
          SBDL   PPNO        CHECK IF LOCK ALREADY SET
          NJN    LOCK30      IF LOCK COULD NOT BE SET, EXIT A .NE. 0
          LDDL   T1
          ADC    -100000B

 LOCK30   UJK    LOCKX       IF LOCK WAS ALREADY SET, EXIT A = 0
                             IF LOCK COULD NOT BE SET, EXIT A .NE. 0

**        SET THE LOCKWORD.

 LOCK40   LDK    100000B
          STDL   T1
          LDK    ZERO
          STDL   T2
          STDL   T3
          LDDL   PPNO
          STDL   T4
          LDDL   T6          CM ADDRESS OF UNIT LOCK.
          LMC    400000B
          CWDL   T1          SET THE LOCKWORD
          LDK    ZERO
          UJK    LOCK30      EXIT, A REGISTER = 0
          SPACE  5,20
** NAME - NSC
*
** PURPOSE - PROCESS NON-SUPPORTED COMMAND ERRORS.
*
** OUTPUT - ERROR RESPONSE GENERATED.
*
          SPACE  2
 NSC      BSSZ   1           ENTRY ONLY  **NO EXIT**

          LDK    REINSC      SET RESPONSE ERROR ID
          STML   RESBUF+/RS/P.REID
          LDK    /RS/K.INTERR  SET INTERFACE ERROR
          STML   RESBUF+/RS/P.ABALRT
          UJK    FAIL
          SPACE  5,20
** NAME - OUTCPE/INCPE
*
** PURPOSE - PROCESS ALL CHANNEL ERROR FLAG ERRORS.
*
** INPUT - CHANNEL ERROR FLAG WAS DETECTED SET AND WAS THEN CLEARED.
*
** OUTPUT - IF CIO CHANNEL (CESR) = CH ERROR STATUS REGISTER AND/OR
*           (GS) AND (DSB) = EQUIPMENT STATUS IF IT CAN BE OBTAINED.
*
          SPACE  2
**        OUTPUT ERROR PROCESSING.
 OUTCPE   BSS                ENTRY

          LDK    REIIOP      SET CHANNEL PARITY ON OUTPUT
          UJN    CCEF10      CONTINUE


**        INPUT ERROR PROCESSING.
 INCPE    BSS                ENTRY

          LDK    REIICP      SET CHANNEL PARITY ON INPUT


**        COMMON CHANNEL ERROR FLAG PROCESSING.
 CCEF10   STML   RESBUF+/RS/P.REID  REPORT THE CHANNEL PARITY ERROR
          STDL   LMCFLG      SET RELOAD MICROCODE FLAG
          LDK    /RS/K.HDWR  SET HARDWARE ERROR
          STML   RESBUF+/RS/P.ABALRT
          RJM    GETHS       GET HARDWARE STATUS
          UJK    FAIL        REPORT FAILURE
          SPACE  5,20
** NAME-- PAUS
*
** PURPOSE-- DELAY PROGRAM EXECUTION FOR A SPECIFIED NUMBER OF
*            MICROSECONDS.
*
** INPUT-- A REGISTER SPECIFIES NUMBER OF MICROSECONDS
*          TO BE DELAYED.
*
** OUTPUT-- A = 0.
*
          SPACE  2
 PAUS     SUBR               ENTRY/EXIT

 PAUS10   SBN    1           EACH ITERATION OF THIS SBN-NJN LOOP
          PSN
          PSN
          NJN    PAUS10      UTILIZES 1 MICROSECOND
          UJK    PAUSX
          SPACE  5,20
** NAME - RCNZ
*
** PURPOSE - PROCESS NON-ZERO RESIDUAL WORD COUNT ERRORS.
*
** INPUT - (A) = RESIDUAL WORD COUNT.
*
** OUTPUT - ERROR RESPONSE GENERATED.
*
** NOTE - THIS ROUTINE HAS TWO ENTRY POINTS,
*         *RCNZI* FOR INPUT OPERATIONS AND
*         *RCNZO* FOR OUTPUT OPERATIONS.
          SPACE  2
 RCNZI    BSS                ENTRY POINT FOR INPUT OPERATIONS

          STML   RESBUF+/RS/P.XFER+1  SAVE BAD RESIDUAL COUNT
          LDK    REIRCI      GET RESPONSE ERROR ID CODE
          UJN    RCNZ10      CONTINUE

 RCNZO    BSS                ENTRY POINT FOR OUTPUT OPERATIONS

          STML   RESBUF+/RS/P.XFER+1  SAVE BAD RESIDUAL COUNT
          LDK    REIRCO      GET RESPONSE ERROR ID CODE

 RCNZ10   STML   RESBUF+/RS/P.REID  GENERATE ERROR RESPONSE
          STDL   LMCFLG      SET RELOAD MICROCODE FLAG
          LDK    /RS/K.HDWR  SET HARDWARE ERROR
          STML   RESBUF+/RS/P.ABALRT
          UJK    FAIL        GO TO FAIL
          SPACE  5,20
** NAME - REL
*
** PURPOSE - RELEASE CONNECTED UNIT.
*
          SPACE  2
 REL      SUBR               ENTRY/EXIT

          LDK    ZERO        CLEAR CONNECTED FLAG
          STDL   CONFLG
          LDK    F.REL       RELEASE UNIT
          RJM    DOFUNC
          UJN    RELX        RETURN
          SPACE  5,20
** NAME-- RESP
*
** PURPOSE-- WRITE STATUS BUFFER TO CM RESPONSE BUFFER.
*
** INPUT-- CM.PIT, CM.RS, LIM, /PIT/IN, /PIT/OUT, RS+/RS/P.RESPL.
*
** OUTPUT-- /PIT/IN, RESPONSE BUFFER.
*
          SPACE  2
 INP      EQU    P4          IN POINTER
 OUTP     EQU    P5          OUT POINTER
          SPACE  2
 RESP     SUBR               ENTRY/EXIT

          LDDL   CMDADR      GET PP ADDRESS OF LAST COMMAND
          ADC    -REQBUF     GET PP WORDS INTO REQUEST
          SHN    1           CM BYTES INTO REQUEST
          ADML   RESBUF+/RS/P.REQ+1  ADD ON HALF 2 OF REQUEST BUFFER RMA
          STML   RESBUF+/RS/P.LASTC+1  RMA HALF 2 OF LAST COMMAND
          SHN    -16         GET CARRY IF ANY
          ADML   RESBUF+/RS/P.REQ  ADD ON HALF 1 OF REQUEST BUFFER RMA
          STML   RESBUF+/RS/P.LASTC  RMA OF HALF 1 OF LAST COMMAND

**        READ IN AND OUT POINTERS OF RESPONSE BUFFER.

 RESP10   LOADC  CM.PIT      LOAD ADDRESS OF PP INTERFACE TABLE
          ADN    /PIT/C.OUT  OFFSET OF OUT POINTER
          CRDL   P2          READ OUT POINTER
          SBN    /PIT/C.OUT-/PIT/C.IN  OFFSET OF 'IN' POINTER
          CRDL   P1          READ 'IN' POINTER

**        CHECK IF THERE IS ROOM FOR THE RESPONSE IN THE RESPONSE BUFFER.

          LDDL   INP
          SBDL   OUTP
          MJN    RESP20      IF IN .LT. OUT
          LDDL   LIM         IN .GE. OUT, SET OUT = OUT + LIMIT
          RADL   OUTP

 RESP20   LDML   RESBUF+/RS/P.RESPL  GET RESPONSE LENGTH
          STDL   T1
          LDK    ZERO
          STDL   T2          FLAG TO DETERMINE IF 1 OR 2 BLOCK WRITES
          LDDL   INP
          RADL   T1          IN + RESPONSE LENGTH
          SBDL   OUTP        CHECK IF ENOUGH ROOM IN BUFFER FOR RESPONSE
          PJK    RESP10      IN NOT ENOUGH ROOM IN BUFFER, LOOP
          LDDL   T1
          SBDL   LIM
          MJN    RESP30      IF IN + RESPONSE LENGTH .LT. LIMIT
          STDL   T1          IN + RESPONSE LENGTH - LIMIT = NEW 'IN' POINTER
          AODL   T2          2 BLOCK WRITES REQUIRED

**        WRITE RESPONSE TO CM.

 RESP30   LDDL   INP
          SHN    -3
          STDL   T3          'IN' POINTER IN WORDS
          LDML   RESBUF+/RS/P.RESPL  CONVERT RESPONSE LENGTH TO WORDS
          SHN    -3
          STDL   T4          RESPONSE LENGTH IN WORDS
          STDL   T5
          LDDL   T2
          ZJN    RESP40      IF ONLY 1 BLOCK WRITE REQUIRED
          LDDL   LIM         FIRST BLOCK WRITE = (LIMIT - IN) WORDS
          SBDL   INP
          SHN    -3
          STDL   T4          NUMBER OF WORDS TO TRANSFER ON 1ST BLOCK
          SHN    2           CONVERT TO NUMBER OF PP WORDS
          ADC    RESBUF
          STML   RESPA       RESPONSE ADDRESS FOR 2ND BLOCK WRITE

 RESP40   LOADC  CM.RS       LOAD CM ADDRESS OF RESPONSE BUFFER
          STDL   T6          SAVE CM ADDRESS
          ADDL   T3          ADD 'IN' OFFSET
          CWML   RESBUF,T4   WRITE RESPONSE TO CM
          LDDL   T5          RESPONSE LENGTH
          SBDL   T4
          ZJN    RESP50      IF ONLY 1 BLOCK WRITE REQUIRED
          STDL   T5          RESPONSE LENGTH - (LIMIT - IN)
          LDDL   T6          LOAD ADDRESS OF RESPONSE BUFFER
          LMC    400000B
          CWML   *,T5        WRITE 2ND PART OF RESPONSE TO CM
 RESPA    EQU    *-1         (BEGINNING OF RESPONSE BUFFER)

 RESP50   LDDL   T1          NEW IN POINTER
          STDL   P4

**        SET UP INTERRUPT PROCESSOR INSTRUCTION IF INTERRUPT IS SELECTED.

          LDML   RESBUF+/RS/P.INT  CHECK IF INTERRUPT WAS SELECTED
          LPK    /RS/K.INT
          NJN    RESP60      IF INTERRUPT SELECTED
          LDK    PSNI        PSN INSTRUCTION
          UJN    RESP70


 RESP60   LDML   RESBUF+/RS/P.PORT  GET PROCESSOR PORT NUMBER TO INTERRUPT
          SHN    -16+/RS/L.PORT+/RS/N.PORT
          LPN    /RS/M.PORT
          ADC    INPNI       INPN INSTRUCTION

 RESP70   STML   INTPRC

**        WRITE UPDATED 'IN' POINTER FOR CM RESPONSE BUFFER TO PIT.

          LOADC  CM.PIT      LOAD ADDRESS OF PP INTERFACE TABLE
          ADN    /PIT/C.IN   OFFSET OF 'IN' POINTER
          CWDL   P1          WRITE NEW 'IN' POINTER TO CM

**        INTERRUPT PROCESSOR.

          LOADC  CM.INT      CM ADDRESS OF INTERRUPT WORD
          CWDL   PPNO-3      SET LAST BYTE NON-ZERO

 INTPRC   INPN   1           INTERRUPT OR PSN
          LJM    RESPX       EXIT
          SPACE  5,20
** NAME - RESPSU
*
** PURPOSE - SET UP RESPONSE BUFFER.
*
** INPUT - REQUEST PVA/RMA AND ENTIRE REQUEST READ INTO PP MEMORY.
*
** OUTPUT - NECESSARY INFORMATION PLACED IN RESPONSE BUFFER. THE REMAINDER
*           OF THE BUFFER IS ZEROED OUT.
*
          SPACE  2
 RESPSU   SUBR               ENTRY/EXIT

**        ZERO OUT RESPONSE BUFFER STARTING AT ABNORMAL STATUS FIELD
*         IN CM WORD 4 TO DETAILED STATUS IN CM WORD 8.

          LDK    /RS/C.DSB-/RS/C.ABALRT  NUMBER OF CM WORDS TO CLEAR
          STDL   T5
          LOADC  CM.COM      LOAD R AND A OF PP COMMUNICATION BUFFER
          ADN    /CB/C.ZEROES  READ FROM ZERO BLOCK
          CRML   RESBUF+/RS/P.ABALRT,T5  ZERO PART OF RESPONSE BUFFER

**        MOVE LOGICAL UNIT, RECOVERY, INTERRUPT, PORT, PRIORITY
*         AND ALERT MASK FROM REQUEST TO RESPONSE BUFFER.

          LDML   REQBUF+/RQ/P.LU
          STML   RESBUF+/RS/P.LU
          LDML   REQBUF+/RQ/P.RECOV
          STML   RESBUF+/RS/P.RECOV
          LDML   REQBUF+/RQ/P.ALRTM
          STML   RESBUF+/RS/P.ALRTM
          LDK    NORMRES     SET LENGTH IN RESPONSE BUFFER
          STML   RESBUF+/RS/P.RESPL

**        MOVE CURRENT REQUEST PVA/RMA TO RESPONSE BUFFER.

          LOADC  CM.COM      LOAD R AND A OF PP COMMUNICATION BUFFER
          ADN    /CB/C.SCRAT  USE SCRATCH AREA
          CWML   UCAHDR+/UCA/P.CPVA-1,TW
          SBN    2
          CRML   RESBUF,TW
          LJM    RESPSUX     RETURN


**        ENSURE THAT NUMBER OF ZERO BYTES IN PP COMMUNICATION BUFFER
*         IS ENOUGH TO ZERO THE NECESSARY PORTION OF THE RESP. BUFFER.

          ERRNG  /CB/B.ZEROES+/RS/C.ABALRT*8-/RS/C.ELB*8
          SPACE  5,20
** NAME - RURBH
*
** PURPOSE - READ URB HEADER AND OLDEST REQUEST PVA BACK INTO PP.
*
** INPUT - (CM.UCA) = CURRENT UNITS UCA.
*
          SPACE  2
 RURBH    SUBR               ENTRY/EXIT

          LDN    3           SET CM WORD COUNT
          STDL   WC
          LOADC  CM.UCA      LOAD R AND A FOR CURRENT UNITS UCA
          ADML   UCAHDR+/UCA/P.INP  OFFSET BY UCA IN POINTER
          CRML   URBHDR,WC   READ THE URB HEADER AND REQUEST PVA
          LDML   URBHDR+/URB/P.UCMDA  RESTORE CMDADR
          STDL   CMDADR
          UJN    RURBHX      RETURN
          SPACE  5,20
** NAME - RURBR
*
** PURPOSE - READ URB RESPONSE BACK INTO PP.
*
** INPUT - (CM.UCA) = CURRENT UNITS UCA.
*
          SPACE  2
 RURBR    SUBR               ENTRY/EXIT

          LDN    NRESW       SET NORMAL RESPONSE CM WORD COUNT
          STDL   WC
          LOADC  CM.UCA      LOAD A AND R WITH CM UCA ADDRESS
          ADML   UCAHDR+/UCA/P.INP  INCREMENT WITH IN POINTER
          ADN    /URB/C.RESP  OFFSET TO RESPONSE FIELD
          CRML   RESBUF,WC   READ RESPONSE BACK INTO PP
          STML   RURBRA      SAVE CM ADDRESS
          LDML   RESBUF+/RS/P.RESPL  CHECK RESPONSE LENGTH
          SBN    NORMRES
          ZJN    RURBRX      RETURN IF NORMAL RESPONSE LENGTH
          LDN    /RS/C.ELB-/RS/C.DSB  REMAINING CM WORD COUNT OF RESPONSE
          STDL   WC
          LDML   RURBRA      GET CM ADDRESS
          LMC    400000B
          CRML   RESBUF+/RS/P.DSB,WC  READ DETAILED STATUS BACK IN TO PP
          UJK    RURBRX      RETURN
          SPACE  2
 RURBRA   DATA   0           SAVE CM ADDRESS
          SPACE  5,20
** NAME - SAVAD
*
** PURPOSE - SAVE RMA THAT IS BEING FORMATTED BY REFAD AND
*            STORE IT IN LOCATIONS GREATER THAN 77.
*
** INPUT - (A) = CM A REGISTER ADDRESS
*          (CMADR) = FORMATTED CM R REGISTER ADDRESS
*          (T2) = DESTINATION PP ADDRESS
*
** OUTPUT - ((T2)) = 3 PP WORD FORMATTED CM ADDRESS
*
          SPACE  2
 SAVAD    SUBR               ENTRY/EXIT
          STML   2,T2
          LDDL   CMADR
          STI    T2
          LDDL   CMADR+1
          STML   1,T2
          UJK    SAVADX      RETURN
          SPACE  5,20
** NAME - SCLK
*
** PURPOSE - SET/CLEAR SPECIFIED LOCKWORD.
*
** INPUT - (A) = 0000XX IF SET LOCK.
*          (A) = 00004X IF CLEAR LOCK.
*          XX = INDEX INTO TABLE *SCLKA* OF LOCK TO SET/CLEAR.
*
** EXIT - (A) = 0 IF LOCK SUCCESSFULLY SET/CLEARED.
*         (A) .NE. 0 IF LOCK NOT SET/CLEARED.
*
** USES - T1, T2, T5, T7.
*
          SPACE  2
 SCLK10   RJM    CLOCK       CLEAR INTERLOCK

 SCLK     SUBR               ENTRY/EXIT

          STDL   T2          SAVE ENTRY
          LPN    37B         MASK OFF SET/CLEAR FLAG
          STDL   T1
          LDML   SCLKA,T1    SET POINTER TO CM ADDRESS OF LOCKWORD
          STDL   T7
          LDML   SCLKA+1,T1  SET INDEX INTO TABLE
          STDL   T5
          LDDL   T2
          SHN    -5
          NJN    SCLK10      IF CLEAR LOCK
          RJM    LOCK        SET LOCK
          UJK    SCLKX       EXIT
          SPACE  3
 SCLKA    BSS    0
          LOC    0
 PPLK     CON    CM.PIT,/PIT/C.LOCK   QUEUE LOCK IN PP INTERFACE TABLE
 QULK     CON    CM.UIT,/UIT/C.QLOCK  QUEUE LOCK IN UNIT INTERFACE TABLE
 CHLK     CON    CM.CHAN,0            CHANNEL LOCK
          LOC    *O

 CURCH    EQU    SCLKA+CHLK+1  LOCATION ALWAYS CONTAINS CURRENT CHANNEL NUMBER
          SPACE  5,20
** NAME - SENCOM
*
** PURPOSE - SEND A COMMAND TO THE SLAVE PP.
*
** INPUT - ADDR OF COMMAND IN A REGISTER.
*
** OUTPUT - COMMAND SENT.
*
          SPACE  2
 SENCOM   SUBR               ENTRY/EXIT

          STML   SENCOMA     INSTRUCTION MODIFICATION
          LOADC  CM.COM      LOAD R AND A OF PP COMMUNICATION BUFFER
          ADN    /CB/C.COMM
          CWML   *,ON        SEND THE COMMAND
 SENCOMA  EQU    *-1

          UJN    SENCOMX     EXIT
          SPACE  4
 HNDSHK   VFD    8/HSHAKC,8/0  HANDSHAKE COMMAND
          BSSZ   3           DO NOT SEPARATE THIS FROM HNDSHK

 NCHANC   VFD    8/NCCOMD,8/0  CHANGE CHANNEL COMMAND
          BSSZ   3           DO NOT SEPARATE THIS FROM NCHANC
          SPACE  5,20
** NAME - SLVERR
*
** PURPOSE - PROCESS A SLAVE DETECTED ERROR.
*
** INPUT - (A) = SLAVE ERROR CODE.
*
          SPACE  2
 SLVERR   BSS                ENTRY

          SBN    REIFE       CHECK IF SLAVE FLAG ERROR
          ZJK    FLAGERR     IF YES  PROCEES IT
          RJM    NSC         ELSE PROCESS NON-SUPPORTED CMD  (NO RETURN)
          SPACE  5,20
** NAME - UINP
*
** PURPOSE - TO UPDATE UCA IN POINTER IN CM.
*
** INPUT - (/UCA/P.ACTCNT) = CURRENT ACTVIVE COUNT OF WRITE REQUESTS.
*
** OUTPUT - (/UCA/P.ACTCNT) = DECREMENTED BY 1 AND
*           (/UCA/P.INP) = UPDATED IN POINTER IN CM.
*
          SPACE  2
 UINP     SUBR               ENTRY/EXIT

          SOML   UCAHDR+/UCA/P.ACTCNT  DECREMENT ACTIVE COUNT
          LDN    C.URB       UPDATE IN POINTER
          RAML   UCAHDR+/UCA/P.INP
          SBN    /UCA/C.ERRSTA  CHECK FOR WRAP AROUND
          MJN    UINP10      IF NOT
          LDK    /UCA/C.URB1  RESET TO FIRST ENTRY
          STML   UCAHDR+/UCA/P.INP

 UINP10   LOADC  CM.UCA      UPDATE UCA HEADER WORD 2 IN CM
          ADN    /UCA/C.ACTCNT  OFFSET TO CM WORD 2
          CWML   UCAHDR+/UCA/P.ACTCNT,ON  UPDATE IT
          UJN    UINPX       RETURN
          SPACE  5,20
** NAME - UNLD
*
** PURPOSE - TO LOAD AND EXECUTE UNLD OVERLAY.
*
          SPACE  2
 UNLD     BSS                ENTRY

          LOADOVL MRO        LOAD THE OVERLAY
          LDK    CONCHMR     SET CHANNEL INSTRUCTIONS
          RJM    CHGCH
          LJM    UNLDO       EXECUTE THE OVERLAY

*         THE OVERLAY WILL EXIT DIRECTLY TO *CMDONE* IF SUCCESSFUL.
          SPACE  5,20
** NAME - WFAIL
*
** PURPOSE - TO LOAD AND EXECUTE WFAIL OVERLAY.
*
          SPACE  2
 WFAIL    SUBR               ENTRY/EXIT

          LOADOVL WFO        LOAD WRITE FAILURE OVERLAY
          RJM    WFAILO      EXECUTE OVERLAY
          RJM    REL         RELEASE THE UNIT
          UJN    WFAILX      RETURN
          SPACE  5,20
** NAME - WRDONE
*
** PURPOSE - TO PROCESS NORMAL WRITE REQUEST COMPLETION.
*
** INPUT - REQUEST ENDING BLOCK ID ALREADY SET INTO RESPONSE (LGBID).
*
** OUTPUT - UCA HEADER AND URB RECORD WRITTEN INTO CM.
*
          SPACE  2
 WRDONE   BSS                ENTRY

 OFL4     IFEQ   OFFLINE,1   CHECK FOR CMSE OFFLINE TESTING
          LDK    R.INT       SET INTERMEDIATE RESPONSE CODE
          STML   RESBUF+/RS/P.RC
          RJM    RESP        SEND INTERMEDIATE RESPONSE
 OFL4     ENDIF

          LDML   RESBUF+/RS/P.LGBID  SET REQUEST ENDING BLOCK ID
          STML   URBHDR+/URB/P.EBID
          LDML   RESBUF+/RS/P.LGBID+1
          STML   URBHDR+/URB/P.EBID+1
          RJM    WRUCA       UPDATE UCA HEADER AND WRITE URB RECORD
          RJM    CHKCH       CHECK IF MALET WANTS THE CHANNEL
          UJK    MAIN        GO TO MAIN IDLE LOOP
          SPACE  5,20
** NAME - WRITCM
*
** PURPOSE - WRITE DATA TO CM DURING A TAPE READ.
*
** DESCRIPTION - THIS SUBROUTINE WILL WRITE A -CHUNK- (SEE GETCM) OF
*                DATA JUST READ FROM TAPE TO CM. IF THE TAPE RECORD IS
*                LONGER THAN THE CM CONTAINER THEN THE EXCESS DATA IS
*                THROWN AWAY AND THE FLAG *LONG* WILL BE SET.
*
          SPACE  2
 WRITCM10 LDML   SHBYTEC     SET LONG INPUT BLOCK FLAG
          RADL   LONG
          SHN    -16
          ZJN    WRITCMX     IF NO OVERFLOW
          LDK    TWO         ENSURE COUNT IS NOT 0 OR 1
          STDL   LONG

 WRITCM   SUBR               ENTRY/EXIT

          RJM    GETBL       DETERMINE THE RMA(S) OF THE BUFFERS
          LDML   SPACE1      SPACE (IN BYTES) AT FIRST RMA
          ZJN    WRITCM10    NO MORE BUFFER SPACE - THROW DATA AWAY
          ADML   SPACE2      CHECK FOR SHORT READ
          SBML   SHBYTEC
          ZJN    WRITCM40    IF NOT SHORT READ AND ENOUGH BUFFER SPACE
          PJN    WRITCM20    IF SHORT READ
          LMC    -0          INDICATE LONG INPUT BLOCK
          STDL   LONG
          UJN    WRITCM40    FILL THE REMAINING BUFFER SPACE

 WRITCM20 LDML   SPACE2      IF SPACE2 = 0 THEN SET SPACE1 = SHBYTEC
          ZJN    WRITCM30
          LDML   SHBYTEC     ELSE SPACE2 = SHBYTEC - SPACE1
          SBML   SPACE1
          STML   SPACE2
          PJN    WRITCM40    IF SECOND RMA INVOLVED
          LDK    ZERO
          STML   SPACE2
          UJN    WRITCM40    PROCESS THE WRITE

 WRITCM30 LDML   SHBYTEC
          STML   SPACE1

 WRITCM40 LDML   SPACE1
          ADN    7           ROUND UP IN CASE THIS IS THE LAST
          SHN    -3          THIS IS THE NUMBER OF CM WORDS
          STDL   T5
          LOADF  RMA1.1      FORMAT THE A AND R REGISTERS
          CWML   DIOBUF,T5
          LDML   SPACE1      COMPUTE THE OFFSET INTO THE PP BUFFER
          SHN    -1            IN CASE THERE ARE TWO CM WRITES
          ADC    DIOBUF
          STML   WRITCMA     MODIFY THE CM WRITE INSTRUCTION
          LDML   SPACE2      WE MAY HAVE TO WRITE TO TWO BUFFERS
          NJN    WRITCM50    IF TWO BUFFERS
          LJM    WRITCMX     ONLY ONE THIS TIME

 WRITCM50 ADN    7           ROUND UP
          SHN    -3          CM WORDS
          STDL   T5
          LOADF  RMA2.1      FORMAT THE SECOND RMA
          CWML   *,T5        WRITE TO THE SECOND BUFFER
 WRITCMA  EQU    *-1

          LJM    WRITCMX     EXIT
          SPACE  5,20
** NAME - WRUCA
*
** PURPOSE - WRITE THE UCA HEADER AND URB RECORD INTO CM.
*
** INPUT - (UCAHDR+/UCA/P.ACTCNT) = PREVIOUS ACTIVE COUNT,
*          (UCAHDR+/UCA/P.OUTP) = CURRENT OUT POINTER.
*
** OUTPUT - (UCAHDR+/UCA/P.ACTCNT) = +1,
*           (UCAHDR+/UCA/P.OUTP) = NEXT OUT POINTER.
*           (UCAHDR+/UCA/P.INP) = INITIALIZED IF FIRST WRITE OPERATION.
*           (UCAHDR+/UCA/P.TPF) = INITIALIZED IF FIRST WRITE OPERATION.
*
          SPACE  2
 WRUCA    SUBR               ENTRY/EXIT

          AOML   UCAHDR+/UCA/P.ACTCNT  INCREMENT ACTIVE COUNT
          SBN    1           CHECK IF FIRST ONE
          NJN    WRUCA10     IF NOT FIRST ONE
          LDK    /UCA/C.URB1  INITIALIZE BOTH INP AND OUTP
          STML   UCAHDR+/UCA/P.INP
          STDL   T1          SAVE IT
          ADN    C.URB       INCREMENT IT FOR THE NEXT OUTP
          STML   UCAHDR+/UCA/P.OUTP
          LDML   BIDBUF+4    INITIALIZE TAPE POSITION FLAG
          STML   UCAHDR+/UCA/P.TPF
          UJN    WRUCA20     CONTINUE

 WRUCA10  LDML   UCAHDR+/UCA/P.OUTP  GET CURRENT OUT POINTER
          STDL   T1          SAVE IT
          ADN    C.URB       INCREMENT IT TO NEXT
          STML   UCAHDR+/UCA/P.OUTP
          SBN    /UCA/C.ERRSTA  CHECK FOR WRAP AROUND
          MJN    WRUCA20     IF NOT
          LDK    /UCA/C.URB1  RESET TO FIRST URB
          STML   UCAHDR+/UCA/P.OUTP

*         WRITE UPDATED UCA HEADER MINUS THE CPU SYNC WORD.
 WRUCA20  LDN    /UCA/C.CRMA-/UCA/C.ACTCNT  CM WORD COUNT
          STDL   WC
          LOADC  CM.UCA      LOAD R AND A OF UNIT COMMUNICATION AREA
          ADN    /UCA/C.ACTCNT  OFFSET PAST CPU SYNC WORD
          CWML   UCAHDR+/UCA/P.ACTCNT,WC  UPDATE THE UCA HEADER

*         WRITE THE URB RECORD WITH CURRENT OUTP OFFSET.
          LDDL   CMDADR      SAVE THE CURRENT COMMAND ADDRESS
          STML   URBHDR+/URB/P.UCMDA
          LDML   RESBUF+/RS/P.RESPL  CALCULATE URB RECORD LENGTH
          SHN    -3          START WITH CM RESPONSE LENGTH
          ADN    /URB/C.RESP-/URB/C.CONF  INCREMENT BY URB HEADER
          STDL   WC          SAVE IT
          LDDL   CM.UCA+2    LOAD CM A ADDRESS
          ADDL   T1          OFFSET WITH CURRENT OUTP
          LMC    400000B
          CWML   URBHDR,WC   WRITE URB RECORD
          UJK    WRUCAX      RETURN
          SPACE  5,20
** NAME - WSC
*
** PURPOSE - WAIT FOR THE SLAVE TO COMPLETE.
*
** OUTPUT - SLAVE RESPONSE IN T1-T4.
*
** NOTE - ON READ  T1 = 00XX  XX=ERROR CODE IF ANY,
*                  T2 = XXXX  SLAVE LONG BLOCK FLAG,
*                  T3-T4 = TRANSFER COUNT.
*
*         ON WRITE T1 = 00XX  XX=ERROR CODE IF ANY,
*                  T2-T3 = NOT USED,
*                  T4 = XXXX RESIDUAL COUNT IF ANY.
*
*         OTHER    T1 = 00XX  XX=ERROR CODE IF ANY,
*                  T2-T4 = NOT USED.
*
          SPACE  2
 WSC      SUBR               ENTRY/EXIT

 WSC10    LOADC  CM.COM      LOAD R AND A FOR PP COMMUNICATION BUFFER
          ADN    /CB/C.COMM
          CRDL   T1
          LDDL   T1          SLAVE WILL CLEAR WHEN DONE
          SHN    -8          POSITION COMMAND BITS
          ZJN    WSCX        COMPLETE
          PAUSE  5           DELAY 5 MICROSECONDS
          UJN    WSC10       TRY AGAIN
          SPACE  5,20
** NAME - INIT
*
** PURPOSE - LOAD AND EXECUTE THE INITIALIZE DRIVER OVERLAY.
*
          SPACE 2
 INIT     BSS                ENTRY

*         CLEAR PP DIRECT CELLS.
          LDK    ENDDIR      CLEAR PP DIRECT CELLS T2 THRU ENDDIR
          STDL   T1

 INIT10   LDK    ZERO        CLEAR CELL
          STIL   T1
          SODL   T1          CHECK FOR DONE
          PJN    INIT10      IF NOT DONE LOOP

*         CLEAR PP MEMORY FROM ENDCODE TO ENDMEM.
          LDK    ENDMEM-ENDCODE
          STDL   T1          SET INDEX

 INIT20   LDN    0
          STML   ENDCODE,T1  CLEAR MEMORY WORD
          SODL   T1          CHECK FOR DONE
          PJN    INIT20      IF NOT  LOOP

*         GET AND REFORMAT OVERLAY DIRECTORY POINTER RMA.
          LDDL   DSRTP       VALIDATE PIT RMA
          ADDL   DSRTP+1
          ZJN    *           IF IN ERROR
          REFAD  DSRTP,CM.PIT  REFORMAT ADDRESS OF PP INTERFACE TABLE
          ADN    /PIT/C.CBUF  OFFSET TO PP COMMUNICATIONS BUFFER RMA
          CRDL   P1          READ THE COMM BUF RMA
          LDDL   P3          VALIDATE PP COMMUNICATION BUFFER RMA
          ADDL   P4
          ZJN    *           IF IN ERROR
          LOADF  P3          REFORMAT ADDRESS OF PP COMM BUFFER
          ADN    /CB/C.ODP   OFFSET TO OVERLAY DIRECTORY RMA
          CRDL   P1          READ THE OVL RMA
          LDDL   P3          VALIDATE OVERLAY DIRECTORY RMA
          ADDL   P4
          ZJN    *           IF IN ERROR
          REFAD  P3,DH       REFORMAT THE OVL RMA

*         LOAD INITIALIZE DRIVER OVERLAY.
          LOADOVL IDO        LOAD THE OVERLAY

*         GO EXECUTE THE INITIALIZE DRIVER OVERLAY.
          RJM    INITO       GO EXECUTE IT

*         OVERLAY WILL RETURN HERE IF IT IS THE MASTER PP.
          RJM    LMC         LOAD CCC MICROCODE IF NECESSARY
          LJM    MAIN        EXIT TO MASTER MAIN IDLE LOOP
          SPACE  4
*         CHANNEL INSTRUCTION MODIFICATION TABLE FOR COMMON CODE.
 CONCHC   BSS    0           START OF TABLE
 TTP+40B  HERE
 T40B+TP  HERE
 TTP      HERE
          CON    0           END OF TABLE

 LASTRLD  BSSZ   1           LAST RELOAD FLAG

          TITLE  WORKING MEMORY, TABLES AND BUFFERS.

 ENDCODE  EQU    *           END OF PERMANENT PP CODE AREA
          SPACE  2
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
*                                                                     *
** NOTE --                                                            *
*                                                                     *
*    MASTER PP - FROM ENDCODE TO ENDMEM ARE CLEARED ON DEADSTARTS     *
*                AND RESUMES, THEN ALL TABLES ARE LOADED.             *
*                                                                     *
*     SLAVE PP - FROM ENDCODE TO ENDMEM ARE CLEARED ON DEADSTARTS     *
*                ONLY. THE SLAVE PP DOES NOT PROCESS RESUMES.         *
*                                                                     *
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
          SPACE  2
 UNITC    BSSZ   1           ACTIVE UNIT DESCRIPTOR COUNT

 UNITD    BSSZ   P.PUD*16    PP UNIT DESCRIPTORS FOR 16 ACTIVE UNITS

**        THE FOLLOWING 6 LOCATIONS ARE USED TO PASS RMA(S) AND LENGTH
*         FOR TAPE READS. DO NOT CHANGE THIER POSITIONS.

 SPACE1   BSSZ   1           SPACE IN BYTES AT RMA1
 RMA1.1   BSSZ   1           FIRST HALF OF FIRST RMA
 RMA1.2   BSSZ   1           SECOND HALF OF FIRST RMA
 SPACE2   BSSZ   1           SPACE IN BYTES OF SECOND RMA
 RMA2.1   BSSZ   1           FIRST HALF OF SECOND RMA
 RMA2.2   BSSZ   1           SECOND HALF OF SECOND RMA

 NUMBUF   BSSZ   1           NUMBER OF BUFFERS IN INDIRECT LIST
 BUFLSTPT BSSZ   2           POINTER TO THE INDIRECT LIST OF BUFFERS

 NADAMAS  BSSZ   1           NO MORE CM BUFFER SPACE (TAPE READ)
 EODATA   BSSZ   1           END OF DATA FLAG (USED FOR WRITE)
 ENTHERE  BSSZ   1           FUNCTION ENDS IN PARTNER PP FLAG
 SHBYTEC  BSSZ   1           BYTE COUNT ON A SHORT READ

 INDLST   BSSZ   MAXIND*4    INDIRECT ADDRESS/LENGTH BUFFER
 SPACE    EQU    INDLST+5    USED BY GETBL AND GETCM
 CBUFRMA  EQU    INDLST+6    USED BY GETBL AND GETCM
 NXSPACE  EQU    INDLST+9    SPACE IN THE NEXT BUFFER
 NBUFRMA  EQU    INDLST+10   ADDRESS (RMA) OF NEXT CM BUFFER
          SPACE  3
 SCRBUF   BSSZ   P.PIT       SCRATCH BUFFER
          SPACE  3,5
 REQBUF   BSSZ   MAXREQ*4    SET REQUEST BUFFER LENGTH
 CMDBUF   EQU    REQBUF+/RQ/P.CMND  COMMAND BUFFER
          SPACE  2,5
**        URBHDR AND RESBUF MUST NOT BE SEPERATED.
 URBHDR   BSSZ   8           URB HEADER, FIRST TWO CM WORDS

 RESBUF   BSSZ   P.RS        RESPONSE BUFFER LENGTH (MAXIMUM)
          SPACE  2,5
 BIDBUF   BSSZ   6           BLOCK ID BUFFER
          SPACE  2
**        CHECK IF DRIVER OVERFLOWS INTO OVERLAY BUFFER.

 OVLADD   EQU    6360B       FOR DRIVER EXPANSION

          ERRPL  *-OVLADD    IF DRIVER OVERFLOWS

          BSSZ   OVLADD-*    CLEAR THE DRIVER EXPANSION AREA
          SPACE  2
**        THE FOLLOWING IS THE BUFFER USED TO SUPPORT OVERLAYS.

 OVLBUF   EQU    *           OVERLAY BUFFER
          SPACE  2
**        THE FOLLOWING ARE DATA BUFFERS THAT CAN BE OVERLAPPED.

 DIOBUF   EQU    ENDMEM-DUALBUFL  PP I/O DATA BUFFER TO ENDMEM

 CNTLBUF  EQU    ENDMEM-CNTLBL  PP CONTROLWARE BUFFER TO ENDMEM
          OVERLAY (INITIALIZE DRIVER),OVLBUF
          ROUTINE IDO        INITIALIZE DRIVER OVERLAY
          SPACE  4
** NAME-- INITO
*
** PURPOSE-- INITIALIZE DRIVER OVERLAY.
*            *MASTER,SLAVE* INITIALIZE THE DRIVER AFTER DEADSTART.
*            *MASTER* REINITIALIZE THE DRIVER ON RESUME COMMAND.
*
** INPUT-- (CM.PIT) = REFORMATED ADDRESS OF THE PP INTERFACE TABLE (PIT).
*
*          (IDLFLG)= 0 FOR DEADSTART INITIALIZATION.
*                    2 FOR RESUME REINITIALIZATION.
*
** OUTPUT-- IF MASTER PP, RETURN TO CALLER.
*           IF SLAVE PP, EXIT DIRECTLY TO *SMAIN*.
*
          SPACE  2
 INITO    SUBR               OVERLAY ENTRY/EXIT

**        READ PP INTERFACE TABLE.  NOTE - THIS IS
*         THE ONLY PLACE THE STATIC FIELDS OF THE PIT
*         TABLES ARE READ INTO THE PP.

          LDK    C.PIT       LENGTH OF PIT
          STDL   WC
          LOADC  CM.PIT      LOAD CM ADDRESS OF PIT
          CRML   SCRBUF,WC   READ PIT INTO SCRATCH BUFFER

          LDML   SCRBUF+/PIT/P.PPNO  SAVE PP NUMBER
          STDL   PPNO

**        READ UNIT DESCRIPTOR TABLES.  NOTE - THIS IS
*         THE ONLY PLACE THE STATIC FIELDS OF THE UNIT DESCRIPTOR
*         TABLES ARE READ INTO THE PP.  IF THE UNIT DESCRIPTOR TABLES EVER
*         CONTAIN DYNAMIC FIELDS, THEY MUST BE READ IN WHEN LOOKING FOR UNIT
*         REQUESTS.  ONLY UNIT DESCRIPTORS THAT ARE NOT NULL ENTRIES ARE
*         SAVED IN THE PP COPY.

          LDK    UNITD       INITIALIZE CRML INSTRUCTION
          STML   INITA
          LDML   SCRBUF+/PIT/P.UNITC  GET NUMBER OF UNIT DESCRIPTORS
          STML   UNITC       SAVE IT
          STDL   T1
          ZJK    INIT60      IF NO UNITS DEFINED
          LDK    ZERO        INITIALIZE LOOP CONTROL
          STDL   T2          NUMBER OF NON-NULL UNIT DESCRIPTORS
          STDL   T3          PP WORD OFFSET INTO UNIT DESCRIPTORS
          STDL   T4          CM WORD OFFSET INTO UNIT DESCRIPTORS

 INIT30   LOADC  CM.PIT      LOAD R REGISTER FOR PIT
          ADN    C.PIT+1     ADVANCE TO START OF UNIT DESCRIPTORS +1
          ADDL   T4          CM WORD OFFSET OF CURRENT UD
          CRML   UNITD,ON    READ SECOND CM WORD OF UD ENTRY INTO PP
 INITA    EQU    *-1
          LDML   UNITD+/PUD/P.UQT,T3
          ADML   UNITD+/PUD/P.UQT+1,T3
          ZJN    INIT40      IF DUMMY ENTRY, DO NOT COUNT
          AODL   T2          INCREMENT COUNT OF ACTIVE UNITS
          SBN    16
          ZJN    INIT50      IF REACHED MAX TABLE SPACE FOR UDS
          LDK    P.PUD       INCREMENT TO NEXT PUD
          RADL   T3
          LDK    P.PUD
          RAML   INITA

 INIT40   LDK    C.UD        INCREMENT TO NEXT CM UD
          RADL   T4
          SODL   T1          DECREMENT TOTAL UNITS IN PIT
          NJN    INIT30      IF NOT DONE SCANNING UD TABLES

 INIT50   LDDL   T2          RESET NUMBER OF ACTIVE UNITS
          STML   UNITC

**        REFORMAT ADDRESS OF RESPONSE BUFFER.
*         INITIALIZE LIM.

 INIT60   REFAD  SCRBUF+/PIT/P.RSBUF,CM.RS  REFORMAT ADDRESS OF RESP BUFFER
          LDML   SCRBUF+/PIT/P.LIMIT  GET LIMIT OF RESPONSE BUFFER
          STDL   LIM

**        REFORMAT ADDRESS OF THE INTERRUPT WORD.

          REFAD  SCRBUF+/PIT/P.INT,CM.INT

**        REFORMAT ADDRESS OF CHANNEL TABLE.

          REFAD  SCRBUF+/PIT/P.CHAN,CM.CHAN

**        REFORMAT ADDRESS OF PP COMMUNICATION BUFFER.

          REFAD  SCRBUF+/PIT/P.CBUF,CM.COM

**        CHECK FOR DUAL PP.

          CRDL   T1          READ FIRST WORD OF COMM. BUFFER
          LDDL   T3          CHECK IF RMA FIELD NON-ZERO
          ADDL   T4
          ZJK    INIT200     IF NO RMA, THIS IS SINGLE PP ERROR
          LDDL   T2          CHECK IF SLAVE BIT IS SET
          LPK    /CB/K.SLAVE
          ZJK    INIT80      IF THIS PP IS THE MASTER PP

**        INITIALIZE DRIVER FOR SLAVE.

          LDK    0#4453      ID = DS (DUAL SLAVE)
          STDL   ID
          LDK    C.PIT       LENGTH OF PP INTERFACE TABLE
          STDL   WC
          REFAD  T3,CM.PIT   SET UP CM.PIT - CM.PIT+2
          CRML   SCRBUF,WC   READ MASTER PIT
          REFAD  SCRBUF+/PIT/P.CBUF,CM.COM  USE MASTER PP COMM. BUFFER

**        CLEAR SLAVE CODE OVERLAY AREA.

          LDK    ESCOBUF+4-BSCOBUF
          STDL   T1          SET INDEX

 INIT70   LDK    ZERO        CLEAR OVERLAY WORD
          STML   BSCOBUF,T1
          SODL   T1          CHECK FOR DONE
          PJN    INIT70      IF NOT LOOP

**        LOAD AND EXECUTE SLAVE CODE.

          LOADOVL SCO        LOAD SLAVE OVERLAY
          UJK    SMAIN       EXECUTE SLAVE MAIN LOOP

**        INITIALIZE DRIVER FOR MASTER PP.

 INIT80   STDL   IDLFLG      CLEAR THE IDLE FLAG
          LDK    0#444D      ID = DM (DUAL MASTER)
          STDL   ID
          LDK    HNDSHK      WAIT FOR SLAVE PP READY
          RJM    SENCOM      SEND HANDSHAKE COMMAND
          RJM    WSC         WAIT FOR SLAVE TO COMPLETE

**        INITIALIZE CHANNEL INSTRUCTIONS.

          LDML   UNITC
          ZJK    INIT130     IF NO ACTIVE UNITS DEFINED
          LDML   UNITD+/PUD/P.CHAN  OBTAIN PRESENT CHANNEL NUMBER
          SHN    -8
          STML   CURCH
          STML   NCHANC+3    SET SLAVE CHANNEL NUMBER
          LDK    NCHANC
          RJM    SENCOM      SEND SLAVE CHANNEL COMMAND
          LDK    CONCHM      MODIFY MASTER PP  CHANNEL INSTRUCTIONS
          RJM    CHGCH
          LDK    CONCHC      MODIFY COMMON CHANNEL INSTRUCTIONS
          RJM    CHGCH
          RJM    WSC         WAIT FOR SLAVE TO COMPLETE

**        LOCK CHANNEL IN CHANNEL INTERLOCK TABLE.

 INIT90   LDN    CHLK        SET CHANNEL LOCKWORD
          RJM    SCLK
          NJN    INIT90      IF CHANNEL LOCK NOT OBTAINED
          AODL   CHLOCK      SET CHANNEL CURRENTLY LOCKED

**        INITIALIZE CHANNEL.

          LOADC  CM.CHAN     DETERMINE CHANNEL TYPE
          ADK    32          INDEX TO CHANNEL CHARACTERISTICS OF CHANNEL TABLE
          ADML   CURCH       CURRENT CHANNEL NUMBER
          CRDL   T1
          LDDL   T1
          SHN    15          POSITION AS LEAST SIGNIFICANT BIT
          LPN    1           MASK IT
          STDL   CHTYPE      SAVE IT, 0=NIO  1=CIO
          RJM    INICH       INITIALIZE THE CHANNEL
          NJK    INIT300     IF ERROR

**        CHECK UNIT TYPE.

          LOADF  UNITD+/PUD/P.UQT  REFORMAT RMA OF FIRST UIT
          CRML   UITHDR,ON   GET FIRST WORD OF UIT
          LDML   UITHDR+/UIT/P.UTYPE  CHECK UNIT TYPE
          SBN    T5680
          NJK    INIT400     IF WRONG UNIT TYPE
          LDN    1           SET LOAD MICROCODE FLAG
          STDL   LMCFLG

**        CHECK PP COMMUNICATIONS BUFFER LENGTH.

 INIT130  LOADC  CM.PIT      LOAD R AND A FOR PIT
          ADN    /PIT/C.CBUFL  OFFSET TO COMM BUFFER LENGTH
          CRDL   T1          GET THE LENGTH
          LDDL   T2
          ADC    -B.CB       CHECK THE LENGTH
          MJK    INIT500     IF ERROR

**        CHECK UNIT COMMUNICATIONS BUFFER LENGTHS

          LDML   UNITC       GET NUMBER OF ACTIVE UNITS
          STDL   T3          SAVE IT FOR LOOP CONTROL
          LDK    UNITD+/PUD/P.UQT  GET UIT RMA ADDRESS
          STDL   T4

 INIT140  SODL   T3          DECREMENT LOOP COUNT
          MJN    INIT160     IF DONE
          LOADF  0,T4        REFORMAT UIT RMA
          CRML   UITHDR,TW   READ THE UIT HEADER  2 CM WORDS
          LDML   UITHDR+/UIT/P.UBUFL  GET THE BUFFER LENGTH
          ADC    -B.UCA      CHECK THE LENGTH
          MJK    INIT500     IF ERROR
          LDK    P.PUD       INCREMENT RMA ADDRESS POINTER
          RADL   T4
          UJN    INIT140     LOOP

**        INITIALIZE PP COMMUNICATIONS BUFFER.

 INIT160  LDK    ZERO        ZERO OUT *ZEROES* FIELD IN COMM. BUFFER
          STDL   T1
          STDL   T2
          STDL   T3
          STDL   T4
          LDK    /CB/B.ZEROES  LENGTH OF ZERO AREA IN BYTES
          SHN    -3
          STDL   T5          LENGTH OF ZERO AREA IN CM WORDS

 INIT170  LOADC  CM.COM      LOAD R AND A OF COMMUNICATION BUFFER
          ADN    /CB/C.ZEROES-1
          ADDL   T5
          CWDL   T1          ZERO ONE CM WORD
          SODL   T5          DECREMENT INDEX
          NJN    INIT170     IF MORE CM WORDS TO CLEAR

**        INITIALIZE SCRBUF.
          LDK    P.PIT-1     WORD COUNT-1 TO CLEAR
          STDL   T5          SET INDEX

 INIT180  LDN    0           CLEAR SCRBUF
          STML   SCRBUF,T5
          SODL   T5          CHECK FOR DONE
          PJN    INIT180     IF NOT  LOOP
          UJK    INITOX      RETURN TO CALLER

**        PROCESS INITIALIZATION ERRORS.

*         PROCESS SINGLE PP INTERFACE ERROR
 INIT200  LDK    REISPP      SET RESPONSE ERROR ID
          UJN    INIT600     CONTINUE

*         PROCESS CHANNEL INITIALIZATION ERROR
 INIT300  STML   RESBUF+/RS/P.GS1  SAVE ERROR STATUS
          LDN    0           CLEAR GS2
          STML   RESBUF+/RS/P.GS2
          LDK    REIMLE      SET RESPONSE ERROR ID
          STML   RESBUF+/RS/P.REID
          LDK    /RS/K.HDWR  SET HARDWARE MALFUNCTION
          STML   RESBUF+/RS/P.HDWR
          UJN    INIT610     CONTINUE

*         PROCESS WRONG UNIT TYPE INTERFACE ERROR
 INIT400  LDK    REIWUT      SET RESPONSE ERROR ID
          UJN    INIT600     CONTINUE

*         PROCESS BUFFER LENGTH ERROR
 INIT500  LDK    REIBLE      SET RESPONSE ERROR ID

 INIT600  STML   RESBUF+/RS/P.REID
          LDK    /RS/K.INTERR  SET INTERFACE ERROR
          STML   RESBUF+/RS/P.ABALRT
          STDL   IDLFLG      FORCE THE PP TO IDLE STATE

 INIT610  LDK    R.UNS       SET UNSOLICITED RESPONSE CODE
          STML   RESBUF+/RS/P.RC
          LDK    NORMRES     SET RESPONSE LENGTH
          STML   RESBUF+/RS/P.RESPL
          RJM    RESP        SEND THE RESPONSE
          UJK    INIT160     CONTINUE
          SPACE  5,10
 CONCHI   BSS    0           INITIALIZATION CHANNEL INSTRUCTION TABLE
 TTP+40B  HERE
 T40B+TP  HERE
 TTP      HERE

*         CHECK IF THERE ARE ANY I/O INSTRUCTIONS.
          ERRNZ  *-CONCHI
          SPACE  2
*         CHECK IF OVERLAY EXCEEDS THE OVERLAY BUFFER.
          ERRPL  *-DIOBUF
          OVERLAY (LOAD MICROCODE),OVLBUF
          ROUTINE LMO        LOAD MICROCODE OVERLAY
** NAME - LMCO
*
** PURPOSE - LOAD MICROCODE OVERLAY.
*
** EXIT - IF MICROCODE LOADED OK THEN AN UNSOLICITED RESPONSE IS SENT.
*         IF ERROR IN LOADING MICROCODE AN UNSOLICITED RESPONSE WILL
*         ONLY BE SENT WHEN (LMCRC) = 0.
*
*         A = GS1 STATUS.
*
** NOTE - THE FOLLOWING CODES CAN BE IN GS1 OF THE RESPONSE.
*               7777B AUTOLOAD FUNCTION TIMEOUT.
*               7776B OUTPUT CHANNEL ERROR FLAG SET.
*               7775B INPUT CHANNEL ERROR FLAG SET.
*               7772B STATUS FUNCTION TIMEOUT.
*               7771B INCOMPLETE TRANSFER DURING AUTOLOAD.
*               5XXXB AUTOLOAD ERROR CODE.
*               1XXXB NORMAL AUTOLOAD STATUS.
*
          SPACE  2
 LMCO     SUBR               OVERLAY ENTRY/EXIT

**        READ UP CONTROLWARE LOAD COMMAND
*         (LENGTH AND RMA OF CONTROLWARE ADDRESS/LENGTH PAIRS).

 LMC10    LOADC  CM.COM      LOAD R AND A OF PP COMMUNICATION BUFFER
          ADN    /CB/C.CONTRL  ADD CONTROLWARE POINTER OFFSET
          CRML   CNTCMDW,ON  NOW HAVE LENGTH AND PTR TO ADDRESS/PAIR LIST
          LDML   CNTCMDW
          SHN    -10
          LMN    3
          NJN    LMC10       IF CONTROLWARE LIST NOT READY YET
          STDL   CONFLG      CLEAR THE CONNECT FLAG
          DCN    40B+TP      DEACTIVATE CHANNEL
          SFM    *+2,TP      CLEAR CHANNEL ERROR FLAG

**        SEND AUTOLOAD FUNCTION AND ACTIVATE CHANNEL.

          LDK    F.MC        AUTOLOAD FUNCTION
          STML   RESBUF+/RS/P.LSTF  SAVE AS LAST FUNCTION
          STML   RESBUF+/RS/P.LSTNSF  SAVE AS LAST NON STATUS FUNCTION
          FAN    TP          SEND FUNCTION
          LCN    ZERO
          SFM    LMC150,TP   CHECK AND CLEAR CHANNEL ERROR FLAG

 LMC20    IJM    LMC30,TP    WAIT FOR INACTIVE RESPONSE
          SBN    1           DECREMENT COUNTER
          NJN    LMC20       IF TIMEOUT NOT EXPIRED
          DCN    TP+40B      DISCONNECT CHANNEL
          LDK    7777B       SET CCC AUTOLOAD TIMEOUT CODE
          LJM    LMC200      REPORT STATUS IN UNSOLICITED RESPONSE

 LMC30    ACN    TP

**        DOWNLOAD THE MICROCODE.

          LOADF  CNTCMDW+/CM/P.RMA  REFORMAT ADDRESS TO CURRENT PAIR
          CRML   CURPAIR,ON
          LOADF  CURPAIR+/CM/P.RMA
          LDML   CURPAIR+/CM/P.LEN
          ADN    7
          SHN    -3
          STML   WCT         ASSURE CM WORD BOUNDARY
          ZJK    LMC110      **MAYBE ISSUE ERROR

 LMC40    LDML   WCT
          SBN    60          PRESENTLY USE 60 CM BUFFER (240 PP WORDS)
          MJN    LMC60       IF WCT LESS THAN 60 CM BUFFER
          LDK    60
          STDL   WC
          LDML   WCT
          SBDL   WC
          STML   WCT         SET REMAINING WORD COUNT
          LDDL   CMADR+2     SET THE A REGISTER FOR CM ADDRESS OF DATA
          LMC    400000B
          CRML   CNTLBUF,WC
          STDL   CMADR+2     UPDATE ADDRESS TO NEXT DATA
          LDDL   WC

 LMC50    SHN    3
          STDL   BYTCNT      SET BYTE COUNT FOR THIS TRANSFER
          RJM    CBYTE       SET CHANNEL BYTES FOR BYTES IN BUFFER
          LDDL   IOCNT       SET NUMBER OF CHANNEL WORD TO OUTPUT
          OAPM   CNTLBUF,TP  OUTPUT TO CCC ADAPTER
          FJM    *,TP        WAIT TILL LAST WORD TAKEN THIS TRANSFER
          NJK    LMC180      IF NON-ZERO RESIDUAL WORD COUNT
          UJN    LMC40       IF MORE DATA THIS ADDRESS LIST

 LMC60    LDML   WCT
          STDL   WC          SET WC FOR REMAINING WC THIS ADDRESS
          STML   LASTWCT     SAVE THIS AS LAST WORD COUNT
          ZJN    LMC70       IF NO REMAINDER THIS ADDRESS BLOCK
          LDDL   CMADR+2     SET ADDRESS TO INPUT REMAINDER
          LMC    400000B
          CRML   CNTLBUF,WC

 LMC70    LDML   CNTCMDW+/CM/P.LEN  DECREMENT ADDRESS PAIR COUNT
          SBN    8
          ZJK    LMC100             IF NO MORE ADDRESS WITH DATA
          STML   CNTCMDW+/CM/P.LEN  SAVE REMAINING LENGTH
          LDK    8
          RAML   CNTCMDW+/CM/P.RMA+1  UPDATE ADDRESS TO NEXT DATA AREA
          SHN    -16
          RAML   CNTCMDW+/CM/P.RMA
          LOADF  CNTCMDW+/CM/P.RMA  READ UP NEXT CURRENT PAIR
          CRML   CURPAIR,ON
          LOADF  CURPAIR+/CM/P.RMA  SET THE R REGISTER FOR CURRENT PAIR
          LDML   CURPAIR+/CM/P.LEN
          ZJK    LMC90       IF END OF LIST (SEND REMAINDER)
          ADN    7
          SHN    -3
          STML   WCT         SAVE TOTAL CM WORD COUNT THIS ADDRESS
          LDML   LASTWCT
          SHN    2           SET NUMBER PP BYTES IN LAST TRANSFER
          ADC    CNTLBUF     ADDRESS OF START OF BUFFER
          STML   LMCB        RESET CM ADDRESS WHERE TO INPUT DATA
          LDK    60
          SBML   LASTWCT     SET TO INPUT REMAINDER OF BUFFER
          STDL   WC          SET THIS TRANSFER LENGTH
          LDDL   CMADR+2     SET THE A REGISTER FOR CM ADDRESS
          LMC    400000B
          CRML   CNTLBUF,WC  FILL REMAINDER OF BUFFER
 LMCB     EQU    *-1
          STDL   CMADR+2     UPDATE TO NEXT DATA ADDRESS
          LDML   WCT         SET REMAINING WORD COUNT THIS BUFFER
          SBDL   WC
          MJN    LMC80       IF THIS BUFFER IS NOW EMPTY
          STML   WCT
          LDK    60          OUTPUT FULL BUFFER
          UJK    LMC50       ENTER LOOP TO GET/SEND CONTROLWARE

 LMC80    LDML   LASTWCT     SET REMAINING WORD COUNT TO OUTPUT
          ADML   WCT
          STDL   WC
          UJN    LMC100      OUTPUT FINAL DATA

 LMC90    LDML   LASTWCT     MUST SEND REMAINING DATA
          STDL   WC

 LMC100   LDDL   WC          MUST OUTPUT FINAL DATA
          ZJN    LMC110      IF LAST ADDRESS CONTAINED FINAL DATA
          SHN    3           SET NUMBER OF BYTES
          STDL   BYTCNT
          RJM    CBYTE       SET CHANNEL WORDS FOR BYTE COUNT GIVEN
          LDDL   IOCNT       PICK UP NUMBER OF 12 BIT CHANNEL WORDS
          OAPM   CNTLBUF,TP
          FJM    *,TP        WAIT FINAL WORD OFF CHANNEL
          NJN    LMC180      PROCESS NON-ZERO RESIDUAL WORD COUNT

**        GET COUPLER STATUS.

 LMC110   DCN    40B+TP
          SFM    LMC150,TP   CHECK AND CLEAR CHANNEL ERROR FLAG
          LDK    F.GS        ISSUE STATUS FUNCTION
          STML   RESBUF+/RS/P.LSTF  SAVE AS LAST FUNCTION
          FAN    TP
          LCN    ZERO
          SFM    LMC150,TP   CHECK AND CLEAR CHANNEL ERROR FLAG

 LMC120   IJM    LMC130,TP   TIMEOUT WAITING FOR STATUS
          SBN    1
          NJN    LMC120      IF TIMEOUT NOT COMPLETE
          UJN    LMC170      PROCESS FUNCTION TIMEOUT

 LMC130   ACN    TP
          IAN    TP          INPUT GENERAL STATUS
          SFM    LMC160,TP   CHECK AND CLEAR CHANNEL ERROR FLAG
          UJN    LMC200      SEND RESPONSE

*         PROCESS ERRORS

 LMC150   LDK    7776B       REPORT OUTPUT CHANNEL ERROR FLAG
          UJN    LMC200      CONTINUE

 LMC160   LDK    7775B       REPORT INPUT CHANNEL ERROR FLAG
          UJN    LMC200      CONTINUE

 LMC170   LDK    7772B       REPORT STATUS FUNCTION TIMEOUT
          UJN    LMC200      CONTINUE

 LMC180   LDK    7771B       REPORT INCOMPLETE TRANSFER ERROR

*         PREPARE AND SEND THE UNSOLICITED RESPONSE.

 LMC200   STML   LMCA        SAVE STATUS
          DCN    40B+TP      DEACTIVATE CHANNEL
          CFM    *+2,TP      CLEAR CHANNEL ERROR FLAG IF SET

          LDN    NORMRES/2   CLEAR RESPONSE BUFFER
          STDL   WC          NORMAL RESPONSE BUFFER LENGTH

 LMC210   LDN    0           CLEAR RESPONSE BUFFER WORD
          STML   RESBUF,WC
          SODL   WC          CHECK IF DONE
          PJN    LMC210      IF NOT  LOOP

          LDML   LMCA        GET SAVED STATUS
          STML   RESBUF+/RS/P.GS1  PUT IT INTO THE RESPONSE
          SHN    -9          CHECK IF ERROR STATUS
          SBN    1
          ZJN    LMC220      IF GOOD STATUS
          LDML   LMCRC       CHECK IF LAST RETRY
          NJN    LMC230      IF NOT LAST ONE
          LDK    REIMLE      SET RESPONSE ERROR ID
          STML   RESBUF+/RS/P.REID
          LDK    /RS/K.HDWR  SET HARDWARE ERROR
          STML   RESBUF+/RS/P.HDWR
          RJM    GETHSC      GET HARDWARE STATUS CHANNEL
          CFM    *+2,TP      CLEAR CHANNEL ERROR FLAG

 LMC220   LDK    R.UNS       SET UNSOLICITED RESPONSE CODE
          STML   RESBUF+/RS/P.RC
          LDK    NORMRES     SET RESPONSE LENGTH
          STML   RESBUF+/RS/P.RESPL
          RJM    RESP        SEND THE RESPONSE

 LMC230   LDN    0
          STDL   LMCFLG      CLEAR LOAD MICROCODE FLAG
          STDL   CONFLG      CLEAR UNIT CONNECTED FLAG
          LDML   LMCA        GET FINAL STATUS
          UJK    LMCOX       RETURN
          SPACE  2
*         WORKING MEMORY.
 LMCA     CON    0           SAVED STATUS

 WCT      CON    0

 LASTWCT  CON    4567B

 CNTCMDW  BSSZ   4           SECOND WORD OF PP COMM. BUFFER

 CURPAIR  BSSZ   4           LENGTH/ADDRESS FOR CTS/CCC CONTROLWARE
          SPACE  5,10
 CONCHL   BSS    0           LOAD MICROCODE CHANNEL INSTRUCTION TABLE
 TTP+40B  HERE
 T40B+TP  HERE
 TTP      HERE
          CON    0           END OF TABLE
          SPACE  2
*         CHECK IF OVERLAY EXCEEDS THE OVERLAY BUFFER.
          ERRPL  *-DIOBUF
          OVERLAY (SLAVE CODE),BSCOBUF
          ROUTINE SCO        SLAVE CODE OVERLAY
          SPACE  4
*         CHECK IF SLAVE OVERLAY STARTS AT MAIN IDLE.
          ERRNZ  MAIN-*
          SPACE  4
** NAME - SMAIN
*
** PURPOSE - SLAVE PP DRIVER MAIN IDLE LOOP.
*
          SPACE  2
 SMAIN    BSS                ENTRY
          RJM    SREQ        CHECK FOR SLAVE REQUEST
          NJN    SMAIN20     REQUEST FOUND
          LDK    50

 SMAIN10  SBN    1           WAIT AWHILE
          NJN    SMAIN10
          UJN    SMAIN       GO CHECK FOR REQUEST

 SMAIN20  RJM    SIBUF       INITIALIZE THE BUFFERS
          RJM    SDORQ       DO THE SLAVE REQUEST
          RJM    SIODNE      TERMINATE REQUEST
          SCF    *+2,TP      SET THE CHANNEL FLAG WHEN DONE
          UJN    SMAIN       SLAVE MAIN LOOP
          EJECT
** NAME - SDORQ  (SLAVE ONLY)
*
** PURPOSE - PERFORM THE REQUIRED SLAVE REQUEST.
*
** INPUT - REQUEST IN REQBUF.
*
** OUTPUT - REQUEST PROCESSED.
*
          SPACE  2
 SDORQ10  RJM    SOUT        OUTPUT 8-BIT DATA

 SDORQ    SUBR               ENTRY/EXIT

          LDK    ZERO        CLEAR THE SLAVE RESPONSE WORDS
          STDL   P1
          STDL   P2
          STDL   P3
          STDL   P4
          STDL   LONG        CLEAR LONG INPUT BLOCK FLAG
          LDML   CMDBUF      GET COMMAND AND FLAGS
          SHN    -8
          SBN    PWRTCMD
          ZJN    SDORQ10     IF OUTPUT 8-BIT DATA
          SBN    LCREAD-PWRTCMD
          NJN    SDORQ20     IF NOT LOGICAL READ, NON-SUPPORTED COMMAND
          RJM    SIN         INPUT 8-BIT DATA
          UJK    SDORQX      EXIT

 SDORQ20  LDK    REINSC      SET SLAVE ERROR, NON-SUPPORTED COMMAND
          UJN    SERR10      CONTINUE
          EJECT
**  NAME - SFLGERR  (SLAVE ONLY)
*
**  PURPOSE - PROCESS SLAVE DETECTED FLAG ERRORS.
*
**  INPUT - CHANNEL FLAG DETECTED IN WRONG STATE.
*
**  OUTPUT - SLAVE ERROR RESPONSE SENT TO THE MASTER.
*
          SPACE  2
 SFLGERR  BSS                ENTRY

          LDK    REIFE       SET FLAG ERROR

 SERR10   STDL   P1          STORE ERROR CODE
          RJM    SIODNE      SEND RESPONSE
          DCN    40B+TP      DEACTIVATE CHANNEL
          SCF    *+2,TP      SET THE CHANNEL FLAG WHEN DONE
          UJK    SMAIN       GO TO SLAVE MAIN LOOP
          EJECT
**  NAME - SIBUF  (SLAVE ONLY)
*
**  PURPOSE - ESTABLISH THE VALUES THAT WILL BE USED BY THE
*             GETCM AND GETBL SUBROUTINES.
*
**  INPUT - REQUEST IN REQBUF.
*
**  OUTPUT - SPACE = THE AMOUNT OF SPACE LEFT IN THE CURRENT CM
*                    BUFFER.
*            CBUFRMA = THE RMA OF THE CURRENT BUFFER.
*            NBUFRMA = THE RMA OF THE NEXT BUFFER.
*            BUFLSTPT = THE RMA POINTER TO THE CM ADDRESS OF THE LAST
*                      LENGTH/ADDRESS PAIR CURRENTLY IN PP MEMORY.
*            NUMBUF = THE NUMBER OF LENGTH/ADDRESS PAIRS ASSOCIATED
*                     WITH THIS COMMAND.
*
          SPACE  2

 SIBUF    SUBR               ENTRY/EXIT

          LDK    ZERO        INITIALIZE SOME FLAGS
          STML   EODATA
          STML   ENTHERE
          STML   NADAMAS
          LDK    DUALBUFL*2  INITIALIZE SHORT BYTE COUNT
          STML   SHBYTEC
          LDK    CMDBUF      SET UP POINTER TO COMMAND
          STDL   T4          THIS POINTS TO A INPUT OR OUTPUT COMMAND
          LDIL   T4          GET COMMAND AND FLAGS
          LPC    INDFLG      GET THE INDIRECT FLAG (BIT 6)
          NJN    SIBUF10     READ INDIRECT LIST
          LDML   2,T4        THERE IS ONLY ONE BUFFER
          STML   CBUFRMA     POINT TO THE BUFFER
          LDML   3,T4        RMA'S ARE 2 PP WORDS LONG
          STML   CBUFRMA+1   STORE BOTH HALVES
          LDML   1,T4        GET THE LENGTH
          STML   SPACE       STORE IT AWAY FOR FUTURE USE
          LDK    ZERO        NUMBER OF BUFFERS - 1
          STML   NUMBUF      SET THE BUFFER COUNT
          UJN    SIBUF20

 SIBUF10  LDML   1,T4        NUMBER OF LENGTH - ADDRESS PAIRS
          SHN    -3          DIVIDE BY 8
          SBN    1
          STML   NUMBUF
          LOADF  2,T4        SET UP ADDRESS OF THE INDIRECT LIST

**        READ THE FIRST TWO LENGTH/ADDRESS PAIRS.
*
**        NOTE - CBUFRMA IS EQUATED TO INDLST+6.
*                SPACE IS EQUATED TO INDLST+5.

          CRML   INDLST+4,TW  READ THE FIRST TWO LENGTH/ADDRESS PAIRS
          LDML   2,T4        INITIALIZE BUFLSTPT WITH SECOND L/A PAIR
          STML   BUFLSTPT
          LDML   3,T4
          ADN    10B
          STML   BUFLSTPT+1
          SHN    -16
          RAML   BUFLSTPT

 SIBUF20  LDK    -DUALBUFL*2    WILL THE SLAVE START IN THE FIRST BUFFER
          RAML   SPACE       ADJUST SPACE (IN BYTES) LEFT THIS BUFFER
          ZJN    SIBUF40     MUST START IN NEXT BUFFER
          MJN    SIBUF40     DITTO
          LDK    DUALBUFL*2  BEGINNING OFFSET

 SIBUF30  RAML   CBUFRMA+1   ADJUST THE RMA
          SHN    -16
          RAML   CBUFRMA     TAKE CARE OF OVERFLOW
          UJK    SIBUFX      EXIT

 SIBUF40  LDML   SPACE       SLAVE STARTS IN SECOND BUFFER
          ZJN    SIBUF50     IF COULD BE ZERO - SPECIAL CASE
          LMC    177777B     COMPLEMENT THE NUMBER

 SIBUF50  STDL   T5          OFFSET INTO SECOND BUFFER
          LDML   NUMBUF      CHECK NUMBER OF RMA LIST ENTRIES
          NJN    SIBUF60     IF MORE THAN ONE RMA INDIRECT LIST ENTRY
          STML   SPACE       SET NO BUFFER SPACE FOR THIS PP
          UJK    SIBUFX      EXIT

 SIBUF60  LDML   INDLST+8    MOVE LENGTH/ADDRESS PAIR TO CURRENT
          STML   INDLST+4      L/A PAIR
          LDML   INDLST+9
          STML   INDLST+5
          LDML   INDLST+10
          STML   INDLST+6
          LDML   INDLST+11
          STML   INDLST+7
          RJM    GNEWPR      GET NEXT LENGTH/ADDRESS PAIR
          LDML   SPACE       ADJUST SPACE IN THIS BUFFER
          SBDL   T5
          PJN    SIBUF70     IF ENOUGH SPACE FOR MASTER TO FILL
          LDK    ZERO        SET NO BUFFER SPACE FOR THIS PP

 SIBUF70  STML   SPACE
          LDDL   T5          SPACE MASTER WILL USE IN SECOND BUFFER
          UJK    SIBUF30     FINISH UP
          EJECT
** NAME - SIN  (SLAVE ONLY)
*
** PURPOSE - TO PERFORM THE PHYSICAL COMMAND INPUT 8-BIT DATA/PARAMETERS.
*
** OUTPUT - COMMAND COMPLETED.
*
** NOTE - THE MASTER PP WILL CHECK THE CHANNEL ERROR FLAG.
*
          SPACE  2
 SIN      SUBR               ENTRY/EXIT

 SIN10    LDK    WDCOUNT     ALWAYS TRY TO READ A FULL BUFFER
          IJM    SIN40,TP    IF CHANNEL INACTIVE  (POSSIBLE RETRY)

 SIN20    FSJM   SIN20,TP    WAIT UNTIL FLAG IS CLEAR
          IAPM   DIOBUF,TP   INPUT DATA FROM TAPE
          SCF    SFLGERR,TP  SET THE FLAG - FIRE UP THE MASTER

          STDL   AREG        SAVE THE CONTENTS OF THE A REGISTER
          NJN    SIN30       PROCESS SHORT READ
          RJM    WRITCM      WRITE THE DATA TO CM
          LDK    DUALBUFL*2  UPDATE THE TRANSFER COUNT
          RADL   P4
          SHN    -16
          RADL   P3
          UJN    SIN10       DO IT ALL OVER AGAIN

 SIN30    LDK    WDCOUNT     COMPUTE THE ACTUAL BYTE COUNT
          SBDL   AREG        NUMBER OF 12 BIT CHANNEL WORDS MOVED
          STDL   T5          STORE THIS VALUE
          SHN    1           MULTIPLY BY 3/2 TO GET BYTE COUNT
          ADDL   T5
          SHN    -1          DONE - ROUNDED DOWN INTENTIONALLY
          STML   SHBYTEC     STORE BYTE COUNT FOR WRITCM ROUTINE
          ZJN    SIN40       IF COUNT = 0
          RADL   P4          UPDATE THE TRANSFER COUNT
          SHN    -16
          RADL   P3
          RJM    WRITCM      WRITE DATA TO CENTRAL

 SIN40    LDDL   LONG        SET LONG INPUT BLOCK INDICATOR FOR MASTER
          STDL   P2
          UJK    SINX        EXIT
          EJECT
** NAME - SIODNE  (SLAVE ONLY)
*
** PURPOSE - TO TERMINATE THE SLAVE REQUEST.
*
** OUTPUT - RESPONSE SENT TO THE MASTER PP.
*
** NOTE - ON READ  P1 = 00XX  XX=ERROR CODE IF ANY,
*                  P2 = XXXX  SLAVE LONG BLOCK FLAG,
*                  P3-P4 = TRANSFER COUNT.
*
*         ON WRITE P1 = 00XX  XX=ERROR CODE IF ANY,
*                  P2-P3 = NOT USED,
*                  P4 = XXXX RESIDUAL COUNT IF ANY.
*
*         OTHER    P1 = 00XX  XX=ERROR CODE IF ANY,
*                  P2-P4 = NOT USED.
*
          SPACE  2
 SIODNE   SUBR               ENTRY/EXIT

          LOADC  CM.COM      LOAD R AND A OF MASTER PP COMMUNICATION BUFFER
          ADN    /CB/C.COMM
          CWDL   P1          SEND SLAVE RESPONSE TO MASTER
          UJK    SIODNEX     EXIT
          EJECT
** NAME - SOUT  (SLAVE ONLY)
*
** PURPOSE - TO PERFORM THE PHYSICAL COMMAND OUTPUT 8-BIT DATA.
*
** OUTPUT - COMMAND COMPLETED.
*
** NOTE - THE MASTER PP WILL CHECK THE CHANNEL ERROR FLAG.
*
          SPACE  2
 SOUT     SUBR               ENTRY/EXIT

 SOUT10   RJM    GETCM       GET A BUFFER FULL
          LDDL   IOCNT       NUMBER OF 12 BIT CHANNEL WORDS
          IJM    SOUTX,TP    IF CHANNEL WENT INACTIVE  (POSSIBLE RETRY)

 SOUT20   FSJM   SOUT20,TP   WAIT UNTIL FLAG IS CLEAR
          OAPM   DIOBUF,TP   WRITE SOME TAPE
          SCF    SFLGERR,TP  SET THE CHANNEL FLAG TO START THE MASTER

          ZJN    SOUT30      IF NO RESIDUAL WORD COUNT LEFT
          STDL   P4          SAVE THE RESIDUAL FOR THE MASTER

 SOUT30   LDML   EODATA      END OF DATA FLAG (SET BY GETCM)
          ADML   ENTHERE     END IN PARTNER (SET IN BUMPIT)
          ZJN    SOUT10      IF NOT COMPLETE
          UJK    SOUTX       EXIT
          EJECT
** NAME - SREQ  (SLAVE ONLY)
*
** PURPOSE - CHECK FOR SLAVE REQUEST FROM MASTER PP.
*
** OUTPUT - A = 0  NO REQUEST.
*         - A .NE. 0  REQUEST IN CMDBUF.
*
          SPACE  2
 SREQ     SUBR               ENTRY/EXIT

          LOADC  CM.COM      LOAD R AND A OF MASTER PP COMMUNICATION BUFFER
          ADN    /CB/C.COMM
          CRML   CMDBUF,ON
          LDML   CMDBUF      CHECK FOR COMMAND
          SHN    -8          LOOK AT THE COMMAND
          ZJN    SREQX       IF NO COMMAND - EXIT
          ADC    -NCCOMD     CHECK FOR CHANGE CHANNEL COMMAND
          NJN    SREQ10      NOT CHANGE CHANNEL
          LDML   CMDBUF+3    SAVE NEW CHANNEL NUMBER
          STML   CURCH
          LDK    CONCHS      MODIFY SLAVE CHANNEL INSTRUCTIONS
          RJM    CHGCH
          LDK    CONCHC      MODIFY COMMON CHANNEL INSTRUCTIONS
          RJM    CHGCH
          UJN    SREQ20      COMPLETE REQUEST

 SREQ10   ADC    NCCOMD-HSHAKC  CHECK FOR THE HANDSHAKE COMMAND
          NJN    SREQX       NOT A HANDSHAKE - MUST BE DATA MOVE

 SREQ20   LDK    ZERO        SET COMMAND PROCESSED
          STDL   P1
          RJM    SIODNE      SEND SLAVE RESPONSE
          LDK    ZERO        SET NO COMMAND TO PROCESS
          UJK    SREQX       EXIT
          SPACE  4
 CONCHS   BSS                SLAVE CHANNEL INSTRUCTION TABLE
 TTP+40B  HERE
 T40B+TP  HERE
 TTP      HERE
          CON    0           END OF TABLE
          SPACE  4
*         CHECK IF OVERLAY EXCEEDS SLAVE OVERLAY BUFFER.
          ERRPL  *-ESCOBUF
          OVERLAY (WRITE FAILURE),OVLBUF
          ROUTINE WFO        WRITE FAILURE OVERLAY
          SPACE  4
** NAME - WFAILO
*
** PURPOSE - PROCESS ABNORMAL WRITE REQUEST COMPLETION.
*
** INPUT - (CHKWRTF) = 0, REQUEST WAS IN PROGRESS WHEN FAILURE OCCURED,
*                         (ACTCNT) = IF NZ ANY PREVIOUS REQUESTS IN UCA.
*
*          (CHKWRTF) =NZ, POST REQUEST PROCESSING DETECTED THE ERROR,
*                         (ACTCNT) = NUMBER OF ACTIVE REQUESTS IN UCA.
*
** PROCESSING - THE FOLLOWING ERRORS ARE PROCESSED IN THE ORDER LISTED.
*
*         1. CATASTROPHIC ERRORS -
*                CAUSED BY - RESPONSE ERROR ID
*                            OR ADAPTER CHECK
*                            OR ADAPTER ERROR CODE (EC33 IGNORED UP TO LIMIT)
*                            OR NOTHING SET IN ABNORMAL STATUS FIELD
*                            OR ALERT ON RETURN FROM GETBID FROM WFAILO.
*                ACTION    - DELINK AND SEND ABNORMAL RESPONSE TO THE FIRST
*                            REQUEST WITH THE FIRST COMMAND RMA SET AS THE
*                            FAILING COMMAND.
*                (LGBID)   = 0000 0000.
*
*         2. ABNORMAL ALERT (EOT) ONLY -
*                CAUSED BY - ABNORMAL ALERT BIT IN ABNORMAL STATUS FIELD
*                            IS THE ONLY BIT SET.
*                ACTION    - DELINK AND SEND NORMAL RESPONSES TO ANY
*                            COMPLETED REQUESTS.
*                            DELINK AND SEND ABNORMAL RESPONSE TO THE REQUEST
*                            IN ERROR WITH THE COMMAND RMA THAT DETECTED EOT
*                            AS THE FAILING COMMAND.
*                NOTE      - EOT IS NEVER DETECTED IN POST REQUEST PROCESSING,
*                            THE (LGBID) IS SET BY ROUTINE FAIL20.
*                (LGBID)   = SET TO THE END OF THE RECORD THAT DETECTED EOT.
*
*         3. HARDWARE ERROR (UNIT CHECK) -
*                CAUSED BY - HARDWARE ERROR STATUS IN ABNORMAL STATUS FIELD
*                            AND GENERAL STATUS UNIT CHECK IS SET
*                            AND SENSE BYTE DATA CHECK IS SET
*                            AND SENSE BYTE ERPA EQUAL NONZERO
*                            AND BLOCK ID POSITIONING INDICIATOR IS NOT SET.
*                ACTION    - DELINK AND SEND NORMAL RESPONSES TO ANY
*                            COMPLETED REQUESTS.
*                            DELINK AND SEND ABNORMAL RESPONSE TO THE REQUEST
*                            IN ERROR WITH THE COMMAND RMA THAT CAUSED THE
*                            ERROR AS THE FAILING COMMAND.
*                (LGBID)   = TAPE POSITION BLOCK ID FROM READ BLOCK ID COMMAND.
*
*         4. NONE OF THE ABOVE -
*                ACTION    - FORCE CATASTROPHIC ERROR, SEE ABOVE.
*
          SPACE  2
 WFAILO   SUBR               OVERLAY ENTRY/EXIT

*         CHECK FOR CATASTROPHIC ERRORS.
          LDML   RESBUF+/RS/P.REID  CHECK RESPONSE ERROR ID
          NJN    WFAIL20     IF YES
          LDML   RESBUF+/RS/P.GS2  CHECK ADAPTER CHECK AND ERROR CODE
          LPK    /RS/K.ADPTC+/RS/M.EC
          NJN    WFAIL10     IF YES
          LDML   RESBUF+/RS/P.ABALRT  CHECK ABNORMAL STATUS
          NJN    WFAIL30     IF SOMETHING IS ALREADY SET
          LCN    1           ELSE FORCE A CATASTROPHIC ERROR
          UJN    WFAIL20     CONTINUE

*         CHECK FOR AND PROCESS CONTROL UNIT BUSY.
 WFAIL10  LPK    /RS/M.EC    MASK ONLY THE ERROR CODE
          SBN    EC33        CHECK FOR ERROR CODE 33
          NJN    WFAIL15     IF NOT
          LDDL   CONFLG      GET THE UNIT NUMBER
          LPN    17B
          STDL   T1          SET AN INDEX
          AOML   SCRBUF+8,T1  INCREMENT UNIT BUSY COUNTER
          SHN    1           POSITION CARRY BIT
          PJN    WFAILOX     IF NOT EXCEEDED  RETURN

 WFAIL15  LDML   RESBUF+/RS/P.GS2  SET CATASTROPHIC ERROR
          LPK    /RS/K.ADPTC+/RS/M.EC

 WFAIL20  STML   WFCE        SET CATASTROPHIC ERROR FLAG
          UJK    WFAIL60     CONTINUE

*         CHECK FOR ABNORMAL ALERT ( EOT ) ONLY CONDITIONS.
 WFAIL30  LPK    -/RS/K.ABALRT
          NJN    WFAIL40     IF SOMETHING ELSE IS SET
          LDN    1           SET EOT FLAG
          STML   WFEOT
          UJK    WFAIL50     CONTINUE

*         CHECK FOR HARDWARE ERROR.
 WFAIL40  LDML   RESBUF+/RS/P.ABALRT  CHECK FOR HARDWARE ERROR
          LPK    /RS/K.HDWR
          ZJK    WFAIL60     IF NOT SET
          LDML   RESBUF+/RS/P.GS2  CHECK FOR UNIT CHECK
          LPK    /RS/K.UNITC
          ZJK    WFAIL60     IF NOT SET
          LDML   RESBUF+/RS/P.DSB  CHECK FOR DATA CHECK
          SHN    6
          PJK    WFAIL60     IF NOT SET
          LDML   RESBUF+/RS/P.DSB+1  CHECK FOR ANY ERPA CODE
          LPK    0#FF
          ZJK    WFAIL60     IF NOT SET
          LDML   RESBUF+/RS/P.DSB+1  CHECK BLOCK ID POSITIONING INDICATOR
          SHN    9
          MJK    WFAIL60     IF SET (SHOULD NEVER BE SET)

*         SAVE ORIGINAL ERROR STATUS.
          LDN    7           SET WORD COUNT
          STDL   WC
          LOADC  CM.UCA      USE CM UNIT COMM AREA
          ADN    /UCA/C.ERRSTA  OFFSET TO ERROR STATUS FIELD
          CWML   RESBUF+/RS/P.GS1,WC  SAVE IT

*         GET CURRENT TAPE POSITION BLOCK ID.
          LDN    1           FAKE GS1 STATUS FOR ROUTINE GETBID
          STML   RESBUF+/RS/P.GS1
          RJM    GETBID      GET CURRENT HOST AND TAPE POSITION BLOCK ID

*         IF THE GETBID ROUTINE GETS A CATASTROPHIC ERROR DURING PROCESSING
*         THIS OVERLAY WILL BE LOADED AGAIN AND A CATASTROPHIC ERROR WILL BE
*         PROCESSED.

          MJN    WFAIL60     IF STATUS ERROR OCCURED

*         RESTORE ORIGINAL ERROR STATUS.
          LDN    7           SET WORD COUNT
          STDL   WC
          LOADC  CM.UCA      USE CM UNIT COMM AREA
          ADN    /UCA/C.ERRSTA  OFFSET TO ERROR STATUS FIELD
          CRML   RESBUF+/RS/P.GS1,WC  RESTORE IT

*         SET LGBID FROM TAPE POSITION BLOCK ID.
          LDML   BIDBUF+3    GET UPPER BYTES
          STML   RESBUF+/RS/P.LGBID
          LDML   BIDBUF+4    GET LOWER BYTES
          STML   RESBUF+/RS/P.LGBID+1

*         SET WRITE FAIL RECOVER REQUEST (WFRR) FLAG.
          LDN    1           SET RECOVER REQUEST FLAG
          STML   WFRR

*         SET ERROR BLOCK ID FLAGS.
 WFAIL50  LDML   RESBUF+/RS/P.LGBID
          LPK    0#FF        MASK OUT PHYSICAL REFERENCE
          STML   WFBIDU      SET ERROR BID UPPER
          LDML   RESBUF+/RS/P.LGBID+1
          STML   WFBIDL

*         CHECK IF REQUEST WAS IN PROGRESS AT FAILURE.
 WFAIL60  LDML   CHKWRTF     GET THE CHECK WRITE FLAG
          NJN    WFAIL70     IF REQUEST WAS NOT IN PROGRESS AT FAILURE
          LCN    0           SET ENDING BLOCK ID TO MAX
          STML   URBHDR+/URB/P.EBID
          STML   URBHDR+/URB/P.EBID+1
          RJM    WRUCA       UPDATE UCA HEADER AND URB RECORD IN CM

*         SAVE FAILURE STATUS.
 WFAIL70  LDN    /RS/C.ELB-/RS/C.GS1  CM WORD COUNT TO SAVE
          STDL   WC
          LOADC  CM.UCA      LOAD R AND A FOR CURRENT UNIT COMM AREA
          ADN    /UCA/C.ERRSTA  OFFSET TO ERROR STATUS
          CWML   RESBUF+/RS/P.GS1,WC
          LDML   RESBUF+/RS/P.ABALRT  SAVE ABNORMAL STATUS
          STML   WFABNS
          LDML   RESBUF+/RS/P.LNGBLK  SAVE ALERT CONDITIONS
          STML   WFAC

*         CHECK TO INSURE AT LEAST 1 MAIN PROCESSING FLAG IS SET.
          LDML   WFCE        GET CATASTROPHIC ERROR FLAG
          ADML   WFEOT       MERGE EOT FLAG
          ADML   WFRR        MERGE RECOVER REQUEST FLAG
          NJN    WFAIL100    IF SOMETHING IS SET
          LDN    1           ELSE SET CATASTROPHIC ERROR FLAG
          STML   WFCE

*         PROCESS ANY ACTIVE REQUESTS.
 WFAIL100 RJM    RURBH       GET FIFO URB HEADER
          RJM    RURBR       GET FIFO URB RECORD
          LDML   WFCE        CHECK IF CATASTROPHIC ERROR
          NJK    WFAIL200    IF YES

*         CHECK IF THIS REQUEST HAS THE ERROR.
          LDML   URBHDR+/URB/P.EBID  COMPARE BLOCK ID-S
          LPK    0#FF
          STDL   T1
          LDML   WFBIDU
          SBDL   T1          COMPARE UPPER BLOCK ID-S
          MJN    WFAIL200    IF THIS REQUEST IS IN ERROR
          LDML   WFBIDL
          SBML   URBHDR+/URB/P.EBID+1  COMPARE LOWER BLOCK ID-S
          MJN    WFAIL200    IF THIS REQUEST IS IN ERROR

*         PROCESS REQUEST COMPLETED NORMALLY.
          RJM    DELINK      DELINK THIS REQUEST
          LDK    R.NRM       SET NORMAL RESPONSE CODE
          STML   RESBUF+/RS/P.RC
          RJM    RESP        SEND THE RESPONSE
          RJM    UINP        UPDATE UCA IN POINTER
          LDML   UCAHDR+/UCA/P.ACTCNT
          NJK    WFAIL100    CHECK NEXT REQUEST

*         NO MATCHING REQUEST FOUND - UPDATE ACTIVE REQUEST COUNT AND EXIT
          LOADC  CM.UCA      LOAD R AND A FOR CURRENT UNIT COMM AREA
          ADN    /UCA/C.ACTCNT  OFFSET TO ACTCNT CM WORD
          CWML   UCAHDR+/UCA/P.ACTCNT,ON
          UJK    WFAILOX

*         PROCESS FAILING REQUEST.
 WFAIL200 LDML   WFEOT       CHECK IF EOT ONLY ERROR
          NJK    WFAIL300    IF YES
          LDN    /RS/C.ELB-/RS/C.GS1  RESTORE THE ERROR STATUS
          STDL   WC
          LOADC  CM.UCA      LOAD R AND A FOR CURRENT UNIT COMM AREA
          ADN    /UCA/C.ERRSTA  OFFSET TO ERROR STATUS
          CRML   RESBUF+/RS/P.GS1,WC  READ BACK THE ERROR STATUS
          LDK    ABNRES      SET ABNORMAL RESPONSE LENGTH
          STML   RESBUF+/RS/P.RESPL
          LDML   WFABNS      RESTORE ABNORMAL STATUS
          STML   RESBUF+/RS/P.ABALRT
          LDML   WFAC        RESTORE ALERT CONDITIONS
          STML   RESBUF+/RS/P.LNGBLK
          LDML   WFCE        CHECK IF CATASTROPHIC ERROR
          ZJN    WFAIL210    IF NOT

*         PROCESS CATASTROPHIC ERROR.
          LDK    CMDBUF      SET FIRST COMMAND AS FAILING COMMAND
          STML   CMDADR
          LDN    0           CLEAR LGBID ON CATASTROPHIC ERRORS
          STML   RESBUF+/RS/P.LGBID
          STML   RESBUF+/RS/P.LGBID+1
          UJN    WFAIL300    GO SEND THE ABNORMAL RESPONSE

*         PROCESS RECOVER THE REQUEST.
 WFAIL210 LDK    CMDBUF+8    INITIALIZE COMMAND ADDRESS TO FIRST OUTPUT
          STDL   CMDADR
*         CALCULATE NUMBER OF GOOD BLOCKS ON THE MEDIA.
          LDML   WFBIDL      GET ERROR LOWER BLOCK ID
          ADK    0#10000     PREVENT UNDERFLOW
          SBML   URBHDR+/URB/P.SBID+1  DECREMENT BY REQUEST STARTING BID
          STDL   T1          SAVE IT TO REMOVE EXCESS
          LDDL   T1          GET IT BACK WITHOUT EXCESS
          SHN    3           MULTIPLE IT BY 8
          RADL   CMDADR      SET COMMAND ADDRESS TO FAILING COMMAND

*         PROCESS REQUEST TERMINATION.
 WFAIL300 LDN    0           CLEAR CHECK WRITE FLAG
          STML   CHKWRTF
          STML   UCAHDR+/UCA/P.ACTCNT  CLEAR UCA ACTIVE COUNT
          LOADC  CM.UCA      LOAD R AND A FOR CURRENT UNIT COMM AREA
          ADN    /UCA/C.ACTCNT  OFFSET TO ACTCNT CM WORD
          CWML   UCAHDR+/UCA/P.ACTCNT,ON
          LDK    R.ABN       SET ABNORMAL RESPONSE CODE
          STML   RESBUF+/RS/P.RC
          RJM    DSABLE      CHECK FOR DISABLE THE UNIT
          RJM    DELINK      DELINK THE REQUEST
          RJM    RESP        SEND THE RESPONSE
          UJK    WFAILOX     RETURN
          SPACE  2
**        WFAIL PROCESSING FLAGS.

 WFCE     DATA   0           CATASTROPHIC ERROR

 WFEOT    DATA   0           END OF TAPE ONLY

 WFRR     DATA   0           RECOVER REQUEST

 WFBIDU   DATA   0           LOGICIAL BLOCK ID UPPER OF ERROR RECORD

 WFBIDL   DATA   0           LOGICAL BLOCK ID LOWER OF ERROR RECORD

 WFABNS   DATA   0           SAVED ERROR ABNORMAL STATUS FIELD

 WFAC     DATA   0           SAVED ERROR ALERT CONDITIONS
          SPACE  4
*         CHECK IF OVERLAY HAS ANY I/O INSTRUCTIONS.
 CONCHX   BSS
 TTP+40B  HERE
 T40B+TP  HERE
 TTP      HERE
          ERRNZ  *-CONCHX    IF ANY THEN ERROR
          SPACE  4
*         CHECK IF OVERLAY HAS EXCEEDED THE OVERLAY BUFFER.
          ERRPL  *-DIOBUF
          OVERLAY (MISC ROUTINES),OVLBUF
          ROUTINE MRO        MISCELLANEOUS ROUTINES
          SPACE  5,20
** NAME - UNLDO
*
** PURPOSE - TO UNLOAD A TAPE UNIT AND GET ITS BUFFERED ERROR LOG.
*
** OUTPUT - BUFFERED ERROR LOG IN RESPONSE BUFFER.
*
          SPACE  2
 UNLDO    BSS                OVERLAY ENTRY

          LDML   URBHDR+/URB/P.WRTCNT  CHECK OUTSTANDING WRITES
          ADML   UCAHDR+/UCA/P.ACTCNT
          NJK    ICS         IF YES REPORT INVALID CMD SEQUENCE
          LDN    2           SET RETRY COUNTER
          STDL   P1

 UNLD05   LDK    /RS/P.ELB+23-/RS/P.DSB  NUMBER OF RESPONSE WORDS TO CLEAR
          STDL   T1          SET INDEX

 UNLD10   LDK    ZERO        CLEAR THE DETAILED STATUS AND ERROR LOG BUFFERS
          STML   RESBUF+/RS/P.DSB,T1
          SODL   T1          CHECK FOR DONE
          PJN    UNLD10      IF NOT  LOOP
          LDK    F.UNL       UNLOAD FUNCTION CODE
          RJM    DOFUNC      SEND FUNCTION CODE

 UNLD20   RJM    GETSTA      GET STATUS
          MJN    UNLD20      IF RETRY OCCURED
          SHN    17-11       CHECK IF ALERT IS SET
          PJN    UNLD25      IF NOT SET
          SODL   P1          DECREMENT RETRY COUNTER
          PJN    UNLD05      IF NOT EXHAUSTED

 UNLD25   RJM    ERRCHK      CHECK FOR ERRORS
          NJN    UNLD40      IF ERRORS OCCURED
          LDK    F.RBEL      READ BUFFERED ERROR LOG FUNCTION CODE
          RJM    DOFUNC      SEND FUNCTION CODE
          LDK    UNLRES      SET UNLOAD RESPONSE LENGTH
          STML   RESBUF+/RS/P.RESPL

 UNLD30   ACN    TP          ACTIVATE CHANNEL
          LDK    32          12-BIT WORD COUNT
          IAPM   RESBUF+/RS/P.ELB,TP  INPUT THE LOG
          DCN    40B+TP      DEACTIVATE CHANNEL
          STDL   AREG        SAVE RESIDUAL WORD COUNT
          SFM    INCPE,TP    CHECK AND CLEAR CHANNEL ERROR FLAG
          RJM    GETSTA      GET STATUS
          MJK    UNLD30      IF RETRY OCCURED
          RJM    ERRCHK      CHECK FOR ERRORS
          NJN    UNLD40      IF ERRORS OCCURED
          LDDL   AREG        CHECK IF ANY RESIDUAL WORD COUNT
          NJK    RCNZI       IF YES  GO PROCESS INPUT ERROR

 UNLD40   UJK    CMDONE      GOTO COMMAND COMPLETE
          SPACE  5,20
** NAME - GETHSO
*
** PURPOSE - GET HARDWARE STATUS ON IOU FAILURES OVERLAY.
*
** NOTE - THIS ROUTINE SHOULD ONLY BE CALLED WHEN AN IOU ERROR
*         HAS ALREADY BEEN DETECTED, AS THIS SUBROUTINE WILL
*         NOT GENERATE ADDITIONAL ERROR RESPONSES.
*
          SPACE  2
 GETHS10  DCN    40B+TP      DEACTIVATE CHANNEL
          SFM    *+2,TP      CLEAR CHANNEL ERROR FLAG

 GETHSO   SUBR               OVERLAY ENTRY/EXIT

          DCN    40B+TP      DEACTIVATE CHANNEL
          LDK    ZERO        CLEAR STATUS RESPONSE AREAS
          STML   RESBUF+/RS/P.CESR  CIO CHANNEL ERROR STATUS REGISTER
          STML   RESBUF+/RS/P.GS1   GENERAL STATUS
          STML   RESBUF+/RS/P.GS2
          LDK    /RS/B.DSB/2-1  DSB LENGTH IN PP WORDS -1
          STDL   T1          SET INDEX

 GETHS20  LDN    0           CLEAR DSB
          STML   RESBUF+/RS/P.DSB,T1
          SODL   T1          CHECK FOR DONE
          PJN    GETHS20     IF NOT LOOP
          LDK    ABNRES      SET ABNORMAL RESPONSE LENGTH
          STML   RESBUF+/RS/P.RESPL
          RJM    GETHSC      GET CIO CHANNEL STATUS
          NJK    GETHS10     IF ERROR
          LDK    F.GS        GO GET GENERAL STATUS
          RJM    GETHSE
          NJK    GETHS10     IF ERROR
          LDK    F.DS        GO GET DETAILED STATUS
          RJM    GETHSE
          UJK    GETHS10     EXIT
          SPACE  5,20
** NAME - GETHSE
*
** PURPOSE - GET HARDWARE STATUS (EQUIPMENT) ON IOU FAILURES.
*
** INPUT - (A) = GENERAL STATUS OR DETAILED STATUS FUNCTION CODE.
*
** OUTPUT - (A) = ZERO IF NO ERROR,
*                 NON-ZERO IF ERROR OCCURED.
*
** NOTE - ERRORS DURING PROCESSING WILL NOT GENERATE ANY NEW
*         ERROR RESPONSE BECAUSE THIS ROUTINE IS BEING USED TO
*         PROCESS AN EXISTING ERROR.
*
          SPACE  2
 GETHSE   SUBR               ENTRY/EXIT

          STML   GETHSEA     SAVE ENTRY PARAMETER
          LDDL   CONFLG      CHECK IF EQUIPMENT IS CONNECTED
          ZJK    GETHSEX     IF NOT EXIT
          LDN    30          FUNCTION TIMEOUT ABOUT 3 SECONDS
          STDL   T2
          LCN    ZERO        END OF OPERATION LOOP COUNTER
          STDL   T3

 GETHSE10 LDC    7777B       FUNCTION CODE (PLUGGED)
 GETHSEA  EQU    *-1
          FAN    TP          SEND FUNCTION

 GETHSE20 LDK    100000      FUNCTION LOOP COUNTER

 GETHSE30 IJM    GETHSE50,TP  IF INACTIVE RECEIVED
          SBN    1           CHECK FUNCTION LOOP COUNTER
          NJK    GETHSE30    IF NOT EXPIRED
          SODL   T2          CHECK FUNCTION TIMEOUT
          NJK    GETHSE20    IF NOT EXPIRED
          DCN    40B+TP      DEACTIVATE CHANNEL

 GETHSE40 LDK    ONE
          UJK    GETHSEX     ERROR EXIT

 GETHSE50 ACN    TP          ACTIVATE CHANNEL FOR INPUT
          LDK    10          10 MICROSECOND LIMIT FOR FIRST FULL

 GETHSE60 FJM    GETHSE70,TP  CHECK IF FIRST WORD OF STATUS IS READY
          SBN    1           DECREMENT TIMER
          NJK    GETHSE60    IF TIME LIMIT NOT EXPIRED
          DCN    40B+TP      DEACTIVATE CHANNEL
          SODL   T3          DECREMENT EOP LOOP COUNTER
          NJK    GETHSE10    IF NOT EXPIRED
          UJK    GETHSE40    EXIT BAD

 GETHSE70 LDML   GETHSEA     CHECK FOR GENERAL STATUS FUNCTION
          SBN    F.GS
          NJN    GETHSE80    IF NOT
          LDK    TWO         PROCESS GENERAL STATUS FUNCTION
          IAM    RESBUF+/RS/P.GS1,TP  INPUT GENERAL STATUS
          UJN    GETHSE90

 GETHSE80 LDK    26          PROCESS DETAILED STATUS
          IAPM   RESBUF+/RS/P.DSB,TP  INPUT DETAILED STATUS

 GETHSE90 DCN    40B+TP      DEACTIVATE CHANNEL
          UJK    GETHSEX     NORMAL EXIT
          SPACE  5,10
 CONCHMR  BSS    0           MISC ROUTINES CHANNEL INSTRUCTION TABLE
 TTP+40B  HERE
 T40B+TP  HERE
 TTP      HERE
          CON    0           END OF TABLE
          SPACE  2
*         CHECK IF OVERLAY EXCEEDS THE OVERLAY BUFFER.
          ERRPL  *-DIOBUF
          TITLE  END OF DRIVER.
          END
/EOR
