          IDENT  D895CIO
          CIPPU
          MEMSEL 8
          TITLE  895 DRIVER FOR CIO CHANNEL
          COMMENT *SMD* LVL=04
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC. 1992
 PRGNAM   MICRO  1,4,'A95C'  1ST 4 CHARACTERS OF OVERLAY NAME

 NPP      EQU    1           NUMBER OF PPS
*                            = 1 IF ONE-PP DMA DRIVER
*                                   ALSO, IF ASSEMBLING THE ONE-PP
*                                   DRIVER, DELETE THE *COPYC PP895_COMMON_DECK
*                                   LINE IN FRONT OF THE TPP    ELSE   LINE
*                            = 2 IF TWO-PP DRIVER
 TPP      IFEQ   NPP,2
 CHANTYP  EQU    1           CHANNEL TYPE
*                            =0 FOR NIO CHANNEL VERSION OF DRIVER
*                            =1 FOR CIO CHANNEL VERSION OF DRIVER

 TPP      ELSE
*
*         THIS IS THE PP DRIVER THAT SUPPORTS THE 895 DISK SUBSYSTEM
*         ON A CIO CHANNEL.  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.  THIS DRIVER USES THE DMA
*         HARDWARE AND ONLY USES ONE PP.  THE PP DRIVER FOR THE NIO
*         CHANNEL USES TWO PPS.  ITS PROGRAM NAME IS D895 AND ITS
*         DECK NAME IS PP895.
          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
 BPS      EQU    4128        BYTES PER SECTOR
 NOU      EQU    8           NUMBER OF ACTIVE UNITS ALLOWED
 CTB      EQU    17770B-510B  CONFIDENCE TEST BUFFER
 OVST     EQU    16000B      OVERLAY STARTING ADDRESS
 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.MC     EQU    0#8000      MASTER CLEAR CIO ADAPTER BOARD FUNCTION
 F.CTR    EQU    0#8200      CLEAR T REGISTERS
 F.SDI    EQU    0#8400      START DMA INPUT
 F.SDO    EQU    0#8600      START DMA OUTPUT
 F.CDM    EQU    0#8800      CLEAR DMA MODE
 F.CTM    EQU    0#8C00      CLEAR TEST MODE
 F.ETM    EQU    0#8E00      ENABLE TEST MODE
 F.WCR    EQU    0#9200      WRITE CONTROL REGISTER OF CIO ADAPTER
 F.RES    EQU    0#9400      READ ERROR STATUS REGISTER OF CIO ADAPTER
 F.ROS    EQU    0#9800      READ OPERATIONAL STATUS REGISTER
 F.RTR    EQU    0#9C00      READ T REGISTER
 F.WTR    EQU    0#9E00      WRITE T REGISTER

 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
 E10      EQU    10          IOU FAILURE - OPERATIONAL STATUS WRONG
 E11      EQU    11          IOU FAILURE - TEST MODE DATA MISCOMPARE
 E12      EQU    12          UNCORRECTED CM ERROR
 E13      EQU    13          CM REJECT
 E14      EQU    14          INVALID CM RESPONSE
 E15      EQU    15          CM RESPONSE CODE PARITY ERROR
 E16      EQU    16          CMI READ DATA PARITY ERROR
 E17      EQU    17          OVERFLOW ERROR
 E18      EQU    18          JY BOARD ERROR
 E19      EQU    19          TRANSFER IN PROGRESS DID NOT CLEAR
 E20      EQU    20          T PRIME REGISTER NOT EMPTY
          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

          SUBRANGE 0,377B    (UNUSED)
 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)
          SUBRANGE 0,3777B   (UNUSED)
 ENTRY    BOOLEAN            REQUEST ON QUEUE SELECTED
          SUBRANGE 0,17B     (UNUSED)
 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
          SUBRANGE 0,37777B  (UNUSED)
 OWNER    BOOLEAN            THIS PP HAS THE UNIT LOCKED
          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
          SUBRANGE 0,377B    (UNUSED)
 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 (UNUSED)
 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
          SUBRANGE 0,37B     (UNUSED)
 DATERR   BOOLEAN            UNCORRECTABLE PARITY OR CHECKWORD ERROR
                             ON AN ADDRESS OR DATA FIELD.
 HDWR     BOOLEAN            UNCORRECTABLE HARDWARE MALFUNCTION IN A
                             CONTROLLER OR UNIT
          BOOLEAN            (UNUSED)
 FTO      BOOLEAN            FUNCTION TIMEOUT
          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
          PPWORD             (UNUSED)
          PPWORD             (UNUSED)
 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)
 OS       PPWORD             OPERATIONAL STATUS
 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 (UNUSED)
 PARTNR   RMA                PARTNERS PPIT (RMA) (UNUSED)

 CONTRL   STRUCT 8           LOAD CONTROLWARE COMMAND
          STRUCT 8
 ODP      STRUCT 8           OVERLAY DIRECTORY POINTER
          STRUCT 56          (UNUSED)

          ALIGN  0,64
 SS       STRUCT 56          SS ENTRY

 SVAREA   STRUCT 16          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
          STRUCT 63*8        MAXIMUM OF 64 CONFIGURED UNITS
 BUF      STRUCT 5328        DATA BUFFER FOR CONFIDENCE TEST
                              BYTES = SECTOR (4128) + 8 TIMES
                              (SECTORS (10) X TRACKS (15))
          MASKP  ACT
 K.ACT    EQU    MSK


 CB       RECEND
          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.  VALUES BC AND RMA MUST BE
* CONSECUTIVE.  THEY ARE WRITTEN INTO THE T REGISTER.

 SVCELLS  BSS
 BC       DATA   0           BYTE COUNT (NOT NECESSARY TO SAVE THIS)
 RMA      DATA   0,0         RMA
 CMLISTL  BSSZ   1           NUMBER OF CM WORDS IN ADDRESS-LENGTH PAIR LIST.
                             (INCLUDES THE NUMBER OF WORDS WHICH HAVEN'T
                             BEEN READ FROM CM.)
 LEN      BSSZ   1           TOTAL NUMBER OF BYTES TO TRANSFER
          BSSZ   1           (UNUSED)
 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
 BAF      BSSZ   1           =0 IF ADDRESS MUST BE BACKED UP AFTER AN ERROR
 SWFLG    BSSZ   1           NONZERO IF A STREAMING REQUEST SWITCH WAS MADE
 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
 CTRC     BSSZ   1           CLEAR T REGISTER COUNTER
          BSS    72B-*
 DSRTP    DATA   2,0         PP INTERFACE TABLE RMA WHEN PP LOADED
 FT       EQU    DSRTP       0 IF FIRST DATA FUNCTION AFTER SEEK
 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.INT   BSSZ   3           CM ADDRESS OF INTERRUPT WORD (REFORMATTED)
 CM.CHAN  BSSZ   3           CM ADDRESS OF CHANNEL INTERLOCK TABLE (REFORMATTED)
 CTBRMA   BSSZ   2           CM ADDRESS OF CONFIDENCE TEST BUFFER
 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
 MD       BSSZ   1           = 0 IF NO MORE DATA TO TRANSFER
 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


 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
 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 AT INITIALIZATION
 IPIT     EQU    17600B      PP INTERFACE TABLE DURING INITIALIZATION
 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  MAIN DRIVER LOOP
** NAME -- MAIN
*
** PURPOSE -- THE MAIN DRIVER LOOP
*
** ENTRY
*         MAIN - FROM INIT AFTER DRIVER IS LOADED
*              - WHEN RESUME RECEIVED
*         MAIN5 - WHEN RETRYING A CONFIDENCE TEST ERROR
*               - WHEN EQUIPMENT IS DOWNED
*         MAIN30 - WHEN RETRYING A DISK REQUEST
*         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    MAIN45      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
          RJM    SRESP       SET UP RESPONSE BUFFER
          RJM    UNCMND      GET COMMAND AND SET UP TO PROCESS
 MAIN30   BSS
          LDN    0
          STDL   SWFLG       CLEAR SWITCH FLAG
          STDL   SECPOS      SET SECTOR POSITION = 0
          LDML   UCMDPR,FNC  GET COMMAND PROCESSOR
          STDL   T1
          RJM    0,T1        PROCESS COMMAND
          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
          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
          TITLE  READ AND WRITE ROUTINES
          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.
*
          SPACE  2
 READX    LJM    **
 READ     EQU    *-1
          LDC    READ25
          STDL   BAF         BACKUP ADDRESS FLAG
          STDL   CA          CONTINUE ADDRESS
 READ5    BSS
          LDDL   SECPOS
          NJN    READ30      IF READ FUNCTION ALREADY SENT
          LDN    F.READ      ISSUE READ FUNCTION TO DISK CONTROLLER
          RJM    FUNC
 READ10   EQU    *-1         FOR FORCING ERRORS
 READ25   BSS
          RJM    UDA         UPDATE DISK ADDRESS
          LDN    1
          STDL   BAF         BACKUP ADDRESS FLAG
          UJN    READ35
 READ30   BSS
          RJM    WFTE        WAIT FOR T PRIME REGISTER EMPTY
 READ35   BSS
          LDML   CMLIST+/CM/P.LEN  BYTES LEFT TO TRANSFER
          STDL   BC
          ADC    -BPS+32     CM BYTES PER SECTOR
          ADDL   SECPOS      BYTES ALREADY TRANSFERRED
          MJN    READ40      IF LESS THAN ONE SECTOR TO TRANSFER
          LDC    BPS-32
          SBDL   SECPOS
          STDL   BC          NUMBER OF BYTES TO TRANSFER
 READ40   BSS
          LDML   CMLIST+/CM/P.RMA
          STDL   RMA
          LDML   CMLIST+/CM/P.RMA+1
          STDL   RMA+1
          RJM    WTR         WRITE T REGISTER
 READ50   EQU    *-1         FOR FORCING ERRORS
          LDDL   SECPOS
          NJN    READ60      IF DMA ALREADY STARTED
          LDC    F.SDI       START DMA INPUT
          RJM    FUNC
          RJM    SVPTR       SAVE CM BUFFER POINTERS
          LDN    0
          STDL   BAF         BACUP ADDRESS FLAG
          LDDL   SWFLG
          ZJN    READ60      IF SWITCH FLAG NOT SET
          RJM    SWITCH      SWITCH TO NEXT REQUEST
 READ60   BSS
          LDDL   BC
          RADL   SECPOS      UPDATE SECTOR POSITION
          ADC    -BPS+32
          ZJN    READ65      IF END OF SECTOR
          LDDL   CMLISTL
          SBN    1
          ZJN    READ65      IF ALL DATA FOR THIS SECTOR TRANSFERRED
          RJM    UBT         UPDATE BYTES TRANSFERRED
          UJK    READ5
 READ65   BSS
          RJM    UBT         UPDATE BYTES TRANSFERRED
          LDC    BPS
          SBDL   SECPOS
          STDL   BC          BYTES OF DON'T CARE DATA
          LDML   CTBRMA      RMA OF DON'T CARE DATA
          STDL   RMA
          LDML   CTBRMA+1
          STDL   RMA+1
          RJM    WFTE        WAIT FOR T PRIME REGISTER EMPTY
          RJM    WTR         WRITE T REGISTER
 READ70   EQU    *-1         FOR FORCING ERRORS
          LDN    0#2E        EXPECTED OPERATIONAL STATUS
          RJM    WFTC        WAIT FOR TRANSFER COMPLETE
 F        IFEQ   FE,1        FOR FORCING ERRORS
          LDC    1
 READ80   EQU    *-1
          SBN    1
          NJN    *-1
 F        ENDIF
          LDML   MD
          NJK    READ5       IF MORE DATA TO TRANSFER
          RJM    GENSTAT     GET LAST 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-- 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
 WRI5     BSS
          LDDL   SECPOS
          NJN    WRI30       IF WRITE FUNCTION ALREADY SENT
          LDN    F.WRITE     ISSUE WRITE FUNCTION TO DISK CONTROLLER
          RJM    FUNC        ISSUE THE FUNCTION
 WRI10    EQU    *-1         FOR FORCING ERRORS
          RJM    UDA         UPDATE DISK ADDRESS
          UJN    WRI35
 WRI30    BSS
          RJM    WFTE        WAIT FOR T PRIME REGISTER EMPTY
 WRI35    BSS
          LDML   CMLIST+/CM/P.LEN  BYTES LEFT TO TRANSFER
          STDL   BC
          ADC    -BPS+32     CM BYTES PER SECTOR
          ADDL   SECPOS      BYTES ALREADY TRANSFERRED
          MJN    WRI40       IF LESS THAN ONE SECTOR TO TRANSFER
          LDC    BPS-32
          SBDL   SECPOS
          STDL   BC          NUMBER OF BYTES TO TRANSFER
 WRI40    BSS
          LDML   CMLIST+/CM/P.RMA
          STDL   RMA
          LDML   CMLIST+/CM/P.RMA+1
          STDL   RMA+1
          RJM    WTR         WRITE T REGISTER
 WRI50    EQU    *-1         FOR FORCING ERRORS
          LDDL   SECPOS
          NJN    WRI60       IF DMA ALREADY STARTED
          LDC    F.SDO       START DMA OUTPUT
          RJM    FUNC
          LDDL   SWFLG
          ZJN    WRI60       IF SWITCH FLAG NOT SET
          RJM    SWITCH      SWITCH TO NEXT REQUEST
 WRI60    BSS
          LDDL   BC
          RADL   SECPOS      UPDATE SECTOR POSITION
          ADC    -BPS+32
          ZJN    WRI65       IF END OF SECTOR
          LDDL   CMLISTL
          SBN    1
          ZJN    WRI65       IF ALL DATA FOR THIS SECTOR TRANSFERRED
          RJM    UBT         UPDATE BYTES TRANSFERRED
          UJK    WRI5
 WRI65    BSS
          RJM    UBT         UPDATE BYTES TRANSFERRED
          LDC    BPS
          SBDL   SECPOS
          STDL   BC          BYTES OF DON'T CARE DATA
          LDML   CTBRMA      RMA OF DON'T CARE DATA
          STDL   RMA
          LDML   CTBRMA+1
          STDL   RMA+1
          RJM    WFTE        WAIT FOR T PRIME REGISTER EMPTY
          RJM    WTR         WRITE T REGISTER
 WRI70    EQU    *-1         FOR FORCING ERRORS
          LDN    0#32        EXPECTED OPERATIONAL STATUS
          RJM    WFTC        WAIT FOR TRANSFER COMPLETE
 F        IFEQ   FE,1        FOR FORCING ERRORS
          LDC    1
 WRI80    EQU    *-1
          SBN    1
          NJN    *-1
 F        ENDIF
          LDML   MD
          NJK    WRI5        IF MORE DATA TO TRANSFER
          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)
          TITLE  RESIDENT ROUTINES
** NAME-- ACN
*
** PURPOSE-- ACTIVATE THE CHANNEL.  THIS ROUTINE IS NECESSARY TO
*            ALLOW AN OVERLAY TO ACTIVATE THE CHANNEL.  THE CHANNEL
*            NUMBER CAN NOT BE SAVED IN AN OVERLAY.
          SPACE  2
 ACNX     LJM    **
 ACN      EQU    *-1
          ACN    DC
          UJN    ACNX
          SPACE  5,20
** 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.
*
** EXIT-- A REGISTER = 0, IF NOT SWITCH.
*         A REGISTER NONZERO, IF SWITCH.
          SPACE  2
 CSW100   BSS
          LDN    0
 CSWX     LJM    **
 CSWIT    EQU    *-1
          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
          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    CTDT5       CONTINUE WRITING
 CTR40    BSS
          LDML   SS+/SS/P.TRACK
          LPN    77B
          SBN    MAXTR+1
          ZJK    CT80        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 THE NEXT REQUEST ON THE QUEUE IF ONE IS PRESENT.
*
** INPUTS-- SS+/SS/P.UQT = POINTER TO UNIT INTERFACE TABLE
*
** OUTPUTS-- 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  ADDRESS OF UNIT INTERFACE 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 INACTIVE
          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
          RJM    RES         READ ERROR STATUS REGISTER
          STML   RS+/RS/P.LERREG
          STML   RS+/RS/P.FERREG
          SHN    4
          PJN    EFP5        IF NOT UNCORRECTED CM RESPONSE
          LDN    E12
          UJN    EFP30
 EFP5     BSS
          SHN    1
          PJN    EFP10       IF NOT CM REJECT
          LDN    E13
          UJN    EFP30
 EFP10    BSS
          SHN    1
          PJN    EFP15       IF NOT INVALID CM RESPONSE
          LDN    E14
          UJN    EFP30
 EFP15    BSS
          SHN    1
          PJN    EFP20       IF NOT CM RESPONSE CODE PARITY ERROR
          LDN    E15
          UJN    EFP60
 EFP20    BSS
          SHN    1
          PJN    EFP25       IF NOT CMI READ DATA PARITY ERROR
          LDN    E16
          UJN    EFP60
 EFP25    BSS
          SHN    2
          PJN    EFP35       IF NOT OVERFLOW ERROR
          LDN    E17
 EFP30    BSS
          UJN    EFP60
 EFP35    BSS
          SHN    5
          PJN    EFP40       IF NOT KZ BOARD ERROR
          LDN    E02
          UJN    EFP60
 EFP40    BSS
          SHN    1
          PJN    EFP45       IF NOT JY BOARD ERROR
          LDN    E18
          UJN    EFP60
 EFP45    BSS
          SHN    1
          PJN    EFP50       IF NOT KX BOARD ERROR
          LDN    E03
          UJN    EFP60
 EFP50    BSS
          LDN    E04         CHANNEL ERROR
 EFP60    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
          AODL   CTRC        INCREMENT CLEAR T REGISTER COUNTER
          LMN    3
          ZJK    EP15        IF CLEAR T REGISTER FAILS
          LDN    0
          STDL   FT          CLEAR FIRST TIME FLAG
          LDDL   CA
          ZJK    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)
          LDK    F.CTR       CLEAR T REGISTER
          RJM    FUNC
          LDN    0
          STDL   CTRC        CLEAR T REGISTER COUNTER
          LDN    F.CONT
          RJM    FUNC        SEND CONTINUE FUNCTION
          AODL   CF          INDICATE CONTINUE FUNCTION SENT
          LDDL   BAF         BACKUP ADDRESS FLAG
          NJN    EP7         IF ERROR ON CURRENT SECTOR
          RJM    RDT         READ DEVICE TABLE
          SHN    -1
          ZJN    EP7         IF ERROR DURING CONFIDENCE TEST
          LOADOVL ERO        LOAD ERROR RECOVERY OVERLAY
          RJM    RSTBP       RESTORE BACKUP POINTERS
 EP7      BSS
          LDN    0
          STDL   SECPOS      POINT TO BEGINNING OF SECTOR
          LJM    0,CA
 EP10     BSS
          LDK    F.CTR       CLEAR T REGISTER
          RJM    FUNC
 EP15     BSS
          LDN    0
          STDL   CTRC        CLEAR T REGISTER COUNTER
          LDDL   RECOV       INDEX TO RECOVERY PROCEDURE
          STDL   T1
          LDML   EPT,T1
          STDL   T1
          LJM    0,T1        EXECUTE NEXT STEP IN RECOVERY SEQUENCE
 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           TURN OFF ALL UNITS ON 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-- 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
 F        IFEQ   FE,1        FORCE ERROR CODE
          SPACE  5,20
** NAME-- FER
*
** PURPOSE-- FORCE ERROR ROUTINE.  THE ERROR CAN BE FORCED BY CHANGING
*            CENTRAL MEMORY AT BYTE 40.
          SPACE  2
 FERX     LJM    **
 FER      EQU    *-1
          LDN    8
          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
          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
          CON    FERL        WRTIE CONTROL REG. TO FORCE ERROR ON READ
          CON    FERM        WRITE CONTROL REG. TO FORCE ERROR ON WRITE
          BSS    0           FERN (UNUSED)
          BSS    0           FERO (UNUSED)
          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
*
** ENTRY
*         40 = XX01 YYYY
*              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   CON    0
          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
          LDN    2           READ ONE TOO MANY WORDS
          UJK    FERB37
          SPACE  5,20
** NAME-- FERB
*
** PURPOSE-- READ 1 TOO FEW WORDS
*
** ENTRY
*         40 = XX02 YYYY
*              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
 FERB     BSS
          LDC    FERB10
 FERB5    BSS
          STML   READ70      MODIFY INSTRUCTION
          LJM    FERX
 FERB10   CON    0
          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    WTR         RESTORE INSTRUCTION
          STML   READ70
 FERB30   BSS
          UJN    FERB40
 FERB35   BSS
          SOML   FEND
          LCN    2           READ 1 TOO FEW WORDS
 FERB37   BSS
          RADL   BC
 FERB40   BSS
          RJM    WTR         WRITE TRANSFER REGISTER
          LJM    READ70+1
          SPACE  5,20
** NAME--FERC
*
** PURPOSE-- WRITE ONE TOO MANY WORDS
*
** ENTRY
*         40 = XX03 YYYY
*              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   CON    0
          LDML   FEST
          NJK    FERD15      IF NOT TIME TO START FORCING ERRORS
          LDML   FEND
          ZJK    FERD25      IF DONE FORCING ERRORS
          SOML   FEND
          LDN    2           WRITE ONE TOO MANY WORDS
          UJK    FERD37
          SPACE  5,20
** NAME-- FERD
*
** PURPOSE-- WRITE ONE TOO FEW WORDS
*
** ENTRY
*         40 = XX04 YYYY
*              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   WRI70       MODIFY INSTRUCTION
          LJM    FERX
 FERD10   CON    0
          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    WTR         RESTORE INSTRUCTION
          STML   WRI70
 FERD30   BSS
          UJN    FERD40
 FERD35   BSS
          SOML   FEND
          LCN    2           WRITE ONE TOO FEW WORDS
 FERD37   BSS
          RADL   BC
 FERD40   BSS
          RJM    WTR         WRITE T REGISTER
          LJM    WRI70+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   READ10
          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   READ10
          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    READ10+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   WRI10
          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   WRI10
          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    WRI10+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
*              XXXX TIMES .5 IS THE USEC DELAY PER READ FUNCTION
          SPACE  2
 FERJ     BSS
          LDDL   P3
          STML   READ80      MODIFY DELAY
          UJN    FERK10
          SPACE  5,20
** NAME-- FERK
*
** PURPOSE-- FORCE OVERRUN ERROR/TEST TIMING MARGIN ON A WRITE
*
** ENTRY
*         40 - 000B XXXX
*              XXXX TIMES .5 IS THE USEC DELAY PER WRITE FUNCTION
          SPACE  2
 FERK     BSS
          LDDL   P3
          STML   WRI80       MODIFY DELAY
 FERK10   BSS
          LJM    FERX
          SPACE  5,20
** NAME-- FERL
*
** PURPOSE-- WRITE CONTROL REGISTER TO FORCE AN ERROR ON READ
*
** ENTRY
*         40 = XX0C YYYY
*              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
*         54 = CCCC  CCCC = CONTROL REGISTER VALUE
*                2100        SELECT 60-BIT CM WORD
*                500         INHIBIT FULL OUT
*                181         INVERT FUNCTION DECODE PROM PARITY
*                182         INVERT PP INPUT DATA PARITY
*                184         FORCE INVALID RESPONSE
*                185         INVERT RESPONSE CODE PARITY
*                186         INVERT CONTROL REGISTER PARITY
*                188         INVERT 12/16 SHIFTER PARITY
*                189         INVERT CONVERSION PARITY
*                18A         INVERT TRANSMIT PARITY
*                18B         INVERT CHANNEL INPUT DATA PARITY
*                190         FORCE ADAPTER INPUT PARITY BIT 0 LOW
*                191         FORCE ADAPTER INPUT PARITY BIT 1 LOW
*                192         FORCE T DATA PARITY BIT LOW
*                193         INVERT UPPER ADAPTER OUTPUT PARITY BIT
*                194         INVERT LOWER ADAPTER OUTPUT PARITY BIT
*                195         FORCE ADDRESS PARITY PREDICTION ERROR
*                196         FORCE BYTE COUNT EQUAL TO 0 ON JY BOARD
          SPACE  2
 FERL     BSS
          LDC    FERL10
          STML   READ50      MODIFY INSTRUCTION
          LJM    FERX
 FERL10   CON    0
          LDN    10
          CRDL   T1
          LDML   SS+/SS/P.UNIT
          LMDL   T1
          NJK    FERL40      IF WRONG DRIVE
          LDDL   T2
          LMDL   PPNO
          NJK    FERL40      IF WRONG LOGICAL PP
          LDML   FEST
          ZJN    FERL20      IF FORCING THE ERROR
          SOML   FEST
          UJN    FERL40
 FERL20   BSS
          LDML   FEND
          NJN    FERL35      IF FORCING THE ERROR
          LDC    WTR         RESTORE INSTRUCTION
          STML   READ50
          UJN    FERL40
 FERL35   BSS
          SOML   FEND
          LDDL   T3          VALUE TO STORE IN CONTROL REGISTER
          RJM    WCR         WRITE CONTROL REGISTER
 FERL40   BSS
          RJM    WTR         WRITE TRANSFER REGISTER
          LJM    READ50+1
          SPACE  5,20
** NAME-- FERM
*
** PURPOSE-- WRITE CONTROL REGISTER TO FORCE AN ERROR ON WRITE
*
** ENTRY
*         40 = XX0D YYYY
*              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
*         54 = CCCC  CCCC = CONTROL REGISTER VALUE (SAME AS ROUTINE FERL)
          SPACE  2
 FERM     BSS
          LDC    FERM10
          STML   WRI50       MODIFY INSTRUCTION
          LJM    FERX
 FERM10   CON    0
          LDN    10
          CRDL   T1
          LDML   SS+/SS/P.UNIT
          LMDL   T1
          NJK    FERM40      IF WRONG DRIVE
          LDDL   T2
          LMDL   PPNO
          NJK    FERM40      IF WRONG LOGICAL PP
          LDML   FEST
          ZJN    FERM20      IF FORCING THE ERROR
          SOML   FEST
          UJN    FERM40
 FERM20   BSS
          LDML   FEND
          NJN    FERM35      IF FORCING THE ERROR
          LDC    WTR         RESTORE INSTRUCTION
          STML   WRI50
          UJN    FERM40
 FERM35   BSS
          SOML   FEND
          LDDL   T3          VALUE TO STORE IN CONTROL REGISTER
          RJM    WCR         WRITE CONTROL REGISTER
 FERM40   BSS
          RJM    WTR         WRITE TRANSFER REGISTER
          LJM    WRI50+1
          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)
          SPACE  5,20
** NAME-- FERU
*
** PURPOSE-- FORCE AN ERROR WHILE WRITING DURING THE CONFIDENCE TEST.
*                20 - 0015 XXXX YYYY
*            IF THE CODE IS 15 AND XXXX IS NONZERO, THE CONTROL REGISTER
*            WILL BE LOADED WITH YYYY AND XXXX WILL BE DECREMENTED BY 1.
*                VALUES FOR YYYY ARE THE SAME AS FOR ROUTINE FERL
          SPACE  5,20
** NAME-- FERV
*
** PURPOSE-- FORCE AN ERROR WHILE READING DURING THE CONFIDENCE TEST.
*                20 - 0016 XXXX YYYY
*            IF THE CODE IS 16 AND XXXX IS NONZERO, THE CONTROL REGISTER
*            WILL BE LOADED WITH YYYY AND XXXX WILL BE DECREMENTED BY 1.
*                VALUES FOR YYYY ARE THE SAME AS FOR ROUTINE FERL
 F        ENDIF
          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-- 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-- 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 WITH BITS SET
*           AS FOLLOWS-- X XX1 XXX 1XX 11X X1X.
          SPACE  2
 FUN100   BSS
          LDML   FUNCD
          ZJN    FUN110      IF CONNECT FUNCTION
          LPC    10462B
          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 148 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 ON 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-- 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    OUT30
 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-- 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
          LDML   CMLIST+/CM/P.LEN  ENSURE AN EVEN NUMBER OF CM WORDS
          ADN    7
          SCN    7
          STML   CMLIST+/CM/P.LEN
          UJK    GLIX
          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    OUT20
          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
*COPYC IODMAC6
          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    OUT40
 OUT8     BSS
          LDDL   T2
          OAM    *,DC        OUTPUT WORDS
 OUT10    EQU    *-1
          ZJN    OUTX        IF NO ERROR
 OUT20    BSS
          STDL   T4          WORDS NOT TRANSFERRED
          RJM    GENSTAT     GET GENERAL STATUS
          LDDL   T4
 OUT30    BSS
          STML   RS+/RS/P.FUNTO  WORDS NOT TRANSFERRED
 OUT40    BSS
          LDN    E05         INCOMPLETE CHANNEL TRANSFER
          RJM    PCER        PREPARE COMMON ERROR RESPONSE (NO RETURN)
          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-- 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
          SBN    E02
          MJN    PER33       IF NO ERROR REGISTER
          SBN    E05-E02
          MJN    PER36       IF ERROR REGISTER PRESENT
          SBN    E12-E05
          MJN    PER33       IF NO ERROR REGISTER
          SBN    E19-E12
          MJN    PER36       IF ERROR REGISTER PRESENT
 PER33    BSS
          LDN    0           CLEAR VALUE FOR ERROR STATUS REGISTER
          STML   RS+/RS/P.FERREG
          STML   RS+/RS/P.LERREG
 PER36    BSS
          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
 POLL10   BSS
          STDL   T8          SET T8 TO MATCH P.OWNER = 1
          LDN    USEQ
 POLL20   BSS
          STDL   LUTLOC      SET TO BEGINNING OF 'IN USE' QUEUE (-1)
 POLL30   BSS
          RJM    UC          UPDATE CLOCK
          LDDL   LUTLOC
          STDL   P1          SAVE POINTER TO PREVIOUS ENTRY
          LDIL   LUTLOC
          STDL   LUTLOC      GET NEXT ENTRY ON QUEUE
          NJN    POLL40      IF ENTRY EXISTS
          LDDL   T8
          ZJN    POLLX       IF SECOND PASS JUST FINISHED, EXIT
          LDN    0           SET T8 FOR NEXT PASS
          UJN    POLL10
 POLL40   BSS
          LDML   /LUT/P.OWNER,LUTLOC
          SBDL   T8
          NJN    POLL30      IF THIS PASS DOESN'T LOOK AT THIS ENTRY
          LDDL   T8
          NJN    POLL50      IF UNIT LOCKED
          RJM    SETLOCK     TRY TO LOCK THE UNIT
          ZJK    POLL30      IF LOCK COULD NOT BE SET
 POLL50   BSS
          LOADR  /LUT/P.UIT,LUTLOC  ADDRESS OF UIT
          ADN    /UIT/C.UBUF
          CRDL   P2          SECOND WORD OF UIT
          LOADF  P4          GET ADDRESS OF COMMUNICATION BUFFER
          CRML   SS,WC       READ SS ENTRY
          LDML   SS+/SS/P.ENTRY  HAS AN ENTRY BEEN SELECTED
          NJK    POLL60      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    POLL53      IF UNIT DISABLED
          LDDL   T5
          ADDL   T6
          NJN    POLL55      IF REQUEST PRESENT
*
*         CLEARING THE UNIT LOCK WITHOUT SELECTING A REQUEST COULD
*         CAUSE AN INFINITE LOOP IF TWO CHANNELS ARE SHARING THE UNIT.
*
 POLL53   BSS
          RJM    CLRLOCK     CLEAR THE UNIT LOCK
 POLL55   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    POLL20      GO TO NEXT ENTRY
 POLL60   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    POLL90      IF A SEEK HAS FINISHED
          LDDL   CLSEC
          SBML   SS+/SS/P.CLKST
          PJN    POLL70      IF CLOCK HASN'T WRAPPED
          ADC    0#10000
 POLL70   BSS
          SBN    10          10 SECOND MINIMUM TIMEOUT
          MJK    POLL80      IF NO TIMEOUT
          LDN    E08         SEEK OR FORMAT COMMAND TIMEOUT
          RJM    PCER        PREPARE COMMON ERROR RESPONSE (NO RETURN)
 POLL80   BSS
          LDN    F.OPCMP
          RJM    FUNC
          UJK    POLL30
 POLL90   BSS
          RJM    POLS        POLL SUBROUTINE
*
*         PUT LUTLOC AT END OF USEQ.  THIS HELPS KEEP USAGE OF UNITS
*         RANDOM.
*
          LDIL   LUTLOC
          ZJN    POLL110     IF ALREADY LAST ENTRY OF USEQ
          STIL   P1          REMOVE ENTRY FROM USEQ
 POLL100  BSS
          STDL   P1
          LDIL   P1
          NJN    POLL100     IF NOT END OF QUEUE
          STIL   LUTLOC
 POLL110  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
 POLSX    BSS
          LDDL   P2
          STDL   LUTLOC      RESTORE POINTER TO CURRENT REQUEST
          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    POLSX       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
 POLS15   BSS
          SBDL   T3           MORE ACCURATE
          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
          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
          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.RES       READ ERROR STATUS REGISTER FUNCTION
          FAN    DC
          LDDL   0           DELAY
          LDN    1
          IJM    RES25,DC    IF FUNCTION REPLY RECEIVED
 RES20    BSS
          LDN    0
          UJN    RESX
 RES25    BSS
          ACN    DC
          IAM    T1,DC       INPUT THE STATUS
*
*         THE ERROR FLAG IS NOT TESTED HERE.  THERE WERE TEST CASES
*         WHERE THE ERROR FLAG IS STILL SET AFTER THE INPUT AND THE
*         ERROR REGISTER IS ACCURATE.
*
          NJN    RES20       IF ERROR
          LDDL   T1
          UJK    RESX
          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   BSS
          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
          INPN   1           INTERRUPT OR PSN
 INTPRC   EQU    *-1         INSTRUCTION MODIFIED
          UJK    RESNX
          SPACE  5,20
** NAME-- ROS
*
** PURPOSE-- READ OPERATIONAL STATUS
          SPACE  2
 ROSX     LJM    **
 ROS      EQU    *-1
          LDC    F.ROS       READ OPERATIONAL STATUS
          RJM    FUNC
          EJM    OUT40,DC    IF CHANNEL NOT FULL
          IAN    DC          INPUT OPERATIONAL STATUS
          STML   RS+/RS/P.OS  SAVE OPERATIONAL STATUS
          CFM    ROSX,DC     IF ERROR FLAG NOT SET
          LDC    F.CDM       CLEAR DMA MODE
          RJM    FUNC
          RJM    EFP         ERROR FLAG PROCESSING (NO RETURN)
          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
          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
          ACN    DC+40B      ACTIVATE THE CHANNEL
          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    OUT20
 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
*
** NOTE-- ASSUMES UNIT QUEUE LOCK HAS BEEN SET.
          SPACE  2
 SELRQX   BSS
          RJM    CQLOCK      CLEAR QUEUE LOCK
 SELRQ10  BSS
          RJM    SAVSS       SAVE 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
          LDML   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-- 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-- 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

* 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-- 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-- 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-- 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-- SVPTR
*
** PURPOSE-- SAVE BUFFER POINTERS IN CASE DATA RETRANSMISSION IS NEEDED.
          SPACE  2
 SVPTRX   LJM    **
 SVPTR    EQU    *-1
          LDML   CMLIST+/CM/P.LEN
          STDL   LEN         SAVE BYTE LENGTH
          LDN    2
          STDL   WC
          RJM    EXLOD       GET CM AREA ADDRESS
          ADN    /CB/C.SVAREA
          CWML   SVCELLS,WC  SAVE IT
          UJN    SVPTRX
          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
          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
          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 FOR RESPONSE BUFFER
          RJM    CLRLOCK     CLEAR LOCK ON UNIT
          STML   RS+/RS/P.RTRY  CLEAR REQUEST RETRY COUNTER
          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 IN RESPONSE BUFFER
          UJK    TERX
          SPACE  5,20
** NAME-- UBT
*
** PURPOSE-- UPDATE BYTES TRANSFERRED
*
** EXIT--  MD = 0 IF NO MORE DATA
          SPACE  2
 UBTX     BSS
          STML   MD
          LJM    **
 UBT      EQU    *-1
          RJM    UC          UPDATE CLOCK
          LDML   BC          CM BYTES TRANSFERRED
          RAML   RS+/RS/P.XFER+1
          SHN    -16
          RAML   RS+/RS/P.XFER  UPDATE BYTES TRANSFERRED IN RESPONSE
          LDML   BC
          RAML   CMLIST+/CM/P.RMA+1  UPDATE CM ADDRESS
          SHN    -16
          RAML   CMLIST+/CM/P.RMA
          LDML   CMLIST+/CM/P.LEN
          SBML   BC
          STML   CMLIST+/CM/P.LEN
          NJN    UBT10       IF MORE BYTES TO TRANSFER TO THIS
                              CM ADDRESS
          SODL   CMLISTL
          ZJN    UBT20       IF END OF RMA LIST
          RJM    GLIST       READ NEXT ENTRY OF LIST
 UBT10    BSS
          LDN    1           INDICATE NO REQUEST SWITCH
          UJK    UBTX
 UBT20    BSS
          RJM    UNCMND      GET NEXT COMMAND
          NJN    UBT10       IF MORE COMMANDS
          RJM    CSWIT       CHECK FOR REQUEST SWITCH
          UJK    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-- 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-- 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    BSS
          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  ENSURE AN EVEN NUMBER OF CM WORDS
          ADN    7
          SCN    7
          STML   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
          LDC    E501        ERROR IN COMMAND CODE
          RJM    INTERR      INTERFACE ERROR (NO RETURN)
 UNC40    BSS
          LDN    1           SET A REGISTER NONZERO FOR EXIT
          UJK    UNCX
          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
          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-- WCR
*
** PURPOSE-- WRITE CONTROL REGISTER VALUE
*
** ENTRY--  CONTENTS OF T3 IS CONTROL REGISTER VALUE
          SPACE  2
 WCRX     LJM    **
 WCR      EQU    *-1
          STDL   T3
          LDN    T3
          STML   OUT10       ADDRESS TO OUTPUT FROM
          LDC    F.WCR       WRITE CONTROL REGISTER
          RJM    FUNC
          LDN    1           WORDS TO OUTPUT
          RJM    OUT         OUTPUT DATA
          RJM    DCN         DISCONNECT THE CHANNEL
          UJN    WCRX
          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
          LJM    OUT20
          SPACE  5,20
** NAME-- WFTC
*
** PURPOSE-- WAIT FOR TRANSFER COMPLETE
*
** ENTRY-- A = EXPECTED OPERATIONAL STATUS
*
** EXIT-- TO CALLING ROUTINE IF NO ERROR
          SPACE  2
 WFTCX    BSS
          STDL   SECPOS      CLEAR SECTOR POSITION
          LDC    F.CDM       CLEAR DMA MODE
          RJM    FUNC
          LJM    **
 WFTC     EQU    *-1
          STDL   T7
          LDC    9677
          STDL   T8          T8 CONTROLS THE TIMEOUT
 WFTC10   BSS
          RJM    ROS         READ OPERATIONAL STATUS
          LMDL   T7
          ZJN    WFTCX       IF NO ERROR
          SODL   T8
          NJN    WFTC10      IF 150 MILLISECOND TIMEOUT NOT EXPIRED
          LDC    F.CDM       CLEAR DMA MODE
          RJM    FUNC
          RJM    GENSTAT     GET GENERAL STATUS
          LDN    E19         TRANSFER IN PROGRESS DID NOT CLEAR
          RJM    PCER        PREPARE COMMON ERROR RESPONSE
          SPACE  5,20
** NAME-- WFTE
*
** PURPOSE-- WAIT FOR T PRIME REGISTER EMPTY
*
** EXIT - TO CALLING ROUTINE IF T PRIME REGISTER GOES EMPTY,
*         ELSE REPORT AN ERROR
          SPACE  2
 WFTEX    LJM    **
 WFTE     EQU    *-1
          LDC    9836
          STDL   T8          T8 CONTROLS THE TIMEOUT
 WFTE10   BSS
          RJM    ROS         READ OPERATIONAL STATUS
          LPN    2
          NJN    WFTEX       IF T PRIME REGISTER EMPTY
          SODL   T8
          NJN    WFTE10      IF 150 MILLISECOND TIMEOUT NOT EXPIRED
          LDC    F.CDM       CLEAR DMA MODE
          RJM    FUNC
          RJM    GENSTAT
          LDN    E20         T PRIME REGISTER NOT EMPTY
          RJM    PCER        PREPARE COMMON ERROR RESPONSE (NO RETURN)
          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
          SPACE  5,20
** NAME-- WTR
*
** PURPOSE-- WRITE T REGISTER
          SPACE  2
 WTRX     LJM    **
 WTR      EQU    *-1
          LDC    F.WTR       WRITE T REGISTER
          RJM    FUNC
          LDK    BC          ADDRESS OF T REGISTER VALUES
          STML   OUT10
          LDN    3           NUMBER OF WORDS IN T REGISTER
          RJM    OUT         OUTPUT PARAMETERS
          RJM    DCN         DISCONNECT THE CHANNEL
          UJN    WTRX
          ERRPL  *-OVST      IF RESIDENT CODE SPILLS INTO OVERLAY 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
          LJM    MAIN
          OVERLAY (CONFIDENCE TEST),OVST
          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   P1
          LOADF  CTBRMA      CM ADDRESS OF CONFIDENCE TEST BUFFER
          STDL   P2
 BCTB10   BSS
          AODL   P1          BUILD INCREMENTING PATTERN
          STDL   T1
          AODL   P1
          STDL   T2
          AODL   P1
          STDL   T3
          AODL   P1
          STDL   T4
          SBML   CTB
          ADC    -P.CB-4+/CB/P.BUF
          PJN    BCTBX       IF ALL WORDS STORED
          LDDL   P2
          LMC    400000B
          CWDL   T1          STORE IN PP COMMUNICATIONS BUFFER
          AODL   P2
          UJK    BCTB10
          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    CT30        IF NOT MODIFYING THE DELAY
          LDDL   T2
          STML   CT10
          LDDL   T3
          STML   CT20
          UJN    CT30
 CT10     DATA   1           VALUE TIMES .5 IS WRITE DELAY
 CT20     DATA   1           VALUE TIMES .5 IS READ DELAY
 CT30     BSS
 F        ENDIF
          LDN    0
          STDL   COMLOOK
          UJN    CT50
 CT40     BSS
          AODL   COMLOOK     UPDATE TO NEXT UNIT
 CT50     BSS
          SBDL   DEVL
          PJN    CTX         IF END OF CONFIGURED UNITS
          RJM    RDT         READ DEVICE TABLE
          SHN    -1
          NJK    CT40        IF NOT RUNNING CONFIDENCE TEST
          LDDL   CTF
          NJN    CT60        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
 CT60     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    CT70        IF UNIT ENABLED
          RJM    CLRLOCK     CLEAR UNIT LOCK
          UJK    CT40
 CT70     BSS
          RJM    CTDT        CONFIDENCE TEST DATA TRANSFER
 CT80     BSS
          LDDL   CTF
          NJN    CT90        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
 CT90     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    CT40
          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    CTDT5       IF NOT DOING UNCONDITIONAL RESERVE
          RJM    UR          UNCONDITIONAL RESERVE
 CTDT5    BSS
          RJM    SEEKON      WAIT FOR ON CYLINDER
*
*         WRITE THE CYLINDER (CM TO DISK)
*
          LDC    CTDT15
          STDL   CA          CONTINUE ADDRESS
          LDC    BPS
          STDL   BC          BYTE COUNT
          LDML   CTBRMA      CM ADDRESS TO GET DATA FROM
          STDL   RMA
          LDML   CTBRMA+1
          STDL   RMA+1
 CTDT10   BSS
          LDN    F.WRITE
          RJM    FUNC        WRITE FUNCTION
 CTDT15   BSS
          LDDL   FT
          ZJN    CTDT20      IF NOT TIME TO UPDATE CM
          LDN    8           UPDATE RMA TO NEXT SECTOR
          RAML   RMA+1
          SHN    -16
          RAML   RMA
 CTDT20   BSS
          RJM    UDA         UPDATE DISK ADDRESS
 F        IFEQ   FE,1
          LDN    4
          CRDL   T1
          LDDL   T1
          LMN    0#15
          NJN    CTDT25      IF NOT FORCING AN ERROR
          LDDL   T2
          ZJN    CTDT25      IF NOT FORCING AN ERROR
          SOML   T2
          LDN    4
          CWDL   T1
          LDDL   T3          CONTROL REGISTER VALUE
          RJM    WCR         WRITE CONTROL REGISTER
 CTDT25   BSS
 F        ENDIF
          RJM    WTR         WRITE T REGISTER
          LDC    F.SDO       START DMA OUTPUT
          RJM    FUNC
          LDN    0#32        EXPECTED OPERATIONAL STATUS
          RJM    WFTC        WAIT FOR TRANSFER COMPLETE
 F        IFEQ   FE,1        FOR FORCING ERRORS
          LDML   CT10
          SBN    1
          NJN    *-1         FOR TESTING
 F        ENDIF

          LDML   SS+/SS/P.SECTOR
          ADML   SS+/SS/P.TRACK
          LPN    77B
          SBN    MAXSEC+MAXTR
          NJK    CTDT10      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 (DISK TO CM)
*           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
          LDN    0
          STML   DMF         CLEAR DATA MISCOMPARE FLAG
          LDML   CTBRMA      CM ADDRESS TO PUT DATA
          STDL   RMA
          LDML   CTBRMA+1
          STDL   RMA+1
 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
 F        IFEQ   FE,1
          LDN    4
          CRDL   T1
          LDDL   T1
          LMN    0#16
          NJN    CTDT67A     IF NOT FORCING AN ERROR
          LDDL   T2
          ZJN    CTDT67A     IF NOT FORCING AN ERROR
          SOML   T2
          LDN    4
          CWDL   T1
          LDDL   T3          CONTROL REGISTER VALUE
          RJM    WCR         WRITE CONTROL REGISTER
 CTDT67A  BSS
 F        ENDIF
          RJM    WTR         WRITE TRANSFER REGISTER
          LDC    F.SDI       START DMA INPUT
          RJM    FUNC
          LDN    0#2E        EXPECTED OPERATIONAL STATUS
          RJM    WFTC        WAIT FOR TRANSFER COMPLETE
          LDML   SS+/SS/P.SECTOR
          NJN    CTDT80      IF NOT FIRST SECTOR OF TRACK
          RJM    VCTD        VERIFY CONFIDENCE TEST DATA
 CTDT80   BSS
 F        IFEQ   FE,1        FOR FORCING ERRORS
          LDML   CT20
          SBN    1
          NJN    *-1
 F        ENDIF

          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
          SPACE  2
 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    BPS/8
          STDL   P3          CM WORDS PER SECTOR
          LDN    0
          STDL   T2
          LDML   SS+/SS/P.TRACK
          LPN    77B
          STDL   T1
 VCTD5    BSS
          ZJN    VCTD10      IF SECTORS TRANSFERRED CALCULATION DONE
          LDN    MAXSEC+1
          RADL   T2
          SODL   T1
          UJN    VCTD5
 VCTD10   BSS
          LDDL   T2          SECTORS TRANSFERRED
          SHN    2
          ADML   CTB
          STDL   P1          STARTING DATA PATTERN VALUE MINUS ONE
          LOADF  CTBRMA
          STDL   P2
 VCTD15   BSS
          LDDL   P2
          LMC    400000B
          CRDL   T4          READ WORD OF SECTOR
          AODL   P1
          SBDL   T4
          NJN    VCTD40      IF DATA MISCOMPARE
          AODL   P1
          SBDL   T5
          NJN    VCTD40      IF DATA MISCOMPARE
          AODL   P1
          SBDL   T6
          NJN    VCTD40      IF DATA MISCOMPARE
          AODL   P1
          SBDL   T7
          NJN    VCTD40      IF DATA MISCOMPARE
          AODL   P2
          SODL   P3
          NJN    VCTD15      IF MORE WORDS TO VERIFY
 VCTD40   BSS
          STML   DMF         INDICATE DATA MISCOMPARE
          UJK    VCTDX
          ERRPL  *-17777B    IF OVERFLOWING MEMORY
          OVERLAY (ERROR RECOVERY),OVST
          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
          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
          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
          LDDL   LEN
          STML   CMLIST+/CM/P.LEN
          LDDL   RMA
          STML   CMLIST+/CM/P.RMA
          LDDL   RMA+1
          STML   CMLIST+/CM/P.RMA+1
          LDN    0
          STDL   SWFLG
          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
          LDN    0
          STDL   SWFLG       CLEAR SWITCH FLAG
          LDML   SIP
          ZJK    RSTRQ20     IF SEEK IN PROGRESS
          LDDL   NCOMRQ
          SBN    2
          MJN    RSTRQ10     IF NO COMPLETED REQUESTS TO DELINK
          SODL   NCOMRQ
          LDML   PRERQ       DELINK REQUESTS THROUGH CURRQ
          STML   CURRQ
          LDML   PRERQ+1
          STML   CURRQ+1
          RJM    DELRQ       DELINK COMPLETED REQUESTS
          UJN    RSTRQ25
 RSTRQ10  BSS
          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    SRESP       SET UP RESPONSE BUFFER
          RJM    UNCMND      GET COMMAND AND SET UP TO PROCESS
          RJM    SEEKON      ISSUE SEEK
          LJM    MAIN30
          ERRPL  *-17777B    IF OVERFLOWING MEMORY
          OVERLAY (FORMAT PACK),OVST
          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
          ERRPL  *-17777B    IF OVERFLOWING MEMORY
          OVERLAY (INITIALIZE TABLES),OVST
          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    BSS
          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-- 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
          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.DEV
          STDL   CM.DEV+2
          LDDL   CMADR
          STML   CM.CB
          STDL   CM.DEV      ADDRESS OF DEVICE TABLE (ONE ENTRY FOR EACH UNIT)
          LDDL   CMADR+1
          STML   CM.CB+1
          STDL   CM.DEV+1
          LDDL   P2          GET LENGTH OF PP COMMUNICATION BUFFER
          ADC    -P.CB-P.CB
          PJN    IT20        IF COMMUNICATIONS BUFFER LARGE ENOUGH
          RJM    HANG

* INITIALIZE COMMUNICATION BUFFERS IN ALL UNIT INTERFACE TABLES.

 IT20     BSS
          LDK    /CB/P.BUF*2  SAVE RMA OF CONFIDENCE TEST BUFFER
          ADDL   P4
          STML   CTBRMA+1
          SHN    -16
          ADDL   P3
          STML   CTBRMA
          RJM    EXLOD       ADDRESS OF PP INTERFACE TABLE *TEMP
          CRDL   P1                                        *TEMP
          LDDL   P2                                        *TEMP
          LPN    1                                         *TEMP
          NJN    *           IF SLAVE PP                   *TEMP
          RJM    ICOM        INITIALIZE COMMUNICATION BUFFERS
          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
          LDN    0
          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

          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
          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 AND SAVE IT.

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

* 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
          SBML   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
          ERRPL  *-IPIT      IF OVERFLOWING MEMORY
          OVERLAY (PATH TEST),OVST
          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-- BTMP
*
** PURPOSE-- BUILD TEST MODE BUFFER.  WHEN WRITTEN TO CM, THE
*            PATTERN LOOKS LIKE
*                FFFF FFFF FFFF FFFF
*                0000 0000 0000 0000
*                1515 1515 1515 1515
*            REPEATED 5 TIMES.
          SPACE  5,20
 BTMPX    LJM    **
 BTMP     EQU    *-1
          LDN    0
          STDL   T1
          STDL   T2
          STDL   T3
 BTMP10   BSS
          LDML   TMB,T2
          STML   CTB,T1
          AODL   T1
          AODL   T2
          LPN    17B
          STDL   T2
          NJN    BTMP10      IF MORE WORDS TO MOVE
          AODL   T3
          LMN    5
          NJN    BTMP10      IF PATTERN AT TMB NOT REPEATED 5 TIMES
          UJK    BTMPX
 TMB      BSS
          DATA   0#FFF,0#FFF,0#FFF,0#FFF
          DATA   0#FFF,0#F00,0,0
          DATA   0,0,1,0#515
          DATA   0#151,0#515,0#151,0#515
          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   T8
 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   BC          TOTAL NUMBER OF CM WORDS TO TRANSFER
                             FROM THIS ADDRESS
          ZJK    LOA70       IF NO WORDS TO TRANSFER FROM THIS ADDRESS
 LOA30    BSS
          STDL   WC          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   WC          NUMBER OF CM WORDS TO TRANSFER TO BUFFER

* TRANSFER DATA FROM CM.

 LOA40    BSS
          LDDL   T8          CM ADDRESS OF DATA AREA
          LMC    400000B
          CRML   CWBUF,WC    READ CONTROLWARE BINARY FROM CM
          STDL   T8          UPDATE CM ADDRESS

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

          LDDL   WC          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   BC          UPDATE TOTAL WORDS LEFT TO TRANSFER
                               TO THIS CM ADDRESS.
          SBDL   WC
          STDL   BC
          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
          LDN    1
          STDL   WC
          LOADC  CM.DEV
          CRML   SPLUT+2,WC  PUT UIT IN A LOGICAL UNIT TABLE
                              FOR ERROR RECOVERY
          LDC    F.MC        MASTER CLEAR ADAPTER
          RJM    FUNC
          LDC    400B        CONTROL REGISTER VALUE
          RJM    WCR         WRITE CONTROL REGISTER
          RJM    TM          TEST MODE (THIS TESTS THE IOU)
          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)
          SPACE  5,20
** NAME-- TM
*
** PURPOSE-- TEST MODE.  THIS TESTS THE DMA HARDWARE OF THE IOU.
*            IT WRITES DATA TO CM, VERIFIES DATA, READS DATA FROM
*            CM, THEN VERIFIES DATA.
          SPACE  2
 TMX      LJM    **
 TM       EQU    *-1

*         TEST MODE, PP TO CM.

          RJM    BTMP        BUILD TEST MODE PATTERN
          LDC    F.ETM       ENABLE TEST MODE
          RJM    FUNC
          LDC    120         SET UP T REGISTER VALUES
          STDL   BC           BYTE COUNT
          LDML   CTBRMA       CM ADDRESS TO WRITE TO
          STDL   RMA
          LDML   CTBRMA+1
          STDL   RMA+1
          RJM    WTR         WRITE T REGISTER
          LDC    F.SDI       DMA INPUT
          RJM    FUNC
          RJM    ACN         ACTIVATE THE CHANNEL
          LDC    CTB
          STML   OUT10       PP ADDRESS TO OUTPUT FROM
          LDC    80          12-BIT WORDS TO TRANSFER
          RJM    OUT         OUTPUT DATA TO BE PUT IN CM
          RJM    DCN         DISCONNECT THE CHANNEL
          RJM    ROS         READ OPERATIONAL STATUS
          LMC    0#6A
          NJK    TM20        IF ERROR
          LDN    15
          STDL   WC
          LOADF  RMA
          CRML   CTB+80,WC   READ DATA JUST WRITTEN BY TEST MODE
          RJM    VTMD        VERIFY TEST MODE DATA
          LDC    F.CDM       CLEAR DMA MODE
          RJM    FUNC
          LDC    F.CTM       CLEAR TEST MODE
          RJM    FUNC

*         TEST MODE (CM TO PP)

          LDC    F.ETM       ENABLE TEST MODE
          RJM    FUNC
          RJM    WTR         WRITE T REGISTER
          LDC    F.SDO       DMA OUTPUT
          RJM    FUNC
          RJM    ACN         ACTIVATE THE CHANNEL
          LDC    CTB+80
          STML   IN10
          LDC    80          12-BIT WORDS TO TRANSFER
          RJM    IN          INPUT DATA TO IN10
          RJM    ROS         READ OPERATIONAL STATUS
          LMC    0#72
          NJN    TM20        IF ERROR
          STDL   T1
 TM10     BSS
          LDML   CTB,T1
          LMML   CTB+80,T1
          NJN    TM50        IF ERROR
          AODL   T1
          LMC    80
          NJN    TM10        IF MORE WORDS TO VERIFY
          LDC    F.CDM       CLEAR DMA MODE
          RJM    FUNC
          LDC    F.CTM       CLEAR TEST MODE
          RJM    FUNC
          LJM    TMX
 TM20     BSS
          LDN    E10         IOU FAILURE - OPERATIONAL STATUS WRONG
          UJN    TM55
 TM50     BSS
          LDN    E11         IOU FAILURE - TEST MODE DATA MISCOMPARE
 TM55     BSS
          RJM    PCER        PREPARE COMMON ERROR RESPONSE (NO RETURN)
          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)
          SPACE  5,20
** NAME-- VTMD
*
** PURPOSE-- VERIFY TEST MODE DATA
          SPACE  2
 VTMDX    LJM    **
 VTMD     EQU    *-1
          LDN    0
          STDL   T1
 VTMD10   BSS
          LDML   CTB+80,T1
          LMC    0#FFFF
          NJN    VTMD30      IF MISCOMPARE
          LDML   CTB+84,T1
          NJN    VTMD30      IF MISCOMPARE
          LDML   CTB+88,T1
          LMC    0#1515
          NJN    VTMD30      IF MISCOMPARE
          AODL   T1
          LPN    3
          NJN    VTMD10      IF MORE WORDS TO VERIFY
          LDN    8
          RADL   T1
          LMN    60
          NJN    VTMD10      IF MORE WORDS TO VERIFY
          UJK    VTMDX
 VTMD30   BSS
          LDN    E11         IOU FAILURE - TEST MODE DATA MISCOMPARE
          RJM    PCER        PREPARE COMMON ERROR RESPONSE (NO RETURN)
          ERRPL  *-CTB       IF OVERFLOWING MEMORY
 TPP      ENDIF
          END
/EOR
