*
*         THIS IS THE PP DRIVER THAT SUPPORTS THE 895 DISK SUBSYSTEM.
*         THE DRIVER FOR THE NIO CHANNEL HAS PROGRAM NAME D895 AND
*         DECK NAME PP895.  THE DRIVER FOR THE CIO CHANNEL HAS PROGRAM
*         NAME D895CIO AND DECK NAME PP895CIO.  CONFIGURATION
*         MANAGEMENT LOADS THE CORRECT DRIVER.  IT PLUGS THE PP
*         INTERFACE TABLE RMA INTO LOCATIONS 72, 73.  LOCATION 0 OF
*         PP MEMORY MUST CONTAIN THE EXECUTION ADDRESS, MINUS ONE,
*         AT WHICH EXECUTION BEGINS.  THE DECK NAME OF THE COMMON
*         DECK THAT THE TWO DRIVERS SHARE IS PP895_COMMON_DECK.
          LIST   -$
*copyc IODMAC1 "{RECORD DEFINITION MACROS}
*copyc IODMAC2 "{LOAD/STORE MACROS}
*copyc IODMAC3 "{GENERAL MACROS}
*copyc IODMAC4 "{GENERAL MACROS}
*copyc IODMAC5 "(OVERLAY MACROS)
          LIST   B,L,N,R
          TITLE  EQUATES SECTION
 FE       EQU    0           = 1 IF ENABLING FORCE ERROR CODE
 DC       EQU    22B         DISK CHANNEL
 SBYTE8   EQU    2752        NUMBER OF 12-BIT BYTES PER DISK SECTOR
 SBYTE9   EQU    2048        NUMBER OF 16-BIT BYTES PER MEMORY SECTOR
 NOU      EQU    8           NUMBER OF ACTIVE UNITS ALLOWED

*         THE NUMBER GIVEN FOR MASWDS, WHEN MULTIPLIED BY 16, MUST
*         THEN BE DIVISIBLE BY 12.

 MASWDS   EQU    228         NUMBER OF CM WORDS TO BE PROCESS BY MASTER
 M        IFEQ   CHANTYP,1
 MASBUF   EQU    17770B-MASWDS*16/4  STARTING ADDRESS OF MASTER BUFFER
 SLVBUF   EQU    17770B-2064+MASWDS*16/4  STARTING ADDRESS OF SLAVE BUFFER
 CTB      EQU    17770B-510B  CONFIDENCE TEST BUFFER
 M        ELSE
 MASBUF   EQU    7770B-MASWDS*16/4  STARTING ADDRESS OF MASTER BUFFER
 SLVBUF   EQU    7770B-2064+MASWDS*16/4  STARTING ADDRESS OF SLAVE BUFFER
 CTB      EQU    7770B-510B  CONFIDENCE TEST BUFFER
 M        ENDIF
 NRQ      EQU    MASBUF      HOLDS NEXT REQUEST DURING DELINKING
 RTRY     EQU    4           RETRY REQUEST 3 TIMES
 MAXCYL   EQU    885         MAXIMUM CYLINDER
 MAXTR    EQU    14          MAXIMUM TRACK
 MAXSEC   EQU    9           MAXIMUM SECTOR

* DISK FUNCTIONS

 F.CONECT EQU    0           CONNECT
 F.SEEK   EQU    1           SEEK
 F.READ   EQU    4           READ
 F.WRITE  EQU    5           WRITE
 F.OPCMP  EQU    10B         OPERATION COMPLETE
 F.GS     EQU    12B         GENERAL STATUS
 F.CONT   EQU    14B         CONTINUE
 F.FMP    EQU    16B         FORMAT PACK
 F.EDS    EQU    23B         EXTENDED DETAILED STATUS
 F.UDIR   EQU    32B         UDI READ
 F.UDIW   EQU    33B         UDI WRITE
 F.DMAR   EQU    43B         DMA READ
 F.DMAW   EQU    44B         DMA WRITE
 F.AUTOP  EQU    414B        AUTOLOAD FROM PP
 F.MCLEAR EQU    100000B     MASTER CLEAR CIO ADAPTOR BOARD FUNCTION
 F.WRCR   EQU    111000B     WRITE CONTROL REGISTER OF CIO ADAPTOR
 F.RDESR  EQU    112000B     READ ERROR STATUS REGISTER OF CIO ADAPTOR

 GS4400   EQU    4400B       RECOVERY IN PROGRESS STATUS
 GS5020   EQU    5020B       SUBSYSTEM ERROR, SENSE BYTES PRESENT
          SPACE  5,20
*
*         ERROR CODES FOR LOCATION EC
*
 E00      EQU    0           NO CODE, CP MUST ISOLATE THE ERROR
 E01      EQU    1           INTERFACE ERROR
 E02      EQU    2           KZ BOARD ERROR
 E03      EQU    3           KX BOARD ERROR
 E04      EQU    4           CHANNEL ERROR
 E05      EQU    5           INCOMPLETE CHANNEL TRANSFER
 E06      EQU    6           PP - CCC DATA INTEGRITY ERROR
 E07      EQU    7           PP - UNIT DATA INTEGRITY ERROR
 E08      EQU    8           SEEK COMMAND TIMEOUT
 E09      EQU    9           CCC FAILURE
          SPACE  5,20
* INTERFACE ERROR CODES.

 E308     EQU    1410B       UNIT COMMUNICATION BUFFER IS TOO SMALL
 E501     EQU    2401B       INVALID COMMAND CODE
 E50A     EQU    2412B       INVALID SEQUENCE OF COMMANDS
          EJECT
* SELECTION SET (SS)
 SS       RECORD PACKED

 FILL1    SUBRANGE 0,377B
 UNIT     SUBRANGE 0,377B    UNIT NUMBER

 CYL      PPWORD             CYLINDER ADDRESS
 TRACK    PPWORD             TRACK ADDRESS
 SECTOR   PPWORD             SECTOR ADDRESS
 UQT      STRUCT 6           UNIT INTERFACE TABLE (RMA, REFORMATTED)
 REQ      STRUCT 4           CURRENT REQUEST (UNFORMATTED RMA)
 PVA      STRUCT 6           PVA OF CURRENT REQUEST
 COM      STRUCT 6           COMMUNICATION BUFFER (RMA, REFORMATTED)
 FILL     SUBRANGE 0,3777B
 ENTRY    BOOLEAN            REQUEST ON QUEUE SELECTED
 FILLA    SUBRANGE 0,17B
 LISTL    PPWORD             SAVED VALUE OF CMLISTL (DURING FORMATTING)
          PPWORD             (UNUSED)
 LASTC    PPWORD             OFFSET OF LAST COMMAND IN REQUEST
 LPP      PPWORD             LOGICAL PP NUMBER
          ALIGN  0,64
 CLKST    STRUCT 4           CLOCK START TIME
 SEEKTM   STRUCT 4           SEEK TIME
 DP       STRUCT 6           REFORMATTED RMA OF DELINK POINTER
          PPWORD             (UNUSED)
          MGEN   N.ENTRY
 M.ENTRY  EQU    MASK$
          MASKP  ENTRY
 K.ENTRY  EQU    MSK
          MGEN   N.UNIT
 M.UNIT   EQU    MASK$
 SS       RECEND

*         ALTERNATE USES OF SS TABLE DURING CONFIDENCE TEST

 CTME     EQU    /SS/P.PVA   START OF A 3-WORD TABLE WITH EACH WORD
                              CONTAINING THE HEAD AND SECTOR NUMBER
                              OF A MEDIA ERROR

* LOGICAL UNIT TABLE.

 LUT      RECORD PACKED
 LINK     PPWORD             ADDRESS OF THE NEXT LUT ENTRY
 OFFSET   PPWORD             INDEX INTO THE CM.DEV TABLE
 FILL     SUBRANGE 0,37777B
 OWNER    BOOLEAN            THIS PP HAS THE UNIT LOCKED
 FILL1    BOOLEAN            UNUSED
 UIT      STRUCT 6           RMA OF THE UIT (REFORMATTED RMA)
          MGEN   N.OWNER
 M.OWNER  EQU    MASK$
          MASKP  OWNER
 K.OWNER  EQU    MSK

 LUT      RECEND
          SPACE  5,20
* PP INTERFACE TABLE
 PIT      RECORD PACKED

 PPNO     PPWORD             PP NUMBER
 FLU      PPWORD             FIRST LOGICAL UNIT
 UNITC    PPWORD             NUMBER OF UNITS
 ACTCH    BOOLEAN            ACTIVE CHECK, THE PP CLEARS THIS BIT WITHIN 1 MINUTE
 IDLREQ   BOOLEAN            IDLE REQUEST
 RESREQ   BOOLEAN            RESUME REQUEST
 PPIDLE   BOOLEAN            PP IDLE
          SUBRANGE 0,3777B   UNUSED
 LOCK     BOOLEAN            PP TABLE LOCK
 INT      RMA                INTERRUPT WORD (RMA)
 CHAN     RMA                CHANNEL TABLE (RMA)
          ALIGN  16,64
 CBUFL    PPWORD             COMMUNICATION BUFFER LENGTH
 CBUF     RMA                COMMUNICATION BUFFER (RMA)
          STRUCT 24          UNUSED
          ALIGN  16,64
 RSPVA    STRUCT 14          RESPONSE BUFFER (PVA)
          ALIGN  32,64
 RSBUF    RMA                RESPONSE BUFFER (RMA)
          ALIGN  48,64
 IN       PPWORD             IN POINTER
          ALIGN  48,64
 OUT      PPWORD             OUT POINTER
          ALIGN  48,64
 LIMIT    PPWORD             LIMIT POINTER

 PIT      RECEND
          SPACE  5,20
* UNIT DESCRIPTORS.

 UD       RECORD PACKED

 LU       PPWORD             LOGICAL UNIT
 UQTPVA   STRUCT 6           UNIT INTERFACE TABLE (PVA)
 CHAN     SUBRANGE 0,377B    CHANNEL NUMBER
 CNTRLR   SUBRANGE 0,377B    CONTROLLER NUMBER
 SDIR     SUBRANGE 0,7       STORAGE DIRECTOR ADDRESS
 FILL1    SUBRANGE 0,377B
 UNIT     SUBRANGE 0,37B     PHYSICAL UNIT NUMBER
 UQT      RMA                UNIT INTERFACE TABLE (RMA)
          MGEN   N.SDIR
 M.SDIR   EQU    MASK$
          MASKP  SDIR
 K.SDIR   EQU    MSK
          MGEN   N.UNIT
 M.UNIT   EQU    MASK$

 UD       RECEND
          SPACE  5,20
* UNIT INTERFACE TABLE

 UIT      RECORD PACKED

 LU       PPWORD             LOGICAL UNIT
 DSABLE   BOOLEAN            UNIT IS ENABLED/DISABLED. (SET = DISABLED)
          ALIGN  32,64
 UTYPE    PPWORD             UNIT TYPE
                               = 400B, 844-4X
                               = 401B, 885-1X
                               = 402B, 885-42
 QCNT     PPWORD             QUEUE COUNT
*
          ALIGN  16,64
 UBUFL    PPWORD             UNIT COMMUNICATION BUFFER LENGTH
 UBUF     RMA                UNIT COMMUNICATION BUFFER (RMA)
 ULOCK    BOOLEAN            UNIT IS RESERVED FOR EXCLUSIVE USE
          ALIGN  48,64
 ULOCKP   PPWORD             UNIT LOCK OWNER
 QLOCK    BOOLEAN            UNIT QUEUE LOCK
          ALIGN  48,64
 QLOCKP   PPWORD             UNIT QUEUE LOCK OWNER
          ALIGN  16,64
 NEXTPV   STRUCT 6           NEXT REQUEST ON UNIT QUEUE (PVA)
          ALIGN  32,64
 NEXT     RMA                NEXT REQUEST ON UNIT QUEUE (RMA)

          MASKP  DSABLE
 K.DSABLE EQU    MSK

 UIT      RECEND
          SPACE  5,20
* PP REQUESTS.

 RQ       RECORD PACKED

          ALIGN  16,64
 NEXTPV   STRUCT 6           NEXT REQUEST ON UNIT QUEUE (PVA)
          ALIGN  32,64
 NEXT     RMA                NEXT REQUEST ON UNIT QUEUE (RMA)
 LEN      PPWORD             REQUEST LENGTH
 LU       PPWORD             LOGICAL UNIT
 RECOV    SUBRANGE 0,3       ERROR RECOVERY OPTIONS
                               0 - ATTEMPT RECOVERY
                               1 - SUPPRESS RECOVERY, TERMINATE WITH
                                    ABNORMAL STATUS.
                               2 - RESERVED FOR FUTURE USE.
                               3 - SUPPRESS RECOVERY, CONTINUE THE REQUEST
                                    IGNORING ERROR CONDITIONS.
 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
          ALIGN  49,64       ALERT MASK
 COMPAR   BOOLEAN            COMPARE NOT SATISFIED ON COMPARE/SWAP COMMAND
          ALIGN  0,64
 SWIT     BOOLEAN            SWITCH TO NEXT REQUEST
          ALIGN  16,64
 CYL      PPWORD             CYLINDER ADDRESS
 TRACK    PPWORD             TRACK ADDRESS
 SECTOR   PPWORD             SECTOR ADDRESS
 CMND     INTEGER            COMMAND SEQUENCE


          MASKP  INT
 K.INT    EQU    MSK
          MGEN   N.PORT
 M.PORT   EQU    MASK$

 RQ       RECEND
          SPACE  5,20
* PP COMMAND.

 CM       RECORD PACKED

 CODE     SUBRANGE 0,377B    COMMAND CODE
 STOR     BOOLEAN            STORE RESPONSE (IF SET)
 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
          SPACE  5,20
* COMMAND CODES.

 C.IDLE   EQU    4           IDLE
 C.RESUME EQU    5           RESUME
 C.READ   EQU    100B        READ BYTES
 C.WRITE  EQU    120B        WRITE BYTES
 C.FORMAT EQU    164B        DISK FORMAT
          SPACE  5,20
* PP RESPONSE.

 RS       RECORD PACKED
 FILL1    BOOLEAN
 SHORT    BOOLEAN            IF SET, ONE-WORD RESPONSE
          SUBRANGE 0,77B     UNUSED
          SUBRANGE 0,377B    LOGICAL UNIT (FOR DEBUG)
          ALIGN  16,64
 PVA      STRUCT 6           PVA OF REQUEST
          ALIGN  32,64
 REQ      RMA                RMA OF REQUEST
 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
          ALIGN  49,64       ALERT MASK
 COMPAR   BOOLEAN            COMPARE NOT SATISFIED ON COMPARE/SWAP COMMAND
          ALIGN  0,64
 ABALRT   BOOLEAN            ABNORMAL ALERT CONDITION DETECTED
 INTERR   BOOLEAN            LOGICAL INTERFACE ERROR (INCLUDE INTERFACE
                             ERROR CODE)
 FORC     BOOLEAN            FORCED TERMINATION AS A RESULT OF STOP UNIT COMMAND
 CHERR    BOOLEAN            CHANNEL PARITY ERROR
 DATOV    BOOLEAN            DATA OVERRUN. A LOST DATA CONDITION
                             OCCURRED ON INPUT OR INADEQUATE DATA RATE ON OUTPUT
 DATERR   BOOLEAN            UNCORRECTABLE PARITY OR CHECKWORD ERROR
                             ON AN ADDRESS OR DATA FIELD.
 HDWR     BOOLEAN            UNCORRECTABLE HARDWARE MALFUNCTION IN A
                             CONTROLLER OR UNIT
 NRDY     BOOLEAN            INTERVENTION REQUIRED BY OPERATOR ON A
                             HARDWARE MALFUNCTION.  EX: UNIT NOT READY,
                             UNIT NOT CONNECTED.
 FTO      BOOLEAN            FUNCTION TIMEOUT
 CHERO    BOOLEAN            CHANNEL OUTPUT PARITY ERROR
          ALIGN  16,64
 IEC      PPWORD             INTERFACE ERROR CODE
 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
                               1 - RECOVERED ERROR
                               2 - COMMAND HAD EXPLICIT RESPONSE FLAG SET
                               3 - BOTH CONDITIONS 1 AND 2
 K.REC    EQU    1           RECOVERED ERROR
          ALIGN  0,64
 XFER     STRUCT 4           TRANSFER COUNT
 LASTC    RMA                LAST COMMAND (RMA)(NOT USED)

 CHAN     PPWORD             CHANNEL NUMBER
 SCYL     PPWORD             STARTING CYLINDER
 STRK     PPWORD             STARTING TRACK
 SSEC     PPWORD             STARTING SECTOR

 UNIT     PPWORD             UNIT NUMBER
 RTRY     PPWORD             REQUEST RETRY COUNT
 FTRK     PPWORD             FAILING TRACK
 FSEC     PPWORD             FAILING SECTOR

 DET      PPWORD             =1, IF DETAILED STATUS PRESENT
 ID       PPWORD
 K.FORS   EQU    200B        DISK FORMATTING STARTED
 K.FORE   EQU    400B        DISK FORMATTING ENDED
 K.UDN    EQU    20000B      UNIT DOWN
 K.CMDN   EQU    40000B      STORAGE DIRECTOR DOWN
 K.CHDN   EQU    100000B     CHANNEL DOWN
 FILL2    PPWORD
 STRY     PPWORD             SECTOR RETRY COUNT

 GENST1   PPWORD             GENERAL STATUS OF THE FIRST TIME ERROR
                               WAS ENCOUNTERED
 GENST2   PPWORD             GENERAL STATUS OF THE LAST TIME ERROR
                               WAS ENCOUNTERED
 FUNTO    PPWORD             FUNCTION CODE IF FUNCTION TIMEOUT ERROR
          PPWORD             UNUSED
 FERREG   PPWORD             FIRST OCCURRENCE OF ERROR STATUS REGISTER (CIO ONLY)
 LERREG   PPWORD             LAST OCCURRENCE OF ERROR STATUS REGISTER (CIO ONLY)
          PPWORD             UNUSED
 EC       PPWORD             ERROR CODE (EXX)
          ALIGN  0,64
 DETAIL   STRUCT 40          DETAILED STATUS OF THE FIRST TIME ERROR
                             WAS ENCOUNTERED
 DET2     STRUCT 40          DETAILED STATUS OF THE LAST TIME ERROR
                             WAS ENCOUNTERED.

          MASKP  DATERR
 K.DATERR EQU    MSK
          MASKP  FTO
 K.FTO    EQU    MSK
          MASKP  SHORT
 K.SHORT  EQU    MSK

 RS       RECEND
          SPACE  5,20
* RESPONSE CODES.
 R.UNS    EQU    0           UNSOLICITED RESPONSE
 R.INT    EQU    1           INTERMEDIATE RESPONSE
 R.NRM    EQU    2           NORMAL REQUEST TERMINATION
 R.ABN    EQU    3           ABNORMAL REQUEST TERMINATION
          SPACE  5,20
* PP COMMUNICATION BUFFER.

 CB       RECORD PACKED

          ALIGN  31,64
 SLAVE    BOOLEAN            NONZERO IF SLAVE PP
 PARTNR   RMA                PARTNERS PPIT (RMA)

 CONTRL   STRUCT 8           LOAD CONTROLWARE COMMAND
          STRUCT 8
 ODP      STRUCT 8           OVERLAY DIRECTORY POINTER
          STRUCT 16
          STRUCT 24

 MSGIN    PPWORD             MESSAGE TO MASTER FROM SLAVE

          ALIGN  0,64
 MSGOUT   PPWORD             MESSAGE TO SLAVE FROM MASTER

          ALIGN  0,64
 SS       STRUCT 56          SS ENTRY

 REQ      STRUCT 40          REQUEST

 SVAREA   STRUCT 48          SAVE PARAMETERS FOR DATA RETRIEVAL

          ALIGN  0,64

*         THERE IS A ONE CM WORD TABLE PER CONFIGURED UNIT.  CM.DEV
*         IS THE REFORMATTED RMA THAT POINTS TO IT.

 DEV      SUBRANGE 0,7777B
 CT       SUBRANGE 0,7       NONZERO WHEN CONFIDENCE TEST COMPLETE
                              1 - NO ERROR
                              2 - ERROR
                              4 - DATA INTEGRITY ERROR
 ACT      BOOLEAN            UNIT ACTIVE (IN PPS IN USE QUEUE)
          STRUCT 6           REFORMATTED RMA OF UNIT INTERFACE TABLE
          MASKP  ACT
 K.ACT    EQU    MSK
          MASKP  SLAVE
 K.SLAVE  EQU    MSK


 CB       RECEND
          SPACE  5,20
* COMMANDS BETWEEN PPS.

                                                            SENT BY
 C.GO     EQU    1           DONE WITH DISK FOR THIS SECTOR  BOTH
 C.REQ    EQU    2           START A DISK REQUEST            MASTER
 C.RTRY   EQU    3           RETRY REQUEST                   MASTER
 C.SWIT   EQU    4           SWITCH TO THE NEXT REQUEST      MASTER
 C.END    EQU    5           END OF THE DISK REQUEST         MASTER
 C.AREG   EQU    6           A REGISTER NONZERO              SLAVE
 C.CPE    EQU    7           CHANNEL PARITY ERROR            SLAVE
 C.RES    EQU    8           RESUME COMMAND                  MASTER
          TITLE  DIRECT CELLS, CONSTANTS, TABLES
          CON    INIT-1

* DIRECT CELLS

 DH       BSSZ   3           REFORMATTED RMA OF OVERLAY DIRECTORY
 CM.PIT   BSSZ   3           CM ADDRESS OF PP INTERFACE TABLE (REFORMATED)

 T1       BSSZ   1
 T2       BSSZ   1
 T3       BSSZ   1
 T4       BSSZ   1
 T5       BSSZ   1
 T6       BSSZ   1
 T7       BSSZ   1
 T8       BSSZ   1

* KEEP GNSTAT AND P1 ADJACENT.
 GNSTAT   BSSZ   1           GENERAL STATUS
 P1       BSSZ   1
 P2       BSSZ   1
 P3       BSSZ   1
 P4       BSSZ   1
 P5       BSSZ   1
 P6       BSSZ   1
 WC       BSSZ   1           WORD COUNT TO READ/WRITE CM WORDS

 DEVL     CON    0           LENGTH OF DEV TABLE (SET BY INIT)
 CHAN     BSSZ   1           CHANNEL NUMBER
 CM.DEV   BSSZ   3           ADDRESS OF DEV TABLE IN COMMON AREA
 CMADR    BSSZ   3           CM ADDRESS

* THE NEXT 8 PP WORDS MUST BE CONTIGUOUS.

 SVCELLS  BSS
 DATADD   BSSZ   3           CM ADDRESS OF DATA AREA
 CMLISTL  BSSZ   1           NUMBER OF CM WORDS IN ADDRESS-LENGTH PAIR LIST.
                             (INCLUDES THE NUMBER OF WORDS WHICH HAVENT
                             BEEN READ FROM CM.)
 WDS      BSSZ   1           NUMBER OF CM WORDS TO TRANSFER FROM CURRENT SECTOR.
 TWDS     BSSZ   1           TOTAL NUMBER OF CM WORDS TO TRANSFER TO THE
 CMRMA    BSSZ   2           SAVED RMA OF DATA RMA LIST

 FNC      BSSZ   1           FUNCTION CODE (INTERNAL)
 SECPOS   BSSZ   1           SECTOR BUFFER TRANSFER POSITION (TO CM)
 USEQ     CON    0           QUEUE HEAD OF LUT ENTRIES IN USE (ACTIVE)
 EMPTQ    CON    LUT         QUEUE HEAD OF LUT ENTRIES NOT IN USE
 NCOMRQ   CON    0           NUMBER OF COMPLETED REQUESTS
 TOGL     BSSZ   1           USED FOR TRANSFERRING ALTERNATE 1/2 SECTORS
 GOFLG    BSSZ   1           =0 IF ADDRESS MUST BE BACKED UP AFTER AN ERROR
 SWFLG    BSSZ   1           NONZERO IF A STREAMING REQUEST SWITCH WAS MADE
 SLAVE    BSSZ   1           NONZERO IF SLAVE PP
 COMLOOK  BSSZ   1           INDEX INTO DEV TABLE (TABLE START IS IN CM.DEV)
 LUTLOC   CON    0           ADDRESS OF CURRENT LUT ENTRY
 CLCUR    BSSZ   1           CHANNEL 14 CURRENT CLOCK
 CLMCS    BSSZ   1           CLOCK, MICROSECOND
 CLMLS    BSSZ   1           CLOCK, MILLISECOND
 CLSEC    BSSZ   1           CLOCK, SECOND
 RECOV    BSSZ   1           STEP OF RECOVERY ALGORITHM
 CF       BSSZ   1           CONTINUE FLAG USED TO CONTROL RECOVERED RESPONSES
 FT       BSSZ   1           0 IF FIRST DATA FUNCTION AFTER SEEK
          BSS    72B-*
 DSRTP    DATA   2,0         PP INTERFACE TABLE RMA WHEN PP LOADED
 WDSS     EQU    DSRTP       USED TO UPDATE BYTES TRANSFERRED IN RESPONSE STATUS
 INPNT    EQU    DSRTP+1     IN POINTER FOR RESPONSE BUFFER
 CA       BSSZ   1           CONTINUE ADDRESS
 PPNO     CON    1           LOGICAL PP NUMBER
 PTF      BSSZ   1           IF 0 EXECUTE PATH TEST
 CTF      BSSZ   1           IF 0 EXECUTE CONFIDENCE TEST
          EJECT
          BSS    100B-*
          LJM    INIT        USED FOR OFF-LINE TESTING
          DATA   5           895 DRIVER (FOR ANAD PROC)
 HANG     CON    0           AN EASY WAY TO SEE CERTAIN PP HUNG ERRORS
          UJN    *
*
*         THE FOLLOWING CM ADDRESSES ARE SET DURING INITIALIZATION.
*         THE BYTE ADDRESS IS
*           RIGHTMOST 10 BITS OF WORD 0 CONCATENATED WITH
*           RIGHTMOST 12 BITS OF WORD 1 CONCATENATED WITH
*           RIGHTMOST 6 BITS OF WORD 2 CONCATENATED WITH
*           3 BITS OF ZEROS.

 CM.RS    BSSZ   3           CM ADDRESS OF RESPONSE BUFFER (REFORMATTED)
 CM.CB    BSSZ   3           CM ADDRESS OF PP COMMUNICATION BUFFER (REFORMATTED)
 CM.MIN   BSSZ   3           CM ADDRESS OF -MESSAGE IN- BUFFER
 CM.MOUT  BSSZ   3           CM ADDRESS OF -MESSAGE OUT- BUFFER
 CM.INT   BSSZ   3           CM ADDRESS OF INTERRUPT WORD
 CM.CHAN  BSSZ   3           CM ADDRESS OF CHANNEL INTERLOCK TABLE
 IDLE     BSSZ   1           NONZERO IF IDLE COMMAND RECEIVED,
                               RESUME COMMAND RESETS IT TO 0
 STORS    BSSZ   1           STORE RESPONSE FLAG (USED BY RESPIN)
                               = 0, IF A RESPONSE IS SENT TO CM
                               = NONZERO, IF NO RESPONSE WAS SENT TO CM
 FUNCD    BSSZ   1           FUNCTION CODE
 FCOMRQ   BSSZ   2           FIRST COMPLETED REQUEST (RMA)
 CURRQ    BSSZ   2           RMA OF CURRENT REQUEST
 PRERQ    BSSZ   2           RMA OF PREVIOUS REQUEST
 CHLOCK   BSSZ   1           CLEARED IF CHANNEL LOCK IS SET
 CHLCNT   CON    C.CHCNT     NUMBER OF REQUESTS TO PROCESS BEFORE
                              CLEARING CHANNEL LOCK
 UTSAVE   BSSZ   1           STARTING OFFSET ON AN LUT SCAN
 NUMCM    BSSZ   1           NUMBER OF COMMANDS LEFT TO PROCESS IN THIS REQUEST
 FRST     BSSZ   1           = 0, IF FIRST TIME THROUGH UNCMND
 LIM      BSSZ   1           LIMIT OF RESPONSE BUFFER (IN 8-BIT BYTES)
 LCF      BSSZ   1           NONZERO IF CCC LOAD IN PROGRESS
 SIP      BSSZ   1           SEEK IN PROGRESS IF ZERO
 DMF      BSSZ   1           DATA MISCOMPARE FLAG FOR CONFIDENCE TEST
 SPLUT    BSSZ   6           SPARE LOGICAL UNIT TABLE FOR CONFIDENCE TEST
 FBUF     CON    0           FIRST OF FORMAT PACK PARAMETERS
 FUN      CON    2300B
          CON    4000B       SET TO SPECIFY 4K SECTORS
 F        IFEQ   FE,1        FORCE ERROR CODE
 FEST     BSSZ   1           PASSES BEFORE FORCING ERROR
 FEND     BSSZ   1           NUMBER OF TIMES TO FORCE ERROR
 F        ENDIF

* THE FOLLOWING 2 CONSTANTS DEFINE THE AMOUNT OF THE DATA ON THE DISK TO
* BE READ OR WRITTEN (EXPRESSED IN CHANNEL WORDS). TO DETERMINE THE NUMBER
* OF PP WORDS USED, MULTIPLY BY 3/4. THIS VALUE IS SLIGHTLY MORE THAN THE
* AMOUNT USED FROM THE SECTOR, BECAUSE THE TOTAL MUST BE DIVISIBLE BY BOTH
* 12 AND 16.
* THE FIRST CONSTANT IS FOR THE MASTER, THE SECOND FOR THE SLAVE.

 IOCOUNT  CON    MASWDS*16/3   MUST BE EXPRESSED AS CHANNEL WORDS ( 12 BIT)
          CON    SBYTE8-MASWDS*16/3  MUST BE SBYTE8-(IOCOUNT)

* THE 2 CONSTANTS THAT FOLLOW (SECWDS) MUST ADD UP TO THE BLOCK SIZE
* EXPRESSED IN CM WORDS.
* THE FIRST CONSTANT IS FOR THE MASTER, THE SECOND FOR THE SLAVE.

 SECWDS   CON    MASWDS      THIS NUMBER TIMES 16 MUST BE EVENLY
                             DIVISIBLE BY 12.
          CON    SBYTE9/4-MASWDS  CONSTANT MUST NOT BE SEPARATED FROM SECWDS

 C.CHCNT  EQU    37          NUMBER OF REQUESTS TO PROCESS BEFORE
                             CLEARING CHANNEL LOCK
 LUT      BSSZ   NOU*P.LUT   LOGICAL UNIT TABLES FOR 8 UNITS
 SS       BSSZ   P.SS        INFORMATION ABOUT THE SELECTED REQUEST
 RQ       BSSZ   P.RQ        THE REQUEST BEING PROCESSED (MUST FOLLOW SS)
 CM       EQU    RQ+/RQ/P.CMND  COMMAND PORTION OF THE REQUEST
 CMLIST   BSSZ   P.CM        ONE ADDRESS AND LENGTH PAIR POINTING TO CM DATA
 RS       BSSZ   P.RS        RESPONSE BUFFER
 TL       EQU    *-LUT       LENGTH OF TABLES TO CLEAR DURING INITIALIZATION
 C        IFEQ   CHANTYP,1
 IPIT     EQU    17600B      PP INTERFACE TABLE DURING INITIALIZATION
 C        ELSE
 IPIT     EQU    7600B       PP INTERFACE TABLE DURING INITIALIZATION
 C        ENDIF
 UBUF     EQU    IPIT+P.PIT  UNIT INTERFACE TABLE DURING INITIALIZATION
 IBUF     EQU    UBUF+P.UIT  UNIT DESCRIPTIOR DURING INITIALIZATION
 CWBUF    EQU    RS+/RS/P.DETAIL START OF BUFFER FOR LOADING CONTROLWARE
 CTLN     EQU    5           LENGTH OF BUFFER USED FOR LOADING (CM WORDS)
          TITLE  RESIDENT SLAVE ROUTINES
          SPACE  5,20
** NAME-- END
*
** PURPOSE-- IDLE LOOP FOR SLAVE
          SPACE  2
 END      BSS
 F        IFEQ   FE,1        FORCE ERROR CODE
          RJM    FER         CHECK FOR FORCE ERROR
 F        ENDIF
          RJM    GETMSG      LOOK FOR REQUEST FROM MASTER
          UJN    END         GO LOOK SOME MORE
          SPACE  5,20
** NAME-- REQ
*
** PURPOSE-- PROCESS THE -REQ- COMMAND FROM THE MASTER PP.
*            SET UP TO PROCESS A DISK REQUEST.
          SPACE  2
 REQ      BSS
          RJM    REQSW       READ DISK REQUEST
          LDN    C.GO
          STDL   GOFLG
          RJM    SEND        SEND -GO- TO PARTNER
          LJM    MAIN25      PROCESS REQUEST
          SPACE  5,20
** NAME-- REQSW.
*
** PURPOSE-- READ THE DISK REQUEST FROM THE PP COMMUNICATION
*            BUFFER.
          SPACE  2
 REQSX    LJM    **
 REQSW    EQU    *-1
          LDN    C.SS+C.RQ   NUMBER OF WORDS TO READ
          STDL   WC
          RJM    EXLOD       ADDRESS OF COMMUNICATION BUFFER
          ADN    /CB/C.SS    ADDRESS OF SS ENTRY
          CRML   SS,WC       READ SS TABLE AND REQUEST
          LDN    0
          STML   FRST        SET FLAG WHEN REQUEST IS READ
          LDML   RQ+/RQ/P.LEN  DETERMINE NUMBER OF COMMANDS
          SHN    -3
          SBN    /RQ/C.CMND
          STML   NUMCM       NUMBER OF COMMANDS
          UJK    REQSX
          SPACE  5,20
** NAME-- RESUME
*
** PURPOSE-- THE MASTER HAS RECEIVED A RESUME AND IS REINITIALIZING
*            TABLES.  LOCATIONS THE SLAVE READS ARE ALREADY INITIALIZED,
*            SO, JUST SEND A GO TO THE MASTER.
          SPACE  2
 RESUME   BSS
          LDN    C.GO
          RJM    SEND        SEND A GO TO THE MASTER
          LJM    END
          SPACE  5,20
** NAME-- SR
*
** PURPOSE-- ENTRY FOR SLAVE TO RETRY THE DATA TRANSFER FOR A SECTOR
          SPACE  2
 SR       BSS
          LDDL   GOFLG
          NJN    SR10        IF POINTERS CORRECT
          LOADOVL ERO        LOAD ERROR RECOVERY OVERLAY
          RJM    RSTBP       RESTORE POINTERS
 SR10     BSS
          LDN    1           RESET TOGL TO 1
          STDL   TOGL
          LJM    READ32      RETURN TO THE READ ROUTINE
          SPACE  5,20
** NAME-- SWIT
*
** PURPOSE-- ENTRY FOR SLAVE TO SWITCH TO NEXT REQUEST
          SPACE  2
 SWIT     BSS                SWITCH TO NEXT REQUEST
          RJM    REQSW       READ REQUEST FROM PP COMMUNICATION BUFFER
          RJM    SRESP       SET UP RESPONSE BUFFER
          RJM    UNCMND      GET COMMAND AND SET UP TO PROCESS
          LDDL   FNC         IS IT A READ
          ZJK    READ3       YES, RETURN TO THE READ ROUTINE
          LJM    WRI5        RETURN TO THE WRITE ROUTINE
          TITLE  RESIDENT MASTER AND SLAVE ROUTINES
** NAME -- MAIN
*
** PURPOSE -- THE MAIN DRIVER LOOP
*
** ENTRY
*         MAIN - FROM INIT AFTER DRIVER IS LOADED (MASTER AND SLAVE)
*              - WHEN RESUME RECEIVED (MASTER ONLY)
*         MAIN5 - WHEN RETRYING A CONFIDENCE TEST ERROR (MASTER ONLY)
*               - WHEN EQUIPMENT IS DOWNED
*         MAIN25 - ENTRY FOR SLAVE TO PROCESS A REQUEST
*         MAIN30 - WHEN RETRYING A DISK REQUEST (MASTER ONLY)
*         MAIN45 - WHEN REQUEST COMPLETES WITHOUT ERROR
*                - IF MEDIA ERROR
          SPACE  2
 MAIN     BSS
          LOADOVL ITO        LOAD INITIALIZE TABLE OVERLAY
          RJM    IT          INITIALIZE TABLES
 MAIN5    BSS
          LOADOVL PTO        PATH TEST OVERLAY
          RJM    PT          PATH TEST
          LOADOVL CTO        LOAD CONFIDENCE TEST OVERLAY
          RJM    CT          CONFIDENCE TEST
 MAIN10   BSS
 F        IFEQ   FE,1        FORCE ERROR CODE
          RJM    FER         CHECK FOR AN ERROR TO FORCE
 F        ENDIF
          RJM    PPREQ       CHECK FOR ANY PP REQUESTS
          RJM    GETUD       SET UP NEW REQUESTS
          LDDL   USEQ
          ZJK    MAIN50      IF NO SEEKS ARE OUTSTANDING
          RJM    POLLON      POLL FOR ON-CYLINDER
          ZJK    MAIN10      IF A SEEK HAS NOT COMPLETED
          RJM    UREQ        READ UNIT REQUEST FROM CM
          RJM    SETRQ       SET UP FOR FIRST REQUEST
 MAIN25   BSS
          RJM    SRESP       SET UP RESPONSE BUFFER
          RJM    UNCMND      GET COMMAND AND SET UP TO PROCESS
 MAIN30   BSS
          LDML   UCMDPR,FNC  GET COMMAND PROCESSOR
          STML   MAIN35
          RJM    **          PROCESS COMMAND (NO RETURN IF SLAVE)
 MAIN35   EQU    *-1
          RJM    UBT         UPDATE BYTES TRANSFERRED
          LDN    F.OPCMP
          RJM    FUNC        RELEASE THE DRIVE
          LDDL   CF
          ZJN    MAIN40      IF CONTINUE NOT SENT
          LDML   RS+/RS/P.RTRY
          NJN    MAIN40      IF ERROR ALREADY REPORTED
          LDN    0
          STML   RS+/RS/P.SHORT   INDICATE ERROR RESPONSE
          LDK    C.RS*8
          STML   RS+/RS/P.RESPL  ERROR RESPONSE LENGTH
          LDC    0#5000
          STML   RS+/RS/P.RC  RECOVERED, INTERMEDIATE RESPONSE
          RJM    TERMP       SEND RECOVERED RESPONSE
 MAIN40   BSS
          LJM    TERM        SEND TERMINATION RESPONSE
 MAIN45   BSS
          SOML   CHLCNT
          NJN    MAIN55      IF PP DOESN'T HAVE TO GIVE UP CHANNEL
 MAIN50   BSS
          RJM    CKC         CHECK IF CHANNEL MUST BE GIVEN UP
 MAIN55   BSS
          UJK    MAIN10

* UNIT COMMANDS
 UCMD     BSS
          CON    C.READ
          CON    C.WRITE
          CON    C.FORMAT

* PP COMMANDS.

          CON    C.IDLE
          CON    C.RESUME
 UCMDL    EQU    *-UCMD

* UNIT COMMAND PROCESSORS.
 UCMDPR   BSS
          CON    READ        READ BYTES
          CON    WRITE       WRITE BYTES
          CON    FMT         FORMAT DISK
          SPACE  5,20
** NAME-- EXLOD
*
** PURPOSE-- UTILITY TO EXECUTE A LOADC CM.CB MACRO.
*
** INPUT-- RJM EXLOD (NO PARAMETERS)
*
** OUTPUT-- R AND A REGISTERS CONTAIN ADDRESS OF COMMUNICATIONS BUFFER.
          SPACE  2
 EXLODX   LJM    **
 EXLOD    EQU    *-1
          LOADC  CM.CB
          UJN    EXLODX
          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-14 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.
          SPACE  2
 FORX     LJM    **
 FORMA    EQU    *-1
          STDL   T1

* REFORMAT CM ADDRESS.

          LDML   1,T1
          LPN    7
          NJN    FORM10      IF RMA ADDRESS ERROR
          LDIL   T1
          LPN    37B
          SHN    16
          LMML   1,T1
          SHN    9
          STD    CMADR+1
          SHN    6
          LPN    77B
          STDL   CMADR+2
          LDIL   T1
          SHN    -5
          STD    CMADR
          LRD    CMADR
          LDDL   CMADR+2
          LMC    400000B
          UJK    FORX
 FORM10   BSS
          RJM    HANG
          SPACE  5,20
** NAME-- GETMSG
*
** PURPOSE-- CHECK FOR A MESSAGE FROM PARTNER PP.
*
** EXIT-- TO CALLING ROUTINE IF GO COMMAND, OTHERWISE THROUGH
*         THE JUMP TABLE.
          SPACE  2
 GETMX    LJM    **
 GETMSG   EQU    *-1
          LDN    0
          STDL   T1          ZERO OUT MESSAGE CODE WHEN IT IS READ
          STDL   T2
          STDL   T3
          STDL   T4
          LOADC  CM.MIN      CM ADDRESS OF MESSAGE CODE
          RDCL   T1          READ MESSAGE AREA
          LDDL   T1          GET MESSAGE CODE
          SBN    C.GO        CHECK FOR GO
          ZJK    GETMX       IF MESSAGE = GO
          MJN    GETMX       IF NO MESSAGE
          SBN    CPROCL+1    CHECK FOR VALID CODE
          MJN    GETM10      IF VALID CODE
          RJM    HANG        INVALID CODE

 GETM10   BSS
          LDML   CPROC-2,T1  GET ADDRESS OF COMMAND PROCESSOR
          STML   GETM20
          LJM    **          PROCESS COMMAND
 GETM20   EQU    *-1

                                                      SENT BY
 CPROC    BSS
          CON    REQ         PROCESS NEW REQUEST       MASTER
          CON    SR          SLAVE RETRY OF SECTOR     MASTER
          CON    SWIT        SWITCH TO NEW REQUEST     MASTER
          CON    END         END OF REQUEST            MASTER
          CON    SMA         A REGISTER NONZERO        SLAVE
          CON    SMB         CHANNEL PARITY ERROR      SLAVE
          CON    RESUME      RESUME COMMAND RECEIVED   MASTER
 CPROCL   EQU    *-CPROC
          SPACE  5,20
** NAME-- GLIST
*
** PURPOSE-- READ THE CM ADDRESS LIST PORTION OF A COMMAND.
          SPACE  2
 GLIX     LJM    **
 GLIST    EQU    *-1
          LDN    1
          STDL   WC          NUMBER OF WORDS TO READ
          LOADF  CM+/CM/P.RMA  LOAD CM ADDRESS AND REFORMAT
          CRML   CMLIST,WC
          LDN    8
          RAML   CM+/CM/P.RMA+1  UPDATE RMA ADDRESS FOR NEXT READ
          STDL   CMRMA+1     SAVE IN CASE A BACKUP IS NEEDED
          SHN    -16
          RAML   CM+/CM/P.RMA
          STDL   CMRMA       SAVE IN CASE A BACKUP IS NEEDED
          UJK    GLIX
*COPYC IODMAC6
          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.
*
** NOTE-- THIS IS SET UP FOR 4X PP TIMING.
          SPACE  2
 PAUSX    LJM    **
 PAUS     EQU    *-1
 PAUS10   BSS
          STDL   0           ONE MICROSECOND LOOP
          SBN    1
          NJN    PAUS10
          UJK    PAUSX
          SPACE  5,20
** NAME-- READ
*
** PURPOSE-- PROCESS READ DATA COMMAND.
*
** INPUT-- CMLISTL = NUMBER OF ADDRESS-LENGTH ENTRIES IN THE
*                    COMMAND WHICH ARE LEFT TO PROCESS.
*          CMLIST  = A TABLE OF THE ADDRESS-LENGTH PAIRS POINTING TO
*                    THE CM DATA AREA.
*
** MASTER/SLAVE INTERACTION
*         MASTER                      SLAVE
*         1.  SEND REQUEST (READ)
*                                     2.  SEND GO (REQ)
*         3.  WAIT (READ32)
*         4.  FUNC (READ32)
*         5.  INPUT (READ35)
*         6.  SEND GO (READ46)
*             (REPEAT 3-6 PER SECTOR  7.  WAIT (READ32)
*                                     8.  INPUT (READ32)
*                                     9.  SEND GO (READ46)
*        10.  WAIT (READ82)               (REPEAT 7-9 PER SECTOR)
*             LAST SECTOR ONLY
*        11.  GENERAL STATUS
          SPACE  2
 READX    LJM    **
 READ     EQU    *-1
          LDDL   SLAVE
          NJN    READ1       IF SLAVE PP
          LDN    C.REQ
          STDL   GOFLG       SET GO FLAG
          RJM    SEND        SEND REQUEST TO SLAVE
          LDC    READ34
          STDL   CA          CONTINUE ADDRESS

 READ1    BSS
          LDN    0
          STDL   SWFLG       CLEAR SWITCH FLAG
          STDL   TOGL        TOGL = 0 TO START
          STDL   WDSS        USED TO UPDATE BYTES TRANSFERRED IN
                             RESPONSE TABLE
 READ3    BSS
          LDN    0
          STDL   SECPOS      SET SECTOR POSITION = 0

* SET UP NUMBER OF WORDS TO TRANSFER TO THIS CM ADDRESS.

 READ10   BSS
          LOADF  CMLIST+/CM/P.RMA  SET UP CM ADDRESS OF DATA AREA
          STDL   DATADD+2
          SRD    DATADD      SAVE R REGISTER
          LDML   CMLIST+/CM/P.LEN  NUMBER OF BYTES TO TRANSFER
          ADN    7           ROUND UP
          SHN    -3          NUMBER OF CM WORDS TO TRANSFER
          STDL   TWDS

* COMPUTE NUMBER OF WORDS TO TRANSFER FROM CURRENT BUFFER.

 READ20   BSS
          STDL   WDS         COMPUTE NUMBER OF WORDS FROM CURRENT BUFFER
          LDML   SECWDS,TOGL NUMBER OF WORDS FOR THE BUFFER FOR THIS PP
          SBDL   SECPOS      WORDS PREVIOUSLY TRANSFERRED FROM THIS BUFFER
          SBDL   WDS         SPACE AVAILABLE IN CM
          PJN    READ25      IF LESS THAN 1 PP WORTH
          LDML   SECWDS,TOGL
          SBDL   SECPOS
          STDL   WDS         NUMBER OF CM WORDS TO TRANSFER
 READ25   BSS
          LDDL   SECPOS      DATA STILL IN THE PP BUFFER
          NJK    READ51      GO MOVE IT TO CM
          LDDL   TOGL
          SBDL   SLAVE       TOGL = SLAVE MEANS I/O IS FOR REAL
          NJK    READ51      IF THIS PP DOES NOT READ THIS PORTION

* TRANSFER DATA FROM THE DISK.

 READ32   BSS
          RJM    WAITP       WAIT FOR A MESSAGE FROM PARTNER
          LDDL   SLAVE
          NJN    READ34A     IF SLAVE, ONLY INPUT THE DATA
          LDN    F.READ      ISSUE READ FUNCTION
          RJM    FUNC
 READ33   EQU    *-1         FOR FORCING ERRORS
 READ34   BSS
          RJM    UDA         UPDATE DISK ADDRESS
 READ34A  BSS
          AODL   GOFLG       SET GO FLAG
 READ35   BSS                INSTRUCTION MODIFIED WHEN FORCING ERRORS
          LDML   IOCOUNT,TOGL  AMOUNT OF DATA TO BE INPUT
          IAPM   7777B,DC    READ THE DATA
 READ36   EQU    *-1
          ZJN    READ40      IF ALL DATA RECEIVED
 READ38   BSS
          STDL   T4          WORDS NOT TRANSFERRED
          LDN    C.AREG      A REGISTER NONZERO
          UJN    READ44

* SEND A GO TO PARTNER.  NOTE THAT IT TAKES 35 MICROSECONDS FROM MASTER
* IAPM TO SLAVE IAPM AND ANOTHER 35 MICROSECONDS FROM SLAVE IAPM TO
* MASTER READ FUNCTION FOR THE NEXT SECTOR.

 READ40   BSS
 F        IFEQ   FE,1        FOR FORCING ERRORS
          LDC    1
 READ40G  EQU    *-1
          SBN    1
          NJN    *-1
 F        ENDIF
          LDDL   SLAVE
          ZJN    READ41      IF MASTER
          RJM    WFI         WAIT FOR INACTIVE
 READ41   BSS
          CFM    READ46,DC   IF ERROR FLAG NOT SET
          LDN    C.CPE       CHANNEL PARITY ERROR
 READ44   BSS
          RJM    RWEP        READ/WRITE ERROR PROCESSING (NO RETURN)
 READ46   BSS
          RJM    SVPTR       SAVE THE CM BUFFER POINTERS
          LDN    C.GO
          RJM    SEND        TELL PARTNER DONE WITH TRANSFER
          RJM    UC          UPDATE CLOCK
          LDN    0
          STDL   GOFLG       CLEAR GO FLAG

* TRANSFER DATA TO CM.

 READ51   BSS
          LDDL   TOGL
          SBDL   SLAVE       TOGL = SLAVE MEANS I/O IS FOR REAL
          NJN    READ55      IF PARTNER IS READING THE DISK
          LDDL   SECPOS      CALCULATE SECTOR
          SHN    2
          ADC    0
 READ52   EQU    *-1         BOTH WORDS OF INSTRUCTION ARE MODIFIED
          STML   READ53
          LDDL   WDS
          ZJN    READ55      IF 0 WORDS TO TRANSFER
          LOADC  DATADD      CM ADDRESS OF DATA AREA
          CWML   -**,WDS     SEND DATA TO CM
 READ53   EQU    *-1
          RJM    UBT         UPDATE BYTES TRANSFERRED

* FLIP THE TOGGLE IF PP BUFFER NOW GOING TO BE EMPTY.

 READ55   BSS
          LDDL   WDS
          RADL   SECPOS      UPDATE BUFFER POSITION
          SBML   SECWDS,TOGL CHECK FOR END OF BUFFER
          ZJN    READ57      IF END OF PP BUFFER
          LDDL   CMLISTL
          SBN    1           IS THIS THE LAST CM AREA
          NJN    READ58      NO, DON'T THROW AWAY DATA IN PP BUFFER
 READ57   BSS
          STDL   SECPOS      RESET BUFFER POSITION TO 0
          LDDL   TOGL
          LMN    1
          STDL   TOGL        FLIP THE TOGGLE
 READ58   BSS
          LDDL   SWFLG       WAS THIS THE FIRST I/O AFTER A REQUEST SWITCH
          ZJN    READ59      NO- (NEVER CAN BE FOR THE SLAVE)
          RJM    SWITCH      GO AND SWITCH THE REQUESTS
 READ59   BSS
          LDDL   WDS
          RADL   WDSS        SAVE BYTES TRANSFERRED FOR LATER UPDATE
          LDDL   WDS
          RADL   DATADD+2    UPDATE CM ADDRESS
          LDDL   TWDS        UPDATE TOTAL WORDS LEFT TO TRANSFER TO THIS
                             CM ADDRESS
          SBDL   WDS
          STDL   TWDS
          NJN    READ59A     IF NOT OUT OF DATA
          LDDL   CMLISTL
          SBN    1           IS THIS THE LAST CM AREA
          NJN    READ60      IF NO, UPDATE AND GO GET MORE REAL DATA
          LDDL   TOGL
          ZJN    READ60      IF THE SLAVE JUST FINISHED
          LDN    0           GO MAKE A DUMMY PASS FOR THE SLAVE
 READ59A  BSS
          UJK    READ20      IF MORE WORDS TO TRANSFER TO THIS CM ADDRESS

* GET NEXT CM ADDRESS OF DATA AREA.

 READ60   BSS
          SODL   CMLISTL     DECREMENT ADDRESS-LENGTH-PAIR COUNT
          ZJN    READ80      IF END OF ADDRESS-LENGTH-PAIRS IN COMMAND
          RJM    GLIST       GET NEXT ENTRY IN LIST
          UJK    READ10      GO CONTINUE READING
 READ80   BSS
          RJM    CSWIT       CHECK IF SWITCH TO NEXT REQUEST
          NJK    READ3       IF SWITCH TO NEXT REQUEST
 READ82   BSS
          RJM    WAITP       MASTER- WAIT FOR SLAVE TO FINISH READING
                             SLAVE- WAIT FOR MASTER TO SAY END
          RJM    GENSTAT     GET GENERAL STATUS
          ZJK    READX       IF NO ERROR
          LDN    E00         CP MUST ISOLATE THE ERROR
          RJM    PCER        PREPARE COMMON ERROR RESPONSE (NO RETURN)
          SPACE  5,20
** NAME-- RWEP
*
** PURPOSE-- READ/WRITE ERROR PROCESSING
*
** ENTRY
*         A = 6  A REGISTER NONZERO
*         A = 7  CHANNEL PARITY ERROR
          SPACE  2
 RWEP     CON    0
          STDL   T8          SAVE TYPE OF ERROR
          LDDL   SLAVE
          ZJN    RWEP5       IF MASTER PP
          LDDL   T4
          STDL   T6          SAVE WORDS NOT TRANSFERRED
          LDDL   T8
          RJM    SEND        TELL MASTER ABOUT THE ERROR
          LJM    END         WAIT FOR DIRECTION FROM MASTER
 RWEP5    BSS
          LDDL   T4
          STML   RS+/RS/P.FUNTO  WORDS NOT TRANSFERRED IF E05
          RJM    GENSTAT     GET GENERAL STATUS
          LDDL   T8
          SBN    C.AREG
          ZJN    RWEP15      IF A REGISTER ERROR
          RJM    EFP         ERROR FLAG PROCESSING (NO RETURN)
 RWEP15   BSS
          LDN    E05         INCOMPLETE CHANNEL TRANSFER
          RJM    PCER        PREPARE COMMON ERROR RESPONSE (NO RETURN)
          SPACE  5,20
** NAME-- SEND.
*
** PURPOSE-- SEND A MESSAGE TO THE PARTNER PP.
*
** ENTRY-- A REGISTER = MESSAGE CODE TO BE SENT.
          SPACE  2
 SENDX    LJM    **
 SEND     EQU    *-1
          STDL   T1          MESSAGE CODE
          LDK    46          MAX WAIT IS 30 SECONDS
          STDL   P2
          STDL   P1
 SEND20   BSS
          LOADC  CM.MOUT     CM ADDRESS OF MESSAGE OUT
          CRDL   T2          READ MESSAGE OUT AREA
          LDDL   T2
          NJN    SEND40      IF LAST MESSAGE WAS NOT RECEIVED
          LDDL   T6          WORDS NOT TRANSFERRED FOR A SLAVE ERROR
          STDL   T4
          LDML   CM.MOUT+2   CM ADDRESS OF MESSAGE OUT
          LMC    400000B
          CWDL   T1          WRITE MESSAGE TO CM AREA
          UJK    SENDX

 SEND40   BSS
          SODL   P1
          NJK    SEND20      IF NOT TIMED OUT
          SODL   P2
          NJK    SEND20      IF NOT TIMED OUT
          RJM    HANG        PARTNER DIED
          SPACE  5,20
** NAME-- SETRQ
*
** PURPOSE-- SET UP FOR FIRST REQUEST.
          SPACE  2
 SETRQX   LJM    **
 SETRQ    EQU    *-1
          LDML   SS+/SS/P.REQ  SAVE RMA OF REQUEST
          STML   FCOMRQ      FIRST COMPLETED REQUEST (RMA)
          STML   CURRQ       CURRENT REQUEST (RMA)
          LDML   SS+/SS/P.REQ+1
          STML   FCOMRQ+1
          STML   CURRQ+1
          LDN    1
          STDL   NCOMRQ      NUMBER OF COMPLETED REQUESTS
          LDDL   SLAVE
          NJN    SETRQX      SLAVE CAN QUIT SETUP HERE
          RJM    SETADD      PUT STARTING ADDRESS IN RESPONSE BUFFER

* SET UP INTERRUPT PROCESSOR INSTRUCTION IF INTERRUPT IS SELECTED.

          LDML   RQ+/RQ/P.INT  CHECK IF INTERRUPT WAS SELECTED
          SHN    /RQ/L.INT+2
          MJN    SETR10      IF INTERRUPT SELECTED
          LDC    2400B       PSN INSTRUCTION
          UJN    SETR20

 SETR10   BSS
          LDML   RQ+/RQ/P.PORT  GET PROCESSOR PORT NUMBER TO INTERRUPT
          SHN    -16+/RQ/L.PORT+/RQ/N.PORT
          LPN    /RQ/M.PORT
          ADC    102600B     INPN INSTRUCTION
 SETR20   BSS
          STML   INTPRC
          UJK    SETRQX
          SPACE  5,20
** NAME-- SRESP
*
** PURPOSE-- SET UP STATUS RESPONSE BUFFER.
          SPACE  2
 SREX     LJM    **
 SRESP    EQU    *-1
          LDML   SS+/SS/P.PVA        PUT PVA OF REQUEST IN RESPONSE BUFFER
          STML   RS+/RS/P.PVA
          LDML   SS+/SS/P.PVA+1
          STML   RS+/RS/P.PVA+1
          LDML   SS+/SS/P.PVA+2
          STML   RS+/RS/P.PVA+2
          LDN    0
          STML   RS+/RS/P.XFER   TRANSFER COUNT
          STML   RS+/RS/P.XFER+1
          LDN    4
          STML   SS+/SS/P.LASTC  OFFSET TO COMMAND
          UJK    SREX
          SPACE  5,20
** NAME-- SVPTR
*
** PURPOSE-- SAVE BUFFER POINTERS IN CASE DATA RETRANSMISSION IS NEEDED.
          SPACE  2
 SVPTRX   LJM    **
 SVPTR    EQU    *-1
          LDN    2
          STDL   WC
          RJM    EXLOD       GET CM AREA ADDRESS
          ADN    /CB/C.SVAREA
          ADDL   SLAVE       ADD 2 WORDS FOR SLAVE (GET OUT OF THE
          ADDL   SLAVE       SPACE THAT THE MASTER WILL BE USING)
          CWML   SVCELLS,WC  SAVE IT
          UJN    SVPTRX
          SPACE  5,20
** NAME-- UBT
*
** PURPOSE-- UPDATE BYTES TRANSFERRED
          SPACE  2
 UBTX     LJM    **
 UBT      EQU    *-1
          LDDL   WDSS        BYTES TRANSFERRED IN LAST SECTOR
          SHN    3
          RAML   RS+/RS/P.XFER+1
          SHN    -16
          RAML   RS+/RS/P.XFER UPDATE BYTES TRANSFERRED IN RESPONSE
          LDN    0
          STDL   WDSS
          UJN    UBTX
          SPACE  5,20
** NAME-- UC
*
** PURPOSE-- UPDATE CLOCK.  THE CLOCK IS USED TO TIMEOUT COMMANDS.
          SPACE  2
 UCX      LJM    **
 UC       EQU    *-1
          LDDL   CLCUR
          STDL   P6          SAVE CURRENT CLOCK
          IAN    14B
          STDL   CLCUR
          SBDL   P6
          PJN    UC5         IF CLOCK HAS NOT WRAPPED
          ADC    10000B
 UC5      BSS
          RADL   CLMCS       UPDATE MICROSECOND PORTION OF CLOCK
          LDDL   CLMCS
          ADC    -2000
          MJN    UCX         IF LESS THAN 2 MILLISECONDS
          STDL   CLMCS
          LDN    2
          RADL   CLMLS       UPDATE MILLISECOND PORTION OF CLOCK
          ADC    -1000
          MJN    UCX         IF LESS THAN 1 SECOND
          STDL   CLMLS
          AODL   CLSEC       UPDATE SECOND PORTION OF CLOCK
          UJN    UCX
          SPACE  5,20
** NAME-- UNCMND
*
** PURPOSE-- GET NEXT COMMAND.
*
** INPUT-- NUMCM, FRST, RS+/RS/P.LASTC
*
** OUTPUT-- CMLIST, FNC, RQ+/RQ/P.CMND
*           CMLISTL.
*
** EXIT-- A REGISTER = 0, IF NO MORE COMMANDS.
*         A REGISTER .NE. 0, IF NEXT COMMAND PRESENT.
          SPACE  2
 UNCX     LJM    **
 UNCMND   EQU    *-1
          LDML   NUMCM
          ZJN    UNCX        IF NO MORE COMMANDS, EXIT, A REGISTER = 0
          SOML   NUMCM       DECREMENT COMMAND COUNT
          LDML   FRST        HAS FIRST COMMAND BEEN PROCESSED
          ZJN    UNC10       IF FIRST COMMAND HASN'T BEEN PROCESSED

*         READ NEXT COMMAND FROM CM.

          AOML   SS+/SS/P.LASTC OFFSET TO COMMAND
          LDN    C.CM
          STDL   WC
          LOADF  SS+/SS/P.REQ  LOAD CM ADDRESS AND REFORMAT
          ADML   SS+/SS/P.LASTC ADD OFFSET OF COMMAND
          CRML   CM,WC       READ COMMAND FROM CM
 UNC10    AOML   FRST        SET NONZERO

*         IF INDIRECT ADDRESS, READ CM ADDRESS LIST.

          LDN    0
          STDL   FNC         SET UP INTERNAL FUNCTION CODE
          LDML   CM+/CM/P.LEN
          STML   CMLIST+/CM/P.LEN
          SHN    -3
          STDL   CMLISTL     LENGTH OF CM ADDRESS AREA  (CM WORDS)
          LDML   CM+/CM/P.INDIR
          SHN    /CM/L.INDIR+2
          PJN    UNC15       IF NOT INDIRECT ADDRESS
          RJM    GLIST       GET CM ADDRESS LIST OF DATA AREA
          UJN    UNC30
 UNC15    BSS
          LDN    1
          STDL   CMLISTL     IF NOT INDIRECT, ONLY 1 COMMAND.
          LDML   CM+/CM/P.RMA
          STML   CMLIST+/CM/P.RMA
          LDML   CM+/CM/P.RMA+1
          STML   CMLIST+/CM/P.RMA+1

*         SET UP INTERNAL FUNCTION CODE, FNC.

 UNC30    BSS
          LDML   CM+/CM/P.CODE  GET COMMAND CODE
          SHN    -16+/CM/N.CODE+/CM/L.CODE
          SBML   UCMD,FNC    COMPARE COMMAND CODE
          ZJN    UNC40       IF COMMAND FOUND
          AODL   FNC
          SBN    UCMDL
          MJN    UNC30       IF MORE COMMANDS TO CHECK
          LDDL   SLAVE
          ZJK    UNC31       NOT SLAVE
          RJM    HANG        NO ERROR RESPONSE FROM SLAVE
 UNC31    BSS
          LDC    E501        ERROR IN COMMAND CODE
          RJM    INTERR      INTERFACE ERROR (NO RETURN)
 UNC40    LDN    1           SET A REGISTER NONZERO FOR EXIT
          UJK    UNCX
          SPACE  5,20
** NAME-- WAITP
*
** PURPOSE-- WAIT FOR A MESSAGE FROM THE PARTNER PP.
          SPACE  2
 WAITX    LJM    **
 WAITP    EQU    *-1
 WAIT10   BSS
          RJM    GETMSG      GET MESSAGE FROM PARTNER
          ZJK    WAITX       IF MESSAGE = GO
          UJK    WAIT10      IF NO MESSAGE
          SPACE  5,20
** NAME-- WFI
*
** PURPOSE-- WAIT FOR CHANNEL INACTIVE
          SPACE  2
 WFIX     LJM    **
 WFI      EQU    *-1
          LCN    0
 WFI10    BSS
          IJM    WFIX,DC     IF CHANNEL INACTIVE
          SBN    1
          NJN    WFI10       IF TIMEOUT NOT EXPIRED
          LDDL   SLAVE
          NJK    READ38      IF SLAVE
          STDL   T4          WORDS NOT TRANSFERRED
          LDN    C.AREG      INCOMPLETE CHANNEL TRANSFER
          RJM    RWEP        READ WRITE ERROR PROCESSING (NO RETURN)
          SPACE  5,20
** NAME-- WRITE
*
** PURPOSE-- PROCESS THE WRITE DATA COMMAND.
*
** INPUT-- CMLISTL = NUMBER OF ADDRESS-LENGTH-PAIR ENTRIES IN THE
*                    COMMAND WHICH ARE LEFT TO PROCESS.
*          CMLIST = LIST OF ADDRESS-LENGTH-PAIRS POINTING TO THE
*                   CM DATA AREA.
          SPACE  2
 WRIX     LJM    **
 WRITE    EQU    *-1
          LDDL   SLAVE
          NJN    WRI3        IF SLAVE PP
          LDN    C.REQ
          STDL   GOFLG       SET GO FLAG
          RJM    SEND        SEND REQUEST TO SLAVE
 WRI3     BSS
          LDN    0
          STDL   WDSS        USED TO UPDATE BYTES TRANSFERRED IN
                             RESPONSE TABLE
          STDL   TOGL        TOGL = ZERO TO START
          STDL   SWFLG       CLEAR SWITCH FLAG
 WRI5     BSS
          LDN    0
          STDL   SECPOS      SET SECTOR POSITION = 0

* SETUP NUMBER OF WORDS TO TRANSFER FROM THIS CM ADDRESS.

 WRI20    BSS
          LOADF  CMLIST+/CM/P.RMA  SET UP CM ADDRESS OF DATA AREA
          STDL   DATADD+2
          SRD    DATADD      SAVE R REGISTER
          LDML   CMLIST+/CM/P.LEN  NUMBER OF 8-BIT BYTES TO TRANSFER
          ADN    7           ROUND UP
          SHN    -3          NUMBER OF CM WORDS TO TRANSFER
          STDL   TWDS        TOTAL NUMBER OF CM WORDS TO TRANSFER
                             FROM THIS ADDRESS
 WRI30    BSS
          STDL   WDS         COMPUTE NUMBER OF WORDS TO TRANSFER TO
                             CURRENT SECTOR
          LDML   SECWDS,TOGL NUMBER OF WORDS FOR THE SECTOR FOR THIS PP
          SBDL   SECPOS      WORDS PREVIOUSLY TRANSFERRED
          SBDL   WDS         WORDS AVAILABLE FROM CM
          PJN    WRI35       IF LESS THAN THIS PP NEEDS TO FILL BUFFER
          LDML   SECWDS,TOGL  NUMBER OF WORDS FOR THIS PP
          SBDL   SECPOS
          STDL   WDS         NUMBER OF CM WORDS CURRENTLY NEEDED

* TRANSFER DATA FROM CM.

 WRI35    BSS
          LDDL   TOGL
          SBDL   SLAVE       TOGL = SLAVE MEANS I/O IS FOR REAL

          NJN    WRI38       IF PARTNER WRITES, I DON'T NEED DATA
          LDDL   SECPOS      CALCULATE SECTOR BUFFER TRANSFER ADDRESS
          SHN    2
          ADC    0           BOTH WORDS OF THE INSTRUCTION ARE MODIFIED
 WRI36    EQU    *-1
          STML   WRI37
          LDDL   WDS
          ZJN    WRI38       IF ZERO WORDS TO TRANSFER
          LOADC  DATADD      CM ADDRESS OF DATA AREA

          CRML   -**,WDS     READ THE DATA
 WRI37    EQU    *-1

* UPDATE SECTOR POSITION.

 WRI38    BSS
          LDDL   WDS
          RADL   SECPOS      UPDATE SECTOR POSITION
          SBML   SECWDS,TOGL  CHECK FOR END OF BUFFER
          NJN    WRI39       IF NOT END OF BUFFER
          STDL   SECPOS      SET BACK TO BEGINNING OF BUFFER
          UJN    WRI46
 WRI39    BSS
          LDDL   CMLISTL     CHECK IF MORE CM ADDRESS-LENGTH-PAIRS
          SBN    1
          NJK    WRI69       IF MORE CM DATA TO TRANSFER
          LDN    0
          STDL   SECPOS      RESET SECTOR POSITION = 0

* WAIT FOR GO FROM PARTNER.

 WRI46    BSS
          LDDL   TOGL
          SBDL   SLAVE       TOGL = SLAVE MEANS I/O IS FOR REAL
          NJK    WRI64       IF PARTNER WRITES THIS SECTOR
          RJM    WAITP       WAIT FOR MESSAGE FROM PARTNER
          LDDL   SLAVE       IF SLAVE, CHANNEL IS ALREADY GOING
          NJN    WRI52       JUST GO AND MOVE THE DATA

* TRANSFER DATA TO DISK.

          LDN    F.WRITE     ISSUE WRITE FUNCTION TO DISK CONTROLLER
          RJM    FUNC        ISSUE THE FUNCTION (MASTER ONLY)
 WRI50    EQU    *-1         FOR FORCING ERRORS
          RJM    UDA         UPDATE DISK ADDRESS
          LDN    1
          STDL   GOFLG       SET GO FLAG
 WRI52    BSS
          LDML   IOCOUNT,TOGL  BUFFER SIZE
          OAPM   7777B,DC    WRITE TO DISK
 WRI53    EQU    *-1
          NJN    WRI56       IF NOT ALL WORDS TRANSFERRED
 F        IFEQ   FE,1        FOR FORCING ERRORS
          LDC    1
 WRI54    EQU    *-1
          SBN    1
          NJN    *-1
 F        ENDIF
          LDDL   SLAVE
          ZJN    WRI58       IF MASTER
          LDN    77B
 WRI55    BSS
          EJM    WRI57,DC    IF CHANNEL EMPTY
          SBN    1
          NJN    WRI55       IF TIMEOUT NOT EXPIRED
 WRI56    BSS
          STDL   T4          WORDS NOT TRANSFERRED
          LDN    C.AREG      NOT ALL WORDS TRANSFERRED
          UJN    WRI59
 WRI57    BSS
          DCN    DC+40B      DISCONNECT THE CHANNEL
 WRI58    BSS
          CFM    WRI60,DC    IF ERROR FLAG NOT SET
          LDN    C.CPE       CHANNEL PARITY ERROR
 WRI59    BSS
          RJM    RWEP        READ WRITE ERROR PROCESSING (NO RETURN)

* SEND A GO TO PARTNER/SAVE POINTERS/UPDATE CLOCK

 WRI60    BSS
          LDN    C.GO
          RJM    SEND        TELL PARTNER DONE WITH TRANSFER
          RJM    UC          UPDATE CLOCK
          LDN    0
          STDL   GOFLG       CLEAR GO FLAG
 WRI64    BSS
          RJM    UBT         UPDATE BYTES TRANSFERRED
          LDDL   SWFLG       WAS THIS THE FIRST I/O AFTER A REQUEST SWITCH
          ZJN    WRI68       NO- (NEVER CAN BE FOR THE SLAVE)
          RJM    SWITCH      GO AND SWITCH REQUESTS
 WRI68    BSS
          LDDL   TOGL        INVERT TOGGLE FLAG
          LMN    1
          STDL   TOGL
 WRI69    BSS
          LDDL   WDS
          RADL   WDSS        SAVE WORDS TRANSFERRED THIS SECTOR
          LDDL   WDS
          RADL   DATADD+2    UPDATE CM ADDRESS
          LDDL   TWDS        UPDATE TOTAL WORDS LEFT TO TRANSFER
                             FROM THIS CM ADDRESS.
          SBDL   WDS
          STDL   TWDS
          NJN    WRI69A      IF MORE TO TRANSFER FROM THIS CM ADDRESS
          LDDL   TOGL
          ZJN    WRI70       IF REALLY NO MORE TO TRANSFER
          LDDL   CMLISTL
          SBN    1           CHECK IF LAST CM ADDRESS POINTER
          NJN    WRI70       IF NO, GO GET THE NEXT DATA ADDRESS
 WRI69A   BSS
          LJM    WRI30       GO GET MORE DATA

* GET NEXT CM ADDRESS OF DATA AREA.

 WRI70    BSS
          SODL   CMLISTL     DECREMENT ADDRESS-LENGTH-PAIR COUNT
          ZJN    WRI74       IF END OF ADDRESS-LENGTH-PAIRS IN COMMAND
          RJM    GLIST       GET NEXT ENTRY OF LIST
          UJK    WRI20

* GET NEXT COMMAND.

WRI74     BSS
          RJM    UNCMND      GET NEXT COMMAND
          ZJN    WRI80       IF NO MORE COMMANDS
          LDDL   FNC         GET COMMAND CODE
          SBN    1
          ZJK    WRI20       IF WRITE
          LDC    E50A
          RJM    INTERR      INTERFACE ERROR (NO RETURN)

* END OF DATA.  GET GENERAL STATUS FOR LAST SECTOR

 WRI80    BSS
          RJM    CSWIT       CHECK IF SWITCH TO NEXT REQUEST
          NJK    WRI5        IF SWITCH TO NEXT REQUEST
 WRI82    BSS
          RJM    WAITP       WAIT FOR PARTNER (SLAVE NEVER RETURNS TO +1)
          RJM    GENSTAT     GET LAST GENERAL STATUS
          ZJK    WRIX        IF NO ERROR
          LDN    E00         CP MUST ISOLATE THE ERROR
          RJM    PCER        PREPARE COMMON ERROR RESPONSE (NO RETURN)
          ERRPL  *-SLVBUF    IF SLAVE CODE OVERFLOWS INTO THE DATA BUFFER
          TITLE  RESIDENT MASTER ROUTINES
** NAME-- CCLOCK
*
** PURPOSE-- CLEARS CHANNEL LOCK.
*
          SPACE  2
 CCLX     LJM    **
 CCLOCK   EQU    *-1
          LDML   CHLOCK
          NJK    CCLX        IF CHANNEL LOCK WAS NOT SET
          LDC    CM.CHAN     CM ADDRESS OF CHANNEL INTERLOCK TABLE
          STDL   P6
          LDDL   CHAN        CHANNEL NUMBER = OFFSET IN TABLE
          STDL   T5
          RJM    CLOCK       CLEAR CHANNEL LOCKWORD
          LDN    1
          STML   CHLOCK      INDICATE CHANNEL LOCK CLEARED
          UJK    CCLX
          SPACE  5,20
** NAME-- CKC
*
** PURPOSE-- CHECK IF CHANNEL MUST BE GIVEN UP
          SPACE  2
 CKCX     LJM    **
 CKC      EQU    *-1
          LDN    C.CHCNT     NUMBER OF REQUESTS TO PROCESS BEFORE
          STML   CHLCNT       GIVING UP THE CHANNEL
          LOADC  CM.CHAN     CM ADDRESS OF CHANNEL INTERLOCK TABLE
          ADDL   CHAN        CHANNEL  NUMBER IS OFFSET IN TABLE
          CRDL   T1          READ CHANNEL LOCKWORD
          LDDL   T2
          LPN    1
          ZJK    CKCX        IF NOT GIVING UP THE CHANNEL
          LDDL   DEVL
          ZJK    CKCX        IF NO UNITS
          RJM    CCLOCK      CLEAR THE CHANNEL LOCK
          PAUSE  130000      DELAY TO ALLOW MAINTENANCE TO GET THE CHANNEL
          RJM    SCLOCK      SET CHANNEL LOCK
          STDL   CTF         SO ERROR WILL BE REPORTED AS UNSOLICITED
          STDL   PTF
          LJM    MAIN5
          SPACE  5,20
** NAME-- CLOCK
*
** PURPOSE-- CLEAR LOCKWORD
*
** ENTRY
*         P6 = POINTER RMA
*         T5 = OFFSET TO LOCKWORD FROM RMA
*
** EXIT
*         A = 0 IF LOCK WAS CLEARED
          SPACE  2
 CLKX     LJM    **
 CLOCK    EQU    *-1
 CLK10    BSS
          LCN    0
          STDL   T1
          STDL   T2
          LDN    0
          STDL   T3
          STDL   T4
          LOADR  0,P6        INTERFACE TABLE ADDRESS
          ADDL   T5          ADD OFFSET
          STDL   T6          SAVE CM ADDRESS
          RDSL   T1          WRITE INTERMEDIATE VALUE
          LDDL   T1
          ADDL   T2
          ADC    -177777B-177777B
          ZJN    CLK10       IF INTERMEDIATE VALUE
          LDDL   T4
          SBDL   PPNO
          ZJN    CLK30       IF THIS PP HAS THE LOCK SET
          LDDL   T6
          LMC    400000B
          CWDL   T1          RESTORE THE ORIGINAL LOCKWORD
          LDN    1
          UJK    CLKX        EXIT, LOCKWORD NOT CLEARED
 CLK30    BSS
          LDN    0
          STDL   T1
          STDL   T2
          STDL   T3
          STDL   T4
          LDDL   T6          CM ADDRESS OF UNIT LOCK
          LMC    400000B
          CWDL   T1          CLEAR THE LOCKWORD
          LDN    0
          UJK    CLKX        EXIT, LOCKWORD CLEARED
          SPACE  5,20
** NAME-- CLRLOCK
*
** PURPOSE-- CLEARS UNIT LOCK IN UNIT INTERFACE TABLE.
*
** ENTRY
*         LUTLOC - POINTER TO CURRENT LOGICAL UNIT TABLE
          SPACE  2
 CLRLX    LJM    **
 CLRLOCK  EQU    *-1
          LDDL   LUTLOC        UNIT INTERFACE TABLE ADDRESS
          ADN    /LUT/P.UIT
          STDL   P6
          LDN    /UIT/C.ULOCK  OFFSET OF UNIT LOCKWORD
          STDL   T5
          RJM    CLOCK       CLEAR UNIT LOCKWORD
          NJN    CLR10       IF LOCK COULD NOT BE CLEARED
          STML   /LUT/P.OWNER,LUTLOC  CLEAR LOCKED FLAG
          UJK    CLRLX
 CLR10    BSS
          RJM    HANG
          SPACE  5,20
** NAME-- CQLOCK
*
** PURPOSE-- CLEARS THE QUEUE LOCK IN THE UNIT INTERFACE TABLE.
          SPACE  2
 CQLX     LJM    **
 CQLOCK   EQU    *-1
          LDDL   LUTLOC      UNIT INTERFACE TABLE ADDRESS
          ADN    /LUT/P.UIT
          STDL   P6
          LDN    /UIT/C.QLOCK  OFFSET OF QUEUE LOCKWORD
          STDL   T5
          RJM    CLOCK       CLEAR THE LOCKWORD
          UJK    CQLX
          SPACE  5,20
** NAME-- CSWIT
*
** PURPOSE-- CHECK IF A SWITCH SHOULD BE MADE TO THE NEXT
*            REQUEST.  THE SWITCH IS DONE BY THE MASTER WHILE
*            THE SLAVE IS TRANSFERRING DATA.
*
** EXIT-- A REGISTER = 0, IF NOT SWITCH.
*         A REGISTER NONZERO, IF SWITCH.
          SPACE  2
 CSW100   BSS
          LDN    0
 CSWX     LJM    **
 CSWIT    EQU    *-1
          LDDL   SLAVE
          NJN    CSW100      IF SLAVE (SLAVE DOESN'T SWITCH)
          LDDL   CF
          NJN    CSW100      IF IN RECOVERY, DON'T SWITCH
          LDML   RS+/RS/P.RTRY
          NJN    CSW100      IF IN RECOVERY, DON'T SWITCH

* RE-READ THE SWITCH FLAG AND LINKAGE WORDS.

          LDN    2           NUMBER OF WORDS TO READ
          STDL   WC
          LOADF  SS+/SS/P.REQ  LOAD CM ADDRESS AND REFORMAT
          ADN    2
          CRML   RQ+2*4,WC   READ CURRENT REQUEST
          SBN    4
          CRML   RQ,WC       READ SWITCH FLAG BEFORE LINKAGE POINTERS
          LDML   RQ+/RQ/P.SWIT  CHECK IF REQUEST SWITCH FLAG SET
          SHN    -16+/RQ/N.SWIT+/RQ/L.SWIT
          STDL   SWFLG       SAVE SWITCH FLAG
          ZJK    CSWX        IF SWITCH FLAG IS NOT SET
          LDML   RQ+/RQ/P.NEXT  PUT RMA OF NEXT REQUEST IN SS TABLE
          STML   SS+/SS/P.REQ
          LDML   RQ+/RQ/P.NEXT+1
          STML   SS+/SS/P.REQ+1
          LDML   RQ+/RQ/P.NEXTPV  PUT PVA OF NEXT REQUEST IN SS TABLE
          STML   SS+/SS/P.PVA
          LDML   RQ+/RQ/P.NEXTPV+1
          STML   SS+/SS/P.PVA+1
          LDML   RQ+/RQ/P.NEXTPV+2
          STML   SS+/SS/P.PVA+2
          RJM    UREQ        READ NEXT REQUEST INTO RQ
          RJM    SAVSS       WRITE SS TABLE TO CM
          LDN    C.SWIT      SEND SWITCH MESSAGE TO SLAVE
          RJM    SEND
          RJM    UNCMND      GET COMMAND AND SET UP TO PROCESS
          LDN    1
          UJK    CSWX        EXIT NONZERO
          SPACE  5,20
** NAME-- CTR
*
** PURPOSE-- CONFIDENCE TEST RECOVERY (THE CONFIDENCE TEST IS
*            CONSIDERED SUCCESSFUL IF NO MORE THAN 3 SECTORS OF
*            A CYLINDER HAVE UNRECOVERABLE MEDIA ERRORS.
*
** EXIT-- TO CALLING ROUTINE WITH
*           A = 0  DATA INTEGRITY ERROR OR MORE THAN 3 MEDIA ERRORS
*           A NOT 0  IF NOT A MEDIA ERROR
*         TO CTDT ROUTINE IF MEDIA ERROR
          SPACE  2
 CTR100   BSS
          LMN    4
 CTRX     LJM    **
 CTR      EQU    *-1
          RJM    RDT         READ DEVICE TABLE
          SHN    -1
          NJN    CTR100      IF NOT IN CONFIDENCE TEST
          LDML   RS+/RS/P.DET
          LMN    1
          NJN    CTRX        IF NOT MEDIA ERROR
          LDML   RS+/RS/P.GENST1
          LMC    GS5020
          NJN    CTRX        IF NOT MEDIA ERROR
          LDML   RS+/RS/P.DETAIL+4
          LPN    17B
          SBN    4
          ZJN    CTR10       IF FORMAT 4 (MEDIA ERROR)
          SBN    1           CHECK FOR FORMAT 5
          NJK    CTRX        IF NOT MEDIA ERROR
 CTR10    BSS
          STDL   T6          CLEAR INDEX TO MEDIA ERROR TABLE
          LDML   SS+/SS/P.TRACK
          LPN    77B
          SHN    8
          ADML   SS+/SS/P.SECTOR
          STDL   T5
 CTR20    BSS
          LDML   SS+CTME,T6
          SHN    2
          MJN    CTR30       IF TABLE ENTRY AVAILABLE
          SHN    -2
          LMDL   T5
          ZJN    CTR30       IF SECTOR IN TABLE
          AODL   T6
          LMN    3
          NJN    CTR20       IF MORE ENTRIES TO CHECK
          UJK    CTRX
*
*         THE CONFIDENCE TEST OVERLAY MUST ALREADY BE LOADED.  LOADING IT
*         HERE WOULD DESTROY RETURN JUMP ADDRESSES.
*
 CTR30    BSS
          LDDL   T5
          STML   SS+CTME,T6  PUT ADDRESS IN TABLE
          LDN    1
          STDL   FT          SO UDA WILL UPDATE ADDRESS
          RJM    UDA         UPDATE DISK ADDRESS
          LDDL   FNC
          ZJN    CTR40       IF READ
          LDML   SS+/SS/P.TRACK
          LPN    77B
          SBN    MAXTR+1
          ZJK    CTDT45      IF ERROR WAS ON LAST SECTOR OF CYLINDER
          LDN    0
          STDL   FT          INDICATE FIRST FUNCTION
          LJM    CTDT20      CONTINUE WRITING
 CTR40    BSS
          LDML   SS+/SS/P.TRACK
          LPN    77B
          SBN    MAXTR+1
          ZJK    CT25        IF ERROR WAS ON LAST SECTOR OF CYLINDER
          LDN    0
          LJM    CTDT50
          SPACE  5,20
** NAME-- DCN
*
** PURPOSE-- WAIT FOR CHANNEL EMPTY, THEN DISCONNECT THE CHANNEL
          SPACE  2
 DCNX     BSS
          DCN    DC+40B      DISCONNECT THE CHANNEL
          LJM    **
 DCN      EQU    *-1
          LCN    0
 DCN10    BSS
          EJM    DCNX,DC     IF CHANNEL EMPTY
          SBN    1
          NJN    DCN10       IF TIMEOUT NOT EXPIRED
          STML   RS+/RS/P.FUNTO  WORDS NOT TRANSFERRED
          LDN    E05         INCOMPLETE CHANNEL TRANSFERR
          RJM    PCER        PREPARE COMMON ERROR RESPONSE (NO RETURN)
          SPACE  5,20
** NAME-- DELRQ
*
** PURPOSE-- DELETE COMPLETED REQUEST FROM THE UNIT QUEUE.
*            SELECT A NEW CURRENT REQUEST BASED UPON CYLINDER ADDRESS.
*
** INPUTS-- SS+P.UQT = POINTER TO UNIT QUEUE TABLE
*           RQ = COMPLETED REQUEST.
*
** OUTPUTS-- RQ = SELECTED REQUEST
*            T8 IS UNCHANGED
          SPACE  2
 DELX     LJM    **
 DELRQ    EQU    *-1
 DEL2     BSS
          RJM    SQLOCK      SET QUEUE LOCKWORD
          NJN    DEL2        IF LOCK COULD NOT BE SET

* DECREMENT QUEUE COUNTER.

          LOADR  SS+/SS/P.UQT  LOAD CM ADDRESS OF UNIT QUEUE TABLE
          STDL   T1
          CRDL   P1          READ QUEUE COUNT
          LDDL   P1+/UIT/P.QCNT  DECREMENT QUEUE COUNT
          SBDL   NCOMRQ      NUMBER OF COMPLETED REQUESTS
          STDL   P1+/UIT/P.QCNT
          MJN    DEL3        IF INVALID QUEUE COUNT
          LDDL   T1
          LMC    400000B
          CWDL   P1          WRITE QUEUE COUNT

* RE-READ RMA CHAIN POINTERS OF CURRENT REQUEST.

 DEL3     BSS
          LDN    2
          STDL   P3
          LOADF  CURRQ       RMA OF CURRENT REQUEST
          CRML   RQ,P3       READ RMA CHAIN OF CURRENT REQUEST

          LOADR  SS+/SS/P.DP  DELINK POINTER
 DEL15    BSS
          STDL   P2
          ADN    1           POINT TO RMA INSTEAD OF PVA
          CRDL   T1          RMA OF A REQUEST
          LDDL   T3
          LMML   FCOMRQ
          NJN    DEL20       IF NOT COMPLETED REQUEST
          LDDL   T4
          LMML   FCOMRQ+1
          ZJN    DEL30       IF THIS IS A COMPLETED REQUEST
 DEL20    BSS
          LOADF  T3          UPDATE DELINK POINTER TO NEXT
          STML   SS+/SS/P.DP+2   REQUEST IN THE CHAIN
          LDDL   CMADR
          STML   SS+/SS/P.DP
          LDDL   CMADR+1
          STML   SS+/SS/P.DP+1
          LDDL   CMADR+2
          LMC    400000B
          UJN    DEL15

* DELINK COMPLETED REQUESTS.
* (P3 = 2.)

 DEL30    BSS
          LDDL   P2          CM ADDRESS OF REQUEST
          LMC    400000B
          CWML   RQ,P3       PVA AND RMA OF NEXT REQUEST IN CHAIN

*         SELECT NEXT REQUEST ON QUEUE

          LDN    0
          STDL   NCOMRQ      CLEAR COMPLETED REQUEST COUNT
          STML   SS+/SS/P.ENTRY  INDICATE NO REQUEST SELECTED
          LDML   RQ+/RQ/P.NEXT
          ADML   RQ+/RQ/P.NEXT+1
          NJN    DEL35       IF REQUEST EXISTS
          LDDL   P4
          ZJK    DEL40       IF QUEUE EMPTY
          RJM    SELRQ       SELECT FIRST REQUEST ON QUEUE
          UJK    DELX
 DEL35    BSS
          RJM    CQLOCK      CLEAR QUEUE LOCK
          LDML   RQ+/RQ/P.NEXT  SAVE RMA OF NEXT REQUEST
          STML   SS+/SS/P.REQ
          LDML   RQ+/RQ/P.NEXT+1
          STML   SS+/SS/P.REQ+1
          LDML   RQ+/RQ/P.NEXTPV  SAVE PVA OF NEXT REQUEST
          STML   SS+/SS/P.PVA
          LDML   RQ+/RQ/P.NEXTPV+1
          STML   SS+/SS/P.PVA+1
          LDML   RQ+/RQ/P.NEXTPV+2
          STML   SS+/SS/P.PVA+2
          LDN    /SS/K.ENTRY
          STML   SS+/SS/P.ENTRY  INDICATE REQUEST SELECTED
          RJM    SSA         SET SEEK ADDRESS
          UJN    DEL45
 DEL40    BSS
          RJM    CQLOCK      CLEAR QUEUE LOCKWORD
 DEL45    BSS
          RJM    SAVSS       SAVE SHARED TABLE
          UJK    DELX
          SPACE  5,20
** NAME-- DS
*
** PURPOSE-- GET DETAILED STATUS.  THIS PROVIDES MORE INFORMATION FOR AN
*            ERROR.  IT IS NOT THE CAUSE OF AN ERROR, SO AN ERROR TRYING
*            TO GET DETAILED STATUS DOES NOT GENERATE AN ERROR.
*
** NOTE -- MUST BE RESIDENT DUE TO CHANNEL INSTRUCTIONS
          SPACE  2
 DSX      LJM    **
 DS       EQU    *-1
          LDDL   GNSTAT
          STML   RS+/RS/P.GENST1 PUT GENERAL STATUS IN RESPONSE
          STML   RS+/RS/P.GENST2
          DCN    DC+40B      ENSURE THE CHANNEL IS DISCONNECTED
          LDN    F.EDS
          FAN    DC          ISSUE DETAILED STATUS FUNCTION
          LCN    0
 DS5      BSS
          IJM    DS10,DC     IF CHANNEL INACTIVE
          SBN    1
          NJN    DS5         IF TIMEOUT NOT EXPIRED
          UJK    DSX
 DS10     BSS
          LDN    20
          STDL   T1
          ACN    DC
          IAM    RS+/RS/P.DETAIL,DC INPUT DETAILED STATUS
          SFM    DS20,DC     IF ERROR
          NJN    DS20        IF ERROR
          LDN    1
          STML   RS+/RS/P.DET INDICATE DETAILED STATUS PRESENT
 DS20     BSS
          LDML   RS+/RS/P.DETAIL-1,T1 MAKE FIRST AND LAST DETAILED
          STML   RS+/RS/P.DETAIL+19,T1  STATUS THE SAME
          SODL   T1
          NJN    DS20
          UJK    DSX
          SPACE  5,20
** NAME-- EFP
*
** PURPOSE-- ERROR FLAG PROCESSING
          SPACE  2
 EFP      CON    0
 F        IFEQ   CHANTYP,1
          RJM    RES         READ ERROR STATUS REGISTER
          STML   RS+/RS/P.LERREG
          STML   RS+/RS/P.FERREG
          SHN    15
          PJN    EFP10       IF NOT KZ BOARD ERROR
          LDN    E02
          UJN    EFP30
 EFP10    BSS
          SHN    2
          PJN    EFP20       IF NOT KX BOARD ERROR
          LDN    E03
          UJN    EFP30
 EFP20    BSS
 F        ENDIF
          LDN    E04
 EFP30    BSS
          RJM    PCER        PREPARE COMMON ERROR RESPONSE (NO RETURN)
          SPACE  5,20
** NAME-- EP
*
** PURPOSE-- ERROR PROCESSING
*
** ENTRY
*         CA - ADDRESS TO GO FOR CONTINUE RECOVERY
*         COMLOOK - INDEX TO TABLE FOR FAILING UNIT
*         LUTLOC - POINTER TO LOGICAL UNIT TABLE
          SPACE  2
 EP       CON    0
          LDML   RS+/RS/P.RTRY
          NJN    EP5         IF NOT FIRST ERROR FOR REQUEST
          STDL   RECOV       CLEAR INDEX TO RECOVERY STEP
 EP5      BSS
          RJM    PPREQ       CHECK FOR IDLE REQUEST
          LDN    0
          STDL   FT          CLEAR FIRST TIME FLAG
          LDDL   CA
          ZJN    EP10        IF NOT SENDING CONTINUE
          LDDL   GNSTAT
          LMC    GS4400
          NJN    EP10        IF NOT SENDING CONTINUE
          LDML   RS+/RS/P.EC
          NJN    EP10        IF NOT SENDING CONTINUE (PARITY ERR ON GENSTAT)
          LDN    F.CONT
          RJM    FUNC        SEND CONTINUE FUNCTION
          AODL   CF          INDICATE CONTINUE FUNCTION SENT
          LDDL   GOFLG
          NJN    EP7         IF ERROR ON CURRENT SECTOR
          RJM    RDT         READ DEVICE TABLE
          SHN    -1
          ZJN    EP7         IF ERROR DURING CONFIDENCE TEST
          LDN    C.RTRY
          RJM    SEND        TELL SLAVE TO BACK UP
          LOADOVL ERO        LOAD ERROR RECOVERY OVERLAY
          RJM    RSTBP       RESTORE BACKUP POINTERS
 EP7      BSS
          LJM    0,CA
 EP10     BSS
          LDDL   RECOV       INDEX TO RECOVERY PROCEDURE
          STDL   T1
          LDML   EPT,T1
          STML   EP20
          LJM    **          EXECUTE NEXT STEP IN RECOVERY SEQUENCE
 EP20     EQU    *-1
 EPT      BSS
          CON    EPA         RETRY THE REQUEST
          CON    EPB         CONFIDENCE TEST/FORMAT
          CON    EPC         AUTOLOAD CCC
          CON    EPD         LAST RECOVERY ATTEMPT FAILED
          CON    EPE         DOWN CHANNEL
          CON    EPF         DOWN UNIT
          CON    EPG         CLEAR UNIT LOCK
*
*         REQUEST RETRY
*
 EPA      BSS
          RJM    INTRS       SEND INTERMEDIATE RESPONSE
          RJM    CTR         CONFIDENCE TEST RECOVERY
          NJN    EPA20       IF ERROR LIMIT NOT REACHED
          AOML   RS+/RS/P.RTRY  REQUEST RETRY COUNTER
          UJK    EPC
 EPA20    BSS
          AOML   RS+/RS/P.RTRY  REQUEST RETRY COUNTER
          SBN    RTRY
          PJN    EPB         IF RETRY LIMIT
          UJK    EPC80
*
*         CONFIDENCE TEST/FORMAT UNIT
*
 EPB      BSS
          LDML   CTF
          ZJK    EPB20       IF IN SUBSYSTEM CONFIDENCE TEST
          LDDL   FNC
          SBN    2
          ZJK    EPD         IF FORMAT
          LDDL   RECOV
          LMN    1
          ZJN    EPB10       IF CONFIDENCE TEST ALREADY STARTED
          AODL   RECOV       INDEX TO NEXT RECOVERY STEP
          RJM    RDT         READ DEVICE TABLE
          LPN    /CB/K.ACT
          STDL   P2
          LDDL   CM.DEV+2
          ADDL   COMLOOK
          LMC    400000B
          CWDL   P2          ENABLE STARTING CONFIDENCE TEST
          LOADOVL CTO        LOAD CONFIDENCE TEST OVERLAY
          RJM    CT          CONFIDENCE TEST
          LDML   /LUT/P.OFFSET,LUTLOC
          STDL   COMLOOK     RESTORE INDEX TO DEVICE TABLE
          LJM    EPC80
 EPB10    BSS
          RJM    CTR         CONFIDENCE TEST RECOVERY
          UJN    EPC
 EPB20    BSS
          LDDL   PTF
          NJN    EPB30       IF PATH TEST COMPLETE
          LDN    4           EPE IS ENTRY FOR NEXT ERROR
          STDL   RECOV
          LJM    MAIN5
 EPB30    BSS
          LDN    0
          STDL   PTF         SO PATH TEST WILL BE RUN
          LOADOVL PTO        LOAD PATH TEST OVERLAY
          RJM    PT          EXECUTE PATH TEST
          LDN    3           EPD IS NEXT STEP IN RECOVRY ALGORITHM
          STDL   RECOV       DOWN UNIT IF FORMAT FAILS
          LOADOVL FMO        LOAD FORMAT OVERLAY
          LDC    MAXCYL-1
          STML   FBUF        CONFIDENCE TEST CYLINDER
          RJM    FC          FORMAT CONFIDENCE TEST CYLINDER
          LJM    MAIN5
*
*         AUTOLOAD CCC
*
 EPC      BSS
          LDDL   RECOV
          SBN    2
          ZJK    EPC50       IF LOAD ALREADY ATTEMPTED
          RJM    RDT         READ DEVICE TABLE
          SHN    -1
          SBN    1
          NJN    EPC40       IF CONFIDENCE TEST FAILED
          LDK    /RS/K.DATERR  INDICATE MEDIA ERROR
          STML   RS+/RS/P.HDWR
          LDC    R.ABN*0#4000  ABNORMAL TERMINATION
          STML   RS+/RS/P.RC  RESPONSE CODE
          RJM    RESP        SEND RESPONSE
          RJM    DELRQ       DELINK REQUEST
          LJM    EPE20
 EPC40    BSS
          ADN    1
          NJN    EPC50       IF ERROR CODE ALREADY STORED
          LDDL   P2
          LPN    1
          LMN    4
          STDL   P2
          LDDL   CM.DEV+2
          ADDL   COMLOOK
          ADC    400000B
          CWDL   P2          INDICATE CONFIDENCE TEST FAILED
 EPC50    BSS
          RJM    INTRS       SEND INTERMEDIATE RESPONSE
          LOADOVL PTO        LOAD NECESSARY OVERLAY
          LDML   RS+/RS/P.RTRY
          SBN    RTRY+1
          MJN    EPC60       IF NOT RETRY LIMIT
          LDN    4           DOWN CHANNEL IF CCC LOAD FAILS (EPE)
          UJN    EPC70
 EPC60    BSS
          LDN    2           RETRY LOAD IF LOAD FAILS (EPC)
 EPC70    BSS
          STDL   RECOV
          AOML   RS+/RS/P.RTRY  REQUEST RETRY COUNTER
          LDN    0
          STDL   PTF         SO PATH TEST WILL BE RUN
          RJM    PT          PATH TEST
          RJM    RDT         READ DEVICE TABLE
          SHN    -1
          LMN    4
          ZJK    EPF         DOWN UNIT IF DATA INTEGRITY ERROR
          LDML   RS+/RS/P.RTRY
          SBN    RTRY+2
          MJN    EPC80       IF NOT RETRY LIMIT
          LDN    3
          STDL   RECOV       NEXT STEP IS EPD
 EPC80    BSS
          LOADOVL ERO        LOAD ERROR RECOVERY OVERLAY
          RJM    RSTRQ       RESTART REQUEST (NO RETURN)
*
*         LAST RECOVERY ATTEMPT HAS FAILED, DOWN THE STORAGE
*         DIRECTOR OR THE DRIVE
*
 EPD      BSS
          LDML   RS+/RS/P.DET
          ZJK    EPF         IF NO DETAILED STATUS
          LDML   RS+/RS/P.GENST1
          LMC    0#A10
          NJK    EPF         IF NO SENSE BYTES
          LDML   RS+/RS/P.DETAIL
          SHN    7
          MJN    EPD10       IF STORAGE DIRECTOR FAILURE
          LDML   RS+/RS/P.DETAIL+4
          LPN    17B
          SBN    2
          MJK    EPF         IF NOT FORMAT 2 OR 3
          SBN    2
          PJK    EPF         IF NOT FORMAT 2 OR 3
 EPD10    BSS
          LDK    /RS/K.CMDN  STORAGE DIRECTOR DOWN
          STML   RS+/RS/P.ID
          RJM    SNMSG       SEND UNSOLICITED MESSAGE
          LOADOVL ERO        LOAD ERROR RECOVERY OVERLAY
          LDN    1           TURN OFF ALL UNITS ON STORAGE DIRECTOR
          UJN    EPE5
*
*         DOWN THE CHANNEL
*
 EPE      BSS
          LDK    /RS/K.CHDN  CHANNEL DOWNED
          STDL   PTF         TO PREVENT RUNNING PATH TEST
          STML   RS+/RS/P.ID
          RJM    SNMSG       SEND UNSOLICITED MESSAGE
          LOADOVL ERO        LOAD ERROR RECOVERY OVERLAY
          LDN    0           TO TURN OFF CHANNEL
 EPE5     BSS
          RJM    OE          TURN OFF ALL UNITS ON THE EQUIPMENT
 EPE20    BSS
          RJM    RESPIN      UPDATE IN POINTER FOR RESPONSE BUFFER
          LDN    0
          STML   RS+/RS/P.HDWR  CLEAR STATUS WORD
          LDN    6
          STDL   RECOV       CLEAR UNIT LOCK IS NEXT STEP (EPG)
          LDN    F.OPCMP
          RJM    FUNC        ISSUE OPERATION COMPLETE
          UJN    EPG
*
*         DOWN THE UNIT
*
 EPF      BSS
          LOADOVL ERO        LOAD ERROR RECOVERY OVERLAY
          LDN    0           CLEAR THE REQUEST SELECTED FLAG
          STML   SS+/SS/P.ENTRY
          RJM    SAVSS       SAVE THE SS TABLE
          LDK    /RS/K.UDN   UNIT DOWNED
          STML   RS+/RS/P.ID
          RJM    SNMSG       SEND UNSOLICITED MESSAGE
          RJM    RDT         READ DEVICE TABLE
          LOADC  P3          ADDRESS OF UNIT INTERFACE TABLE
          RJM    OFFUN       TURN OFF THE UNIT
          UJK    EPE20
*
*         CLEAR THE UNIT LOCK
*
 EPG      BSS
          RJM    WFUL        WAIT FOR UNIT LOCK.  THE PATH TEST DOES
                              NOT SET THE UNIT LOCK
          RJM    CLRLOCK     CLEAR UNIT LOCK
          STML   RS+/RS/P.RTRY  CLEAR REQUEST RETRY COUNTER
          LJM    MAIN5
          SPACE  5,20
** NAME-- FUNC
*
** PURPOSE-- ISSUE FUNCTION TO DISK CONTROLLER.
*
** INPUT-- A REGISTER = FUNCTION CODE.
*
** EXIT
*         - TO CALLING ROUTINE IF NO ERROR.  THE CHANNEL WILL BE
*           ACTIVATED FOR ALL FUNCTIONS EXCEPT 10 AND 100000.
          SPACE  2
 FUN100   BSS
          LDML   FUNCD
          ZJN    FUN110      IF CONNECT FUNCTION
          LPC    77767B
          ZJN    FUNX        IF NO DATA TRANSFER
 FUN110   BSS
          ACN    DC          ACTIVATE THE CHANNEL
 FUNX     LJM    **
 FUNC     EQU    *-1
          DCN    DC+40B      ENSURE THE CHANNEL IS INACTIVE
          FAN    DC          ISSUE THE FUNCTION
          STML   FUNCD       SAVE FUNCTION CODE
          LDN    0           TIMEOUT 128 MS ON READS AND WRITES
          STDL   T1
          STDL   GNSTAT      CLEAR GENERAL STATUS
          LDN    3           TIMEOUT 3 TIMES LONGER FOR ALL OTHERS
          STDL   T2
 FUN10    BSS
          LDN    0
          IJM    FUN100,DC   IF CHANNEL INACTIVE
          SODL   T1
          NJN    FUN10       IF TIMEOUT NOT EXPIRED
          LDML   FUNCD       CHECK FOR A READ OR WRITE
          SBN    F.READ
          ZJN    FUN30       IF ITS A READ, QUIT TIMING
          SBN    F.WRITE-F.READ
          ZJN    FUN30       IF ITS A WRITE, QUIT TIMING
          SBN    F.CONT-F.WRITE
          ZJN    FUN20       IF CONTINUE, QUIT TIMING
          SODL   T2
          NJN    FUN10       GO TIME OUT SOME MORE
 FUN20    BSS
          LDML   FUNCD
          UJN    FUN40
 FUN30    BSS
          LDDL   FT
          ZJN    FUN20       IF FIRST SECTOR
          RJM    GENSTAT     GET GENERAL STATUS
          LDDL   FNC
          ADN    4           TIMEOUT 4 OR 5, NOT 12, FUNCTION
 FUN40    BSS
          STML   RS+/RS/P.FUNTO
          LDK    /RS/K.FTO
          STML   RS+/RS/P.HDWR
          LDN    E00         CP MUST ISOLATE THE ERROR
          RJM    PCER        PREPARE COMMON ERROR RESPONSE (NO RETURN)
          SPACE  5,20
** NAME-- FMT
*
** PURPOSE-- FORMAT A PORTION OF THE DISK
          SPACE  2
 FMT      CON    0
          LOADOVL FMO        LOAD FORMAT OVERLAY
          RJM    FORMD       FORMAT (NO RETURN)
 FMTR     BSS
          LOADOVL FMO        LOAD FORMAT OVERLAY
          LJM    FORMD20     RETRY THE FORMAT
          SPACE  5,20
** NAME-- GENSTAT
*
** PURPOSE-- READ GENERAL STATUS FROM CONTROLLER.
*
** OUTPUT-- A REGISTER = GENERAL STATUS.
*           GNSTAT = GENERAL STATUS.
          SPACE  2
 GENSX    LJM    **
 GENSTAT  EQU    *-1
          LDN    F.GS        GENERAL STATUS FUNCTION CODE
          RJM    FUNC        ISSUE FUNCTION CODE
          LDN    1
          IAM    GNSTAT,DC   INPUT GENERAL STATUS
          NJN    GENS5       IF INPUT DID NOT COMPLETE
          CFM    GENS8,DC    CHECK AND CLEAR CHANNEL ERROR
          RJM    EFP         ERROR FLAG PROCESSING (NO RETURN)
 GENS5    BSS
          LJM    OUTPK30
 GENS8    BSS
          LDDL   GNSTAT      SAVE GENERAL STATUS
          ZJN    GENS30      IF NO ERRORS
          SBN    2           CHECK 'NOT ON CYLINDER'
          ZJN    GENS30      IF ONLY BUSY
          SBN    6           WAS THE STORAGE DIRECTOR AVAILABLE
          ZJN    GENS30      STORAGE DIRECTOR IS BUSY ELSEWHERE
          RJM    DS          DETAILED STATUS
          LDML   LCF
          ZJN    GENS15      IF NOT CCC LOAD FAILURE (CP MUST ISOLATE ERROR)
          LDN    E09         CCC LOAD FAILURE
          UJN    GENS20
 GENS15   BSS
          LDC    400000B     INDICATE DETAILED STATUS PRESENT
 GENS20   BSS
          RJM    PCER        PREPARE COMMON ERROR RESPONSE (NO RETURN)
 GENS30   BSS
          LDDL   GNSTAT      A REGISTER = GENERAL STATUS
          UJK    GENSX
          SPACE  5,20
** NAME-- GETUD
*
** PURPOSE-- GET A UNIT REQUEST FROM CM.
*
** OUTPUT-- THE SS TABLE IS FILLED WITH THE NEW UNIT REQUEST.
*
** NOTE-- THIS ONLY SELECTS A REQUEST IF THE QUEUE WAS PREVIOUSLY
*         EMPTY.  IF THE QUEUE IS NOT EMPTY, THE DELINK ROUTINE
*         SELECTS THE NEXT REQUEST.
          SPACE  2
 GETUX    LJM    **
 GETUD    EQU    *-1
          LDDL   DEVL
          ZJN    GETUX       IF NO UNITS
          LDN    0
          STDL   CF          CLEAR CONTINUE FLAG
          STML   SIP         INDICATE SEEK IN PROGRESS
          LDDL   COMLOOK
          STML   UTSAVE      SAVE STARTING POSITION IN TABLE
 GETUD3   BSS
          RJM    UC          UPDATE CLOCK
          LDN    1
          STDL   WC          CONSTANTS FOR CM I/O
          LDN    C.SS
          STDL   P1
          LDDL   EMPTQ
          ZJN    GETUX       NO AVAILABLE EMPTY ENTRIES
          AODL   COMLOOK     GO TO NEXT TABLE ENTRY
          SBD    DEVL
          MJN    GETUD5      IF NOT END OF TABLE
          LDN    0
          STDL   COMLOOK     SET BACK TO FIRST ENTRY
 GETUD5   BSS
          LDDL   EMPTQ
          STDL   LUTLOC      SET AVAILABLE ENTRY UP FOR POSSIBLE USE
          ADN    /LUT/P.UIT-1
          STML   GETUD7
          LOADC  CM.DEV      START LOOKING AT NEXT UNIT
          ADDL   COMLOOK
          CRDL   P2          SAVE UIT ADDRESS IN LUT
          CRML   -**,WC      GET ADDRESS OF UIT
 GETUD7   EQU    *-1
          LDDL   P2          CHECK IF DEVICE IS ACTIVE
          LPN    /CB/K.ACT
          NJK    GETUD80     IF ALREADY ACTIVE - SKIP TO NEXT ONE
          LOADC  P3
          CRDL   T1          FIRST WORD OF UIT
          ADN    /UIT/C.UBUF
          CRDL   T5          SECOND WORD OF UIT
          ADN    /UIT/C.NEXT-/UIT/C.UBUF
          CRDL   T3          SIXTH WORD OF UIT
          LDDL   T5          CHECK FOR A REQUEST
          ADDL   T6
          ZJK    GETUD80     NO REQUEST, GO TO NEXT ONE
          LDDL   T1+/UIT/P.DSABLE  CHECK IF UNIT IS DISABLED
          SHN    2+/UIT/L.DSABLE
          MJK    GETUD80     IF UNIT IS DISABLED
          LDIL   LUTLOC      REMOVE ENTRY FROM EMPTY QUEUE
          STDL   EMPTQ
          LDDL   USEQ        PLACE ENTRY ON 'IN USE' QUEUE
          STIL   LUTLOC
          LDDL   LUTLOC
          STDL   USEQ
          LDDL   COMLOOK
          STML   /LUT/P.OFFSET,LUTLOC  SAVE INDEX TO CM.DEV TABLE
          LDDL   P2
          LPC    177776B
          LMN    /CB/K.ACT
          STDL   P2          SET ACTIVE BIT IN THE CM.DEV TABLE
          LOADC  CM.DEV
          ADDL   COMLOOK
          CWDL   P2
          RJM    SETLOCK     LOCK THE UNIT
          ZJN    GETUD80     CANNOT LOCK, OTHER DRIVER HAS IT
          LOADF  T7
          CRML   SS,P1       READ SS TABLE
          LDML   SS+/SS/P.ENTRY
          NJN    GETUD40     IF ALREADY SELECTED, GO ON TO NEXT
          RJM    SQLOCK      SET QUEUE LOCKWORD
          NJN    GETUD80     IF QUEUE NOT LOCKED
          RJM    SELRQ       SELECT A REQUEST ON THIS UNIT
          UJN    GETUD80
 GETUD40  BSS
          RJM    USC         UPDATE SAVED CLOCK
 GETUD80  BSS
          LDDL   COMLOOK     CHECK IF LOOKED AT ALL ENTRIES
          SBML   UTSAVE
          NJK    GETUD3      IF NO
          UJK    GETUX       EXIT
          SPACE  5,20
** NAME-- IN
*
** PURPOSE-- INPUT WORDS FROM THE CHANNEL
*
** ENTRY
*         A = WORDS TO INPUT
*         IN10 = LOCATION TO BE PLUGGED WITH ADDRESS TO STORE DATA
          SPACE  2
 INX      LJM    **
 IN       EQU    *-1
          IAM    *,DC
 IN10     EQU    *-1
          ZJN    INX         IF NO ERROR
          LJM    OUTPK20
          SPACE  5,20
** NAME-- INPK
*
** PURPOSE-- INPUT AND PACK WORDS FROM THE CHANNEL
*
** ENTRY
*         A = WORDS TO INPUT
*         INPK10 = LOCATION TO BE PLUGGED WITH ADDRESS TO STORE DATA
          SPACE  2
 INPKX    LJM    **
 INPK     EQU    *-1
          IAPM   *,DC
 INPK10   EQU    *-1
          ZJN    INPKX       IF NO ERROR
          LJM    OUTPK20
          SPACE  5,20
** NAME-- INTERR
*
** PURPOSE-- REPORT AN INTERFACE ERROR
          SPACE  2
 INTERR   CON    0
          STML   RS+/RS/P.IEC  INTERFACE ERROR CODE
          LDN    E01         INTERFACE ERROR
          STML   RS+/RS/P.EC
          LDN    0           CLEAR WORDS SO CP REPORTS CORRECT ERROR
          STML   RS+/RS/P.GENST1
          STML   RS+/RS/P.ID
          RJM    SNMSG       SEND UNSOLICITED MESSAGE
          RJM    RESPIN      UPDATE IN POINTER FOR RESPONSE BUFFER
          RJM    HANG
          SPACE  5,20
** NAME-- INTRS
*
** PURPOSE-- SEND INTERMEDIATE RESPONSE.
          SPACE  2
 INTRSX   LJM    **
 INTRS    EQU    *-1
          LDN    0
          STML   RS+/RS/P.SHORT   INDICATE ERROR RESPONSE
          LDK    C.RS*8
          STML   RS+/RS/P.RESPL  RESPONSE LENGTH
          LDDL   CTF
          NJN    INTRS10     IF REQUEST EXISTS
          RJM    SNMSG       SEND UNSOLICITED MESSAGE
          RJM    RESPIN      UPDATE IN POINTER FOR RESPONSE BUFFER
          UJK    INTRSX
 INTRS10  BSS
          LDK    R.INT*0#4000  INTERMEDIATE RESPONSE
          STML   RS+/RS/P.RC
          RJM    TERMP       SEND RESPONSE TO CM
          UJK    INTRSX
          SPACE  5,20
** NAME-- LOCK
*
** PURPOSE-- SET THE LOCKWORD
*
** ENTRY
*         P6 = RMA OFFSET
*         T5 = OFFSET TO LOCKWORD FROM RMA
*
** EXIT
*         A = 0 IF LOCK SUCCESSFULLY SET
          SPACE  2
 LOCKX    LJM    **
 LOCK     EQU    *-1
 LOCK1    BSS
          LCN    0
          STDL   T1
          STDL   T2
          LDN    0
          STDL   T3
          STDL   T4
          LOADR  0,P6        TABLE ADDRESS
          ADDL   T5          ADD LOCKWORD OFFSET
          STDL   T6          SAVE CM ADDRESS
          RDSL   T1          WRITE INTERMEDIATE VALUE

          LDDL   T1
          ZJN    LOCK5       IF LOCK COULD BE SET
          ADDL   T2
          ADC    -177777B-177777B
          ZJN    LOCK1       IF INTERMEDIATE VALUE
          LDDL   T2
          LPC    77777B
          ADC    100000B
          STDL   T2          SET THE VE BIT
          LDDL   T6
          LMC    400000B
          CWDL   T1          RESTORE THE LOCKWORD WITH THE VE BIT
          LDDL   T4
          SBDL   PPNO
          NJN    LOCK3       IF LOCK COULD NOT BE SET
          LDDL   T1
          ADC    -100000B
 LOCK3    BSS
          UJK    LOCKX       IF LOCK WAS ALREADY SET, EXIT A = 0
                             IF LOCK COULD NOT BE SET, EXIT A .NE. 0
 LOCK5    BSS
          LDC    100000B
          STDL   T1
          LDN    0
          STDL   T2
          STDL   T3
          LDDL   PPNO
          STDL   T4
          LDDL   T6          CM ADDRESS OF UNIT LOCK.
          LMC    400000B
          CWDL   T1          SET THE LOCKWORD
          LDN    0
          UJK    LOCKX
          SPACE  5,20
** NAME-- OUT
*
** PURPOSE-- OUTPUT WORDS FROM THE PP TO THE CCC
*
** ENTRY
*         A = NUMBER OF WORDS TO OUTPUT
*         OUT10 = LOCATION TO BE PLUGGED WITH ADDRESS TO OUTPUT FROM
*
** EXIT   TO CALLING ROUTINE IF NO ERROR
          SPACE  2
 OUTX     LJM    **
 OUT      EQU    *-1
          STDL   T2          SAVE WORD COUNT
*
*         THIS TIMEOUT LOOP PREVENTS THE PP FROM HANGING ON AN ISI CHANNEL
*
          LCN    0
 OUT4     BSS
          EJM    OUT8,DC     IF CHANNEL EMPTY
          SBN    1
          NJN    OUT4        IF TIMEOUT NOT EXPIRED
          UJN    OUTPK40
 OUT8     BSS
          LDDL   T2
          OAM    *,DC        OUTPUT WORDS
 OUT10    EQU    *-1
          ZJN    OUTX        IF NO ERROR
          UJN    OUTPK20
          SPACE  5,20
** NAME-- OUTPK
*
** PURPOSE-- OUTPUT PACKED DATA TO THE CHANNEL
*
** ENTRY
*         A = NUMBER OF WORDS TO OUTPUT
*         OUTPK10 = LOCATION TO BE PLUGGED WITH ADDRESS TO OUTPUT FROM
*
** EXIT   TO CALLING ROUTINE IF NO ERROR
          SPACE  2
 OUTPKX   LJM    **
 OUTPK    EQU    *-1
          OAPM   *,DC        OUTPUT WORDS
 OUTPK10  EQU    *-1
          ZJN    OUTPKX      IF NO ERROR
 OUTPK20  BSS
          STDL   T4          WORDS NOT TRANSFERRED
          RJM    GENSTAT     GET GENERAL STATUS
          LDDL   T4
 OUTPK30  BSS
          STML   RS+/RS/P.FUNTO  WORDS NOT TRANSFERRED
 OUTPK40  BSS
          LDN    E05         INCOMPLETE CHANNEL TRANSFER
          RJM    PCER        PREPARE COMMON ERROR RESPONSE (NO RETURN)
          SPACE  5,20
** NAME-- PCER
*
** PURPOSE-- PREPARE COMMON ERROR RESPONSE
*
** ENTRY
*         A = ERROR CODE FOR LOCATION /RS/P.EC
*         COMLOOK = INDEX TO DEVICE TABLE
          SPACE  2
 PCER     CON    0
          RJM    PER         PREPARE ERROR RESPONSE
          RJM    EP          ERROR PROCESSING (NO RETURN)
          SPACE  5,20
** NAME-- PER
*
** PURPOSE-- PREPARE ERROR RESPONSE
*
** ENTRY
*         A = ERROR CODE FOR LOCATION ERRID
*         A = NEGATIVE VALUE IF DETAILED STATUS PRESENT
*         COMLOOK = INDEX TO DEVICE TABLE
          SPACE  2
 PERX     LJM    **
 PER      EQU    *-1
          STML   RS+/RS/P.EC  SAVE ERROR CODE
          MJN    PER3        IF DETAILED STATUS PRESENT
          LDN    0
          STML   RS+/RS/P.DET  CLEAR DETAILED STATUS PRESENT FLAG
 PER3     BSS
          LDDL   GNSTAT      SAVE GENERAL STATUS
          STML   RS+/RS/P.GENST1
          STML   RS+/RS/P.GENST2
          RJM    RDT         READ DEVICE TABLE
          LDDL   CTF
          ZJN    PER5        IF CONFIDENCE TEST FAILURE
          LDDL   P2          FIRST WORD OF DEVICE TABLE
          SHN    -1
          LPN    3
          NJN    PER10       IF NOT CONFIDENCE TEST FAILURE
 PER5     BSS
          STML   RS+/RS/P.STRK  STARTING TRACK
          STML   RS+/RS/P.SSEC  STARTING SECTOR
          LDC    MAXCYL-1
          UJN    PER11
 PER10    BSS
          LDN    1
          STDL   T2
          LDML   SIP
          NJN    PER13       IF SEEK COMPLETE
          RJM    SRESP       PUT PVA IN RESPONSE
          LDDL   FNC
          SBN    2
          NJN    PER12       IF NOT FORMAT
          STML   RS+/RS/P.STRK  STARTING TRACK
          STML   RS+/RS/P.SSEC  STARTING SECTOR
          LDML   FBUF
 PER11    BSS
          STML   RS+/RS/P.SCYL  STARTING CYLINDER
          UJN    PER20
 PER12    BSS
          LOADF  SS+/SS/P.REQ  RMA OF CURRENT REQUEST
          UJN    PER16
 PER13    BSS
          LOADF  CURRQ       RMA OF CURRENT REQUEST
 PER16    BSS
          ADN    3
          CRML   RS+/RS/P.CHAN,T2  SAVE CYLINDER, TRACK AND SECTOR
          LDDL   CHAN
          STML   RS+/RS/P.CHAN  SAVE CHANNEL NUMBER
 PER20    BSS
          LDML   RS+/RS/P.DET
          NJN    PER30       IF DETAILED STATUS VALID
          STDL   T1
 PER25    BSS
          LDN    0
          STML   RS+/RS/P.DETAIL,T1
          AODL   T1
          LMN    40
          NJN    PER25       IF MORE WORDS TO CLEAR
 PER30    BSS
          LOADC  P3          REFORMATTED RMA OF UIT
          CRDL   T1          FIRST WORD OF UNIT INTERFACE TABLE
          ADN    1
          CRDL   T2          SECOND WORD OF UIT
          LDDL   T1
          STML   RS+/RS/P.LU  LOGICAL UNIT
          LOADF  T4          RMA OF UNIT COMMUNICATIONS BUFFER
          CRDL   T1          FIRST WORD OF SS TABLE
          LDDL   T1
          STML   RS+/RS/P.UNIT  PHYSICAL UNIT NUMBER
          LDML   SS+/SS/P.TRACK
          LPN    77B
          STML   RS+/RS/P.FTRK  FAILING TRACK
          LDML   SS+/SS/P.SECTOR
          STML   RS+/RS/P.FSEC  FAILING SECTOR
          LDN    0
          STML   RS+/RS/P.ID  CLEAR ERROR ID
          LDML   RS+/RS/P.EC
          ZJN    PER40       IF ERROR CODE ZERO
          SBN    E05
          ZJN    PER50       IF WORD COUNT STORED
          LDN    0
          UJN    PER45
 PER40    BSS
          LDML   RS+/RS/P.HDWR
          LPC    /RS/K.FTO
          NJN    PER50       IF FUNCTION IS SAVED
 PER45    BSS
          STML   RS+/RS/P.FUNTO  CLEAR FUNCTION OR WORD COUNT
 PER50    BSS
          LJM    PERX
          SPACE  5,20
** NAME-- PDR
*
** PURPOSE-- PREPARE NORMAL DISK RESPONSE
          SPACE  2
 PDRX     LJM    **
 PDR      EQU    *-1
          LDN    0
          STML   RS+/RS/P.HDWR  ABNORMAL STATUS
          LDN    8           SET RESPONSE LENGTH FOR NORMAL RESPONSE
          STML   RS+/RS/P.RESPL
          LDML   RQ+/RQ/P.LU  LOGICAL UNIT
          LPC    0#FF
          LMC    /RS/K.SHORT  INDICATE ONE-WORD RESPONSE
          STML   RS+/RS/P.SHORT
          UJK    PDRX
          SPACE  5,20
** NAME-- POLLON
*
** PURPOSE-- THIS ROUTINE POLLS UNITS FOR ON-CYLINDER
*
** INPUT-- IN USE QUEUE (USEQ)
*
** OUTPUT-- A REGISTER = 0, IF NOTHING WAS ON CYLINDER
*
*         POLLON SCANS THE 'IN USE' QUEUE TWICE.  FIRST IT LOOKS AT
*         ENTRIES FOR WHICH THE UNIT IS ALREADY LOCKED TO THIS
*         PP (P.OWNER=1).  IF NONE OF THESE HAVE COMPLETED SEEKS
*         PENDING, ANOTHER SCAN IS MADE, THIS TIME LOOKING AT UNITS
*         THAT ARE NOT YET LOCKED.
          SPACE  2
 POLLX    LJM    **
 POLLON   EQU    *-1
          LDN    C.SS
          STDL   WC
          LDN    /LUT/K.OWNER
 POLL2    BSS
          STDL   TOGL        SET TOGL TO MATCH P.OWNER = 1
          LDN    USEQ
 POLL4    BSS
          STDL   LUTLOC      SET TO BEGINNING OF 'IN USE' QUEUE (-1)
 POLL6    BSS
          RJM    UC          UPDATE CLOCK
          LDDL   LUTLOC
          STDL   P1          SAVE POINTER TO PREVIOUS ENTRY
          LDIL   LUTLOC
          STDL   LUTLOC      GET NEXT ENTRY ON QUEUE
          NJN    POLL8       IF ENTRY EXISTS
          LDDL   TOGL
          ZJN    POLLX       IF SECOND PASS JUST FINISHED, EXIT
          LDN    0           SET TOGL FOR NEXT PASS
          UJN    POLL2
 POLL8    BSS
          LDML   /LUT/P.OWNER,LUTLOC
          SBDL   TOGL
          NJN    POLL6       IF THIS PASS DOESN'T LOOK AT THIS ENTRY
          LDDL   TOGL
          NJN    POLL10      IF UNIT ALREADY LOCKED
          RJM    SETLOCK     TRY TO LOCK THE UNIT
          ZJN    POLL6       IF LOCK COULD NOT BE SET
 POLL10   BSS
          LOADR  /LUT/P.UIT,LUTLOC  ADDRESS OF UIT
          ADN    /UIT/C.UBUF
          CRDL   P2          SECOND WORD OF UIT
          LOADF  P4          ADDRESS OF UNIT COMMUNICATION BUFFER
          CRML   SS,WC       READ SS ENTRY
          LDML   SS+/SS/P.ENTRY  HAS AN ENTRY BEEN SELECTED
          NJK    POLL25      IF REQUEST SELECTED
          LOADR  SS+/SS/P.UQT  ADDRESS OF UNIT INTERFACE TABLE
          CRDL   T1
          ADN    /UIT/C.NEXT  OFFSET TO RMA OF DISK REQUEST
          CRDL   T3
          LDDL   T2
          SHN    2+/UIT/L.DSABLE
          MJN    POLL13      IF UNIT DISABLED
          LDDL   T5
          ADDL   T6
          NJN    POLL15      IF REQUEST PRESENT
*
*         CLEARING THE UNIT LOCK WITHOUT SELECTING A REQUEST COULD
*         CAUSE AN INFINITE LOOP IF TWO CHANNELS ARE SHARING THE UNIT.
*
 POLL13   BSS
          RJM    CLRLOCK     CLEAR UNIT LOCK
 POLL15   BSS
          LDIL   LUTLOC
          STIL   P1          REMOVE LUT ENTRY FROM 'IN USE' QUEUE
          LCN    0
          STDL   T2
          STDL   T3
          STDL   T4
          LMN    /CB/K.ACT
          STDL   T1
          LOADC  CM.DEV
          ADML   /LUT/P.OFFSET,LUTLOC
          RDCL   T1          CLEAR ACTIVE BIT IN CM.DEV TABLE
          LDDL   EMPTQ
          STIL   LUTLOC
          LDDL   LUTLOC
          STDL   EMPTQ       PUT LUT ENTRY ON THE EMPTY QUEUE
          LDDL   P1
          LJM    POLL4       GO TO NEXT ENTRY
 POLL25   BSS
          RJM    USC         UPDATE SAVED CLOCK
          LDML   /LUT/P.OFFSET,LUTLOC
          STDL   COMLOOK     INDEX TO DEVICE TABLE
          RJM    SEEKCK      ISSUE A SEEK FOR POLLING
          ZJN    POLL30      IF A SEEK HAS FINISHED
          LDDL   CLSEC
          SBML   SS+/SS/P.CLKST
          PJN    POLL27      IF CLOCK HASN'T WRAPPED
          ADC    0#10000
 POLL27   BSS
          SBN    10          10 SECOND MINIMUM TIMEOUT
          MJK    POLL28      IF NO TIMEOUT
          LDN    E08         SEEK OR FORMAT COMMAND TIMEOUT
          RJM    PCER        PREPARE COMMON ERROR RESPONSE (NO RETURN)
 POLL28   BSS
          LDN    F.OPCMP
          RJM    FUNC
          UJK    POLL6
 POLL30   BSS
          RJM    POLS        POLL SUBROUTINE
*
*         PUT LUTLOC AT END OF USEQ.  THIS HELPS KEEP USAGE OF UNITS
*         RANDOM.
*
          LDIL   LUTLOC
          ZJN    POLL50      IF ALREADY LAST ENTRY OF USEQ
          STIL   P1          REMOVE ENTRY FROM USEQ
 POLL40   BSS
          STDL   P1
          LDIL   P1
          NJN    POLL40      IF NOT END OF QUEUE
          STIL   LUTLOC
 POLL50   BSS
          LDDL   LUTLOC
          STIL   P1          ADD LUTLOC TO END OF USEQ
          UJK    POLLX
          SPACE  5,20
** NAME-- POLS
*
** PURPOSE-- POLL SUBROUTINE.  RELEASE UNIT LOCK ON OTHER UNITS.
          SPACE  2
 POLS40   BSS
          LDDL   P2
          STDL   LUTLOC      RESTORE POINTER TO CURRENT REQUEST
 POLSX    LJM    **
 POLS     EQU    *-1
          RJM    SAVSS
          LDDL   LUTLOC
          STDL   P2          SAVE LUT POINTER
          LDN    USEQ
          STDL   LUTLOC      RESET TO BEGINNING OF QUEUE
          STML   SIP         INDICATE SEEK COMPLETE
 POLS10   BSS
          LDIL   LUTLOC
          ZJK    POLS40      IF END OF QUEUE
          STDL   LUTLOC
          SBDL   P2          IS THIS ENTRY THE CURRENT ONE
          ZJN    POLS10      IF YES, DON'T RELEASE THE LOCK
          LDML   /LUT/P.OWNER,LUTLOC  IS ENTRY LOCKED TO THIS PP
          ZJN    POLS10      IF UNLOCKED
          LOADR  /LUT/P.UIT,LUTLOC  ADDRESS OF UIT
          ADN    /UIT/C.UBUF
          CRDL   P3          ADDRESS OF COMMUNICATIONS BUFFER
          LOADF  P5          ADDRESS OF SS TABLE
          STDL   T1
          ADN    /SS/C.CLKST
          CRDL   T2          READ CLOCK FROM SS TABLE
          LDDL   T2
          STDL   T6          SAVE SECONDS PORTION OF CLOCK START
          LDDL   CLMLS       UPDATE SEEK TIME SO TIMEOUT WILL BE
          STDL   T5           MORE ACCURATE
 POLS15   BSS
          SBDL   T3          CLOCK START TIME
          PJN    POLS20      IF CLOCK HASN'T WRAPPED
          AODL   T6
          LDC    1000        MILLISECONDS PER SECOND
          RADL   T5
          UJN    POLS15
 POLS20   BSS
          STDL   T5          SAVE SEEK TIME (MILLISECONDS)
          LDDL   CLSEC
          SBDL   T6          CLOCK START TIME
          PJN    POLS30      IF CLOCK HASN'T WRAPPED
          ADC    0#10000
 POLS30   BSS
          STDL   T4          SAVE SEEK TIME (SECONDS)
          LDDL   T1
          ADC    400000B+/SS/C.CLKST
          CWDL   T2          SAVE CLOCK AND SEEK TIME IN SS TABLE
          RJM    CLRLOCK     CLEAR THE LOCK
          UJK    POLS10      GO LOOK AT THE NEXT ONE
          SPACE  5,20
** NAME-- PPREQ
*
** PURPOSE-- CHECK FOR ANY PP REQUESTS
          SPACE  2
 PPRQX    LJM    **
 PPREQ    EQU    *-1
          LCN    0
          STDL   T1
          STDL   T2
          STDL   T3
          LDC    0#7FFF      CLEAR ACTIVE CHECK BIT
          STDL   T4
          LOADC  CM.PIT      CM ADDRESS OF PP INTERFACE TABLE
          RDCL   T1          CLEAR ACTIVE BIT, READ IDLE/RESUME BITS
          LDDL   T4
          LPC    0#6000
          ZJN    PPRQX       IF NOT IDLE OR RESUME
          STDL   T5
          LOADOVL ERO        LOAD ERROR RECOVERY OVERLAY
          RJM    SPLOCK      SET PP TABLE LOCK
          RJM    PIR         PROCESS IDLE OR RESUME COMMAND (NO RETURN)
          SPACE  5,20
** NAME-- RDT
*
** PURPOSE-- READ DEVICE TABLE
          SPACE  2
 RDTX     LJM    **
 RDT      EQU    *-1
          LOADC  CM.DEV      ADDRESS OF DEVICE TABLE
          ADDL   COMLOOK     INDEX INTO TABLE
          CRDL   P2
          LDDL   P2
          UJN    RDTX
 F        IFEQ   CHANTYP,1
          SPACE  5,20
** NAME-- RES
*
** PURPOSE-- READ ERROR STATUS REGISTER OF CIO CHANNEL.
*
** EXIT-- A = STATUS REGISTER READ, OTHERWISE ZERO
*
** NOTE-- THIS ROUTINE MUST BE RESIDENT DUE TO CHANNEL INSTRUCTIONS
          SPACE  2
 RESX     LJM    **
 RES      EQU    *-1
          DCN    DC+40B      ENSURE THE CHANNEL IS INACTIVE
          LDC    F.RDESR     READ ERROR STATUS REGISTER FUNCTION
          FAN    DC
          LCN    0
 RES10    BSS
          IJM    RES25,DC    IF FUNCTION REPLY RECEIVED
          SBN    1
          NJN    RES10       IF TIMEOUT NOT EXPIRED
 RES20    BSS
          LDN    0
          UJN    RESX
 RES25    BSS
          LDN    1
          ACN    DC
          IAM    T1,DC       INPUT THE STATUS
          SFM    RES20,DC    IF ERROR
          NJN    RES20       IF ERROR
          LDDL   T1
          UJK    RESX
 F        ENDIF
          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
 RESPX    LJM    **
 RESP     EQU    *-1

* CHECK IF RESPONSE SHOULD BE SENT TO CM.

          LDN    0
          STML   STORS       SET FLAG TO STORE RESPONSE
          LDML   CM+/CM/P.STOR  CHECK IF CALLER WANTS RESPONSE
          SHN    /CM/L.STOR+2
          MJN    RESP10      IF STORE RESPONSE FLAG IS SET
          LDML   RS+/RS/P.SHORT
          SHN    /RS/L.SHORT+2
          PJN    RESP10      IF NOT NORMAL RESPONSE, STORE RESPONSE
          AOML   STORS       NONZERO MEANS DO NOT STORE RESPONSE
          UJK    RESPX

* READ IN AND OUT POINTERS OF RESPONSE BUFFER.

 RESP10   BSS
          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.

          LDN    0
          STDL   T5          NUMBER OF WORDS IN 2ND BLOCK WRITE
          LDDL   INP
          SBDL   OUTP
          MJN    RESP20      IF IN .LT. OUT
          LDML   LIM         IN .GE. OUT, SET OUT = OUT + LIMIT
          RADL   OUTP
 RESP20   LDML   RS+/RS/P.RESPL  GET RESPONSE LENGTH
          ADDL   INP
          STDL   INPNT       IN + RESPONSE LENGTH
          SBDL   OUTP        CHECK IF ENOUGH ROOM IN BUFFER FOR RESPONSE
          MJN    RESP30      IF ROOM IN BUFFER
          RJM    PPREQ       CHECK FOR IDLE REQUEST
          UJK    RESP10
 RESP30   BSS
          LDDL   INP
          SHN    -3
          STDL   T3          'IN' POINTER IN WORDS
          LDML   RS+/RS/P.RESPL  CONVERT RESPONSE LENGTH TO WORDS
          SHN    -3
          STDL   T4          RESPONSE LENGTH IN WORDS
          LDDL   INPNT
          SBML   LIM
          MJN    RESP50      IF IN + RESPONSE LENGTH .LT. LIMIT
                             ONLY 1 BLOCK WRITE
          STDL   INPNT       IN + RESPONSE LENGTH - LIMIT = NEW 'IN' POINTER
          SHN    -3
          STDL   T5          NUMBER OF WORDS IN 2ND BLOCK WRITE

* WRITE RESPONSE TO CM.

          LDML   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    RS
          STML   RESP60      RESPONSE ADDRESS FOR 2ND BLOCK WRITE
 RESP50   BSS
          LOADC  CM.RS       LOAD CM ADDRESS OF RESPONSE BUFFER
          STDL   T6          SAVE CM ADDRESS
          ADDL   T3          ADD 'IN' OFFSET
          CWML   RS,T4       WRITE RESPONSE TO CM
          LDDL   T5          RESPONSE LENGTH
          ZJN    RESP70      IF ONLY 1 BLOCK WRITE REQUIRED
          LDDL   T6          LOAD ADDRESS OF RESPONSE BUFFER
          LMC    400000B
          CWML   **,T5       WRITE 2ND PART OF RESPONSE TO CM
                             (BEGINNING OF RESPONSE BUFFER)
 RESP60   EQU    *-1

 RESP70   BSS
          LJM    RESPX
          SPACE  5,20
** NAME-- RESPIN
*
** PURPOSE-- UPDATE THE 'IN' POINTER IN THE CM RESPONSE BUFFER.
*
** INPUT-- INPNT = NEW 'IN' POINTER.
          SPACE  2
 RESNX    LJM    **
 RESPIN   EQU    *-1

* CHECK IF RESPONSE SHOULD BE SENT TO CM.

          LDML   STORS       CHECK IF CALLER WANTS RESPONSE
          NJK    RESNX       IF NO RESPONSE WAS SENT

* UPDATE THE 'IN' POINTER.

          LDN    0
          STDL   P1
          STDL   P2
          STDL   P3
          LDDL   INPNT       NEW 'IN' POINTER
          STDL   P4
          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. SETRQ ROUTINE SETS UP THIS INSTRUCTION.
          LOADC  CM.INT      CM ADDRESS OF INTERRUPT WORD
          CWDL   PPNO-3      SET LAST BYTE NONZERO
 INTPRC   INPN   1           INTERRUPT OR PSN
          UJK    RESNX
          SPACE  5,20
** NAME-- SAVSS
*
** PURPOSE-- WRITE THE SS ENTRY TO THE COMMUNICATION BUFFER
*            IN THE UNIT INTERFACE TABLE.
*
** INPUT-- SS TABLE WHICH IDENTIFIES THE UNIT TABLE.
          SPACE  2
 SAVX     LJM    **
 SAVSS    EQU    *-1
          LDN    C.SS        NUMBER OF WORDS TO WRITE
          STDL   WC
          RJM    EXLOD       GET ADDRESS OF COMMUNICATION BUFFER
          ADN    /CB/C.SS    ADDRESS OF SS TABLE
          CWML   SS,WC       WRITE SS ENTRY TO PP COMM. BUFFER
          LOADR  SS+/SS/P.COM
          CWML   SS,WC       WRITE SS ENTRY TO UNIT COMM. BUFFER
          UJK    SAVX
          SPACE  5,20
** NAME-- SC
*
** PURPOSE-- SAVE CLOCK IN SS TABLE.  IT IS USED FOR TIMING OUT SEEK
*            COMMANDS
          SPACE  2
 SCX      LJM    **
 SC       EQU    *-1
          LDDL   CLSEC       SAVE CLOCK START TIME
          STML   SS+/SS/P.CLKST
          LDDL   CLMLS
          STML   SS+/SS/P.CLKST+1
          LDDL   PPNO        SAVE PP THAT DID LAST TIMING
          STML   SS+/SS/P.LPP
          LDN    0           CLEAR SEEK TIME
          STML   SS+/SS/P.SEEKTM
          STML   SS+/SS/P.SEEKTM+1
          UJN    SCX
          SPACE  5,20
** NAME-- SCLOCK
*
** PURPOSE-- SETS THE CHANNEL LOCK.
*
** EXIT--  A = 0 WITH CHANNEL LOCK SET
          SPACE  2
 SCLX     LJM    **
 SCLOCK   EQU    *-1
 SCL30    BSS
          LDC    CM.CHAN     CM ADDRESS OF CHANNEL INTERLOCK TABLE
          STDL   P6
          LDDL   CHAN        CHANNEL NUMBER IS OFFSET IN TABLE
          STDL   T5
          RJM    LOCK        SET LOCKWORD
          NJN    SCL30       IF LOCK WAS NOT SET
          STML   CHLOCK      INDICATE CHANNEL LOCK SET
          UJK    SCLX        EXIT, LOCK WAS SET
          SPACE  5,20
** NAME-- SEEKCK
*
** PURPOSE-- ISSUE A SEEK
          SPACE  2
 SEEX     LJM    **
 SEEKCK   EQU    *-1
          LDN    F.SEEK
          RJM    FUNC        ISSUE THE SEEK
 SEEK10   EQU    *-1         FOR FORCING ERRORS
          LDN    0
          STDL   CA          DON'T ALLOW CONTINUE FUNCTION
          STDL   FT          FIRST TIME FLAG
          LDN    4
          OAM    SS+/SS/P.UNIT,DC  SEND SEEK FUNCTION PARAMETERS
          ZJN    SEEK20      IF NO ERROR
          LJM    OUTPK20
 SEEK20   BSS
          RJM    DCN         DISCONNECT THE CHANNEL
          RJM    GENSTAT     READ GENERAL STATUS
          UJN    SEEX
          SPACE  5,20
** NAME-- SEEKON
*
** PURPOSE-- ISSUE SEEK, CHECK FOR ERRORS, WAIT FOR ON-CYLINDER.
          SPACE  2
 SEKOX    LJM    **
 SEEKON   EQU    *-1
          LDDL   CLSEC
          STML   SS+/SS/P.CLKST
 SEK015   BSS
          RJM    SEEKCK      ISSUE SEEK AND RECOVER SEEK ERRORS
          ZJN    SEKOX       IF ON CYLINDER
          RJM    UC          UPDATE CLOCK
          LDDL   CLSEC
          SBML   SS+/SS/P.CLKST
          PJN    SEK020      IF CLOCK HASN'T WRAPPED
          ADC    0#10000
 SEK020   BSS
          SBN    5
          MJN    SEK015      IF TIMEOUT NOT EXPIRED
          LDN    E08         SEEK TIMEOUT
          RJM    PCER        PREPARE COMMON ERROR RESPONSE (NO RETURN)
          SPACE  5,20
** NAME-- SELRQ.
*
** PURPOSE-- SELECTS THE FIRST REQUEST IN THE CHAIN FOR THE
*            CURRENT REQUEST.
*
** INPUTS-- SS+P.UQT = POINTER TO UNIT QUEUE TABLE.
*
** OUTPUTS-- RQ = CURRENT REQUEST.
*            SS+/SS/P.REQ
*            SS+/SS/P.CYL
*            SS+/SS/P.TRACK
*            SS+/SS/P.SECTOR
*            SS+/SS/M.CUR
*            SS+/SS/M.WRITE
*
** NOTE-- ASSUMES UNIT QUEUE LOCK HAS BEEN SET.
          SPACE  2
 SELRQX   BSS
          RJM    CQLOCK      CLEAR QUEUE LOCK
 SELRQ10  BSS
          RJM    SAVSS       SVE SHARED TABLE
          LJM    **
 SELRQ    EQU    *-1

* READ RMA OF NEXT REQUEST FROM UNIT QUEUE.
* SET CURRENT REQUEST = FIRST REQUEST IN QUEUE.

          LDN    2
          STDL   WC
          LOADR  SS+/SS/P.UQT  LOAD CM ADDRESS OF UIT
          ADN    /UIT/C.NEXTPV
          CRML   T1,WC       READ RMA OF FIRST REQUEST IN CHAIN
          LDDL   T7
          STML   SS+/SS/P.REQ  SET RMA OF CURRENT REQUEST
          LDDL   T8
          STML   SS+/SS/P.REQ+1
          ADDL   T7
          ZJK    SELRQX      IF QUEUE EMPTY
          LDDL   T2          SET PVA OF CURRENT REQUEST
          STML   SS+/SS/P.PVA
          LDDL   T3
          STML   SS+/SS/P.PVA+1
          LDDL   T4
          STML   SS+/SS/P.PVA+2
          RJM    CQLOCK      CLEAR QUEUE LOCK
          LDML   SS+/SS/P.UQT  SET DELINK POINTER TO BEGINNING OF QUEUE
          STML   SS+/SS/P.DP
          LDML   SS+/SS/P.UQT+1
          STML   SS+/SS/P.DP+1
          LDM    SS+/SS/P.UQT+2
          ADN    /UIT/C.NEXTPV  PVA IN UNIT INTERFACE TABLE
          STML   SS+/SS/P.DP+2
          RJM    SSA         SET SEEK ADDRESS
          LDK    /SS/K.ENTRY
          STML   SS+/SS/P.ENTRY  SET CURRENT REQUEST IN SS
          UJK    SELRQ10
          SPACE  5,20
** NAME-- SETADD
*
** PURPOSE-- SET STARTING DISK ADDRESS IN RESPONSE BUFFER.
          SPACE  2
 SETADDX  LJM    **
 SETADD   EQU    *-1
          LDML   SS+/SS/P.UNIT  UNIT NUMBER
          STML   RS+/RS/P.UNIT

* PUT STARTING ADDRESS IN RESPONSE BUFFER.

          LDML   SS+/SS/P.CYL  STARTING CYLINDER ADDRESS
          STML   RS+/RS/P.SCYL
          LDML   SS+/SS/P.TRACK  TRACK
          LPN    77B
          STML   RS+/RS/P.STRK
          LDML   SS+/SS/P.SECTOR  SECTOR
          STML   RS+/RS/P.SSEC
          UJK    SETADDX
          SPACE  5,20
** NAME-- SETLOCK
*
** PURPOSE-- SETS THE UNIT LOCK IN THE UNIT INTERFACE TABLE.
*
** INPUT-- SS TABLE WHICH IDENTIFIES THE UNIT TABLE.
*
** EXIT-- A REGISTER  .NE. 0  IF LOCK WAS SUCCESSFULLY SET.
*                     .EQ. 0  IF LOCK COULD NOT BE SET.
          SPACE  2
 SETL20   BSS
          LDN    0
          STML   /LUT/P.OWNER,LUTLOC  INDICATE LOCK NOT SET
 SETLX    LJM    **
 SETLOCK  EQU    *-1
          LDDL   LUTLOC
          ADN    /LUT/P.UIT    UNIT INTERFACE TABLE ADDRESS
          STDL   P6
          LDN    /UIT/C.ULOCK  OFFSET OF UNIT LOCKWORD
          STDL   T5
          RJM    LOCK        SET LOCKWORD
          NJK    SETL20      IF LOCK COULD NOT BE SET
          LDN    /LUT/K.OWNER
          STML   /LUT/P.OWNER,LUTLOC  INDICATE LOCK SET
          UJK    SETLX
          SPACE  5,20
** NAME-- SMA
*
** PURPOSE-- SLAVE MESSAGE A.  TELL MASTER THAT THE SLAVE DETECTED
*            AN A REGISTER NONZERO ERROR.
          SPACE  2
 SMA      BSS
          LDN    C.AREG      A REGISTER NONZER ERROR
          UJN    SMB10
          SPACE  5,20
** NAME-- SMB
*
** PURPOSE-- SLAVE MESSAGE B.  TELL THE MASTER THAT THE SLAVE DETECTED
*            THE ERROR FLAG SET.
          SPACE  2
 SMB      BSS
          LDN    C.CPE       CHANNEL PARITY ERROR
 SMB10    BSS
          RJM    RWEP        READ WRITE ERROR PROCESSING (NO RETURN)




          SPACE  5,20
** NAME-- SNDRSP
*
** PURPOSE-- SEND THE RESPONSE TO CM.
*            USED WHEN SWITCHING TO THE NEXT REQUEST.
          SPACE  2
 SNDX     LJM    **
 SNDRSP   EQU    *-1
          RJM    RESP        SEND RESPONSE TO CM
          RJM    RESPIN      UPDATE -IN- POINTER IN RESPONSE BUFFER
          RJM    SRESP       SET UP RESPONSE BUFFER
          UJK    SNDX
          SPACE  5,20
** NAME-- SNMSG
*
** PURPOSE-- SEND UNSOLICITED MESSAGE
          SPACE  2
 SNMSGX   LJM    **
 SNMSG    EQU    *-1
          LDN    0
          STML   RS+/RS/P.SHORT  INDICATE ERROR RESPONSE
          LDC    C.RS*8
          STML   RS+/RS/P.RESPL
          LDN    R.UNS
          STML   RS+/RS/P.RC  UNSOLICITED RESPONSE CODE
          RJM    RESP        SEND RESPONSE TO CM
          UJK    SNMSGX
          SPACE  5,20
** NAME-- SPLOCK
*
** PURPOSE-- SETS THE PP TABLE LOCK IN THE
*            PP INTERFACE TABLE.
          SPACE  2
 SPLX     LJM    **
 SPLOCK   EQU    *-1
 SPLOCK4  BSS
          LDN    0
          STDL   T1
          STDL   T2
          STDL   T3
          LDN    1
          STDL   T4
          LOADC  CM.PIT      CM ADDRESS OF PP INTERFACE TABLE
          RDSL   T1          ATTEMPT TO SET PP TABLE LOCK
          LDDL   T4
          LPN    1
          ZJK    SPLX        IF LOCK SET
          UJK    SPLOCK4
          SPACE  5,20
** NAME-- SQLOCK
*
** PURPOSE-- SETS THE QUEUE LOCK IN THE UNIT INTERFACE TABLE.
*
** INPUT-- SS TABLE WHICH IDENTIFIES THE UNIT TABLE.
*
** EXIT-- A REGISTER = 0, IF LOCK WAS SUCCESSFULLY SET.
*                    .NE. 0, IF LOCK COULD NOT BE SET.
          SPACE  2
 SQLX     LJM    **
 SQLOCK   EQU    *-1
          LDDL   LUTLOC
          ADN    /LUT/P.UIT    UNIT INTERFACE TABLE ADDRESS
          STDL   P6
          LDN    /UIT/C.QLOCK  OFFSET OF QUEUE LOCKWORD
          STDL   T5
          RJM    LOCK        SET LOCKWORD
          UJK    SQLX
          SPACE  5,20
** NAME-- SSA
*
** PURPOSE-- SET SEEK ADDRESS
          SPACE  2
 SSAX     LJM    **
 SSA      EQU    *-1
          RJM    UREQ        READ SELECTED REQUEST INTO RQ
          LDML   RQ+/RQ/P.CYL
          STML   SS+/SS/P.CYL  CYLINDER ADDRESS OF CURRENT REQUEST
          LDML   RQ+/RQ/P.TRACK
          ADC    4000B       SET SECTOR SIZE FOR HARDWARE
          STML   SS+/SS/P.TRACK  TRACK ADDRESS OF CURRENT REQUEST
          LDML   RQ+/RQ/P.SECTOR
          STML   SS+/SS/P.SECTOR  SECTOR ADDRESS OF CURRENT REQUEST
          RJM    SC          SAVE CLOCK
          UJK    SSAX
          SPACE  5,20
** NAME-- SWITCH
*
** PURPOSE-- THE FIRST REQUEST AFTER A REQUEST SWITCH WAS SUCCESSFULLY
*            STARTED (NOW WE KNOW THAT NO ERRORS WERE DETECTED ON THE
*            PREVIOUS REQUEST). AT THIS POINT WE CAN UPDATE INTERNAL
*            POINTERS TO REFLECT THE REQUEST JUST STARTED.
          SPACE  2
 SWITCHX  LJM    **
 SWITCH   EQU    *-1
          LDN    0
          STDL   SWFLG       CLEAR SWITCH FLAG
          RJM    PDR         PREPARE DISK RESPONSE
          RJM    SNDRSP      SEND RESPONSE TO CM FOR LAST REQUEST
          AODL   NCOMRQ      INCREMENT NUMBER OF COMPLETED REQUESTS
          LDML   SS+/SS/P.SECTOR   ASDF
          SBML   RQ+/RQ/P.SECTOR
          NJN    SW10        IF ERROR
          LDML   SS+/SS/P.TRACK
          LPN    77B
          SBML   RQ+/RQ/P.TRACK
          NJN    SW10        IF ERROR
          LDML   SS+/SS/P.CYL
          SBML   RQ+/RQ/P.CYL
          NJN    SW10        IF ERROR
          LDML   CURRQ       SAVE RMA OF PREVIOUS REQUEST
          STML   PRERQ
          LDML   CURRQ+1
          STML   PRERQ+1
          LDML   SS+/SS/P.REQ  SAVE RMA OF CURRENT REQUEST
          STML   CURRQ
          LDML   SS+/SS/P.REQ+1
          STML   CURRQ+1
          UJK    SWITCHX
 SW10     BSS
          RJM    HANG
          SPACE  5,20
** NAME-- TERM
*
** PURPOSE-- TERMINATE UNIT REQUEST. (ONLY DONE BY MASTER)
          SPACE  2
 TERM     BSS
          RJM    PDR         PREPARE DISK RESPONSE
          RJM    RESP        SEND RESPONSE TO CPU
          RJM    DELRQ       DELINK COMPLETED REQUESTS FROM QUEUE
          RJM    RESPIN      UPDATE 'IN' POINTER IN RESPONSE BUFFER
          RJM    CLRLOCK     CLEAR LOCK ON UNIT
          STML   RS+/RS/P.RTRY  CLEAR REQUEST RETRY COUNTER
          LDN    C.END
          RJM    SEND        SEND END MESSAGE TO SLAVE
          UJK    MAIN45      RETURN TO MAIN LOOP
          SPACE  5,20
** NAME-- TERMP
*
** PURPOSE-- SEND TERMINATION RESPONSE
          SPACE  2
 TERX     LJM    **
 TERMP    EQU    *-1
          RJM    RESP        SEND RESPONSE TO CPU
          RJM    RESPIN      UPDATE 'IN' POINTER FOR RESPONSE BUFFER
          UJK    TERX
          SPACE  5,20
** NAME-- UDA
*
** PURPOSE-- UPDATE DISK ADDRESS.  USE OF FLAG FT KEEPS THE DISK
*            ADDRESS ACCURATE FOR ERROR REPORTING.
          SPACE  2
 UDA10    BSS
          AODL   FT          INDICATE NOT FIRST FUNCTION
 UDAX     LJM    **
 UDA      EQU    *-1
          LDDL   FT
          ZJN    UDA10       IF FIRST DATA FUNCTION
          AOML   SS+/SS/P.SECTOR UPDATE SECTOR
          SBN    MAXSEC+1
          MJN    UDAX        IF SAME TRACK
          STML   SS+/SS/P.SECTOR CLEAR SECTOR
          AOML   SS+/SS/P.TRACK UPDATE TRACK
          UJN    UDAX
          SPACE  5,20
** NAME-- UREQ
*
** PURPOSE-- READ A UNIT REQUEST FROM CM.
*
** INPUT-- SS TABLE WHICH IDENTIFIES THE UNIT QUEUE.
*
** OUTPUT-- RQ  CONTAINS CURRENT REQUEST.
*           FRST = 0
*           NUMCM = NUMBER OF COMMANDS.
          SPACE  2
 UREQX    LJM    **
 UREQ     EQU    *-1
          LDN    0
          STML   FRST        SET FLAG WHEN REQUEST IS READ
          LDN    3           NUMBER OF WORDS TO READ
          STDL   WC
          LOADF  SS+/SS/P.REQ  LOAD CM ADDRESS AND REFORMAT
          ADN    2
          CRML   RQ+2*4,WC   READ CURRENT REQUEST
          SBN    5
          CRML   RQ,WC       READ SWITCH FLAG BEFORE LINKAGE POINTERS
          LDML   RQ+/RQ/P.LEN  DETERMINE NUMBER OF COMMANDS
          SHN    -3
          SBN    /RQ/C.CMND
          STML   NUMCM       NUMBER OF COMMANDS

* PUT REQUEST IN PP COMMUNICATION BUFFER.

          LDN    C.RQ
          STDL   WC
          RJM    EXLOD       GET CM ADDRESS OF COMMUNICATION BUFFER
          ADN    /CB/C.REQ
          CWML   RQ,WC       WRITE CURRENT REQUEST
          UJK    UREQX
          SPACE  5,20
** NAME-- USC
*
** PURPOSE-- UPDATE SAVED CLOCK
          SPACE  2
 USCX     LJM    **
 USC      EQU    *-1
          LDDL   PPNO        LOGICAL PP NUMBER
          SBML   SS+/SS/P.LPP
          ZJN    USCX        IF CLOCK START VALUE ACCURATE
          LDDL   PPNO
          STML   SS+/SS/P.LPP
          LDDL   CLMLS
          STDL   P6
 USC5     BSS
          SBML   SS+/SS/P.SEEKTM+1
          STML   SS+/SS/P.CLKST+1
          PJN    USC10       IF CLOCK HASN'T WRAPPED
          AOML   SS+/SS/P.SEEKTM
          LDC    1000        MILLISECONDS PER SECOND
          RADL   P6
          UJN    USC5
 USC10    BSS
          LDDL   CLSEC
          SBML   SS+/SS/P.SEEKTM
          PJN    USC30       IF CLOCK HASN'T WRAPPED
          ADC    0#10000
 USC30    BSS
          STML   SS+/SS/P.CLKST
          RJM    SAVSS
          UJK    USCX
          SPACE  5,20
** NAME-- WFUL
*
** PURPOSE-- WAIT FOR UNIT LOCK
          SPACE  2
 WFULX    LJM    **
 WFUL     EQU    *-1
 WFUL10   BSS
          RJM    SETLOCK     SET UNIT LOCK
          NJN    WFULX       IF LOCK SET
          UJN    WFUL10
          ERRPL  *-MASBUF    IF RESIDENT CODE SPILLS INTO DATA AREA
          SPACE  5,20
** NAME-- INIT
*
** PURPOSE-- REFORMAT AND SAVE ADDRESS OF PPIT AND OVERLAY
*            DIRECTORY.  THIS CODE MAY BE OVERLAYED AFTER IT
*            IS EXECUTED.
          SPACE  2
 INIT     BSS
          REFAD  DSRTP,CM.PIT REFORMAT ADDRESS OF PP INTERFACE TABLE
                               AND SAVE AT CM.PIT
          ADN    /PIT/C.CBUF
          CRDL   P1          READ RMA OF PP COMMUNICATIONS BUFFER
          LOADF  P3          REFORMAT ADDRESS OF COMMUNICATIONS BUFFER
          ADN    /CB/C.ODP
          CRDL   T1          READ RMA OF OVERLAY DIRECTORY
          REFAD  T3,DH       REFORMAT ADDRESS OF OVERLAY DIRECTORY
                              AND SAVE AT DH
 F        IFEQ   FE,1
          LOADOVL FEO        LOAD FORCE ERROR OVERLAY
 F        ENDIF
          LJM    MAIN
          OVERLAY (CONFIDENCE TEST),MASBUF
          ROUTINE CTO        CONFIDENCE TEST OVERLAY
          SPACE  5,20
** NAME-- BCTB
*
** PURPOSE-- BUILD CONFIDENCE TEST BUFFER
          SPACE  2
 BCTBX    LJM    **
 BCTB     EQU    *-1
          IAN    14B
          STML   CTB         STARTING VALUE FOR INCREMENTING PATTERN
          STDL   T1
          LDN    0
          STDL   T3          INDEX TO BUFFER
 BCTB10   BSS
          AODL   T1          BUILD INCREMENTING PATTERN
          STML   CTB+1,T3
          AODL   T3
          LMC    420B
          NJN    BCTB10      IF MORE WORDS TO STORE
          UJK    BCTBX
          SPACE  5,20
** NAME-- CT
*
** PURPOSE-- CONFIDENCE TEST.  RESERVE DRIVE, WRITE, READ, VERIFY
*            DATA ON THE CONFIDENCE TEST CYLINDER, THEN RELEASE THE
*            DRIVE IF INITIALIZATION CONFIDENCE TEST.
*
** ENTRY
*         1) AT INITIALIZATION WHEN PP IS LOADED
*         2) WHEN PP IS RESUMED
*         3) DURING ERROR RECOVERY TO ISOLATE AN ERROR TO MEDIA
          SPACE  2
 CTX      BSS
          LDN    0
          STDL   COMLOOK     ENSURE COMLOOK HAS A LEGAL VALUE
          LDN    1
          STDL   CTF         CONFIDENCE TEST COMPLETE
          LJM    **
 CT       EQU    *-1
 F        IFEQ   FE,1        FOR FORCING ERRORS
          LDN    4
          CRDL   T1
          LDDL   T1
          LMN    0#13
          NJN    CT5         IF NOT MODIFYING THE DELAY
          LDDL   T2
          STML   CTD1
          LDDL   T3
          STML   CTD2
          UJN    CT5
 CTD1     DATA   1           VALUE TIMES .5 IS WRITE DELAY
 CTD2     DATA   1           VALUE TIMES .5 IS READ DELAY
 CT5      BSS
 F        ENDIF
          LDN    0
          STDL   COMLOOK
          UJN    CT20
 CT10     BSS
          AODL   COMLOOK     UPDATE TO NEXT UNIT
 CT20     BSS
          SBDL   DEVL
          PJN    CTX         IF END OF CONFIGURED UNITS
          RJM    RDT         READ DEVICE TABLE
          SHN    -1
          NJK    CT10        IF NOT RUNNING CONFIDENCE TEST
          LDDL   CTF
          NJN    CT21        IF ORIGINAL ERROR OCCURRED ON A REQUEST
          LDC    SPLUT       SPARE LOGICAL UNIT TABLE
          STDL   LUTLOC
          LDN    1
          STDL   WC
          LOADC  CM.DEV      ADDRESS OF DEVICE TABLE
          ADDL   COMLOOK     INDEX INTO TABLE
          CRML   SPLUT+2,WC  ADDRESS OF UNIT INTERFACE TABLE
 CT21     BSS
          RJM    PPREQ       CHECK FOR IDLE REQUEST
          RJM    WFUL        WAIT FOR UNIT LOCK
          RJM    RDT         READ DEVICE TABLE
          LOADC  P3          ADDRESS OF UNIT INTERFACE TABLE
          CRDL   T1
          LDDL   T1+/UIT/P.DSABLE
          SHN    2+/UIT/L.DSABLE
          PJN    CT23        IF UNIT ENABLED
          RJM    CLRLOCK     CLEAR UNIT LOCK
          UJK    CT10
 CT23     BSS
          RJM    CTDT        CONFIDENCE TEST DATA TRANSFER
 CT25     BSS
          LDDL   CTF
          NJN    CT30        IF NOT INITIALIZATION CONFIDENCE TEST
          STML   RS+/RS/P.RTRY CLEAR RETRY COUNTER
          LDN    F.OPCMP
          RJM    FUNC        RELEASE THE DRIVE
          RJM    CLRLOCK     CLEAR UNIT LOCK
 CT30     BSS
          RJM    RDT         READ DEVICE TABLE
          LPN    /CB/K.ACT
          LMN    2
          STDL   P2          INDICATE CONFIDENCE TEST SUCCESSFUL
          LDML   CM.DEV+2
          ADDL   COMLOOK
          LMC    400000B
          CWDL   P2          SAVE IN DEVICE TABLE
          UJK    CT10
          SPACE  5,20
** NAME-- CTDT
*
** PURPOSE-- CONFIDENCE TEST DATA TRANSFER
          SPACE  2
 CTDTX    LJM    **
 CTDT     EQU    *-1
          LDN    F.OPCMP     OPERATION COMPLETE (ENSURE CHAINING IS CLEARED)
          RJM    FUNC
          LOADR  /LUT/P.UIT,LUTLOC  ADDRESS OF UNIT INTERFACE TABLE
          ADN    /UIT/C.UBUF
          CRDL   T4          ADDRESS OF UNIT COMMUNICATIONS BUFFER
          LDN    C.SS
          STDL   WC
          LOADF  T6          ADDRESS OF SS TABLE
          CRML   SS,WC       READ SS TABLE
          LDC    MAXCYL-1
          STML   SS+/SS/P.CYL CONFIDENCE TEST CYLINDER
          LDC    4000B
          STML   SS+/SS/P.TRACK TRACK
          LDN    0
          STML   SS+/SS/P.SECTOR SECTOR
          STDL   FT          INDICATE FIRST FUNCTION
          LCN    0           MAKE MEDIA ERROR TABLE LOOK EMPTY
          STML   SS+CTME
          STML   SS+CTME+1
          STML   SS+CTME+2
          RJM    BCTB        BUILD CONFIDENCE TEST BUFFER
          LDML   RS+/RS/P.RTRY
          SBN    2
          MJN    CTDT20      IF NOT DOING UNCONDITIONAL RESERVE
          RJM    UR          UNCONDITIONAL RESERVE
 CTDT20   BSS
          RJM    SEEKON      WAIT FOR ON CYLINDER
*
*         WRITE THE CYLINDER
*           PP OUTPUTS 8 BLOCKS EACH OF LENGTH 530 OCTAL WORDS.
*           EACH BLOCK TAKES 402 OCTAL PP MEMORY LOCATIONS.
*
          LDC    CTDT35
          STDL   CA          CONTINUE ADDRESS
 CTDT30   BSS
          LDN    F.WRITE
          RJM    FUNC        WRITE FUNCTION
 CTDT35   BSS
          RJM    UDA         UPDATE DISK ADDRESS
          LDN    0
          STDL   T1          FIRST OF 8 BLOCKS
          LDN    1
          STDL   FNC         INDICATE WRITE OPERATION
          LDC    CTB
          STML   OUTPK10     ADDRESS TO OUTPUT FROM
 CTDT40   BSS
          LDC    530B        WORDS TO OUTPUT
          RJM    OUTPK       OUTPUT PACKED DATA
          AOML   OUTPK10     UPDATE ADDRESS TO OUTPUT FROM
          AODL   T1
          LPN    7
          STDL   T1          UPDATE BLOCK NUMBER
          NJN    CTDT40      IF MORE DATA IN SECTOR
          RJM    DCN         DISCONNECT THE CHANNEL

 F        IFEQ   FE,1        FOR FORCING ERRORS
          LDML   CTD1
          SBN    1
          NJN    *-1         FOR TESTING
 F        ENDIF

          AODL   FT          INDICATE NOT FIRST TIME
          LDML   SS+/SS/P.SECTOR
          ADML   SS+/SS/P.TRACK
          LPN    77B
          SBN    MAXSEC+MAXTR
          NJK    CTDT30      IF MORE SECTORS TO TRANSFER
          RJM    GENSTAT     GET GENERAL STATUS
          NJK    CTDT90      IF ERROR
 CTDT45   BSS
          LDC    4000B
          STML   SS+/SS/P.TRACK CLEAR TRACK NUMBER
          LDN    0
          STML   SS+/SS/P.SECTOR  CLEAR SECTOR NUMBER
 CTDT50   BSS
          STDL   FT          INDICATE FIRST FUNCTION
          STDL   FNC         INDICATE READ OPERATION
          RJM    SEEKON      SEEK, WAIT FOR ON CYLINDER
*
*         READ THE CYLINDER
*           PP INPUTS 8 BLOCKS, EACH OF LENGTH 530 OCTAL WORDS.
*           EACH BLOCK REQUIRES 402 OCTAL PP MEMORY LOCATIONS. ONLY
*           THE DATA IN THE FIRST SECTOR OF EACH HEAD IS VERIFIED.
*           THIS ALLOWS THE PP TO STREAM DATA FOR 10 SECTORS.
*
          LDC    CTDT65
          STDL   CA          CONTINUE ADDRESS
          LDC    CTB+1
          STML   INPK10      ADDRESS TO INPUT TO
          LDN    0
          STML   DMF         CLEAR DATA MISCOMPARE FLAG
 CTDT60   BSS
          LDN    F.READ
          RJM    FUNC        SEND READ FUNCTION
          LDDL   FT
          ZJN    CTDT65      IF FIRST FUNCTION
          LDML   DMF
          ZJN    CTDT65      IF NO DATA MISCOMPARE
          LDN    E07         PP - DRIVE DATA INTEGRITY ERROR
          STDL   T1
          RJM    RDT         READ DEVICE TABLE
          LPN    /CB/K.ACT
          LMN    8
          STDL   P2
          LOADC  CM.DEV
          ADDL   COMLOOK
          CWDL   P2          INDICATE DATA INTEGRITY ERROR
          LDDL   T1
          RJM    PCER        PREPARE COMMON ERROR RESPONSE (NO RETURN)
 CTDT65   BSS
          RJM    UDA         UPDATE DISK ADDRESS
          LDN    0
          STDL   T1          FIRST OF 8 BLOCKS
 CTDT70   BSS
          LDC    530B        WORDS TO INPUT
          RJM    INPK        INPUT AND PACK DATA
          LDML   SS+/SS/P.SECTOR
          NJN    CTDT75      IF NOT FIRST SECTOR OF TRACK
          RJM    VCTD        VERIFY CONFIDENCE TEST DATA
 CTDT75   BSS
          AODL   T1
          LPN    7
          STDL   T1
          NJN    CTDT70      IF MORE DATA IN SECTOR
          RJM    WFI         WAIT FOR INACTIVE

 F        IFEQ   FE,1        FOR FORCING ERRORS
          LDML   CTD2
          SBN    1
          NJN    *-1
 F        ENDIF

          AODL   FT          INDICATE NOT FIRST SECTOR
          LDML   SS+/SS/P.SECTOR
          ADML   SS+/SS/P.TRACK
          LPN    77B
          SBN    MAXSEC+MAXTR
          NJK    CTDT60      IF MORE SECTORS TO TRANSFER
          RJM    GENSTAT     GET GENERAL STATUS
          NJN    CTDT90      IF ERROR
          UJK    CTDTX
 CTDT90   BSS
          LDN    E00         CP MUST ISOLATE THE ERROR
          RJM    PCER        PREPARE COMMON ERROR RESPONSE (NO RETURN)
          SPACE  5,20
** NAME-- UR
*
** PURPOSE-- UNCONDITIONAL RESERVE OF THE DRIVE
*
** NOTE-- UNCONDITIONAL RESERVE ONLY WORKS IF CHAINING HAS BEEN DROPPED
*         BY THE OTHER STORAGE DIRECTOR.
          SPACE  2
 URX      BSS
          LDN    F.OPCMP
          RJM    FUNC        OPERATION COMPLETE (DROP CHAINING)
          LJM    **
 UR       EQU    *-1
          LDN    F.CONECT
          RJM    FUNC        SEND CONNECT FUNCTION
          LDML   SS+/SS/P.UNIT
          ADC    4000B
          STDL   T1          UNIT NUMBER/UNRECOVERED RESPONSE
          LDN    T1
          STML   OUT10       ADDRESS TO OUTPUT FROM
          LDN    1
          RJM    OUT         OUTPUT PARAMETER WORD
          RJM    DCN         DISCONNECT THE CHANNEL
          RJM    GENSTAT     GET GENERAL STATUS
          ZJN    URX         IF NO ERROR
          LDN    E00         CP MUST ISOLATE THE ERROR
          RJM    PCER        PREPARE COMMON ERROR RESPONSE (NO RETURN)
          SPACE  5,20
** NAME-- VCTD
*
** PURPOSE-- VERIFY CONFIDENCE TEST DATA
*
** ENTRY
*         T1 = BLOCK NUMBER (0 TO 7) OF DATA READ
          SPACE  2
 VCTD40   BSS
          STML   DMF         INDICATE DATA MISCOMPARE
 VCTDX    LJM    **
 VCTD     EQU    *-1
          LDN    0
          STDL   P1
          LDML   SS+/SS/P.TRACK
          SHN    8
          STDL   P2          PUT CURRENT TRACK, SECTOR IN ONE WORD
 VCTD3    BSS
          LDML   SS+CTME,P1
          LMDL   P2
          ZJK    VCTDX       IF SECTOR NOT WRITTEN
          AODL   P1
          LMN    3
          NJN    VCTD3       IF MORE TABLE LOCATIONS TO CHECK
          LDC    402B
          STDL   T4          WORDS TO VERIFY
          LDML   CTB
          ADDL   T1
          STDL   T2          PATTERN FIRST WORD
          LDN    0
          STDL   T3          INDEX TO BUFFER
 VCTD20   BSS
          LDML   CTB+1,T3
          LMDL   T2
          NJN    VCTD40      IF ERROR
          AODL   T2
          AODL   T3
          SODL   T4
          NJN    VCTD20      IF MORE WORDS TO VERIFY
          UJK    VCTDX
          ERRPL  *-CTB       IF OVERFLOWING MEMORY
          OVERLAY (ERROR RECOVERY),MASBUF
          ROUTINE ERO        ERROR RECOVERY OVERLAY
          SPACE  5,20
** NAME-- OE
*
** PURPOSE-- TURN OFF ALL UNITS ON AN EQUIPMENT
*
** ENTRY
*         A = 0 TO TURN OFF ALL UNITS ON AN A CHANNEL
*         A NOT 0 TO TURN OFF ALL UNITS ON A STORAGE DIRECTOR
          SPACE  2
 OEX      LJM    **
 OE       EQU    *-1
          STDL   P2
          LDDL   DEVL
          ZJN    OEX         IF NO UNITS
          LDN    0
          STDL   COMLOOK     SET TO BEGINNING OF CM.DEV TABLE
          LDDL   LUTLOC
          STDL   P1          SAVE LUTLOC
          LDK    SPLUT       SPARE LOGICAL UNIT TABLE
          STDL   LUTLOC
 OE2      BSS
          LDN    1
          STDL   WC
          LOADC  CM.DEV      ADDRESS OF DEVICE TABLE
          ADDL   COMLOOK     INDEX INTO TABLE
          CRML   SPLUT+2,WC
          LOADR  SPLUT+/LUT/P.UIT
          CRDL   T1          GET FIRST WORD OF UIT
          ADN    /UIT/C.UBUF
          CRDL   T5          GET SECOND WORD OF UIT
          LDDL   T1+/UIT/P.DSABLE
          SHN    /UIT/L.DSABLE+2
          MJK    OE50        IF UNIT DISABLE ALREADY IS SET
          RJM    WFUL        WAIT FOR UNIT LOCK
          LDN    C.SS
          STDL   WC          LENGTH OF SS TABLE
          LOADF  T7
          CRML   SS,WC       READ SS ENTRY
          LDML   IDLE        IS THIS TRIP A RESULT OF AN IDLE COMMAND
          NJN    OE20        IF YES, AVOID TURNING OFF THE UNIT
          LDDL   P2
          ZJN    OE10        IF OFFING A CHANNEL
          LDML   RS+/RS/P.UNIT
          LMML   SS+/SS/P.UNIT
          LPN    40B
          NJN    OE20        IF DIFFERENT STORAGE DIRECTOR
 OE10     BSS
          LOADR  SPLUT+/LUT/P.UIT  ADDRESS OF UIT
          RJM    OFFUN       GO SET THE UNIT OFF
 OE20     BSS
          LDN    0           CLEAR THE REQUEST SELECTED FLAG
          STML   SS+/SS/P.ENTRY
          RJM    SAVSS       SAVE THE SS ENTRY
          RJM    CLRLOCK     UNLOCK UNIT
 OE50     BSS
          AODL   COMLOOK     ARE ALL UNITS PROCESSED?
          SBD    DEVL
          NJK    OE2         NO, GO TO THE NEXT ONE
          STDL   COMLOOK     ENSURE COMLOOK HAS LEGAL VALUE
          LDDL   P1
          STDL   LUTLOC      RESTORE LUTLOC
          LJM    OEX
          SPACE  5,20
** NAME-- OFFUN
*
** PURPOSE-- SET THE DISABLE FLAG IN THE UNIT INTERFACE TABLE.
*
** INPUT-- A & R REGISTERS = CM ADDRESS OF UNIT INTERFACE TABLE.
          SPACE  2
 OFUX     LJM    **
 OFFUN    EQU    *-1
          STDL   T1
          LDK    /UIT/K.DSABLE  SET UNIT DISABLE FLAG
          STDL   T3
          LDN    0
          STDL   T2
          STDL   T4
          STDL   T5
          LDDL   T1
          LMC    400000B
          RDSL   T2          -LOGICAL OR- THE UNIT DISABLE FLAG
          UJN    OFUX
          SPACE  5,20
** NAME-- PIR
*
** PURPOSE-- PROCESS IDLE OR RESUME COMMAND
          SPACE  2
 PIR      CON    0
          LDDL   T5
          SHN    /PIT/L.IDLREQ+2
          MJN    PIR10       IF IDLE REQUEST
          LDDL   T4          CLEAR ACTIVE CHECK BIT, RESUME REQUEST
          LPC    0#4FFE       BIT, IDLE STATUS BIT, AND LOCK BIT IN
          STDL   T4           PP INTERFACE TABLE
          LDDL   CM.PIT+2
          LMC    400000B
          CWDL   T1
          LDN    0
          STML   IDLE        CLEAR IDLE FLAG
          LDN    C.RES
          RJM    SEND        TELL SLAVE THAT RESUME OCCURRED
          LJM    MAIN
 PIR10    BSS
          LDDL   NCOMRQ
          SBN    2
          MJN    PIR15       IF NO COMPLETED REQUESTS TO DELINK
          SOML   NCOMRQ      MAKE COMPLETED REQUEST COUNT ACCURATE
          LDML   PRERQ       DELINK REQUESTS FROM FCOMRQ THRU CURRQ
          STML   CURRQ
          LDML   PRERQ+1
          STML   CURRQ+1
          RJM    DELRQ       DELINK COMPLETED REQUESTS
 PIR15    BSS
          AOML   IDLE        SET IDLE FLAG
          LDN    0
          RJM    OE          CLEAR UNIT LOCKS
          RJM    CCLOCK      CLEAR CHANNEL LOCK
          LOADC  CM.PIT      ADDRESS OF PP INTERFACE TABLE
          CRDL   T1          READ FIRST WORD OF PP INTERFACE TABLE
          LDDL   T4
          LPC    0#2FFE      CLEAR ACTIVE CHECK BIT, IDLE REQUEST BIT,
          LMC    0#1000       CLEAR LOCK BIT, AND SET THE IDLE STATUS BIT
          STDL   T4
          LDDL   CM.PIT+2
          LMC    400000B
          CWDL   T1
 PIR20    BSS
          RJM    PPREQ       WAIT FOR RESUME
          UJN    PIR20
          SPACE  5,20
** NAME-- RSTBP
*
** PURPOSE-- RESTORE BUFFER POINTERS WHEN THE READ PROCESS HAS TO
*            BACK UP 1 SECTOR.
          SPACE  2
 RSTBPX   LJM    **
 RSTBP    EQU    *-1
          LDN    2           LENGTH OF SAVE AREA
          STDL   WC
          RJM    EXLOD       ADDRESS OF COMMUNICATIONS BUFFER
          ADN    /CB/C.SVAREA
          ADDL   SLAVE       ADD OFFSET SO MASTER AND SLAVE DO NOT USE
          ADDL   SLAVE        THE SAME AREA
          CRML   SVCELLS,WC  READ THE BACKED UP POINTERS
          LDDL   CMRMA       RESTORE RMA DATA POINTERS
          STML   CM+/CM/P.RMA
          LDDL   CMRMA+1
          STML   CM+/CM/P.RMA+1
          LDN    0
          STDL   SWFLG
          STDL   WDSS        AVOID COUNTING BYTES DURING RECOVERY
          UJN    RSTBPX      EXIT
          SPACE  5,20
** NAME-- RSTRQ
*
** PURPOSE-- SET UP FOR REQUEST RETRY
          SPACE  2
 RSTRQ    CON    0
          LDN    0
          STML   RS+/RS/P.HDWR  CLEAR ERROR STATUS
          LDDL   CTF
          ZJK    MAIN5       IF ERROR DURING CONFIDENCE TEST
          LDN    F.OPCMP     OPERATION COMPLETE (ENSURE CHAINING IS CLEARED)
          RJM    FUNC
          LDDL   FNC
          SBN    2
          NJN    RSTRQ2      IF NOT FORMAT
          LJM    FMTR        FORMAT RETRY
 RSTRQ2   BSS
          LDDL   GOFLG
          ZJN    RSTRQ4      IF ERROR ON PREVIOUS SECTOR
          LDDL   SWFLG
          ZJN    RSTRQ4      IF NOT SWITCHING REQUESTS
          RJM    SWITCH      SEND RESPONSE FOR GOOD REQUEST
 RSTRQ3   BSS
          SODL   NCOMRQ      DECREMENT COMPLETED REQUEST COUNT
          LDML   PRERQ
          STML   CURRQ
          LDML   PRERQ+1
          STML   CURRQ+1
          RJM    DELRQ       DELETE THE COMPLETED REQUEST
          UJK    RSTRQ25
 RSTRQ4   BSS
          LDML   SIP
          ZJK    RSTRQ20     IF SEEK IN PROGRESS
          LDDL   NCOMRQ
          SBN    2
          PJN    RSTRQ3      TO DELINK COMPLETED REQUESTS
          LDML   CURRQ       RESTORE RMA OF CURRENT REQUEST
          STML   SS+/SS/P.REQ
          LDML   CURRQ+1
          STML   SS+/SS/P.REQ+1
          LDML   RS+/RS/P.PVA  RESTORE PVA OF CURRENT REQUEST
          STML   SS+/SS/P.PVA
          LDML   RS+/RS/P.PVA+1
          STML   SS+/SS/P.PVA+1
          LDML   RS+/RS/P.PVA+2
          STML   SS+/SS/P.PVA+2
          RJM    SSA         SET SEEK ADDRESS
          UJN    RSTRQ30
 RSTRQ20  BSS
          RJM    POLS        POLL SUBROUTINE
          RJM    UREQ        READ UNIT REQUEST FROM CM
 RSTRQ25  BSS
          RJM    SETRQ       SET UP FOR FIRST REQUEST
 RSTRQ30  BSS
          RJM    SAVSS       SAVE SS TABLE
          RJM    SETADD      PUT STARTING ADDRESS IN RESPONSE BUFFER
          RJM    SRESP       SET UP RESPONSE BUFFER
          RJM    UNCMND      GET COMMAND AND SET UP TO PROCESS
          RJM    SEEKON      ISSUE SEEK
          LJM    MAIN30
 C        IFEQ   CHANTYP,1
          ERRPL  *-17777B
 C        ELSE
          ERRPL  *-7777B     IF OVERFLOWING MEMORY
 C        ENDIF
          OVERLAY (FORMAT PACK),MASBUF
          ROUTINE FMO        FORMAT OVERLAY
** NAME-- FC
*
** PURPOSE-- FORMAT ONE CYLINDER
          SPACE  2
 FCX      LJM    **
 FC       EQU    *-1
 F        IFEQ   FE,1        IF FORCING ERRORS
          LDN    4
          CRDL   T1
          LDDL   T1
          LMN    0#14
          NJN    FC4         IF NOT CHANGING THE RECORD SIZE
          LDDL   T2
          STML   FUN+1       SET RECORD SIZE
 FC4      BSS
 F        ENDIF
          LDML   SS+/SS/P.UNIT
          ADC    2300B       WRITE RECORDS, CYLINDER MODE
          STML   FUN         PUT UNIT ADDRESS IN PARAMETER LIST
          LDN    F.FMP
          RJM    FUNC        FORMAT FUNCTION
          LDC    FBUF
          STML   OUT10       ADDRESS OF FORMAT PARAMETERS
          LDN    18
          RJM    OUT         OUTPUT FORMAT PARAMETERS
          RJM    DCN         DISCONNECT THE CHANNEL
          LDDL   CLSEC
          STML   SS+/SS/P.CLKST
 FC10     BSS
          RJM    GENSTAT     GET GENERAL STATUS
          ZJK    FCX         IF FORMAT COMPLETE
          RJM    UC          UPDATE CLOCK
          LDDL   CLSEC
          SBML   SS+/SS/P.CLKST
          PJN    FC20        IF CLOCK HAS NOT WRAPPED
          ADC    0#10000
 FC20     BSS
          SBN    5
          MJN    FC10        IF TIMEOUT NOT EXPIRED
          LDN    E00         CP MUST ISOLATE THE ERROR
          RJM    PCER        PREPARE COMMON ERROR RESPONSE (NO RETURN)
          SPACE  5,20
** NAME-- FORMD
*
** PURPOSE-- PROCESS TO FORMAT DISK COMMAND.
*
** INPUT-- CMLISTL = NUMBER OF ADDRESS-LENGTH ENTRIES IN THE
*                    COMMAND WHICH ARE LEFT TO PROCESS.
*          CMLIST  = A TABLE OF THE ADDRESS-LENGTH PAIRS POINTING TO
*                    THE CM DATA AREA.
          SPACE  2
 FORMD    CON    0
          LDN    E00
          RJM    PER         PREPARE ERROR RESPONSE
          LDK    /RS/K.FORS
          STML   RS+/RS/P.ID
          RJM    INTRS       TELL OPERATOR THAT FORMATTING IS STARTING

* THE CYL NUMBERS ARE AT ANOTHER LEVEL OF INDIRECTION.

          LDML   CMLIST+/CM/P.LEN  TAKE OUT 1 LEVEL OF INDIRECTION
          STML   CM+/CM/P.LEN
          SHN    -3          RESET CMLISTL
          STDL   CMLISTL
          LDML   CMLIST+/CM/P.RMA
          STML   CM+/CM/P.RMA
          LDML   CMLIST+/CM/P.RMA+1
          STML   CM+/CM/P.RMA+1
          RJM    GLIST       GO GET THE CYLINDER NUMBERS

 FORMD5   BSS
          LDML   CMLIST+/CM/P.RMA  STARTING CYLINDER
          STML   SS+/SS/P.CYL   PUT IT IN THE SS ENTRY
 FORMD10  BSS
          LDDL   CMLISTL
          STML   SS+/SS/P.LISTL  SAVE CURRENT CMLISTL POINTER
 FORMD20  BSS
          LDML   SS+/SS/P.CYL
          STML   FBUF        PUT CYLINDER NUMBER IN PARAMETER LIST
 F        IFEQ   FE,1        FOR FORCING ERRORS
          LDN    4
          CRDL   T1
          LDDL   T1
          LMN    0#11
          NJN    FORMD30     IF NOT FORCING AN ERROR
          LDDL   T2
          ZJN    FORMD30     IF NOT FORCING AN ERROR
          LCN    0           FORCE ERROR BY SENDING AN ILLEGAL
          STML   FBUF         CYLINDER NUMBER
          SODL   T2
          LDN    4
          CWDL   T1
 FORMD30  BSS
 F        ENDIF
          RJM    FC          FORMAT CYLINDER
          LDML   SS+/SS/P.LISTL
          STDL   CMLISTL     RESTORE SAVED CMLISTL POINTER
          LDML   CMLIST+/CM/P.RMA+1
          SBML   SS+/SS/P.CYL  CHECK IF FINISHED WITH RANGE
          ZJK    FORMD56     DONE
          LDN    1
          RAML   SS+/SS/P.CYL   SET TO NEXT CYLINDER
          RJM    PPREQ       CHECK FOR IDLE REQUEST
          UJK    FORMD10     GO DO THE NEXT CYLINDER
 FORMD56  BSS
          SODL   CMLISTL
          NJK    FORMD57     FORMAT IS NOT FINISHED
          LDN    F.OPCMP
          RJM    FUNC        RELEASE THE DRIVE
          LDN    E00
          RJM    PER         PREPARE ERROR RESPONSE
          LDK    /RS/K.FORE
          STML   RS+/RS/P.ID
          RJM    INTRS       TELL OPERATOR FORMAT FINISHED FOR 1 PACK
          LJM    TERM        EXIT - DONE
 FORMD57  BSS
          RJM    GLIST       GET NEXT ENTRY FROM LIST
          LJM    FORMD5      CONTINUE FORMATTING
 C        IFEQ   CHANTYP,1
          ERRPL  *-17777B
 C        ELSE
          ERRPL  *-7777B     IF OVERFLOWING MEMORY
 C        ENDIF
          OVERLAY (INITIALIZE TABLES),MASBUF
          ROUTINE ITO        INITIALIZE TABLES
** NAME-- CHGCH
*
** PURPOSE-- SET CHANNEL NUMBER IN INSTRUCTIONS
*
** INPUT-- CHAN = CHANNEL NUMBER
          SPACE  2
 CHGX     LJM    **
 CHGCH    EQU    *-1
          LDN    0
          STDL   T1          CHANGE DISK CHANNEL INSTRUCTIONS
 CHG10    LDML   CONCH,T1    ADDRESS OF CHANNEL INSTRUCTIONS
          ZJN    CHGX        END OF LIST
          STDL   T2
          LDIL   T2
          SCN    37B
          LMDL   CHAN        CHANNEL NUMBER
          STIL   T2
          AODL   T1
          UJK    CHG10

 CONCH    BSS                TABLE OF DISK CHANNEL REFERENCES
 TDC+40B  HERE   DISK CHANNEL REFERENCES
 T40B+DC  HERE
 TDC      HERE
          CON    0           END OF TABLE
          SPACE  5,20
** NAME-- FPART
*
** PURPOSE-- THE SLAVE MUST FIND THE MASTER PP AND USE ITS COMMUNICATION
*            BUFFER.
          SPACE  2
 FPAX     LJM    **
 FPART    EQU    *-1
          RJM    EXLOD       GET CM ADDRESS OF COMMUNICATION BUFFER
          CRDL   P1          READ CM ADDRESS OF PARTNERS PP-INTERFACE-TABLE
          LDDL   P1+/CB/P.SLAVE  CHECK IF THIS PP IS THE SLAVE
          LPK    /CB/K.SLAVE
          STDL   SLAVE       NONZERO IF THIS PP IS THE SLAVE
          ZJK    FPAX        IF THIS PP IS THE MASTER

* USE MASTER'S PP NUMBER.

          LOADF  P1+/CB/P.PARTNR  CM ADDRESS OF MASTER'S PP-INTERFACE-TABLE
          CRDL   T1          READ MASTER'S PP NUMBER
          LDDL   T1
          STDL   PPNO        USE MASTER'S PP NUMBER

* USE MASTER'S PP COMMUNICATION BUFFER.

          LDDL   CMADR+2     CM ADDRESS OF MASTERS PP-INTERFACE-TABLE
          LMC    400000B
          RJM    SETCB       SAVE ADDRESS OF COMMUNICATION BUFFER
          LDDL   CMADR+2     SWITCH IN AND OUT
          ADN    /CB/C.MSGIN
          STML   CM.MOUT+2
          ADN    /CB/C.MSGOUT-/CB/C.MSGIN
          STML   CM.MIN+2
          UJK    FPAX
          SPACE  5,20
** NAME-- IT
*
** PURPOSE-- INITIALIZE TABLES
*
** ENTRY
*         CM.PIT - 3 LOCATIONS CONTAINING THE REFORMATTED PPIT RMA
          SPACE  2
 ITX      LJM    **
 IT       EQU    *-1
          LDC    LUT
          STDL   USEQ        QUEUE HEAD FOR IN USE UNITS
          STDL   EMPTQ       QUEUE HEAD FOR UNITS NOT IN USE

* READ PP_INTERFACE_TABLE.

          LDN    C.PIT
          STDL   WC
          LOADC  CM.PIT      LOAD CM ADDRESS OF PP INTERFACE TABLE
          CRML   IPIT,WC     READ PP INTERFACE TABLE
          LDML   IPIT+/PIT/P.PPNO  GET PP NUMBER
          STDL   PPNO
          LDML   IPIT+/PIT/P.UNITC  NUMBER OF UNIT DESCRIPTORS
          SHN    1
          STDL   T8          LENGTH OF UNIT DESCRIPTORS (CM WORDS)

* REFORMAT ADDRESS OF RESPONSE BUFFER.
* INITIALIZE CM.RS, LIM.

          REFAD  IPIT+/PIT/P.RSBUF,CM.RS  REFORMAT CM ADDRESS OF RESPONSE
                             BUFFER
          LDML   IPIT+/PIT/P.LIMIT  GET LIMIT OF RESPONSE BUFFER
          STML   LIM

* REFORMAT ADDRESS OF INTERRUPT WORD.

          REFAD  IPIT+/PIT/P.INT,CM.INT  REFORMAT CM ADDRESS OF
                             INTERRUPT WORD

* REFORMAT ADDRESS OF CHANNEL TABLE.

          REFAD  IPIT+/PIT/P.CHAN,CM.CHAN  REFORMAT CM ADDRESS OF
                             CHANNEL TABLE

*  REFORMAT ADDRESS OF PP COMMUNICATIONS BUFFER

          LOADC  CM.PIT      ADDRESS OF PP INTERFACE TABLE
          RJM    SETCB       SAVE ADDRESS OF COMMUNICATIONS BUFFER

*  LOOK FOR A PARTNER PP.

          RJM    FPART       FIND PARTNER PP

* INITIALIZE COMMUNICATION BUFFERS IN ALL UNIT INTERFACE TABLES.

          RJM    ICOM        INITIALIZE COMMUNICATION BUFFERS

*
* SET UP MASTER/SLAVE DEPENDENT INSTRUCTIONS.

          LDDL   SLAVE
          NJN    INIT100     IF SLAVE PP
          LDC    MASBUF      ADDRESS OF MASTERS DATA BUFFER
          UJK    INIT110     GO FILL IN DATA ADDRESSES

 INIT100  BSS
          LDC    SLVBUF      ADDRESS OF SLAVE DATA BUFFER

* SET UP POINTERS TO THE CORRECT DATA BUFFER AND EXIT

 INIT110  BSS
          STML   READ36
          STML   WRI36
          STML   READ52
          STML   WRI53
          SHN    -12
          ADC    2100B       ADC INSTRUCTION
          STML   WRI36-1
          STML   READ52-1
          LDDL   SLAVE
          NJK    END         GO START THE SLAVE
          LJM    ITX
          SPACE  5,20
** NAME-- ICOM
*
** PURPOSE-- INITIALIZE THE UNIT COMMUNICATION BUFFER IN ALL THE UNIT
*            INTERFACE TABLES.
*            INITIALIZE ALL STATIC VARIABLES IN THE COMMUNICATION
*            BUFFER:  DEVICE TYPE, CHANNEL NUMBER, SEEK FUNCTION,
*            UNIT NUMBER, COMMUNICATION BUFFER (RMA), UNIT INTERFACE
*            TABLE (RMA).
          SPACE  2

* CHANGE DISK CHANNEL INSTRUCTIONS.

 ICOM100  BSS
          RJM    CHGCH       CHANGE DISK CHANNEL INSTRUCTIONS

* THE DISK CHANNEL IS ALSO USED TO LOAD THE PPS.  THEREFORE,
* THE PPS SHAKE HANDS BEFORE USING THE DISK CHANNEL.

          LDN    C.GO        EACH PP SENDS A -GO- TO PARTNER
          RJM    SEND
 ICOM110  BSS
          RJM    GETMSG      WAIT FOR PARTNER TO GET LOADED
          NJN    ICOM110     IF NOT A -GO- MESSAGE
          STDL   USEQ        SET IN USE QUEUE TO EMPTY
 ICOMX    LJM    **
 ICOM     EQU    *-1
          LDN    0
          STDL   T7          INDEX TO UNIT DESCRIPTORS
          STDL   DEVL        CLEAR DEVICE TABLE LENGTH
          STDL   PTF         ENABLE RUN OF PATH TEST
          STDL   CTF         ENABLE RUN OF CONFIDENCE TEST
          LDDL   T8          LENGTH OF UNIT DESCRIPTORS (CM WORDS)
          ZJN    ICOMX       IF NO UNIT DESCRIPTORS

*         ZERO OUT TABLES

          LDK    TL
          STDL   T1
 ICOM20   BSS
          LDN    0
          STML   LUT-1,T1     ZERO OUT TABLES
          SODL   T1
          NJN    ICOM20
 ICOM10   BSS
          LDDL   CM.PIT+2    CM ADDRESS OFFSET OF UNIT DESCRIPTORS
          ADN    C.PIT
          ADDL   T7
          STDL   CMADR+2
          LDN    C.UD        READ 2 CM WORDS
          STDL   WC
          LOADC  CM.PIT,CMADR+2
          CRML   IBUF,WC     READ UNIT DESCRIPTOR

* CHECK FOR NULL ENTRY.

          LDML   IBUF+/UD/P.UQT  RMA = 0 IF NULL ENTRY
          ADML   IBUF+/UD/P.UQT+1
          ZJK    ICOM80      IF NULL ENTRY

          LDDL   SLAVE
          NJK    ICOM40      IF SLAVE
          LDC    LUT
          STDL   LUTLOC      SO SETLOCK, CLRLOCK WILL WORK
          REFAD  IBUF+/UD/P.UQT,LUT+/LUT/P.UIT
          RJM    WFUL        WAIT FOR UNIT LOCK
          LDN    C.SS        LENGTH OF SS TABLE
          STDL   WC
          LOADR  LUT+/LUT/P.UIT  ADDRESS OF UNIT INTERFACE TABLE
          ADN    /UIT/C.UBUF
          CRDL   T1
          LOADF  T3          ADDRESS OF UNIT COMMUNICATIONS BUFFER
          CRML   SS,WC       READ SS TABLE
 ICOM40   BSS
          REFAD  IBUF+/UD/P.UQT,SS+/SS/P.UQT  REFORMAT RMA ADDRESS OF
                             UNIT INTERFACE TABLE

* READ UNIT INTERFACE TABLE

          LDN    C.UIT
          STDL   WC
          LOADR  SS+/SS/P.UQT  LOAD ADDRESS OF UNIT INTERFACE TABLE
          CRML   UBUF,WC     READ UNIT INTERFACE TABLE

* GET CHANNEL NUMBER SAVE IT.

          LDML   IBUF+/UD/P.CHAN
          SHN    -8
          STDL   CHAN        CHANNEL NUMBER
          STML   RS+/RS/P.CHAN  SAVE IN RESPONSE BUFFER

          LDDL   SLAVE       CHECK IF SLAVE PP
          NJK    ICOM100     LET MASTER INITIALIZE THE UNITS

* PUT PHYSICAL UNIT NUMBER IN SEEK FUNCTION.

          LDML   IBUF+/UD/P.UNIT
          LPN    /UD/M.UNIT
          STML   SS+/SS/P.UNIT
          LDML   IBUF+/UD/P.UNIT  ADD STORAGE DIRECTOR ADDRESS
          LPK    /UD/K.SDIR
          SHN    /UD/L.SDIR+10
          RAML   SS+/SS/P.UNIT

* REFORMAT COMMUNICATION BUFFER RMA.

          REFAD  UBUF+/UIT/P.UBUF,SS+/SS/P.COM

* CHECK THAT COMMUNICATION BUFFER IS LONG ENOUGH.

          LDML   UBUF+/UIT/P.UBUFL  NUMBER OF 8-BIT BYTES IN COMMUNICATION BUFFER
          SHN    -3          NUMBER OF CM WORDS
          SBN    C.SS        MUST BE LARGER THAN SS ENTRY
          PJN    ICOM70      IF COMMUNICATION BUFFER IS LARGE ENOUGH
                             ERROR - COMMUNICATION BUFFER TOO SMALL
          LDC    E308
          RJM    INTERR      INTERFACE ERROR (NO RETURN)

* SAVE SS ENTRY IN UNIT COMMUNICATION BUFFER.  NOTE THAT CONFIGURATION
* MANAGEMENT CLEARS THE UNIT COMMUNICATIONS BUFFER BEFORE THE DRIVER IS LOADED.

 ICOM70   BSS
          RJM    SAVSS       SAVE SS TABLE
          RJM    CLRLOCK     CLEAR UNIT LOCK
          LDML   UBUF+/UIT/P.DSABLE
          SHN    /UIT/L.DSABLE+2
          MJN    ICOM80      IF UNIT DISABLED

* SET AN ENTRY INTO THE CM.DEV TABLE.

          LDN    1
          STDL   WC
          LDN    0
          STML   SS+/SS/P.SECTOR  CLEAR ACTIVE AND CONFIDENCE TEST BITS
          LOADC  CM.DEV
          ADDL   DEVL
          CWML   SS+/SS/P.UQT-1,WC
          AODL   DEVL
          SBN    1
          ZJN    ICOM80      IF ONE, LINK MUST BE ZERO
          SBN    NOU         NUMBER OF UNITS
          PJN    ICOM80      IF TABLE FULL
          LDDL   USEQ
          ADN    P.LUT       POINTER TO NEXT LOGICAL UNIT ENTRY
          STIL   USEQ        FILL IN THE LINK FIELD
          LDN    P.LUT
          RADL   USEQ        SET POINTER TO NEXT ENTRY

* BUMP TO NEXT ENTRY.

 ICOM80   BSS
          LDN    C.UD
          RADL   T7          BUMP TO NEXT UNIT DESCRIPTOR ENTRY
          SBDL   T8          CHECK FOR END OF UNIT DESCRIPTORS
          NJK    ICOM10      IF MORE UNIT DESCRIPTORS
          UJK    ICOM100     EXIT
          SPACE  5,20
** NAME-- SAVAD
*
** PURPOSE-- SAVE RMA THAT IS BEING FORMATTED BY REFAD AND
*            STORED IN LOCATIONS GREATER THAN 77
          SPACE  2
 SAVAX    LJM    **
 SAVAD    EQU    *-1
          STML   2,T2
          LDDL   CMADR
          STI    T2
          LDDL   CMADR+1
          STML   1,T2
          UJK    SAVAX
          SPACE  5,20
** NAME-- SETCB
*
** PURPOSE-- REFORMAT AND SAVE ADDRESS OF COMMUNICATIONS BUFFER
*
** ENTRY-- A AND R REGISTERS POINT TO THE PP INTERFACE TABLE
          SPACE  2
 SETCBX   LJM    **
 SETCB    EQU    *-1
          ADN    /PIT/C.CBUF  OFFSET OF PP COMMUNICATION BUFFER ADDRESS
          CRDL   P1          READ ADDRESS OF PP COMMUNICATION BUFFER
          LOADF  P3          REFORMAT CM ADDRESS OF PP COMMUNICATION BUFFER
          STML   CM.CB+2
          ADN    /CB/C.MSGIN
          STML   CM.MIN+2
          ADN    /CB/C.MSGOUT-/CB/C.MSGIN
          STML   CM.MOUT+2
          ADC    /CB/C.DEV-/CB/C.MSGOUT
          STDL   CM.DEV+2
          LDDL   CMADR
          STML   CM.CB
          STML   CM.MIN      ADDRESS OF IN MESSAGE
          STML   CM.MOUT     ADDRESS OF OUT MESSAGE
          STDL   CM.DEV      ADDRESS OF DEVICE TABLE (ONE ENTRY FOR EACH UNIT)
          LDDL   CMADR+1
          STML   CM.CB+1
          STML   CM.MIN+1
          STML   CM.MOUT+1
          STDL   CM.DEV+1
          LDDL   P2          GET LENGTH OF PP COMMUNICATION BUFFER
          ADC    -P.CB-P.CB
          PJK    SETCBX      IF COMMUNICATIONS BUFFER LARGE ENOUGH
          RJM    HANG
          ERRPL  *-IPIT      IF OVERFLOWING MEMORY
          OVERLAY (PATH TEST),MASBUF
          ROUTINE PTO        PATH TEST OVERLAY
          SPACE  5,20
** NAME-- BPTB
*
** PURPOSE-- BUILD PATH TEST BUFFER
          SPACE  2
 BPTBX    LJM    **
 BPTB     EQU    *-1
          LDN    0
          STDL   T1          INDEX TO BUFFER
 BPTB10   BSS
          LDC    0#FFF       PATTERN IS FFF,000,AAA,555,EBD REPEATED
          STML   CTB,T1
          LDN    0
          STML   CTB+1,T1
          LDC    0#AAA
          STML   CTB+2,T1
          SHN    -1
          STML   CTB+3,T1
          LDC    0#EBD
          STML   CTB+4,T1
          LDN    5
          RADL   T1
          ADC    -328
          PJN    BPTBX       IF DONE
          UJK    BPTB10
          SPACE  5,20
** NAME-- LOADCON
*
** PURPOSE-- LOAD CCC CONTROLWARE
          SPACE  2
 LOAX     LJM    **
 LOADCON  EQU    *-1
          LDN    1
          STDL   WC
          RJM    EXLOD       GET CM ADDRESS OF COMMUNICATION BUFFER
          ADN    /CB/C.CONTRL  CM ADDRESS OF CONTROLWARE COMMAND
          CRML   CM,WC       READ COMMAND
          LDML   CM+/CM/P.LEN
          SHN    -3
          STDL   CMLISTL     LENGTH OF CM ADDRESS AREA (CM WORDS)
          RJM    GLIST       GET CM ADDRESS LIST OF DATA AREA
          LDK    F.AUTOP     ISSUE LOAD CONTROLWARE FUNCTION
          STML   LCF         INDICATE LOAD IN PROGRESS
          RJM    FUNC        ISSUE THE FUNCTION

* SETUP NUMBER OF WORDS TO TRANSFER FROM THIS CM ADDRESS.

 LOA20    BSS
          LOADF  CMLIST+/CM/P.RMA  SET UP CM ADDRESS OF DATA AREA
          STDL   DATADD+2
 F        IFEQ   FE,1        FOR FORCING ERRORS (FERP)
          LDN    4
          CRDL   T1
          LDDL   T1
          LMN    0#10
          NJN    LOA25       IF NOT FORCING AN ERROR
          LDDL   T2
          ZJN    LOA25       IF NOT FORCING AN ERROR
          LDC    -2000
          RAML   CMLIST+/CM/P.LEN
          SODL   T2          DECREMENT THE FORCE ERROR COUNTER
          LDN    4
          CWDL   T1
 LOA25    BSS
 F        ENDIF
          LDML   CMLIST+/CM/P.LEN  NUMBER OF 8-BIT BYTES TO TRANSFER
          ADN    7           ROUND UP
          SHN    -3          NUMBER OF CM WORDS TO TRANSFER
          STDL   TWDS        TOTAL NUMBER OF CM WORDS TO TRANSFER
                             FROM THIS ADDRESS
          ZJK    LOA70       IF NO WORDS TO TRANSFER FROM THIS ADDRESS
 LOA30    BSS
          STDL   WDS         COMPUTE NUMBER OF CM WORDS TO TRANSFER TO BUFFER
          SBN    CTLN        MAXIMUM SIZE OF BUFFER IN PP
          MJN    LOA40       IF LESS THAN PP BUFFER
          LDK    CTLN
          STDL   WDS         NUMBER OF CM WORDS TO TRANSFER TO BUFFER

* TRANSFER DATA FROM CM.

 LOA40    BSS
          LDDL   DATADD+2    CM ADDRESS OF DATA AREA
          LMC    400000B
          CRML   CWBUF,WDS   READ CONTROLWARE BINARY FROM CM
          STDL   DATADD+2    UPDATE CM ADDRESS

* CONVERT DATA TO ONE 8-BIT BYTE PER PP WORD.

          LDDL   WDS         NUMBER OF CM WORDS
          SHN    3
          STDL   T2          NUMBER OF 8-BIT BYTES
          STDL   T3
          SHN    -1          NUMBER OF 16-BIT PP WORDS
          ADC    CWBUF-1
          STDL   T1
 LOA50    BSS
          LDIL   T1          CONVERT DATA
          LPC    377B
          STML   CWBUF-1,T2
          LDIL   T1
          SHN    -8
          STML   CWBUF-2,T2
          SODL   T1
          SODL   T2
          SODL   T2
          NJK    LOA50       IF MORE DATA

* SEND DATA TO CONTROLLER.

          LDC    CWBUF       ADDRESS TO OUTPUT FROM
          STML   OUT10
          LDDL   T3
          RJM    OUT         SEND DATA TO CCC
          LDDL   TWDS        UPDATE TOTAL WORDS LEFT TO TRANSFER
                               TO THIS CM ADDRESS.
          SBDL   WDS
          STDL   TWDS
          NJK    LOA30       IF MORE WORDS TO TRANSFER FROM THIS CM ADDRESS

* GET NEXT CM ADDRESS OF DATA AREA.

 LOA70    BSS
          SODL   CMLISTL     DECREMENT ADDRESS-LENGTH-PAIR COUNT
          ZJN    LOA80       IF END OF ADDRESS-LENGTH-PAIRS IN COMMAND
          RJM    GLIST       GET NEXT ENTRY FROM LIST
          UJK    LOA20

* END OF DATA.  GET GENERAL STATUS.

 LOA80    BSS
          RJM    DCN         DISCONNECT THE CHANNEL
          RJM    GENSTAT     GET GENERAL STATUS
          NJN    LOA90       IF ERROR
          STML   LCF         INDICATE LOAD COMPLETE
          UJK    LOAX        IF NOT UNRECOVERED ERROR
 LOA90    BSS
          LDN    E00         CP MUST ISOLATE THE ERROR
          RJM    PCER        PREPARE COMMON ERROR RESPONSE (NO RETURN)
          SPACE  5,20
** NAME-- PT
*
** PURPOSE-- PATH TEST.  LOAD CONTROLWARE, THEN DO FURTHER TESTING
*            ON THE PP TO CCC PATH.
          SPACE  2
 PT100    BSS
          AODL   PTF         INDICATE PATH TEST COMPLETE
 PTX      LJM    **
 PT       EQU    *-1
          LDDL   DEVL
          ZJN    PT100       IF NO UNITS
          LDDL   PTF
          NJN    PTX         IF NOT RUNNING PATH TEST
          RJM    SCLOCK      SET CHANNEL LOCK
          STDL   GNSTAT      CLEAR GENERAL STATUS
          LDDL   CTF
          NJN    PT10        IF ORIGINAL ERROR ON DISK REQUEST
          LDML   RS+/RS/P.RTRY
          NJN    PT10        IF ALREADY IN RECOVERY
          STDL   COMLOOK     CLEAR INDEX TO DEVICE TABLE
          LDC    SPLUT
          STDL   LUTLOC      SPARE LOGICAL UNIT TABLE
 PT10     BSS
 F        IFEQ   CHANTYP,1   IF CIO CHANNEL
          LDC    F.MCLEAR    MASTER CLEAR ADAPTOR
          RJM    FUNC
          LDC    F.WRCR      WRITE CONTROL REGISTER
          RJM    FUNC
          LDC    INITAA
          STML   OUT10       ADDRESS TO OUTPUT FROM
          LDN    1           WORDS TO OUTPUT
          RJM    OUT         OUTPUT DATA
          RJM    DCN         DISCONNECT THE CHANNEL
 F        ENDIF
          LDN    1
          STDL   WC
          LOADC  CM.DEV
          CRML   SPLUT+2,WC  PUT UIT IN A LOGICAL UNIT TABLE
                              FOR ERROR RECOVERY
          RJM    LOADCON     LOAD CONTROLWARE
          RJM    BPTB        BUILD PATH TEST BUFFER
 F        IFEQ   FE,1        FOR FORCING ERRORS (FERR)
          LDN    4
          CRDL   T1
          LDDL   T1
          LMN    0#12
          NJN    PT20        IF NOT FORCING AN ERROR
          LDDL   T2
          ZJN    PT20        IF NOT FORCING AN ERROR
          LDN    0           FORCE DATA MISCOMPARE BY WRITING
          STML   CTB          THE WRONG DATA PATTERN
          SODL   T2
          LDN    4
          CWDL   T1
 PT20     BSS
 F        ENDIF
          LDC    CTB
          STML   IN10        ADDRESS TO INPUT DATA
          STML   OUT10       ADDRESS TO OUTPUT DATA
          LDN    F.UDIW
          RJM    FUNC        UDI WRITE
          LDC    502B        WORDS TO OUTPUT
          RJM    OUT         OUTPUT DATA
          RJM    DCN         DISCONNECT THE CHANNEL
          RJM    GENSTAT     GET GENERAL STATUS
          NJN    PT30        IF ERROR
          LDN    F.UDIR
          RJM    FUNC        UDI READ

          LDC    502B        WORDS TO INPUT
          RJM    IN          INPUT DATA
          RJM    WFI         WAIT FOR INACTIVE
          RJM    GENSTAT     THIS CHECKS FOR ERROR FLAG
          RJM    VPTD        VERIFY PATH TEST DATA
          LDN    F.DMAW
          RJM    FUNC        DMA WRITE

          LDC    502B        WORDS TO OUTPUT
          RJM    OUT         OUTPUT DATA
          RJM    DCN         DISCONNECT THE CHANNEL
          RJM    GENSTAT     GET GENERAL STATUS
 PT30     BSS
          NJN    PT50        IF ERROR
          LDN    F.DMAR
          RJM    FUNC        DMA READ

          LDC    502B        WORDS TO INPUT
          RJM    IN          INPUT DATA
          RJM    WFI         WAIT FOR INACTIVE
          RJM    GENSTAT     GET GENERAL STATUS
          NJN    PT50        IF ERROR
          RJM    VPTD        VERIFY PATH TEST DATA
          UJK    PT100
 PT50     BSS
          LDN    E00         CP MUST ISOLATE THE ERROR
          RJM    PCER        PREPARE COMMON ERROR RESPONSE (NO RETURN)
 INITAA   CON    400B        VALUE FOR CONTROL REGISTER (CIO ONLY)
          SPACE  5,20
** NAME-- VPTD
*
** PURPOSE-- VERIFY PATH TEST DATA
          SPACE  2
 VPTDX    LJM    **
 VPTD     EQU    *-1
          LDN    0
          STDL   T1          INDEX TO BUFFER
 VPTD10   BSS
          LDC    7777B
          LMML   CTB,T1
          NJN    VPTD20      IF ERROR
          LDN    0
          LMML   CTB+1,T1
          NJN    VPTD20      IF ERROR
          LDC    0#AAA
          LMML   CTB+2,T1
          NJN    VPTD20      IF ERROR
          LDC    0#555
          LMML   CTB+3,T1
          NJN    VPTD20      IF ERROR
          LDC    0#EBD
          LMML   CTB+4,T1
          NJN    VPTD20      IF ERROR
          LDN    5
          RADL   T1
          ADC    -328
          PJK    VPTDX       IF ALL WORDS VERIFIED
          UJK    VPTD10
 VPTD20   BSS
          LDN    E06         PP - CCC DATA INTEGRITY
          STDL   T1
          RJM    RDT         READ DEVICE TABLE
          LPN    /CB/K.ACT
          LMN    8
          STDL   P2
          LOADC  CM.DEV
          ADDL   COMLOOK
          CWDL   P2          INDICATE DATA INTEGRITY ERROR
          LDDL   T1
          RJM    PCER        PREPARE COMMON ERROR RESPONSE (NO RETURN)
          ERRPL  *-CTB       IF OVERFLOWING MEMORY
 F        IFEQ   FE,1        FORCE ERROR CODE
          OVERLAY (FORCE ERROR CODE),14000B
          ROUTINE FEO        FORCE ERROR OVERLAY
** NAME-- FER
*
** PURPOSE-- FORCE ERROR ROUTINE.  THE ERROR CAN BE FORCED IN THE MASTER
*            PP BY CHANGING CENTRAL MEMORY AT BYTE 40 AND CAN BE FORCED IN THE
*            SLAVE PP BY CHANGING CENTRAL MEMORY AT BYTE 48.
          SPACE  2
 FERX     LJM    **
 FER      EQU    *-1
          LDN    8
          ADDL   SLAVE
          CRDL   P2          READ LOCATION WITH ERROR ROUTINE
          LDDL   P2
          ZJN    FERX        IF NOT FORCING AN ERROR
          STML   FEST
          LPN    77B
          STDL   P6          INDEX TO TABLE
          SBN    FETND-FET
          PJN    FERX        IF UNDEFINED VALUE
          LDN    0
          STDL   P2
          LDN    8
          ADDL   SLAVE
          CWDL   P2          INDICATE ERROR BEING FORCED
          LDML   FEST
          SHN    -8
          STML   FEST        FORCE ERROR START COUNT
          LDDL   P3
          STML   FEND        FORCE ERROR END COUNT
          LDML   FET,P6
          STDL   P2
          LJM    0,P2        JUMP TO FORCE ERROR ROUTINE
* TABLE OF ERRORS TO FORCE
 FET      BSS
          CON    FERX        NO ERROR
          CON    FERA        READ ONE TOO MANY WORDS
          CON    FERB        READ ONE TOO FEW WORDS
          CON    FERC        WRITE ONE TOO MANY WORDS
          CON    FERD        WRITE ONE TOO FEW WORDS
          CON    FERE        READ FUNCTION TIMEOUT
          CON    FERF        WRITE FUNCTION TIMEOUT
          CON    FERG        STATUS ERROR ON SEEK (ILLEGAL CYLINDER)
          CON    FERH        STATUS ERROR ON READ (ILLEGAL HEAD)
          CON    FERI        CHANGE ONE MEMORY LOCATION
          CON    FERJ        TEST TIMING ON READ
          CON    FERK        TEST TIMING ON WRITE
          BSS    0           FERP - LOAD CONTROLWARE ERROR
          BSS    0           FERQ - FORMAT PACK ERROR
          BSS    0           FERR - PATH TEST ERROR
          BSS    0           FERS - CONFIDENCE TEST ERROR
          BSS    0           FERT - FORMAT WRONG RECORD SIZE
 FETND    BSS
          SPACE  5,20
** NAME-- FERA
*
** PURPOSE-- READ ONE TOO MANY WORDS
*            (SAME RESULTS IF READ ONE TOO FEW)
*
** ENTRY
*         40 = XX01 YYYY   FOR MASTER (NOTE, SLAVE DETECTS ERROR)
*              X = BURSTS TO READ BEFORE FORCING FIRST ERROR
*              Y = NUMBER OF TIMES TO FORCE THE ERROR
*         50 = 00DD 00PP  DD = DRIVE NUMBER  PP = LOGICAL PP NUMBER
          SPACE  2
 FERA     BSS
          LDC    FERA10
          UJN    FERB5
 FERA10   BSS
          LDN    10
          CRDL   T1
          LDML   SS+/SS/P.UNIT
          LMDL   T1
          NJK    FERB30      IF WRONG DRIVE
          LDDL   T2
          LMDL   PPNO
          NJK    FERB30      IF WRONG LOGICAL PP
          LDML   FEST
          NJN    FERB15      IF NOT TIME TO START FORCING ERROR
          LDML   FEND
          ZJN    FERB25      IF DONE FORCING ERRORS
          SOML   FEND
          LDML   IOCOUNT,TOGL
          ADN    1           READ ONE TOO MANY WORDS
          UJK    FERB40
          SPACE  5,20
** NAME-- FERB
*
** PURPOSE-- READ 1 TOO FEW WORDS (SAME RESULTS AS FERA)
*
** ENTRY
*         40 = XX02 YYYY   FOR MASTER (NOTE, SLAVE DETECTS ERROR)
*              X = BURSTS TO READ BEFORE FORCING FIRST ERROR
*              Y = NUMBER OF TIMES TO FORCE THE ERROR
          SPACE  2
 FERB     BSS
          LDC    FERB10
 FERB5    BSS
          STML   READ35+1    MODIFY INSTRUCTION
          LDC    100B
          STML   READ35
          LJM    FERX
 FERB10   BSS
          LDML   FEST
          ZJN    FERB20      IF FORCING THE ERROR
 FERB15   BSS
          SOML   FEST
          UJN    FERB30
 FERB20   BSS
          LDML   FEND
          NJN    FERB35      IF FORCING THE ERROR
 FERB25   BSS
          LDC    105000B+TOGL  RESTORE INSTRUCTION
          STML   READ35
          LDC    IOCOUNT
          STML   READ35+1
 FERB30   BSS
          LDML   IOCOUNT,TOGL
          UJN    FERB40
 FERB35   BSS
          SOML   FEND
          LDML   IOCOUNT,TOGL
          SBN    1           READ ONE TOO FEW WORDS
 FERB40   BSS
          LJM    READ36-1
          SPACE  5,20
** NAME--FERC
*
** PURPOSE-- WRITE ONE TOO MANY WORDS
*            (THIS IS NOT DETECTED BY HARDWARE)
*
** ENTRY
*         40 = XX03 YYYY   FOR MASTER (NOTE, SLAVE DETECTS ERROR)
*              X = BURSTS TO WRITE BEFORE FORCING FIRST ERROR
*              Y = NUMBER OF TIMES TO FORCE THE ERROR
          SPACE  2
 FERC     BSS
          LDC    FERC10
          UJN    FERD5
 FERC10   BSS
          LDML   FEST
          NJK    FERD15      IF NOT TIME TO START FORCING ERRORS
          LDML   FEND
          ZJK    FERD25      IF DONE FORCING ERRORS
          SOML   FEND
          LDML   IOCOUNT,TOGL
          ADN    1           WRITE ONE TOO MANY WORDS
          UJK    FERD40
          SPACE  5,20
** NAME-- FERD
*
** PURPOSE-- WRITE ONE TOO FEW WORDS
*
** ENTRY
*         40 = XX04 YYYY   FOR MASTER (NOTE, SLAVE DETECTS ERROR)
*              X = BURSTS TO WRITE BEFORE FORCING FIRST ERROR
*              Y = NUMBER OF TIMES TO FORCE THE ERROR
*         50 = 00DD 00PP  DD = DRIVE NUMBER  PP = LOGICAL PP NUMBER
          SPACE  2
 FERD     BSS
          LDC    FERD10
 FERD5    BSS
          STML   WRI52+1     MODIFY INSTRUCTION
          LDC    100B
          STML   WRI52
          LJM    FERX
 FERD10   BSS
          LDN    10
          CRDL   T1
          LDML   SS+/SS/P.UNIT
          LMDL   T1
          NJK    FERD30      IF WRONG DRIVE NUMBER
          LDDL   T2
          LMDL   PPNO
          NJK    FERD30      IF WRONG LOGICAL PP
          LDML   FEST
          ZJN    FERD20      IF FORCING THE ERROR
 FERD15   BSS
          SOML   FEST
          UJN    FERD30
 FERD20   BSS
          LDML   FEND
          NJN    FERD35      IF FORCING THE ERROR
 FERD25   BSS
          LDC    105000B+TOGL  RESTORE INSTRUCTION
          STML   WRI52
          LDC    IOCOUNT
          STML   WRI52+1
 FERD30   BSS
          LDML   IOCOUNT,TOGL
          UJN    FERD40
 FERD35   BSS
          SOML   FEND
          LDML   IOCOUNT,TOGL
          SBN    1           WRITE ONE TOO FEW WORDS
 FERD40   BSS
          LJM    WRI53-1
          SPACE  5,20
** NAME-- FERE
*
** PURPOSE--FORCE READ FUNCTION TIMEOUT ERROR
*
** ENTRY
*         40 = XX05 YYYY   FOR MASTER
*              X = BURSTS TO READ BEFORE FORCING FIRST ERROR
*              Y = NUMBER OF TIMES TO FORCE THE ERROR
*         50 = 00DD  00PP  DD= DRIVE NUMBER  PP = LOGICAL PP
          SPACE  2
 FERE     BSS
          LDC    FERE10      MODIFY INSTRUCTION
          STML   READ33
          LJM    FERX
 FERE10   CON    0
          LDN    10
          CRDL   T1
          LDML   SS+/SS/P.UNIT
          LMDL   T1
          NJK    FERE25      IF WRONG DRIVE NUMBER
          LDDL   T2
          LMDL   PPNO
          NJK    FERE25      IF WRONG LOGICAL PP
          LDML   FEST
          NJN    FERE20      IF NOT TIME TO FORCE ERROR
          LDML   FEND
          NJN    FERE30      IF FORCING AN ERROR
          LDC    FUNC        RESTORE INSTRUCTION
          STML   READ33
          UJN    FERE25
 FERE20   BSS
          SOML   FEST
 FERE25   BSS
          LDN    F.READ
          UJN    FERE35
 FERE30   BSS
          SOML   FEND
          LDN    3           A FUNCTION THAT GETS NO REPLY
 FERE35   BSS
          RJM    FUNC
          LJM    READ33+1
          SPACE  5,20
** NAME-- FERF
*
** PURPOSE-- FORCE FUNCTION TIMEOUT ON WRITE
*
** ENTRY
*         40 = XX06 YYYY   FOR MASTER
*              X = BURSTS TO READ BEFORE FORCING FIRST ERROR
*              Y = NUMBER OF TIMES TO FORCE THE ERROR
*         50 = 00DD 00PP  DD = DRIVE NUMBER  PP = LOGICAL PP
          SPACE  2
 FERF     BSS
          LDC    FERF10      MODIFY INSTRUCTION
          STML   WRI50
          LJM    FERX
 FERF10   CON    0
          LDN    10
          CRDL   T1
          LDML   SS+/SS/P.UNIT
          LMDL   T1
          NJK    FERF25      IF WRONG DRIVE NUMBER
          LDDL   T2
          LMDL   PPNO
          NJK    FERF25      IF WRONG LOGICAL PP
          LDML   FEST
          NJN    FERF20      IF NOT TIME TO FORCE ERROR
          LDML   FEND
          NJN    FERF30      IF FORCING AN ERROR
          LDC    FUNC
          STML   WRI50
          UJN    FERF25
 FERF20   BSS
          SOML   FEST
 FERF25   BSS
          LDN    F.WRITE
          UJN    FERF35
 FERF30   BSS
          SOML   FEND
          LDN    3           A FUNCTION THAT GETS NO REPLY
 FERF35   BSS
          RJM    FUNC
          LJM    WRI50+1
          SPACE  5,20
** NAME-- FERG
*
** PURPOSE-- FORCE STATUS ERROR ON SEEK DUE TO SENDING AN ILLEGAL CYLINDER
*            NUMBER
*
** ENTRY
*         40 = XX07 YYYY   FOR MASTER
*              X = BURSTS TO READ BEFORE FORCING FIRST ERROR
*              Y = NUMBER OF TIMES TO FORCE THE ERROR
*         50 = 00DD 00PP  DD = DRIVE NUMBER  PP = LOGICAL PP NUMBER
          SPACE  2
 FERG     BSS
          LDC    FERG10      MODIFY INSTRUCTION
          STML   SEEK10
          LJM    FERX
 FERG10   CON    0
          LDN    10
          CRDL   T1
          LDML   SS+/SS/P.UNIT
          LMDL   T1
          NJK    FERH40      IF NOT TIME TO FORCE THE ERROR
          LDDL   T2
          LMDL   PPNO
          NJK    FERH40
          LDML   FEST
          NJK    FERH30      IF NOT TIME TO FORCE ERROR
          LDML   FEND
          ZJN    FERH15      IF DONE FORCING ERRORS
          LDC    886         ILLEGAL CYLINDER NUMBER
          STML   SS+/SS/P.CYL
          UJN    FERH25
          SPACE  5,20
** NAME-- FERH
*
** PURPOSE-- FORCE A STATUS ERROR ON WRITE OR READ BY SENDING AN ILLEGAL
*            HEAD NUMBER
*
** ENTRY
*         40 = XX08 YYYY   FOR MASTER
*              X = BURSTS TO READ BEFORE FORCING FIRST ERROR
*              Y = NUMBER OF TIMES TO FORCE THE ERROR
          SPACE  2
 FERH     BSS
          LDC    FERH10      MODIFY INSTRUCTION
          STML   SEEK10
          LJM    FERX
 FERH10   CON    0
          LDML   FEST
          NJN    FERH30      IF NOT TIME TO FORCE ERROR
          LDML   FEND
          NJN    FERH20      IF FORCING AN ERROR
 FERH15   BSS
          LDC    FUNC        RESTORE INSTRUCTION
          STML   SEEK10
          UJN    FERH40
 FERH20   BSS
          LDK    4017B       ILLEGAL HEAD NUMBER
          STML   SS+/SS/P.TRACK
 FERH25   BSS
          SOML   FEND
          UJN    FERH40
 FERH30   BSS
          SOML   FEST
 FERH40   BSS
          LDN    F.SEEK
          RJM    FUNC
          LJM    SEEK10+1
          SPACE  5,20
** NAME-- FERI
*
** PURPOSE-- CHANGE ONE MEMORY LOCATION
*         40 = 0009 0000 XXXX YYYY
*              X = ADDRESS
*              Y = VALUE
          SPACE  2
 FERI     BSS
          LDDL   P5
          STIL   P4
          LJM    MAIN10
          SPACE  5,20
** NAME-- FERJ
*
** PURPOSE-- TEST TIMING MARGIN ON A READ
*
** ENTRY
*         40 - 000A XXXX  FOR MASTER
*         48 - 000A XXXX  FOR SLAVE
*              XXXX TIMES .5 IS THE USEC DELAY PER READ FUNCTION
          SPACE  2
 FERJ     BSS
          LDDL   P3
          STML   READ40G     MODIFY DELAY
          UJN    FERK10
          SPACE  5,20
** NAME-- FERK
*
** PURPOSE-- FORCE OVERRUN ERROR/TEST TIMING MARGIN ON A WRITE
*
** ENTRY
*         40 - 000B XXXX  FOR MASTER
*         48 - 000B XXXX  FOR SLAVE
*              XXXX TIMES .5 IS THE USEC DELAY PER WRITE FUNCTION
          SPACE  2
 FERK     BSS
          LDDL   P3
          STML   WRI54       MODIFY DELAY
 FERK10   BSS
          LJM    FERX
          SPACE  5,20
** NAME-- FERP
*
** PURPOSE-- FORCE AN ERROR DURING LOADING OF CCC CONTROLWARE.  ONLY
*            THE DOCUMENTATION IS HERE.  THE LOAD CONTROLWARE ROUTINE
*            READS CENTRAL MEMORY AT BYTE 20
*                20 - 0010 XXXX
*            IF THE CODE OF 0010 IS PRESENT AND XXXX IS NONZERO, THE
*            LAST 40 WORDS OF CCC CONTROLWARE WILL NOT BE LOADED.  THIS
*            WILL FORCE A CHECKSUM ERROR.  XXXX IS THE NUMBER OF TIMES
*            TO FORCE THE ERROR.
          SPACE  5,20
** NAME-- FERQ
*
** PURPOSE-- FORCE AN ERROR DURING FORMAT OF A PACK.  ONLY THE DOCUMENTAION
*            IS HERE.  THE FORMAT ROUTINE READS AT BYTE LOCATION 20
*                20 - 0011 XXXX
*            IF THE CODE OF 0011 IS PRESENT AND XXXX IS NONZERO, THE FORMAT
*            PACK COMMAND WILL BE ISSUED TO THE CCC WITH AN ILLEGAL CYLINDER
*            NUMBER.  XXXX WILL BE DECREMENTED BY ONE FOR EACH ERROR FORCED.
          SPACE  5,20
** NAME-- FERR
*
** PURPOSE-- FORCE AN ERROR DURING THE PATH TEST.  ONLY THE DOCUMENTAION IS
*            HERE.  THE PATH TEST ROUTINE READS CM AT BYTE LOCATION 20
*                20 - 0012 XXXX
*            IF THE CODE IS 0012 AND XXXX IS NONZERO, THE PATH TEST WILL
*            WRITE THE WRONG PATTERN, WHICH WILL RESULT IN A DATA MISCOMPARE.
*            XXXX WILL BE DECREMENTED BY ONE FOR EACH ERROR FORCED.
          SPACE  5,20
** NAME-- FERS
*
** PURPOSE-- FORCE AN ERROR DURING THE CONFIDENCE TEST AND VERIFY TIMING
*            MARGINS FOR THE WRITE AND READ ROUTINES DURING THE CONFIDENCE
*            TEST.  IF THE CODE IS 0013, THEN THE DELAY COUNTS XXXX AND
*            YYYY WILL BE USED RATHER THAN THE DEFAULT VALUE WHICH IS CLOSE
*            TO ZERO.
*                20 - 0013 XXXX YYYY
*                    XXXX TIMES .5 IS THE DELAY BETWEEN WRITE FUNCTIONS
*                    YYYY TIMES .5 IS THE DELAY BETWEEN READ FUNCTIONS
          SPACE  5,20
** NAME-- FERT
*
** PURPOSE-- CREATE ERRORS BY FORMATTING WITH THE WRONG RECORD SIZE.  ONLY
*            THE DOCUMENTATION IS HERE.  THE FORMAT ROUTINE READS BYTE ADDRESS 20
*                20 - 0014 XXXX
*            IF THE CODE IS 0014, THE VALUE XXXX WILL BE USED TO DETERMINE THE
*            SECTOR SIZE TO FORMAT
*                0000 - SMALL SECTOR
*                0200 - NOS LARGE SECTOR
*                0800 - NOS/VE SECTOR (NO ERROR)
 F        ENDIF
