          IDENT  TAPC
          CIPPU
          MEMSEL 16
          TITLE  IOM$TAPC - 5698-1X IPI TAPE DRIVER FOR I0.
          COMMENT  *SMD* LVL=02
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC. 1992
          SPACE  4
*         THIS IS THE PP DRIVER FOR THE IPI CHANNEL THAT SUPPORTS THE
*         5698-1X IPI TAPE SLAVE WITH 698-3X TAPE FACILITIES ON THE
*         CYBER 180-930 SYSTEM. THE PROGRAM NAME IS E5P5698 AND THE DECK
*         NAME IS IOM$TAPC.
*
*         WHEN THE PP DRIVER IS LOADED THE FOLLOWING LOCATIONS ARE REQUIRED.
*         72 AND 73 MUST CONTAIN THE RMA OF THE PP INTERFACE TABLE (PIT).
*         0 MUST CONTAIN THE ADDRESS-1 AT WHICH EXECUTION BEGINS.
          SPACE  4
*         IODMAC4 HAS BEEN MODIFIED FOR USE WITH CYBER 180-930 SYSTEMS.
*         THE NEW R-REGISTER INSTRUCTION AND THE NEW HOLD (WAIT)
*         INSTRUCTION ARE BEING USED.
          TITLE  IODMAC1 MACROS
*COPYC IODMAC1
          TITLE  IODMAC2 MACROS
*COPYC IODMAC2
          TITLE  IODMAC3 MACROS
*COPYC IODMAC3
          TITLE  MODIFIED IODMAC4 MACROS
*BEGIN IODMAC4
          SPACE  5,20
*
** NAME-- LMK,LPK,LDK,ADK,ZJK,NJK,PJK,MJK,UJK
*
** PURPOSE-- DETERMINE FOR THOSE INSTRUCTIONS HAVING A SHORT AND LONG
*            FORM WHICH INSTRUCTION FORM NEEDS TO BE GENERATED.
*
** CALLING SEQUENCE-- SAME AS THE REGULAR PP INSTRUCTION
*
** RESTRICTIONS-- SYMBOLS REFERENCED BY THESE MACROS SHOULD BE
*                 DEFINED PRIOR TO THE MACRO CALL.
*
* NO-ADDRESS AND CONSTANT INSTRUCTIONS
NEWOP     ECHO   ,I=(LM,LP,LD,AD)
*
I_K       MACRO  P1
L         IF     DEF,P1
L         IFLE   P1,77B
L         IFGE   P1,0
          I_N    P1
L         ELSE   1
          I_C    P1
          ENDM
NEWOP     ENDD
*
*
*
* JUMP INSTRUCTIONS
NEWOP     ECHO   ,I=(ZJ,NJ,PJ,MJ),J=(NJ,ZJ,MJ,PJ)
*
I_K       MACRO  P1
L         IF     DEF,P1
L         IFGE   *-P1,0
L         IFLT   *-P1,40B
          I_N    P1
L         ELSE   2
          J_N    *+3
          LJM    P1
          ENDM
NEWOP     ENDD
*
*
*
UJK       MACRO  P1
L         IF     DEF,P1
L         IFGE   *-P1,0
L         IFLT   *-P1,40B
          UJN    P1
L         ELSE   1
          LJM    P1
          ENDM
          SPACE  5,20
** NAME-- AJM,SCF,IJM,CCF,FJM,SFM,EJM,CFM,IAN,IAM,OAN,OAM,ACN,DCN
*         FAN,FNC,FSJM,FCJM,IAPM,OAPM,CMCH,CHCM,MCLR
*
** PURPOSE-- REDEFINE I/O INSTRUCTIONS SO THAT THE ADDRESS OF CHANNEL
*            INSTRUCTIONS CAN BE SAVED IN A TABLE.
NEWOP     ECHO   ,OP=(AJM,SCF,IJM,DCN,FJM,SFM,EJM,CFM,IAN,IAM,OAN,OAM,AC
,N,FAN,FNC,FSJM,FCJM,IAPM,OAPM,CCF,CMCH,CHCM,MCLR)
*
 OP_.     OPSYN  OP          E.G.  IAN. = IAN
*
          PURGMAC OP
OP        MACRO  P1,P2
          LOCAL  TAG
L         IFC    EQ,$P2$$
TAG       OP_.   P1
T_P1      RMT                IAN,OAN,ACN,DCN,FAN
          CON    TAG
          RMT
L         ELSE
TAG       OP_.   P1,P2
T_P2      RMT                AJM,IJM,FJM,EJM,IAM,OAM,FCN,IAPM,OAPM,
*                            SCF,CCF,SFM,CFM,FSJM,FCJM,CHCM,CMCH,MCLR
          CON    TAG
          RMT
L         ENDIF
OP        ENDM
NEWOP     ENDD
          SPACE  5,20
** NAME-- LOADC      ** MODIFIED **
*
** PURPOSE-- LOAD A CM ADDRESS INTO THE R AND A REGISTERS.
*
** CALLING SEQUENCE-- LOADC   CMR,CMA
*     CMR = ADDRESS OF THE WORD(S) TO BE LOADED INTO THE R REGISTER.
*           (IF CMA IS ABSENT, THEN THE FIRST WORD FOLLOWING CMR THAT WAS
*           NOT LOADED INTO THE R REGISTER IS LOADED INTO THE A REGISTER.
*     CMA = ADDRESS OF THE CONTENTS TO BE LOADED INTO THE A REGISTER.
*     CMA IS OPTIONAL.

 LOADC    MACRO  CMR,CMA
 L        IFLE   CMR,76B
 L        IFGE   CMR,0
          LRDL   CMR
          LDDL   CMR+1
 L        ELSE
          LRML   CMR
          LDML   CMR+1
 L        ENDIF
*
 P        IFC    NE,$CMA$$
 M        IFLE   CMA,76B
 M        IFGE   CMA,0
          ADDL   CMA
 M        ELSE
          ADML   CMA
 M        ENDIF
 P        ENDIF
          ENDM
          SPACE  5,20
** NAME--LOADR    ** MODIFIED **
*
** PURPOSE-- LOAD A CM ADDRESS INTO THE R AND A REGISTERS.
*            AN INDEXED MEMORY LOCATION SPECIFIES THE ADDRESS.
*
** CALLING SEQUENCE-- LOADR   CMR,INDEX
*     THE CM ADDRESS IS CONTAINED IN THE LOCATIONS STARTING AT
*         CMR INDEXED BY INDEX.

 LOADR    MACRO  CMR,INDEX
 M        IFC    NE,$INDEX$$
          LRML   CMR,INDEX
          LDML   CMR+1,INDEX
 M        ELSE
 X        IFNE   CMR,CMADR
          LRML   CMR
          LDML   CMR+1
 X        ENDIF
          LRDL   CMR
          LDDL   CMR+1
 M        ENDIF
          ENDM
          SPACE  5,20
** NAME--LOADF    ** MODIFIED **
*
** PURPOSE-- REFORMAT A CM ADDRESS AND LOAD IT INTO THE R AND A REGISTERS.
*
** CALLING SEQUENCE-- LOADF   CMR,INDEX
*     THE UNFORMATTED CM ADDRESS IS CONTAINED IN THE LOCATIONS
*          STARTING AT CMR INDEXED BY INDEX.
*     INDEX IS OPTIONAL.

 LOADF    MACRO  CMR,INDEX
 N        IFC    NE,$INDEX$$
          LRML   CMR,INDEX
          LDML   CMR+1,INDEX
          SHN    -3
 N        ELSE
 P        IFLE   CMR,76B
 P        IFGE   CMR,0
          LRDL   CMR
          LDDL   CMR+1
 P        ELSE
          LRML   CMR
          LDML   CMR+1
 P        ENDIF
          SHN    -3
 N        ENDIF
          ENDM
          SPACE  5,20
** NAME-- REFAD    ** MODIFIED **
*
** PURPOSE-- REFORMAT AND SAVE A CM ADDRESS.
*
** NOTE-- R IS NOT LOADED.
*
** CALLING SEQUENCE-- REFAD   CMR,SAV
*     THE UNFORMATTED CM ADDRESS IS CONTAINED IN THE LOCATIONS
*          STARTING AT CMR.
*     THE REFORMATTED CM ADDRESS IS STORED IN THE LOCATIONS
*          STARTING AT SAV.
*
 REFAD    MACRO  CMR,SAV
 L        IFLE   CMR,76B
 L        IFGE   CMR,0
          LDDL   CMR
 M        IFLE   SAV,76B
 M        IFGE   SAV,0
          STDL   SAV
          LDDL   CMR+1
          SHN    -3
          STDL   SAV+1
 M        ELSE
          STML   SAV
          LDDL   CMR+1
          SHN    -3
          STML   SAV+1
 M        ENDIF
 L        ELSE
          LDML   CMR
 P        IFLE   SAV,76B
 P        IFGE   SAV,0
          STDL   SAV
          LDML   CMR+1
          SHN    -3
          STDL   SAV+1
 P        ELSE
          STML   SAV
          LDML   CMR+1
          SHN    -3
          STML   SAV+1
 P        ENDIF
 L        ENDIF
          ENDM
          SPACE  5,20
*
*         PAUSE   ** MODIFIED **
*
 PAUSE    MACRO  X           DELAY X MICROSECONDS
 R        IFLE   X,77B
          LDN    X
 R        ELSE
          LDC    X
 R        ENDIF
          HOLD               WAIT INSTRUCTION
          ENDM
          SPACE  5,20
 MASKP    MACRO  FIELD
          LOCAL  X
 X        SET    16-N.FIELD-L.FIELD
          MGEN   N.FIELD
 MSK      SET    MASK$
          DUP    X
 MSK      SET    MSK+MSK
          ENDD
          ENDM
          ENDIF
* END IODMAC4
          TITLE  SPECIAL MACROS
          SPACE  4
**        SUBR - DEFINE SUBROUTINE ENTRY/EXIT.
*
*NAME     SUBR
*         DECLARE *NAME* TO BE THE ENTRY POINT TO A PP SUBROUTINE
*         WHICH IS ENTERED VIA *RJM* TO *NAME*.
*
*         THE FOLLOWING CODE IS GENERATED.
*NAMEX    LJM    *
*NAME     EQU    *-1

          PURGMAC  SUBR

          MACRO  SUBR,A
 A_X      LJM    *
 A        EQU    *-1
          ENDM
          TITLE  CPU RECORD DEFINITIONS AND EQUATES
*
* PP INTERFACE TABLE
*

 PIT      RECORD PACKED

* WORD 1
 PPNO     PPWORD             PP NUMBER
 FLU      PPWORD             FIRST LOGICAL UNIT
 UNITC    PPWORD             NUMBER OF UNITS
* WORD 2
          ALIGN  0,64
 INT      RMA                INTERRUPT WORD (RMA)
 CHAN     RMA                CHANNEL TABLE (RMA)
* WORD 3
 FILL1    PPWORD             UNUSED
 CBUFL    PPWORD             COMMUNICATION BUFFER LENGTH
 CBUF     RMA                COMMUNICATION BUFFER (RMA)
* WORD 4
 LOCK     BOOLEAN            PP REQUEST QUEUE LOCK
          ALIGN  48,64
 LOCKPP   PPWORD             PP REQUEST QUEUE LOCK OWNER
* WORD 5
          ALIGN  16,64
 PPQPVA   STRUCT 6           NEXT QUEUED PP REQUEST (PVA)
* WORD 6
          ALIGN  32,64
 PPQ      RMA                NEXT QUEUED PP REQUEST (RMA)
* WORDS 7-8
          ALIGN  16,64
 RSPVA    STRUCT 14          RESPONSE BUFFER (PVA)
* WORD 9
          ALIGN  32,64
 RSBUF    RMA                RESPONSE BUFFER (RMA)
* WORD 10
          ALIGN  48,64
 IN       PPWORD             IN POINTER
* WORD 11
          ALIGN  48,64
 OUT      PPWORD             OUT POINTER
* WORD 12
          ALIGN  48,64
 LIMIT    PPWORD             LIMIT POINTER

 PIT      RECEND
          EJECT
*
* UNIT DESCRIPTORS.
*

 UD       RECORD PACKED

* WORD 1
 LU       PPWORD             LOGICAL UNIT
 UQTPVA   STRUCT 6           UNIT INTERFACE TABLE (PVA)
* WORD 2
 CHAN     SUBRANGE 0,377B    CHANNEL NUMBER
 CNTRLR   SUBRANGE 0,377B    CONTROLLER NUMBER
 UNIT     PPWORD             PHYSICAL UNIT NUMBER
 UQT      RMA                UNIT INTERFACE TABLE (RMA)

 UD       RECEND
          SPACE  4
*
* UNIT INTERFACE TABLE
*

 UIT      RECORD PACKED

* WORD 1
 LU       PPWORD             LOGICAL UNIT
 DSABLE   BOOLEAN            UNIT IS ENABLED/DISABLED. (SET = DISABLED)
          ALIGN  32,64
 UTYPE    PPWORD             UNIT TYPE
 QCNT     PPWORD             NOT USED
* WORD 2
          ALIGN  16,64
 UBUFL    PPWORD             UNIT COMMUNICATION BUFFER LENGTH
 UBUF     RMA                UNIT COMMUNICATION BUFFER (RMA)
* WORD 3
 ULOCK    BOOLEAN            UNIT IS RESERVED FOR EXCLUSIVE USE
          ALIGN  48,64
 ULOCKP   PPWORD             UNIT LOCK OWNER
* WORD 4
 QLOCK    BOOLEAN            UNIT QUEUE LOCK
          ALIGN  48,64
 QLOCKP   PPWORD             UNIT QUEUE LOCK OWNER
* WORD 5
          ALIGN  16,64
 NEXTPV   STRUCT 6           NEXT REQUEST ON UNIT QUEUE (PVA)
* WORD 6
          ALIGN  32,64
 NEXT     RMA                NEXT REQUEST ON UNIT QUEUE (RMA)

          MASKP  DSABLE
 K.DSABLE EQU    MSK

 UIT      RECEND
          EJECT
*
* UNIT COMMUNICATION AREA
*

 UCA      RECORD PACKED

* WORD 1
 IN       PPWORD
 LIMIT    PPWORD
* WORDS 2-5
          ALIGN  0,64
 FILL1    STRUCT 32          RESERVRD

 UCA      RECEND
          SPACE  5
*
* REQUEST QUEUE
*

 RQ       RECORD PACKED

* WORD 1
          ALIGN  16,64
 NEXTPV   STRUCT 6           NEXT REQUEST ON UNIT QUEUE (PVA)
* WORD 2
          ALIGN  32,64
 NEXT     RMA                NEXT REQUEST ON UNIT QUEUE (RMA)
* WORD 3
 LEN      PPWORD             REQUEST LENGTH
 LU       PPWORD             LOGICAL UNIT
 RECOV    SUBRANGE 0,3       ERROR RECOVERY OPTIONS
                               0 - ENABLE 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
 LONGB    BOOLEAN            LONG INPUT BLOCK
* WORD 4
          ALIGN  0,64
 SECADR   INTEGER            SECONDARY ADDRESS
* WORDS 5-64 COMMANDS

 RQ       RECEND
          EJECT
*
* COMMANDS
*

 CM       RECORD PACKED

* WORD 1
 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
          EJECT
*
* PP RESPONSE.
*

 RS       RECORD PACKED

* WORD 1
          ALIGN  16,64
 PVA      STRUCT 6           PVA OF REQUEST
* WORD 2
          ALIGN  32,64
 REQ      RMA                RMA OF REQUEST
* WORD 3
 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       ALERT MASK
 LONGB    BOOLEAN            LONG INPUT BLOCK
* WORD 4
          ALIGN  0,64
 ABALRT   BOOLEAN            ABNORMAL ALERT CONDITION DETECTED
 INTERR   BOOLEAN            LOGICAL INTERFACE ERROR (INCLUDE INTERFACE
                             ERROR CODE)
 FORC     BOOLEAN            FORCED TERMINATION AS A RESULT OF STOP UNIT COMMAND
 CHERR    BOOLEAN            CHANNEL PARITY ERROR ON INPUT
 DATOV    BOOLEAN            DATA OVERRUN. A LOST DATA CONDITION
                             OCCURRED ON INPUT OR INADEQUATE DATA RATE ON OUTPUT
 DATERR   BOOLEAN            UNCORRECTABLE PARITY OR CHECKWORD ERROR
                             ON AN ADDRESS OR DATA FIELD.
 HDWR     BOOLEAN            UNCORRECTABLE HARDWARE MALFUNCTION IN A
                             CONTROLLER OR UNIT
 NRDY     BOOLEAN            INTERVENTION REQUIRED BY OPERATOR ON A
                             HARDWARE MALFUNCTION.  EXAMPLE- UNIT NOT READY.
 FTO      BOOLEAN            FUNCTION TIMEOUT
 CHERO    BOOLEAN            CHANNEL PARITY ERROR ON OUTPUT
          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  40,64
 URC      SUBRANGE 0,377B    UNSOLICITED RESPONSE CODE
                               1 - UNIT CHANGED FROM READY TO NOT READY
                               2 - UNIT CHANGED FROM NOT READY TO READY
                               3 - ABNORMAL CONDITION DURING HOUSEKEEPING CYCLE,
                                   (CHECK ABNORMAL STATUS OR INTERFACE ERROR CODE)
                               4 - CONTROLLER RESERVED TO ANOTHER ACCESS
                               5 - UNIT RESERVED TO ANOTHER ACCESS
                               6 - RECOVERED ABNORMAL CONDITION
                               7 - DEADSTART RESPONSE
                               8 - INITIALIZATION ERROR
                                   (CHECK ERRID FOR CONDITION)
          ALIGN  48,64       ALERT CONDITIONS
 LNGBLK   BOOLEAN            LONG INPUT BLOCK
 COMPRC   BOOLEAN            COMPARE NOT SATISFIED ON COMPARE/SWAP COMMAND
 PDLIM    BOOLEAN            PHYSICAL DELIMITER ENCOUNTERED (EOT OR BOT)
 LDLIM    BOOLEAN            LOGICAL DELIMITER ENCOUNTERED (TAPE MARK)
 CHARF    BOOLEAN            CHARACTER FILL PERFORMED
 DUNIT    BOOLEAN            UNIT WAS DISABLED BY PP
* WORD 5
          ALIGN  0,64
 XFER     STRUCT 4           TRANSFER COUNT
 LASTC    RMA                LAST COMMAND (RMA)
* WORD 6-13
 IOR      STRUCT 64          INDIVIDUAL OPERATION RESULTS
                             (BLOCK ID AND ON-THE-FLY CORRECTIONS)
* WORD 14
 ERRID    PPWORD             ERROR IDENTIFICATION
 FUNTO    PPWORD             FUNCTION WITH TIMEOUT
 STREG    PPWORD             STATUS REGISTER IPI CHANNEL
 ERREG    PPWORD             ERROR REGISTER IPI CHANNEL
* WORD 15
 DOWNST   PPWORD             DOWN STATUS
 K.PDN    EQU    8           PP IDLED ITSELF
 K.FDN    EQU    4           PP DOWNED THE FACILITY
 K.SDN    EQU    2           PP DOWNED THE SLAVE
 K.CDN    EQU    1           PP DOWNED THE CHANNEL
 K.NDN    EQU    0           PP DOWNED NOTHING

 FILL1    PPWORD             RESERVED
 FILL2    PPWORD             RESERVED
 FILL3    PPWORD             RESERVED
* WORD 16
 FACSTA   STRUCT 4           FACILITY STATUS, IPI ID52

 FILL4    PPWORD             RESERVED
 FILL5    PPWORD             RESERVED

* WORDS 17-48                IPI RESPONSE PACKET IF PRESENT
*                            VARIABLE LENGTH
          EJECT

          MASKP  INT
 K.INT    EQU    MSK
          MGEN   N.PORT
 M.PORT   EQU    MASK$
          MASKP  ABALRT
 K.ABALRT EQU    MSK
          MASKP  INTERR
 K.INTERR EQU    MSK
          MASKP  HDWR
 K.HDWR   EQU    MSK
          MASKP  CHERR
 K.CHERR  EQU    MSK
          MASKP  DATOV
 K.DATOV  EQU    MSK
          MASKP  FTO
 K.FTO    EQU    MSK
          MASKP  LNGBLK
 K.LNGBLK EQU    MSK
          MASKP  PDLIM
 K.PDLIM  EQU    MSK
          MASKP  LDLIM
 K.LDLIM  EQU    MSK
          MASKP  CHARF
 K.CHARF  EQU    MSK
          MASKP  DUNIT
 K.DUNIT  EQU    MSK
          MASKP  CHERO
 K.CHERO  EQU    MSK

 RS       RECEND
          EJECT
*
* PP COMMUNICATION BUFFER.
*

 CB       RECORD PACKED

* WORD 1
          ALIGN  31,64
 SLAVE    BOOLEAN            NONZERO IF SLAVE PP
 PARTNR   RMA                PARTNERS PIT (RMA)
* WORD 2
 CONTRL   STRUCT 8           LOAD CONTROLWARE COMMAND
* WORD 3
 CMCMD    STRUCT 8           SLAVE COMMAND
* WORD 4
 OVRLAY   STRUCT 8           OVERLAY RMA
* WORDS 5-8
 FILL1    STRUCT 32          RESERVED
* WORDS 9-13
 SCRAT    STRUCT 40          SCRATCH AREA
* WORDS 14-28
 ZEROES   STRUCT 120         120 BYTES (15 CM WORDS) OF ZERO
* WORDS 29-544
 PTD      STRUCT 4128        PATH TEST DATA (516 CM WORDS)


          MASKP  SLAVE
K.SLAVE   EQU    MSK


 CB       RECEND
          TITLE  PP RECORD DEFINITIONS AND EQUATES
          SPACE  3
*
* CONFIGURED SLAVES.
*

 SL       RECORD PACKED

* PP WORD 1
 FBA      PPWORD             FACILITITES (BY ADDRESS BIT) ON THIS SLAVE

* PP WORD 2
 SIU      PPWORD             SLAVE IN USE FLAG

* PP WORD 3
 FACLCK   SUBRANGE 0,1777B   CURRENT FACILITY LOCKED FLAG
 CURFAC   SUBRANGE 0,77B     CURRENT FACILITY NUMBER (FOR USE IN SCANNING)

* PP WORD 4
 SLVTST   PPWORD             SLAVE TESTING REQUIRED  = 1
*                                ATTRIBUTES REQUIRED = 2

 SL       RECEND
          SPACE  4
*
* CONFIGURED UNITS.
*

 UN       RECORD PACKED

* PP WORD 1
 FILL1    SUBRANGE 0,177B    RESERVED
 FC       BOOLEAN            FACILITY CONFIGURED
 FD       BOOLEAN            FACILITY DISABLED
 CTF      BOOLEAN            CONFIDENCE TEST REQUIRED FLAG
 SN       SUBRANGE 0,7       SLAVE NUMBER
 FN       SUBRANGE 0,7       FACILITY NUMBER

* PP WORD 2
 LU       PPWORD             LOGICIAL UNIT NUMBER

* PP WORDS 3-4
 UIT      STRUCT 4           RMA OF UNIT INTERFACE TABLE (REFORMATTED)


          MASKP  FC
 K.FC     EQU    MSK
          MASKP  FD
 K.FD     EQU    MSK
          MASKP  CTF
 K.CTF    EQU    MSK

 UN       RECEND
          EJECT
 MBID     EQU    30          MAX. NUMBER OF BLOCK ID-S TO SUPPORT (PP WORDS)
 MAXREQ   EQU    65          MAX. REQUEST LENGTH (CM WORDS)
 MAXSDC   EQU    10          MAX. NUMBER OF DIRECT CELLS TO SAVE IN TS TABLE
          SPACE  2
*
* TS TABLE DEFINITIONS.
*

 TS       RECORD PACKED

* PP WORD 1
 CRN      PPWORD             USED TO MAKE COMMAND REFERENCE NUMBER UNIQUE

* PP WORD 2
 SN       SUBRANGE 0,377B    SLAVE NUMBER
 FN       SUBRANGE 0,377B    FACILITY NUMBER

* PP WORDS 3-6
 CPVACM   STRUCT 2           FILL FOR CM BOUNDARY
 CPVA     STRUCT 6           CURRENT REQUEST PVA (UNFORMATTED)

* PP WORDS 7-10
 CREQCM   STRUCT 4           FILL FOR CM BOUNDARY
 CREQ     STRUCT 4           CURRENT REQUEST RMA (UNFORMATTED)

* PP WORD 11
 LASTC    PPWORD             OFFSET OF COMMAND IN REQUEST

* PP WORD 12
 NUMCM    PPWORD             NUMBER OF COMMANDS LEFT TO PROCESS

* PP WORD 13
 ILSTL    PPWORD             NUMBER OF INDIRECT LIST ADDRESS-LENGTH PAIRS

* PP WORDS 14-15
 XFER     STRUCT 4           TRANSFER COUNT

* PP WORD 16
 CLK      PPWORD             STARTING OPERATION CLOCK VALUE

* PP WORD 17
 SECLIM   PPWORD             SECONDS LIMIT FOR CURRENT OPERATION

* PP WORDS 18-21
 CURCMD   STRUCT 8           CURRENT COMMAND

* PP WORD 22
 DENSEL   PPWORD             DENSITY SELECTION
                              1 = 1600 (PE)
                              2 = 6250 (GCR)
* PP WORD 23
 ECSEL    PPWORD             ERROR CORRECTION SELECTION
                              1 = EC ENABLED
                              2 = EC DISABLED
* PP WORD 24
 BIDEF    PPWORD             BLOCK ID EXPECTED FLAG
                              0 = NONE
                              1 = BID EXPECTED
                              2 = TAPE MARK EXPECTED
                              3 = EITHER TM OR BID EXPECTED
* PP WORD 25
 SCOND    PPWORD             STATUS CONDITIONS
                             100000 = LONG BLOCK
                              20000 = PHYSICAL DELIMITER (EOT)
                              10000 = LOGICIAL DELIMITER (TAPE MARK)
                               4000 = CHARACTER FILL
* PP WORD 26
 CHAIN    PPWORD             IPI COMMAND CHAINING FLAG
                             X0 = LAST COMMAND CHAIN WAS NOT ABORTED
                             X1 = LAST COMMAND CHAIN WAS ABORTED
                             0X = LAST COMMAND SENT WAS NOT CHAINED
                             2X = LAST COMMAND SENT WAS CHAINED
* PP WORDS 27-28
 FACSTA   STRUCT 4           FACILITY STATUS, IPI ID52

* PP WORDS 29-30
 ILSTA    STRUCT 4           INDIRECT LIST RMA (UNFORMATTED) ADDRESS

* PP WORDS 31-34
 ILSTP    STRUCT 8           INDIRECT LIST LENGTH/ADDRESS PAIR

* PP WORD 35
 CBURBC   PPWORD             CURRENT BURST BYTE COUNT

* PP WORD 36
 PARLAP   PPWORD             PARTIAL LENGTH/ADDRESS PAIR FLAG

* PP WORD 37
 RESBC    PPWORD             RESIDUAL BYTE COUNT FROM TRANSFER

* PP WORD 38
 SLVEES   PPWORD             SLAVE ENCODED ENDING STATUS

* PP WORD 39
 RETRY    PPWORD             RETRY COUNTER

* PP WORD 40
 NSCA     PPWORD             NON-STOP COMMAND ADDRESS (PP ADDRESS)

* PP WORD 41
 NSWC     PPWORD             NON-STOP WRITE COUNTER

* PP WORD 42
 NSRC     PPWORD             NON-STOP READ COUNTER

* PP WORD 43
 NSCRN    PPWORD             NON-STOP COMMAND REFERENCE NUMBER

* PP WORD 44
 WSTNF    PPWORD             WAIT SPECIAL TRANSFER NOTIFICATION FLAG

* PP WORD 45
 GNSCRN   PPWORD             GROUP NON-STOP COMMAND REFERENCE NUMBER

* PP WORD 46
 GNUMCM   PPWORD             GROUP NUMBER OF COMMANDS LEFT

* PP WORD 47
 GNSCA    PPWORD             GROUP NON-STOP PP COMMAND ADDRESS
          SPACE  4
* TS BUFFERS

*         BLOCK ID BUFFER
 BIDB     STRUCT MBID*2      BLOCK ID BUFFER
 OTFC     PPWORD             ON-THE-FLY ERROR CORRECTION COUNTER
 BIDBP    PPWORD             BLOCK ID BUFFER POINTER

*         RECORD TRANSFER COUNT CIRCULAR BUFFER
 RTCIP    PPWORD             IN POINTER
 RTCOP    PPWORD             OUT POINTER
 RTCB     STRUCT 16          BUFFER FOR 4 32-BIT RECORD TRANSFER COUNTS


*         NOTE - ALL TS TABLE CELLS UP TO HERE ARE CLEARED DURING
*                REQUEST INITIALIZATION PROCESSING.

*         SWITCH BUFFERS
 SAVEDC   STRUCT MAXSDC*2    SAVED DIRECT CELLS WHEN SWITCHING TS TABLES
 SATTR    PPWORD             SAVED SUBROUTINE ADDRESSES WHEN SWITCHING
 SOPMO    PPWORD
 SCFC     PPWORD
 SGFS     PPWORD
 SRSEL    PPWORD
 SRFEL    PPWORD
 SCLREQ   PPWORD
 SPTW     PPWORD
 SPTR     PPWORD
 SSLVT    PPWORD
 SISR     PPWORD
 SLIR     PPWORD
 SPTWOD   PPWORD
 SPTRID   PPWORD
 SREL     PPWORD
 SFACT    PPWORD
 SIH      PPWORD
 SWSTN    PPWORD

 RQB      STRUCT C.RQ*8      UNIT REQUEST HEADER BUFFER

 CQB      STRUCT C.CM*8*MAXREQ  UNIT COMMAND SEQUENCE BUFFER

 SPARE    STRUCT 14          SPARE BYTES

 TS       RECEND
          EJECT
* DEFINED RECORD EQUATES

* PP INTERFACE TABLE
 EBPIT    EQU    B.PIT       BYTE LENGTH
 EPPIT    EQU    P.PIT       PP WORD LENGTH
 ECPIT    EQU    C.PIT       CM WORD LENGTH

* UNIT DESCRIPTOR
 EBUD     EQU    B.UD        BYTE LENGTH
 EPUD     EQU    P.UD        PP WORD LENGTH
 ECUD     EQU    C.UD        CM WORD LENGTH

* UNIT INTERFACE TABLE
 EBUIT    EQU    B.UIT       BYTE LENGTH
 EPUIT    EQU    P.UIT       PP WORD LENGTH
 ECUIT    EQU    C.UIT       CM WORD LENGTH

* UNIT COMMUNICATIONS BUFFER
 EBUCA    EQU    B.UCA       BYTE LENGTH
 EPUCA    EQU    P.UCA       PP WORD LENGTH
 ECUCA    EQU    C.UCA       CM WORD LENGTH

* REQUEST QUEUE
 EBRQ     EQU    B.RQ        BYTE LENGTH
 EPRQ     EQU    P.RQ        PP WORD LENGTH
 ECRQ     EQU    C.RQ        CM WORD LENGTH

* COMMAND QUEUE
 EBCM     EQU    B.CM        BYTE LENGTH
 EPCM     EQU    P.CM        PP WORD LENGTH
 ECCM     EQU    C.CM        CM WORD LENGTH

* RESPONSE BUFFER (IPI RESPONSE BUFFER NOT INCLUDED)
 EBRS     EQU    B.RS        BYTE LENGTH
 EPRS     EQU    P.RS        PP WORD LENGTH
 ECRS     EQU    C.RS        CM WORD LENGTH

* PP COMMNUNICATIONS BUFFER
 EBCB     EQU    B.CB        BYTE LENGTH
 EPCB     EQU    P.CB        PP WORD LENGTH
 ECCB     EQU    C.CB        CM WORD LENGTH

* CONFIGURED SLAVES
 EBSL     EQU    B.SL        BYTE LENGTH
 EPSL     EQU    P.SL        PP WORD LENGTH
 ECSL     EQU    C.SL        CM WORD LENGTH

* CONFIGURED UNITS
 EBUN     EQU    B.UN        BYTE LENGTH
 EPUN     EQU    P.UN        PP WORD LENGTH
 ECUN     EQU    C.UN        CM WORD LENGTH

* TAPES SUPPORTED TABLE
 EBTS     EQU    B.TS        BYTE LENGTH
 EPTS     EQU    P.TS        PP WORD LENGTH
 ECTS     EQU    C.TS        CM WORD LENGTH
          TITLE  BUFFER EQUATES
*
* RESPONSE BUFFER EQUATES
*
 HRESPL   EQU    P.RS        NORMAL RESPONSE LENGTH (IN PP WORDS)
 NRL      EQU    HRESPL*2    NORMAL RESPONSE LENGTH (IN BYTES)

 SRESPL   EQU    128+1       MAX. IPI RESPONSE LENGTH +1 (IN PP WORDS)

 MRESPL   EQU    HRESPL+SRESPL  MAX. TOTAL RESPONSE BUFFER +1 (IN PP WORDS)
          SPACE  4
*
* CONFIGURATION EQUATES
*
 MAXCHP   EQU    1           MAX. NUMBER OF CHANNEL PORTS TO SUPPORT
 SLVPCH   EQU    8           MAX. NUMBER OF SLAVES PER CHANNEL PORT TO SUPPORT

 MAXSL    EQU    MAXCHP*SLVPCH  MAX. TOTAL SL TABLES TO SUPPORT

 FACPSL   EQU    8           MAX. NUMBER OF FACILITIES PER SLAVE TO SUPPORT
 MAXUD    EQU    MAXSL*FACPSL  MAX. TOTAL FACILITIES TO SUPPORT

 MCSLV    EQU    2           MAX. NUMBER OF CONCURRENT SLAVES TO SUPPORT
 MAXTS    EQU    1+MCSLV     MAX. NUMBER OF TS TABLES TO SUPPORT
          SPACE  4
*
* BUFFER EQUATES
*

* NOTE  CMSE FROM 37400-37777B
 ENDMEM   EQU    37371B            LARGEST DRIVER ADDRESS

 RPB      EQU    ENDMEM-SRESPL     IPI RESPONSE PACKET BUFFER

 RS       EQU    RPB-P.RS          PP RESPONSE BUFFER

 PITB     EQU    RS-P.PIT          PP INTERFACE TABLE

 SLB      EQU    PITB-P.SL*MAXSL   SLAVES CONFIGURED TABLE

 UNITS    EQU    SLB-P.UN*MAXUD    FACILITIES CONFIGURED TABLE

 TS       EQU    UNITS-P.TS*MAXTS  TS TABLES
*         NOTE   THE FIRST TS TABLE IS FOR PP REQUESTS

 STRTBUF  EQU    TS                STARTING BUFFER ADDRESS

 UNITD    EQU    RPB+1             TRANSIENT UNIT DESCRIPTOR
 UITB     EQU    UNITD+P.UD        TRANSIENT UIT BUFFER
          TITLE  EQUATES
* CONDITIONAL ASSEMBLY EQUATES
 FH       EQU    0           1= KEEP FUNCTION HISTORY TABLE
 KH       EQU    0           1= KEEP HISTORY OF IPI COMMAND/RESPONSE PACKETS
 VALID    EQU    1           1= VALIDATE CPU TABLES AND BUFFERS

* RESPONSE CODES (AA).
 R.UNS    EQU    0           UNSOLICITED RESPONSE
 R.INT    EQU    40000B      INTERMEDIATE RESPONSE
 R.NRM    EQU    100000B     NORMAL REQUEST TERMINATION
 R.ABN    EQU    140000B     ABNORMAL REQUEST TERMINATION

* RESPONSE CODES (BB).
 R.RCV    EQU    10000B      RECOVERED ERROR CAUSED RESPONSE
 R.FLG    EQU    20000B      FLAG FIELD CAUSED RESPONSE
 R.RPF    EQU    R.RCV+R.FLG  BOTH CONDITIONS OCCURED

* UNSOLICITED RESPONSE CODES
 URC.RN   EQU    1           CHANGE FROM READY TO NOT READY
 URC.NR   EQU    2           CHANGE FROM NOT READY TO READY
 URC.IE   EQU    3           INTERNAL OR INTERFACE ERROR
 URC.CR   EQU    4           SLAVE RESERVED TO ANOTHER ACCESS
 URC.UR   EQU    5           FACILITY RESERVED TO ANOTHER ACCESS
 URC.RA   EQU    6           RECOVERED ABNORMAL CONDITION
 URC.DS   EQU    7           DEADSTART COMPLETED
 URC.IN   EQU    8           INITIALIZATION ERROR

* COMMAND EQUATES
 PSNI     EQU    2400B       PSN INSTRUCTION
 INPNI    EQU    102600B     INPN INSTRUCTION

 INDFLG   EQU    100B        INDIRECT ADDRESSING FLAG
 STRSP    EQU    200B        STORE RESPONSE FLAG

 IDLCMD   EQU    4           PP IDLE COMMAND
 RSUMCMD  EQU    5           PP RESUME COMMAND
 FUNCCMD  EQU    0#20        PHYSICAL COMMAND - FUNCTION (20 HEX)
 PWRTCMD  EQU    0#23        PHYSICAL COMMAND - OUTPUT 8-BIT DATA (23 HEX)
 LCREAD   EQU    0#41        LOCICAL READ RECORD OF 8-BIT DATA (41 HEX)
 LCWRITE  EQU    0#51        LOGICAL WRITE RECORD COMMAND (51 HEX)
 LCSTC    EQU    0#61        LOGICAL COMMAND STORE TRANSFER COUNT (61 HEX)

*         ATS PHYSICAL FUNCTION CODES
 F.FU     EQU    04B         FORMAT UNIT
 F.REW    EQU    10B         REWIND/UNLOAD UNIT
 F.SB     EQU    13B         FORESPACE/BACKSPACE BLOCK
 F.STM    EQU    15B         SEARCH TAPE MARK FWD/REV
 F.WTM    EQU    51B         WRITE TAPE MARK
 F.ERS    EQU    52B         ERASE TAPE
          EJECT
*
*         EQUATES FOR IPI ADAPTER
*
 H0X15    EQU    0#0015      REQUEST CLASS (X=PLUGGED) INTERRUPTS
 H0022    EQU    0#0022      CLEAR IPI ERROR REGISTER
 H0029    EQU    0#0029      SELECT OUT, FULL WHEN SLAVE IN IS 1
 H005B    EQU    0#005B      SET SYNC OUT
 H0071    EQU    0#0071      FULL WHEN SLAVE IN IS 0
 H00E1    EQU    0#00E1      READ STATUS REGISTER
 H00F1    EQU    0#00F1      READ ERROR REGISTER
 H0281    EQU    0#0281      STREAM, READ
 H0381    EQU    0#0381      STREAM, WRITE
 H0A81    EQU    0#0A81      STREAM, READ, DMA
 H7C42    EQU    0#7C42      IPI CHANNEL TRANSFER RATE (5.00 MB)
 H8025    EQU    0#8025      MASTER OUT, FULL WHEN SLAVE IN IS 1
 H8039    EQU    0#8039      SELECT OUT, FULL WHEN SLAVE IN IS 1
 H8115    EQU    0#8115      SET MASTER OUT, PHYSICAL INTERFACE RESET
 H8215    EQU    0#8215      SET MASTER OUT, LOGICAL INTERFACE RESET
 H8415    EQU    0#8415      SET MASTER OUT, SLAVE RESET
 H9211    EQU    0#9211      DROP SYNC OUT
 H9213    EQU    0#9213      SET SYNC OUT
          SPACE  2
*
* BUS CONTROL EQUATES
*
 CMDOUT   EQU    0           COMMAND, INFORMATION OUT
 RSPIN    EQU    1           RESPONSE, INFORMATION IN
 DATAOUT  EQU    2           DATA OUT
 DATAIN   EQU    3           DATA IN
          SPACE  2
*
* ENDING STATUS EQUATES
*
 EVENOT   EQU    0#0         EVEN OCTET TRANSFER
 ODDOT    EQU    0#F         ODD OCTET TRANSFER
          EJECT
*
* IPI COMMAND EQUATES
*
 OCNOP    EQU    0#0000      NOP
 OCATT    EQU    0#0200      ATTRIBUTES
 OCRAS    EQU    0#0300      REPORT ADDRESSEE STATUS
 OCPA     EQU    0#0400      PORT ADDRESS
 OCPC     EQU    0#0500      PATH CONTROL
 OCAC     EQU    0#0600      ATTENTION CONTROL
 OCOM     EQU    0#0700      OPERATING MODE
 OCABT    EQU    0#0800      ABORT
 OCREAD   EQU    0#1000      READ
 OCWRITE  EQU    0#2000      WRITE
 OCSPACE  EQU    0#4000      SPACE BLOCK/FILE
 OCPOSC   EQU    0#4100      POSITION CONTROL
 OCREPP   EQU    0#4200      REPORT POSITION
 OCRECP   EQU    0#4300      RECORD POSITION
 OCREADV  EQU    0#5000      READ VERIFY
 OCRFB    EQU    0#5200      READ FROM BUFFER
 OCRFDTB  EQU    0#5300      READ FACILITY DATA TO BUFFER
 OCWTB    EQU    0#6200      WRITE TO BUFFER
 OCWBTF   EQU    0#6300      WRITE BUFFER TO FACILITY
 OCIML    EQU    0#6600      LOAD SLAVE IML
 OCERASE  EQU    0#6700      ERASE
 OCPSD    EQU    0#8000      PERFORM SLAVE DIAGNOSTICS
 OCPFD    EQU    0#8100      PERFORM FACILITY DIAGNOSTICS
 OCREL    EQU    0#8400      READ ERROR LOG
          SPACE  4
*
* IPI COMMON MODIFIER EQUATES
*
 CMPRI    EQU    0#40        PRIORITY
 CMCHN    EQU    0#10        CHAIN
          SPACE  4
*
* IPI OPCODE MODIFIER EQUATES
*
 OMRF     EQU    0#2         READ FORWARD
 OMRR     EQU    0#A         READ REVERSE
 OMRVF    EQU    0#0         READ VERIFY FORWARD
 OMRVR    EQU    0#8         READ VERIFY REVERSE
 OMSFF    EQU    0#1         SEARCH FILE FORWARD
 OMSFR    EQU    0#9         SEARCH FILE REVERSE
 OMDSE    EQU    0#0         ERASE - DSE
 OMGAP    EQU    0#6         ERASE - GAP
 OMOMS    EQU    0#4         OPERATION MODE - SET
 OMAL     EQU    0#9         ATTRIBUTE - LOAD
 OMRELC   EQU    0#0         READ ERROR LOG - CLEAR
 OMRASC   EQU    0#1         REPORT ADDRESSEE STATUS - CONDITION
          EJECT
*
* IPI COMMON PARAMETER EQUATES
*
 CPTP     EQU    0#0251      TAPE POSITION PARAM
 CPTM     EQU    0#0251      TAPE MARK PARAM
 CPSRB    EQU    0#026E      SLAVE RECONFIGURATION BIT PARAM
 CPSRF    EQU    0#176F      SLAVE RECONFIGURATION FIELD PARAM
 CPNOP    EQU    0#0301      NOP PARAM
 CPBA     EQU    0#0350      BUFFER ADDRESS PARAM
 CPPM     EQU    0#0450      PORT MASK PARAM
 CPCE     EQU    0#0531      COMMAND EXTENT PARAM
 CPSCE    EQU    0#05D2      MAXIMUM BLOCK LENGTH (READ) PARAM
 CPTMB    EQU    0#0552      TAPE MODE BIT PARAM
 CPBCE    EQU    0#0931      BUFFER COMMAND EXTENT PARAM
 CPTMF    EQU    0#0953      TAPE MODE FIELD PARAM
 CPBID    EQU    0#02D0      ENABLE/DISABLE BID PARAM
          SPACE  4
*
* IPI ID EQUATES
*
 ID13     EQU    0#13        MICROCODE EXCEPTION FOR SLAVE
 ID14     EQU    0#14        INTERVENTION REQUIRED FOR SLAVE
 ID15     EQU    0#15        ALTERNATE PORT EXCEPTION
 ID16     EQU    0#16        MACHINE EXCEPTION FOR SLAVE
 ID17     EQU    0#17        COMMAND EXCEPTION FOR SLAVE
 ID18     EQU    0#18        COMMAND ABORTED FOR SLAVE
 ID19     EQU    0#19        SLAVE CONDITIONAL SUCCESS
 ID24     EQU    0#24        INTERVENTION REQUIRED FOR FACILITY
 ID26     EQU    0#26        MACHINE EXCEPTION FOR FACILITY
 ID29     EQU    0#29        FACILITY CONDITIONAL SUCCESS
 ID2A     EQU    0#2A        INCOMPLETE STATUS FOR FACILITY
 ID32     EQU    0#32        RESPONSE EXTENT PARAMETER
 ID51     EQU    0#51        CONDITION PARAMETER
 ID52     EQU    0#52        MEDIA STATUS PARAMETER
 IDD0     EQU    0#D0        BLOCK ID PARAMETER
 IDD2     EQU    0#D2        MAXIMUM BLOCK LENGTH PARAMETER
          EJECT
*
* IPI COMMAND/RESPONSE PACKET EQUATES
*
 CRN      EQU    1           COMMAND REFERENCE NUMBER
 OPCD     EQU    2           OPERATION CODE FOR SLAVE
 SLAD     EQU    3           SLAVE ADDRESS, FACILITY ADDRESS
 MAJST    EQU    4           MAJOR STATUS
          SPACE  4
*
* IPI MAJOR STATUS EQUATES
*         RESPONSE TYPES
 CC       EQU    1           COMMAND COMPLETE RESPONSE
 AR       EQU    4           ASYNCHRONOUS RESPONSE
 TN       EQU    5           TRANSFER NOTIFICATION
 CCS      EQU    0#18        COMMAND COMPLETE, SUCCESSFUL
          SPACE  4
*
* IPI LEFT SHIFTS FOR MAJOR STATUS
*
 LSCE     EQU    2           COMMAND EXCEPTION
 LSME     EQU    3           MACHINE EXCEPTION
 LSAPE    EQU    4           ALTERNATE PORT EXCEPTION
 LSIR     EQU    5           INTERVENTION REQUIRED
 LSMME    EQU    6           MESSAGE/MICROCODE EXCEPTION
 LSS      EQU    14          SUCCESSFUL
 LSI      EQU    15          INCOMPLETE
 LSCS     EQU    16          CONDITIONAL SUCCESS
 LSCA     EQU    17          COMMAND ABORTED
          SPACE  4
*
* IPI MISCELLANEOUS EQUATES
*
 BURST    EQU    8192        IPI BURST SIZE (MUST BE MULTIPLE OF 8)
          SPACE  4
*
*         MISCELLANEOUS EQUATES
*
 DC       EQU    37B         DEVICE CHANNEL NUMBER
 T698.1   EQU    21B         5698 UIT UNIT TYPE FOR 698-3X TAPE FACILITY
 MALETVE  EQU    1           MALVET/VE CHANNEL REQUEST VALUE IN WORD (T2)
 MS25     EQU    26738       25 MILLISECOND TIMEOUT FOR CERTAIN LOOPS
 SRT      EQU    45          SLAVE RESET TIMEOUT (SECONDS)
 BYPSD    EQU    400000B     BYPASS SELECT/DESELECT IN ROUTINE CPT
          EJECT
*
* IOU/SLAVE/FACILITY ERROR CODES    *** DEC ***
*
 E00      EQU    0           CP MUST DECODE STATUS IN RESPONSE PACKET
 E01      EQU    1           FUNCTION TIMEOUT
 E02      EQU    2           CHANNEL EMPTY WHEN ACTIVATED
 E03      EQU    3           PERIOD COUNTER PARITY
 E04      EQU    4           UPPER ICI PARITY
 E05      EQU    5           LOWER ICI PARITY
 E06      EQU    6           IOU ERROR
 E19      EQU    19          ILLEGAL OPERATION
 E20      EQU    20          CANT SELECT SLAVE
 E21      EQU    21          BIT SIGNIFICANT RESPONSE ERROR
 E22      EQU    22          NO SYNC IN
 E23      EQU    23          SYNC IN DID NOT DROP
 E24      EQU    24          IPI SEQUENCE ERROR
 E25      EQU    25          UPPER IPI CHANNEL PARITY
 E26      EQU    26          LOWER IPI CHANNEL PARITY
 E27      EQU    27          SLAVE IN NOT SET
 E28      EQU    28          SLAVE IN DID NOT DROP
 E29      EQU    29          INCOMPLETE TRANSFER
 E30      EQU    30          CHANNEL STAYED ACTIVE
 E31      EQU    31          BUFFER COUNTER PARITY
 E32      EQU    32          SYNC COUNTER PARITY
 E33      EQU    33          LOST DATA
 E34      EQU    34          BUS PARITY
 E35      EQU    35          COMMAND REJECT
 E36      EQU    36          SYNC OUT NOT EQUAL SYNC INS
 E37      EQU    37          BUS B ACKNOWLEDGE INCORRECT
 E38      EQU    38          NO SLAVE INTERRUPT
 E39      EQU    39          ENDING STATUS WRONG
 E40      EQU    40          SLAVE ENCODED ENDING STATUS WRONG
 E50      EQU    50          EXECUTING SLAVE DIAGNOSTICS
 E51      EQU    51          SLAVE DIAGNOSTICS PASSED
 E60      EQU    60          SLAVE FAILURE
 E61      EQU    61          FACILITY FAILURE
 E70      EQU    70          INTERNAL SLAVE ERROR
 E71      EQU    71          SLAVE INTERVENTION REQUIRED
 E72      EQU    72          SLAVE MACHINE EXCEPTION
 E73      EQU    73          COMMAND EXCEPTION
 E74      EQU    74          MICROCODE EXECUTION ERROR
 E75      EQU    75          ALTERNATE PORT EXCEPTION
 E76      EQU    76          UNEXPECTED RESPONSE
 E77      EQU    77          FACILITY RESERVED TO OTHER SLAVE
 E78      EQU    78          NO BLOCK ID PARAMETER RETURNED
 E79      EQU    79          UNEXPECTED CLASS 2 INTERRUPT
 E90      EQU    90          NO END OF EXTENT (TAPE MARK) DETECTED
 E110     EQU    110         PP-SLAVE DATA INTEGRITY
 E111     EQU    111         SLAVE-FACILITY DATA INTERGRITY
 E120     EQU    120         SOFTWARE FAILURE
          EJECT
*
* INTERFACE ERROR CODES.     *** HEX ***
*
 E201     EQU    1001B       RMA OF CHANNEL RESERVATION TABLE NOT
                              A WORD BOUNDARY
 E202     EQU    1002B       RMA OF UNIT ACTIVITY MASK NOT A
                              WORD BOUNDARY
 E203     EQU    1003B       RMA OF PP COMMUNICATION BUFFER NOT A
                              WORD BOUNDARY
 E204     EQU    1004B       RESERVED FIELD OF THE PP COMMUNICATION
                             BUFFER DESCRIPTOR IS NOT ZERO
 E205     EQU    1005B       RESERVED FIELD OF THE PP REQUEST QUEUE
                             DESCRIPTOR IS NOT ZERO
 E206     EQU    1006B       RMA OF NEXT PP NOT A WORD BOUNDARY
 E207     EQU    1007B       RESERVED FIELD OF THE PP RESPONSE
                             BUFFER DESCRIPTOR IS NOT ZERO
 E208     EQU    1010B       LOGICAL UNIT OF UNIT DESCRIPTOR NOT
                             IN SEQUENCE OR NOT IN RANGE
 E209     EQU    1011B       RMA OF UNIT INTERFACE TABLE NOT A
                             WORD BOUNDARY
 E20A     EQU    1012B       INVALID CHANNEL NUMBER SPECIFIED
                             IN UNIT DESCRIPTOR
 E20B     EQU    1013B       COMMUNICATION BUFFER LENGTH NOT A
                             MULTIPLE OF WORDS OR NOT LONG ENOUGH
 E20D     EQU    1015B       RESERVED FIELD OF IN POINTER
                             IS NOT ZERO
 E20E     EQU    1016B       RESERVED FIELD OF OUT POINTER
                             IS NOT ZERO
 E20F     EQU    1017B       RESERVED FIELD OF LIMIT POINTER
                             IS NOT ZERO
 E210     EQU    1020B       INVALID PHYSICAL UNIT NUMBER
 E211     EQU    1021B       RMA OF INTERRUPT WORD NOT A WORD
                             BOUNDARY
 E212     EQU    1022B       RMA OF CHANNEL TABLE NOT A WORD
                             BOUNDARY
 E213     EQU    1023B       NO ACTIVE (NON NULL) UNIT DESCRIPTORS DEFINED
 E301     EQU    1401B       LOGICAL UNIT NUMBER NOT EQUAL TO LOGICAL
                             UNIT OF UNIT DESCRIPTOR
 E302     EQU    1402B       RMA OF UNIT COMMUNICATION BUFFER
                             NOT A WORD BOUNDARY
 E303     EQU    1403B       A RESERVED FIELD OF THE UNIT COMMUNICATION BUFFER
                             DESCRIPTOR IS NOT ZERO
 E304     EQU    1404B       RMA OF NEXT UNIT REQUEST
                             NOT A WORD BOUNDARY
 E305     EQU    1405B       RESERVED FIELD OF UNIT REQUEST QUEUE
                             DESCRIPTOR IS NOT ZERO
 E306     EQU    1406B       INVALID UNIT TYPE
 E307     EQU    1407B       UNIT COMMUNICATION BUFFER LENGTH NOT A
                             MULTIPLE OF CM WORDS
 E308     EQU    1410B       UNIT COMMUNICATION BUFFER IS TOO SMALL
 E501     EQU    2401B       INVALID COMMAND CODE
 E505     EQU    2405B       INVALID LENGTH SPECIFICATION IN COMMAND
 E50A     EQU    2412B       INVALID SEQUENCE OF COMMANDS
          TITLE  DIRECT CELLS
 T0       CON    START-1     START OF DRIVER-1
 T1       BSSZ   1           SCRATCH CELLS
 T2       BSSZ   1
 T3       BSSZ   1
 T4       BSSZ   1
 T5       BSSZ   1
 T6       BSSZ   1
 T7       BSSZ   1
 T8       BSSZ   1
 P1       BSSZ   1
 P2       BSSZ   1
 P3       BSSZ   1
 P4       BSSZ   1
 P5       BSSZ   1
 P6       BSSZ   1
          SPACE  2
 CLCUR    BSSZ   1           CURRENT CHANNEL 14 CLOCK VALUE
 CLMCS    BSSZ   1           CLOCK, MICROSECOND
 CLMLS    BSSZ   1           CLOCK, MILLISECOND
 CLSEC    BSSZ   1           CLOCK, SECOND
 CPTBP    BSSZ   1           CPT BYPASS PARAMETER
 CSLVS    BSSZ   1           CONFIGURED SLAVES BY BIT ADDRESS
 CTM      BSSZ   1           IPI CHANGE TRANSFER MODE FLAG
 CURCH    BSSZ   1           CURRENT CHANNEL NUMBER
 FI       BSSZ   1           FUNCTION HISTORY BUFFER INDEX
 HBP      BSSZ   1           HISTORY BUFFER POINTER
 LF       BSSZ   1           LAST FUNCTION TO IPI ADAPTER
 LIM      BSSZ   1           LIMIT OF CM RESPONSE BUFFER
 MALREQF  BSSZ   1           MALET CHANNEL REQUEST FLAG
 TIU      BSSZ   1           TS TABLES IN USE BY BIT ADDRESS
 TSLVS    BSSZ   1           TOTAL NUMBER OF SLAVES CONFIGURED
 WC       BSSZ   1           WORD COUNTER

          BSSZ   4           UNUSED
          SPACE  4
*         THE FOLLOWING DIRECT CELLS ARE SAVED/LOADED WITH THE TS TABLE
 SAVEFWA  EQU    *
 ASYNCP   BSSZ   1           ASYNCHRONUS PROCESSING FLAG
 CTST     BSSZ   1           CURRENT TS TABLE INDEX
 FACN     BSSZ   1           CURRENT FACILITY NUMBER
 SLVN     BSSZ   1           CURRENT SLAVE NUMBER
 STATUS   BSSZ   1           IPI CHANNEL STATUS
 SX       BSSZ   1           SLAVES TABLE INDEX
 UX       BSSZ   1           UNITS TABLE INDEX
 SAVELWA  EQU    *-1
          ERRPL  SAVELWA-SAVEFWA-MAXSDC  INSURE TS SAVE AREA IS ENOUGH
*         THIS IS THE END OF THE SAVED TS TABLE DIRECT CELLS
          EJECT
* THE FOLLOWING CM.XXX ARE REFORMATTED CM ADDRESSES
 CM.PIT   BSSZ   2           CM ADDRESS OF PP INTERFACE TABLE
 CM.INT   BSSZ   2           CM ADDRESS OF INTERRUPT TABLE
 CM.CHAN  BSSZ   2           CM ADDRESS OF CHANNEL TABLE
 CM.COM   BSSZ   2           CM ADDRESS OF PP COMMUNICATION BUFFER
 CM.RS    BSSZ   2           CM ADDRESS OF RESPONSE BUFFER

* NOTE   DIRECT CELLS T1 THRU DCCEND WILL BE CLEARED ON DEADSTART/RESUMES
 DCCEND   EQU    *-1
          SPACE  4
 BURSTSZ  CON    BURST       IPI BURST SIZE
 INITFLG  DATA   1           INITIALIZATION FLAG 1=DS, 2=RESUME, 3=MALET
 PPREQF   DATA   0           PP REQUEST FLAG
 ONE      CON    1           CONSTANT ONE (DO NOT CHANGE THIS CELL)
 TWO      CON    2           CONSTANT TWO (DO NOT CHANGE THIS CELL)
 FF       CON    0#FF        CONSTANT HEX FF (DO NOT CHANGE THIS CELL)
 DSRTP    DATA   2,0         REAL MEMORY WORD-ADDRESS OF PIT (PLUGGED)

          ERRNZ  DSRTP-72B   MUST BE AT LOCATION 72

 IDLFLG   DATA   0           PP IDLE FLAG, IF NONZERO ONLY PP REQUESTS ARE DONE.
 CLF      DATA   1           CHANNEL LOCK FLAG  ** 0 = LOCKED **
 PPNO     DATA   5           LOGICAL PP NUMBER
          BSSZ   1           UNUSED


 ID       DATA   H*TAPC*     IDENTIFICATION

          ERRNZ  ID-100B     ID MUST BE AT LOCATION 100B
          SPACE  5
*
*         ENTRY POINT
*
          SPACE  2
 START    LJM    INIT        ENTRY POINT OF DRIVER

          ERRNZ  START-102B  ENTRY MUST BE AT LOCATION 102B
          TITLE  PP MONITOR

          SPACE  4
*
* PP MONITOR
*
          SPACE  2
 MAIN     BSS
          RJM    CKIT        CHECK FOR INITIALIZATION REQUIRED

          RJM    CKPPRQ      CHECK FOR ANY PP REQUESTS
          ZJN    MAIN10      IF NONE
          RJM    DOPPRQ      PROCESS PP REQUEST

 MAIN10   BSS
          LDDL   IDLFLG      CHECK IF PP IS IDLED
          NJN    MAIN        IF YES

 MAIN20   BSS
          RJM    CKCREQ      CHECK FOR MALET REQUESTING THE CHANNEL
          ZJN    MAIN30      IF NOT
          RJM    DOCREQ      PROCESS MALET CHANNEL REQUEST

 MAIN30   BSS
          RJM    CKUR        CHECK FOR UNIT REQUESTS
          ZJN    MAIN40      IF NONE
          LJM    DOUR        PROCESS UNIT REQUEST

 MAIN40   BSS
          RJM    CKINT       CHECK/PROCESS SLAVE ASYNCHRONUS INTERRUPTS

          LJM    MAIN        RELOOP
          TITLE  MONITOR SUBROUTINES
** NAME-- CKIT
*
** PURPOSE-- CHECK IF INITIALIZATION TESTING REQUIRED
*
** EXIT-- IMEDIATELY IF TESTING ALREADY COMPLETED.
*         AFTER TESTING ALL SLAVES WITH AT LEAST ONE
*         CONFIGURED NON-DISABLED FACILITY.
          SPACE  4
 CKIT     SUBR   ENTRY/EXIT
          LDDL   INITFLG     CHECK IF TESTING IS COMPLETE
          ZJN    CKITX       IF YES EXIT
          LDDL   IDLFLG      CHECK IF PP IS IDLE
          NJK    CKIT110     IF YES BYPASS TESTING
          LDDL   CTST        CHECK IF FIRST PASS THRU
          LMML   TS1
          NJN    CKIT10      IF NOT
          STDL   SLVN        START WITH SLAVE 0
          RJM    SCLOCK      GET CHANNEL LOCKED
          LDML   TS2         USE FIRST SLAVE TS TABLE
          STDL   CTST
          RJM    MR          MASTER RESET
          UJN    CKIT20      CONT.
 CKIT10   BSS
          AODL   SLVN        INCREMENT SLAVE NUMBER
          SBN    SLVPCH      CHECK FOR DONE
          PJK    CKIT100     IF YES
 CKIT20   BSS
          RJM    SETSX       SETUP SLAVE TABLE INDEX
          ZJN    CKIT10      IF NO CONFIGURED FACILITIES
          LDN    3           SET SLAVE TESTING/ATTRIBUTES REQUIRED FLAG
          STML   SLB+/SL/P.SLVTST,SX
          LDN    0
          STDL   FACN        START WITH FACILITY NUMBER 0
          UJN    CKIT40      CONT.
 CKIT30   BSS
          AODL   FACN        INCREMENT FACILITY NUMBER
          SBN    FACPSL      CHECK FOR LIMIT
          PJN    CKIT10      IF YES
 CKIT40   BSS
          RJM    SETUX       SETUP UNITS TABLE INDEX
          ZJN    CKIT30      IF UNIT NOT CONFIGURED
          LDML   UNITS+/UN/P.FD,UX
          SHN    /UN/L.FD+2  CHECK FOR DISABLED
          MJN    CKIT30      IF YES
          LOADR  UNITS+/UN/P.UIT,UX  ADDRESS OF UIT
          CRDL   T1          GET UIT DISABLE BIT
          LDDL   T1+/UIT/P.DSABLE
          SHN    /UIT/L.DSABLE+2
          MJN    CKIT30      IF DISABLED
          LDML   TS2         USE FIRST SLAVE TS TABLE
          STDL   CTST
          RJM    INTS        INITIALIZE TS TABLE
          LDML   UNITS+/UN/P.LU,UX  GET LOGICIAL UNIT NUMBER
          STML   /TS/P.RQB+/RQ/P.LU,CTST  PUT INTO TS TABLE
          LDDL   INITFLG     CHECK IF DEADSTART INITIALIZATION
          SBN    1
          NJN    CKIT50      IF NOT
 CKIT45   BSS
          LDN    2           SET RETRY LEVEL
          STML   /TS/P.RETRY,CTST
          RJM    ISR         ISSUE SLAVE RESET
          UJN    CKIT60      CONT.
 CKIT50   BSS
          LDML   SRTAB,SLVN  CHECK IF SLAVE RESET EVER ISSUED
          ZJN    CKIT45      IF NOT
          LDN    1           SET RETRY LEVEL
          STML   /TS/P.RETRY,CTST
          RJM    LIR         LOGICIAL INTERFACE RESET
 CKIT60   BSS
          LDN    0           SET RETRY LEVEL
          STML   /TS/P.RETRY,CTST
          LDN    1           ENABLE ERROR CORRECTION
          STML   /TS/P.ECSEL,CTST
          RJM    ATTRIB      SET ALL SLAVE ATTRIBUTES
          RJM    PTW         PATH TEST WRITE
          RJM    PTR         PATH TEST READ
          LDN    0           CLR SLAVE TESTING/ATTRIBUTES REQUIRED FLAG
          STML   SLB+/SL/P.SLVTST,SX
          UJK    CKIT10      GO DO NEXT SLAVE

*         INITIALIZATION TESTING COMPLETE
 CKIT100  BSS
          LDN    0           CLEAR SLAVE TS TABLE
          STDL   SLVN
          STDL   FACN
          RJM    CLRTS       CLEAR TS2 SLAVE TABLE
 CKIT110  BSS
          LDML   TS1         RESET TO TS1 IF PP RESUME
          STDL   CTST
          LDDL   INITFLG     DETERMINE WHAT CAUSED PP INITIALIZATION
          SBN    3
          ZJN    CKIT120     IF MALET
          RJM    CLRTS       CLEAR TS1 PP TABLE
          LDN    0
          STDL   TIU         CLEAR TS TABLES IN USE FLAG
          STDL   PPREQF      CLEAR IF FROM RESUME
          STML   RPB         CLEAR IPI RESPONSE LENGTH
          STDL   SX          CLEAR SLAVE INDEX
          STDL   UX          CLEAR UNIT INDEX
          UJN    CKIT130     CONT.
 CKIT120  BSS
          LDDL   IDLFLG      MALET PROCESSING
          NJN    CKIT140     IF PP IS IDLE (TESTING DONE BY RESUME)
 CKIT130  BSS
          LDN    0
          STDL   INITFLG     CLR INITIALIZATION FLAG
 CKIT140  BSS
          UJK    CKITX       EXIT
          EJECT
** NAME-- CKPPRQ
*
** PURPOSE-- CHECK IF THERE ARE ANY PP REQUESTS QUEUED.
*
** EXIT-- A = NZ IF NEW OR PENDING REQUEST ACTIVE (PPREQF = NZ).
*         A = 0  IF NO REQUEST ACTIVE (PPREQF = 0).
          SPACE  2
 CKPPRQ2  RJM    CPLOCK      UNLOCK PP REQUEST QUEUE IN PIT
 CKPPRQ4  LDN    0           NO NEW REQUESTS


 CKPPRQ   SUBR               ENTRY/EXIT


          LDDL   PPREQF      CHECK IF PENDING REQUEST
          NJN    CKPPRQX     IF YES EXIT
          LOADC  CM.PIT      LOAD A AND R FOR PIT
          ADK    /PIT/C.PPQ
          CRML   T1,ONE      READ REQUEST RMA FROM PIT
          LDDL   T3          HALF 1 OF REQUEST RMA
          ADDL   T4          HALF 2 OF REQUEST RMA
          ZJN    CKPPRQX     IF NO REQUEST QUEUED
          RJM    SPLOCK      LOCK PP REQUEST QUEUE IN PIT
          NJK    CKPPRQ4     RETURN IF PP REQUEST QUEUE ALREADY LOCKED
          LOADC  CM.PIT      CM ADDRESS TO A AND R FOR READ
          ADK    /PIT/C.PPQPVA
          CRML   PITB+/PIT/P.PPQPVA-1,TWO  READ IN REQUEST PVA/RMA FROM PIT
          LDML   PITB+/PIT/P.PPQ  GET HALF 1 OF RMA OF 1ST REQUEST
          ADML   PITB+/PIT/P.PPQ+1
          ZJK    CKPPRQ2     IF RMA = 0 NO PP REQUEST QUEUED
          LDN    1           SET PP REQUEST FLAG
          STDL   PPREQF
          UJK    CKPPRQX     EXIT
          EJECT
** NAME-- DOPPRQ
*
** PURPOSE-- PROCESS THE WAITING PP REQUEST IF POSSIBLE.
*
** NOTE-- THE ONLY PP COMMANDS SUPPORTED ARE IDLE AND RESUME.
*         THERE CAN BE ONLY ONE COMMAND PER PP REQUEST.
          SPACE  2
 DOPPRQ   SUBR               ENTRY/EXIT
          LDDL   TIU         CHECK IF ANY SLAVE USING TS TABLES
          LPN    76B         MASK OUT PP TS TABLE
          NJN    DOPPRQX     IF YES EXIT
          STDL   PPREQF      CLEAR THE PP REQUEST FLAG
          STDL   SLVN        CLEAR SLAVE NUMBER
          STDL   FACN        CLEAR FACILITY NUMBER
          LDN    1           SET PP TS TABLE IN USE
          STDL   TIU
          LDML   TS1         USE TS TABLE 1 FOR THE PP REQUEST
          STDL   CTST
          LDK    CM.PIT      SETUP SOURCE OF REQUEST
          STDL   T7
          RJM    LDTS        LOAD THE TS TABLE AND UNLOCK QUEUE
          LDML   /TS/P.NUMCM,CTST  CHECK NUMBER OF COMMANDS
          SBN    1           PP CAN ONLY HAVE 1 ACTIVE COMMAND
          ZJN    DOPPRQ5     IF OK
          LDK    E50A        INVALID SEQUENCE OF COMMANDS
          RJM    SWFAIL      REPORT SOFTWARE FAILURE (NO RETURN)
 DOPPRQ5  BSS
          LDML   /TS/P.CQB,CTST  GET THE PP COMMAND
          SHN    -8          POSITION IT
          SBN    IDLCMD      CHECK FOR IDLE COMMAND
          ZJK    IDLE        IF YES
          SBN    RSUMCMD-IDLCMD  CHECK FOR RESUME COMMAND
          ZJK    RESUME      IF YES
          LDK    E501        INVALID COMMAND CODE
          RJM    SWFAIL      REPORT SOFTWARE FAILURE (NO RETURN)
          EJECT
** NAME-- CKCREQ
*
** PURPOSE-- CHECK IF CHANNEL IS REQUESTED BY MALET.
*
** EXIT-- A = NZ IF NEW OR PENDING REQUEST ACTIVE (MALREQF = NZ).
*         A = 0  IF NO REQUEST ACTIVE (MALREQF = 0).
          SPACE  2
 CKCREQ1  LDN    0           EXIT A = 0
          STDL   MALREQF     CLEAR MALET REQUEST FLAG

 CKCREQ   SUBR               ENTRY/EXIT


          LDDL   MALREQF     CHECK IF REQUEST ALREADY ACTIVE
          NJK    CKCREQX     IF YES, EXIT
          LDDL   CLF         CHECK IF CHANNEL IS CURRENTLY LOCKED
          NJN    CKCREQ1     IF NOT, EXIT
          LOADC  CM.CHAN     ADDRESS OF CM CHANNEL TABLE
          ADDL   CURCH       CHANNEL NUMBER IS INDEX INTO TABLE
          CRML   T1,ONE      READ CM CHANNEL ENTRY
          LDDL   T2          GET MAINTENANCE BYTES OF CHANNEL WORD
          LMK    MALETVE     CHECK IF REQUESTED
          NJK    CKCREQ1     IF CHANNEL IS NOT REQUESTED
          LDDL   T2          SET MALREQF
          STDL   MALREQF
          UJK    CKCREQX     EXIT A = NZ
          EJECT
** NAME-- DOCREQ
*
** PURPOSE-- PROCESS MALET CHANNEL REQUEST IF POSSIBLE
*
          SPACE  2
 DOCREQ   SUBR               ENTRY/EXIT
          LDDL   TIU         CHECK IF ANY SLAVE TABLES STILL IN USE
          LPN    76B         EXCEPT PP TS TABLE
          NJN    DOCREQX     IF YES EXIT
          DCN    DC+40B      INSURE CHANNEL IS INACTIVE
          RJM    CCLOCK      CLEAR CHANNEL LOCK
          LDN    0
          STDL   MALREQF     CLEAR MALET REQUEST FLAG
          PAUSE  25000       GIVE MAINTENANCE PP THE CHANNEL
          LDDL   IDLFLG      CHECK IF PP IS IDLE
          NJN    DOCREQX     IF YES EXIT
*                            RESUME WILL CAUSE INITIALIZATION TESTING
          LDDL   INITFLG     CHECK IF TESTING ALREADY ESTABLISHED
          NJN    DOCREQ5     IF YES
          LDN    3           SET MALET REQUIRED INIT TESTING
          STDL   INITFLG
 DOCREQ5  BSS
          LDML   TS1         ENABLE TESTING
          STDL   CTST
          LJM    MAIN        GO DO TESTING
          EJECT
** NAME-- CKUR
*
** PURPOSE-- CHECK FOR ANY NEW OR CURRENT UNIT REQUESTS
*
** EXIT-- A = 0 IF NO REQUESTS ARE ACTIVE.
*         A = 1 IF CURRENT REQUEST ACTIVE.
*         A = 2 IF NEW LOCKABLE REQUEST IS ACTIVE.
          SPACE  2
 CKUR     SUBR               ENTRY/EXIT
          LDDL   TIU         GET TABLES IN USE
          LPN    76B         MASK WITH SLAVE TABLES USABLE
          ZJN    CKUR20      IF NONE ACTIVE

 CKUR10   RJM    SCANT       SCAN TABLES FOR NEXT ACTIVE ONE
          ZJN    CKUR10      IF NOT THIS ONE
          LDN    1           SET A=1, ACTIVE CURRENT REQUEST
          UJN    CKURX       EXIT

 CKUR20   LDDL   PPREQF      CHECK FOR ACTIVE PP REQUEST
          ADDL   MALREQF     ALSO MALET CHANNEL REQUEST
          ZJN    CKUR30      IF NOT
          LDN    0           SET A=0, DO NOT START ANY NEW REQUESTS
          UJN    CKURX       EXIT

 CKUR30   RJM    SNXTAB      SELECT NEXT SLAVE TS TABLE TO USE
          RJM    SCANAS      SCAN ALL SLAVES FOR A LOCKABLE REQUEST
          ZJN    CKURX       IF NONE ACTIVE, EXIT A=0

          LDN    2           SET A=2, NEW REQUEST TO PROCESS
          UJN    CKURX       EXIT
          EJECT
** NAME-- DOUR
*
** PURPOSE-- PROCESS CURRENT OR NEW UNIT REQUESTS
*
** ENTRY--A = 1 IF CURRENT REQUEST TO BE PROCESSED
*         A = 2 IF NEW REQUEST TO BE PROCESSED
          SPACE  2
 DOUR     BSS                ENTRY
          SBN    1           CHECK FOR CURRENT ACTIVE REQUEST
          NJN    DOUR20      IF NOT

          RJM    RELDTAB     RELOAD CURRENT REQUEST TS TABLE
          LDML   SLB+/SL/P.SIU,SX  GET PROCESSING ADDRESS
          STML   DOURA       STORE JUMP ADDRESS
          LJM    *           GO PROCESS REQUEST
 DOURA    EQU    *-1

 DOUR20   RJM    INITNR      INITIALIZE NEW REQUEST
 DOUR30   SOML   /TS/P.NUMCM,CTST  DECREMENT COMMANDS REMAINING
          LDN    0           DO NOT INCREMENT COMMAND OFFSET
          RJM    NEXTCMD     GET NEXT (FIRST) COMMAND
          EJECT
*         DECODE AND EXECUTE THE NEXT COMMAND
 CMDEXEC  LDN    0
          STML   RPB         CLEAR IPI RESPONSE PACKET LENGTH
          STML   /TS/P.SCOND,CTST  CLEAR LAST STATUS CONDITIONS

          LDML   /TS/P.CURCMD,CTST  GET COMMAND CODE
          SHN    -8          POSITION IT

*         CHECK FOR PHYSICAL FUNCTION COMMAND (20 HEX)
 CMDEX20  SBN    FUNCCMD
          NJN    CMDEX23     IF NOT
          LJM    PFUNC

*         CHECK FOR OUTPUT 8-BIT DATA COMMAND (23 HEX)
 CMDEX23  SBN    PWRTCMD-FUNCCMD
          NJN    CMDEX41     IF NOT
          LJM    OUT8D

*         CHECK FOR LOGICIAL READ COMMAND (41 HEX)
 CMDEX41  SBN    LCREAD-PWRTCMD
          NJN    CMDEX51     IF NOT
          LJM    READ

*         CHECK FOR LOGICIAL WRITE COMMAND (51 HEX)
 CMDEX51  SBN    LCWRITE-LCREAD
          NJN    CMDEX61     IF NOT
          LJM    WRITE

*         CHECK FOR STORE TRANSFER COUNT COMMAND (61 HEX)
 CMDEX61  SBN    LCSTC-LCWRITE
          NJN    CMDEX99     IF NOT
          LJM    STRTC

*         INVLAID COMMAND
 CMDEX99  LDK    E501        INVALID COMMAND CODE
          RJM    SWFAIL      REPORT SOFTWARE FAILURE (NO RETURN)
          EJECT
*         CURRENT COMMAND HAS COMPLETED
 CMDCOMP  BSS
          RJM    ERRCHK      CHECK FOR ERRORS
          NJK    FAIL        IF ERRORS

 NOSTAT   LDML   /TS/P.CURCMD,CTST  CHECK FOR STORE RESPONSE REQUESTED
          LPK    STRSP
          ZJN    NOSTR       IF NOT REQUESTED
          LDML   /TS/P.NUMCM,CTST  CHECK IF THIS IS LAST COMMAND
          ZJN    REQCOMP     IF YES
          RJM    PNR         PREPARE NORMAL RESPONSE
          LDC    R.FLG       SET FLAG CAUSED RESPONSE BIT
          RAML   RS+/RS/P.RC
          RJM    RESP        SEND RESPONSE

 NOSTR    LDML   /TS/P.NUMCM,CTST  CHECK IF MORE COMMANDS
          ZJN    REQCOMP     IF NONE LEFT
          SOML   /TS/P.NUMCM,CTST  DECREMENT COMMANDS LEFT
          LDN    8           INCREMENT COMMAND OFFSET TO GET NEXT COMMAND
          RJM    NEXTCMD     GET NEXT COMMAND
          UJK    CMDEXEC     GO EXECUTE NEXT COMMAND

*         REQUEST HAS BEEN COMPLETED
 REQCOMP  BSS
          RJM    GFS         GET FACILITY ID52 STATUS
          RJM    PNR         PREPARE NORMAL RESPONSE

 FAIL     LJM    IODONE      PROCESS END OF REQUEST
          EJECT
** NAME-- CKINT
*
** PURPOSE-- CHECK FOR ANY ASYNCHRONUS SLAVE INTERRUPTS
*            AND PROCESS THEM
          SPACE  2
 CKINT1   LDML   CKINTA      RESTORE ORIGINAL SLVN AND FACN
          STDL   SLVN
          LDML   CKINTB
          STDL   FACN
          RJM    CLRTS       CLEAR TS TABLE
          LDN    0           CLEAR ASYNCHRONUS PROCESSING FLAG
          STDL   ASYNCP
          LDDL   TIU         CLEAR TS TABLE IN USE
          LPN    73B
          STDL   TIU

 CKINT    SUBR               ENTRY/EXIT

          LDDL   TIU         CHECK IF ANY TS TABLES ARE IN USE
          NJN    CKINTX      IF YES EXIT
          LDN    4           SET TS3 TABLE IN USE
          STDL   TIU
          LDML   TS3         SET CURRENT TS TABLE TO TS3
          STDL   CTST
          STDL   ASYNCP      SET ASYNCHRONUS PROCESSING FLAG
          LDDL   SLVN        SAVE ORIGINAL SLVN AND FACN
          STML   CKINTA
          LDDL   FACN
          STML   CKINTB
          LDN    0           INITIALIZE RPB AND SLAVE NUMBER
          STML   RPB
          STDL   SLVN
          RJM    INTS        INITIALIZE CURRENT TS TABLE
          RJM    MCC         MASTER CLEAR CHANNEL
          UJN    CKINT20     CONT.

 CKINT10  AODL   SLVN        INCREMENT SLAVE NUMBER
          SBN    SLVPCH      CHECK FOR DONE
          ZJK    CKINT1      IF YES

 CKINT20  RJM    SETSX       CHECK IF SLAVE IS CONFIGURED
          ZJN    CKINT10     IF NOT
          LDN    0           INITIALIZE FACILITY NUMBER
          STDL   FACN

 CKINT30  RJM    SETUX       CHECK IF FACILITY IS CONFIGURED
          NJN    CKINT40     IF YES
          AODL   FACN        INCREMENT FACILITY NUMBER
          UJN    CKINT30     TRY NEXT ONE

*         CHECK FOR CLASS 2 INTERRUPTS
 CKINT40  LDN    2           CLASS 2 INTERRUPTS
          RJM    RI          REQUEST INTERRUPTS
          LDML   SELT,SLVN   GET SLAVE ADDRESS MASK
          LPDL   STATUS      MASK WITH ACTIVE SLAVE INTERRUPTS
          ZJN    CKINT50     IF NONE

*         PROCESS CLASS 2 INTERRUPTS
          RJM    SARF        SET ATTRIBUTES REQUIRED FLAG
          LDN    0           NO IPI STATUS IN RESPONSE
          STML   RPB
          RJM    PUR         PREPARE UNSOLICITED RESPONSE
          LDK    E79         UNEXPECTED CLASS 2 INTERRUPT
          STML   RS+/RS/P.ERRID
          LDDL   STATUS      SHOW SLAVE ADDRESSES WITH CLASS 2 INTERRUPTS
          STML   RS+/RS/P.STREG
          RJM    RESP        SEND RESPONSE
          RJM    LIR         LOGICIAL INTERFACE RESET TO CLEAR INTERRUPTS
          UJK    CKINT10     LOOP

*         CHECK FOR CLASS 1 OR 3 INTERRUPTS
 CKINT50  LDN    5           CLASS 1 AND 3 INTERRUPTS
          RJM    RI          REQUEST INTERRUPTS
          LDML   SELT,SLVN   GET SLAVE ADDRESS MASK
          LPDL   STATUS      MASK WITH ACTIVE SLAVE INTERRUPTS
          ZJK    CKINT10     IF NONE

*         PROCESS CLASS 1 OR 3 INTERRUPTS
          RJM    DTM         DETERMINE TRANSFER MODE
          RJM    SEL         SELECT SLAVE
          STDL   CTM         CLEAR CHANGE TRANSFER MODE FLAG
          RJM    RPT         RESPONSE PACKET TRANSFER
          RJM    DCM         DESELECT SLAVE
          LDML   RPB+MAJST   CHECK FOR ASYNC RESPONSE
          SHN    -4
          LPN    0#F
          LMK    AR
          NJN    CKINT60     IF NOT ASYNC RESPONSE
          LDML   RPB+SLAD    CHECK IF FACILITY ASYNC
          LPDL   FF
          LMDL   FF
          NJN    CKINT50     IF YES CHECK FOR OTHER INTERRUPTS
          RJM    SARF        SET ATTRIBUTES REQUIRED FLAG
 CKINT60  RJM    PCER        PREPARE COMMON ERROR RESPONSE
          RJM    RESP        SEND RESPONSE
          UJK    CKINT50     CHECK FOR OTHER INTERRUPTS THIS SLAVE
          SPACE  2
 CKINTA   BSSZ   1           ORIGINAL SLVN
 CKINTB   BSSZ   1           ORIGINAL FACN
          TITLE  COMMAND ROUTINES
** NAME-- IDLE
*
** PURPOSE-- PROCESS PP IDLE COMMAND
*            (LOGICIAL COMMAND 04)
          SPACE  2
 IDLE     BSS                ENTRY
          RJM    CCLOCK      CLEAR THE CHANNEL LOCK
          LDN    76B
          STDL   IDLFLG      SET THE PP IDLE FLAG
          LDN    0           NO IPI STATUS IN RESPONSE
          STML   RPB
          RJM    PNR         PREPARE NORMAL RESPONSE
          LDK    /RS/K.PDN   PP IDLED
          STML   RS+/RS/P.DOWNST
          RJM    RESP        SEND THE RESPONSE
          RJM    CLREQ       CLEAR THE REQUEST
          LJM    MAIN        GO TO MAIN AND WAIT FOR RESUME COMMAND
          EJECT
** NAME-- RESUME
*
** PURPOSE-- PROCESS PP RESUME COMMAND
*            (LOGICIAL COMMAND 05)
*
** NOTE-- RESPONSE TO RESUME COMMAND WILL BE SENT AFTER INITIALIZATION
*         TESTING HAS COMPLETED.
          SPACE  2
 RESUME   BSS                ENTRY
          LDN    0
          STDL   IDLFLG      CLEAR THE PP IDLE FLAG
          LDN    2
          STDL   INITFLG     SET INITIALIZATION FLAG TO RESUME
          LJM    INIT        REINITIALIZE THIS DRIVER
          EJECT
** NAME - PFUNC
*
** PURPOSE - TO PERFORM THE PHYSICAL COMMAND FUNCTION.
*            (LOGICIAL COMMAND 20)
*
** INPUT - PHYSICAL FUNCTION CODE IN CURRENT TS TABLE
*          LOCATION CURCMD+3.
          SPACE  2
 PFUNC    BSS                ENTRY
          LDML   /TS/P.CURCMD+3,CTST  GET FUNCTION CODE TO PROCESS
          LPN    77B         MASK MAJOR FUNCTION CODE BITS
* DECODE ATS FUNCTION CODE
          SBN    F.FU
          NJN    PFUNC10
          LJM    PFORM       IF FORMAT UNIT
 PFUNC10  BSS
          SBN    F.REW-F.FU
          NJN    PFUNC20
          LJM    PREW        IF REWIND/UNLOAD
 PFUNC20  BSS
          SBN    F.SB-F.REW
          NJN    PFUNC30
          LJM    PSPB        IF SPACE BLOCK FWD/REV
 PFUNC30  BSS
          SBN    F.STM-F.SB
          NJN    PFUNC40
          LJM    PSTM        IF SEARCH TAPE MARK FWD/REV
 PFUNC40  BSS
          SBN    F.WTM-F.STM
          NJN    PFUNC50
          LJM    PWTM        IF WRITE TAPE MARK
 PFUNC50  BSS
          SBN    F.ERS-F.WTM
          NJN    PFUNC90
          LJM    PERS        IF ERASE TAPE

*         NON-SUPPORTED COMMAND
 PFUNC90  BSS
          LDK    E501        NON-SUPPORTED COMMAND
          RJM    SWFAIL      REPORT SOFTWARE FAILURE (NO RETURN)
          EJECT
** NAME - OUT8D
*
** PURPOSE - PROCESS THE OUTPUT 8-BIT DATA COMMAND.
*            (LOGICIAL COMMAND 23)
*
** NOTE - THE WRITE COMMAND PACKET HAS ALREADY BEEN SENT BY THE
*         WRITE (LOGICIAL 51) COMMAND. THE TRANSFER NOTIFICATION
*         HAS NOT BEEN RECEIVED YET.
          SPACE  2
 OUT8D    BSS                ENTRY

 O8D05    LDML   /TS/P.WSTNF,CTST  CHECK WSTN FLAG
          NJK    O8D440      IF SET, CONTINUE CURRENT RECORD
          SPACE  2
*         PROCESS IPI INTERRUPTS
 O8D10    LDN    10          SECONDS LIMIT  (INCLUDES ID RETRY)
          RJM    IH          INTERRUPT HANDLER
          SHN    -4          POSITION RESPONSE TYPE
          LPN    0#F         MASK IT
          SBN    1           CHECK FOR COMMAND COMPLETION
          ZJK    O8D600      IF YES
          SBN    4           CHECK FOR TRANSFER NOTIFICATION
          ZJN    O8D20       IF YES
          LDN    0           ELSE MUST BE ASYNCHRONUS RESPONSE
          RJM    CMDRESP     COMMAND RESPONSE DECODE
          UJN    O8D05       LOOP
          SPACE  2
*         INITIALIZE DATA TRANSFER
 O8D20    LDML   /TS/P.WSTNF,CTST CHECK WSTN FLAG
          ZJN    O8D25       IF NOT SET, START NEW RECORD
          LDN    0           CLEAR WSTN FLAG
          STML   /TS/P.WSTNF,CTST
          UJN    O8D30       CONTINUE CURRENT RECORD

 O8D25    RJM    NSI         NON-STOP INITIALIZATION
          LDML   /TS/P.NSCRN,CTST  COMPARE COMMAND REFERENCE NUMBERS
          LMML   RPB+CRN
          ZJN    O8D30       IF OK
          LDK    E76         REPORT UNEXPECTED STATUS
          RJM    PCER        PREPARE COMMON ERROR RESPONSE
          RJM    CMDTERM     COMMAND TERMINATE (NO RETURN)
          SPACE  2
*         START DATA TRANSFER
 O8D30    RJM    SEL         SELECT SLAVE

 O8D40    LDN    DATAOUT     BUS A DATA OUT
          RJM    BCS         BUS CONTROL SEQUENCE
          LDC    H0381       STREAM AND WRITE
          RJM    FUNC
          ACN    DC          ACTIVATE CHANNEL
          LDN    0           CLEAR CURRENT BURST BYTE COUNT
          STML   /TS/P.CBURBC,CTST

*         DETERMINE BURST CHARACTERISTICS
 O8D50    LDML   /TS/P.ILSTP+1,CTST  GET REQUESTED BYTE COUNT THIS PAIR
          STDL   T1          SAVE IT
          ADML   /TS/P.CBURBC,CTST  ADD CURRENT BURST BYTE COUNT
          SBDL   BURSTSZ     SUBTRACT SLAVE BURST SIZE
          ZJN    O8D200      IF TRANSFER IS TO BURST BOUNDARY
          PJN    O8D300      IF TRANSFER IS GREATER THAN BURST BOUNDARY

*         PROCESS TRANSFER OF LESS THAN BURST BOUNDARY
          LDN    0           CLEAR PARTIAL L/A PAIR FLAG
          STML   /TS/P.PARLAP,CTST
          LDDL   T1          GET REQUESTED BYTE COUNT THIS PAIR
          ADN    1           ROUND UP (IF LAST PAIR HAS ODD BYTE COUNT)
          SHN    -1          ADJUST TO CHANNEL WORDS
          STDL   WC          SET CHANNEL WORD COUNT
          LDDL   T1          INCREMENT CURRENT BURST BYTE COUNT
          RAML   /TS/P.CBURBC,CTST
          RJM    OUTPUT      OUTPUT THE DATA
          NJN    O8D400      IF PARTIAL RECORD
          RJM    GETNP       GET NEXT L/A PAIR
          ZJN    O8D400      IF NO MORE L/A PAIRS
          UJN    O8D50       CONTINUE TO OUTPUT

*         PROCESS TRANSFER TO BURST BOUNDARY
 O8D200   LDN    0           CLEAR PARTIAL L/A PAIR FLAG
          STML   /TS/P.PARLAP,CTST
          LDDL   T1          GET REQUESTED BYTE COUNT THIS PAIR
          SHN    -1          ADJUST TO CHANNEL WORDS
          STDL   WC          SET CHANNNEL WORD COUNT
          LDDL   BURSTSZ     INCREMENT CURRENT BURST BYTE COUNT
          STML   /TS/P.CBURBC,CTST
          RJM    OUTPUT      OUTPUT THE DATA
          UJN    O8D400      PROCESS END OF BURST

*         PROCESS TRANSFER OF GREATER THAN BURST BOUNDARY
 O8D300   LDDL   BURSTSZ     COMPUTE BYTE COUNT TO BURST BOUNDARY
          SBML   /TS/P.CBURBC,CTST  DECREMENT BY BYTES TRANSFERED ALREADY
          STML   /TS/P.PARLAP,CTST  SET PARTIAL L/A PAIR FLAG
          SHN    -1          ADJUST TO CHANNEL WORDS
          STDL   WC          SET CHANNEL WORD COUNT
          LDDL   BURSTSZ
          STML   /TS/P.CBURBC,CTST  SET CURRENT BURST BYTE COUNT
          RJM    OUTPUT      OUTPUT THE DATA

*         PROCESS END OF BURST
 O8D400   RJM    WSID        WAIT FOR SLAVE IN TO DROP
          LDML   /TS/P.CBURBC,CTST  CHECK FOR ODD/EVEN TRANSFER
          LPN    1
          ZJN    O8D420      IF EVEN, USE EVEN OCTET MASTER ENDING STATUS
          LDN    ODDOT       ELSE USE ODD OCTET STATUS
 O8D420   RJM    GES         GET ENDING STATUS
          LDDL   STATUS      SAVE SLAVE ENCODED ENDING STATUS
          STML   /TS/P.SLVEES,CTST
          RJM    URECTC      UPDATE RECORD TRANSFER COUNT
          NJN    O8D460      IF PARTIAL RECORD, REPORT ERROR
          LDML   /TS/P.SLVEES,CTST  CHECK FOR END OF RECORD
          LPN    60B         MASK PAUSE AND TDO BITS
          SBN    20B
          ZJN    O8D500      IF END OF RECORD
          RJM    GETNP       GET NEXT L/A PAIR
          ZJN    O8D460      IF NO PAIRS LEFT, REPORT ERROR
          LDML   /TS/P.SLVEES,CTST  CHECK FOR SLAVE PAUSE
          LPN    60B         MASK PAUSE AND TDO BITS
          ZJK    O8D40       IF NO PAUSE
          RJM    DCM         DESELECT SLAVE

 O8D440   RJM    WSTN        WAIT FOR SPECIAL TRANSFER NOTIFICATION
          ZJK    O8D30       IF NEXT BURST IS READY
          UJK    O8D10       ELSE PROCESS OTHER INTERRUPT

 O8D460   LDK    E505        INVALID LENGTH SPECIFICATION
          RJM    SWFAIL      REPORT ERROR (NO RETURN)
          SPACE  2
*         PROCESS END OF RECORD
 O8D500   RJM    DCM         DESELECT SLAVE
          LDML   /TS/P.RTCIP,CTST  INCREMENT RECORD XFER COUNT IN POINTER
          ADN    2
          LPN    7
          STML   /TS/P.RTCIP,CTST
          LDN    2           SEND 2 MORE WRITE COMMANDS IF ANY LEFT
          RJM    GWRT
          UJK    O8D10       WAIT FOR INTERRUPT
          SPACE  2
*         PROCESS COMMAND COMPLETION
 O8D600   AOML   /TS/P.CRN,CTST  INCREMENT COMMAND REFERENCE NUMBER
          SOML   /TS/P.NSWC,CTST  DECREMENT NON-STOP WRITE COUNTER
          RJM    UREQTC      UPDATE REQUEST TRANSFER COUNTS
          LDML   RPB+MAJST   GET MAJOR STATUS
          LMN    CCS         CHECK FOR SUCCESSFUL
          NJN    O8D610      IF NOT
          LDML   /TS/P.CRN,CTST  CHECK THE CRN
          LMML   RPB+CRN
          NJN    O8D620      IF MISCOMPARE
          RJM    GBID        GET AND STORE BLOCK ID
          LJM    CMDCOMP     COMMAND COMPLETE

 O8D610   LDN    1           EXPECT BLOCK ID
          RJM    CMDRESP     COMMAND RESPONSE DECODE (NO RETURN)

 O8D620   LDK    E76         REPORT UNEXPECTED RESPONSE
          RJM    PCER        PREPARE COMMON ERROR RESPONSE
          RJM    CMDTERM     COMMAND TERMINATE (NO RETURN)
          EJECT
** NAME - READ
*
** PURPOSE - PROCESS LOGICAL READ RECORD COMMAND.
*            (LOGICIAL COMMAND 41)
*
** INPUT - THE SECONDARY ADDRESS FIELD OF THE REQUEST HEADER MUST HAVE A
*          MAXIMUM BYTE COUNT IN THE LEAST SIGNIFICANT 32 BITS. THIS
*          BYTE COUNT IS USED FOR THE IPI READ COMMAND EXTENT PARAMETER.
          SPACE  2
 READ     BSS                ENTRY

          LDML   /TS/P.NSRC,CTST  CHECK IF FIRST READ COMMAND
          NJK    READ40      IF NOT
          SPACE  2
*         SEND ALL READ COMMANDS TO SLAVE
          LDML   /TS/P.CRN,CTST  GET COMMAND REFERENCE NUMBER
          STML   /TS/P.NSCRN,CTST  SET NON-STOP COMMAND REFERENCE NUMBER
          ADN    1           INCREMENT IT
          STML   READCP1     SAVE IT
          LDML   /TS/P.SN,CTST  GET ADDRESSEE
          STML   READCP5
          LDML   /TS/P.RQB+/RQ/P.SECADR+2,CTST  GET MAX. BYTE COUNT
          STML   READCP9     SET IN READ COMMAND PACKET
          LDML   /TS/P.RQB+/RQ/P.SECADR+3,CTST
          STML   READCPB
          ADML   READCP9     CHECK IF NON ZERO BYTE COUNT
          NJN    READ10      IF OK
          LDK    E505        INVALID LENGTH SPECIFICATION
          RJM    SWFAIL      REPORT SOFTWARE FAILURE (NO RETURN)

 READ10   LDML   /TS/P.NUMCM,CTST  GET NUMBER OF COMMANDS LEFT
          ADN    1           ADJUST FOR THIS COMMAND
          STDL   P5          SAVE IT
          LDML   /TS/P.LASTC,CTST  BUILD PP COMMAND ADDRESS
          SHN    -1
          ADDL   CTST
          ADK    /TS/P.CQB
          STDL   P6          SAVE IT
          STML   /TS/P.NSCA,CTST  SAVE FIRST NON-STOP COMMAND ADDRESS
          UJN    READ30

 READ20   LDN    8           INCREMENT PP ADDRESS TO NEXT COMMAND
          RADL   P6
          LDIL   P6          GET NEXT COMMAND
          SHN    -8          POSITION COMMAND CODE
          ADK    -LCREAD     CHECK FOR LOGICIAL READ
          NJN    READ40      IF NOT

 READ30   LDC    READCP      COMMAND PACKET FWA
          RJM    CPT         COMMAND PACKET TRANSFER
          AOML   /TS/P.NSRC,CTST  INCREMENT NON-STOP READ COUNTER
          LDDL   P5          DECREMENT COMMANDS LEFT COUNTER
          SBN    2
          STDL   P5
          ZJN    READ40      IF DONE
          AOML   READCP1     INCREMENT COMMAND REFERENCE NUMBER
          UJN    READ20      LOOP
          SPACE  4
*         PROCESS IPI INTERRUPTS
 READ40   LDML   /TS/P.WSTNF,CTST  CHECK WSTN FLAG
          NJK    READ440     IF SET, CONTINUE CURRENT RECORD

 READ50   LDK    100         SECS LIMIT (PARTIAL READ OF MAX 32K PE REC)
          RJM    IH          INTERRUPT HANDLER
          SHN    -4          POSITION RESPONSE TYPE
          LPN    0#F         MASK IT
          SBN    1           CHECK FOR COMMAND COMPLETION
          ZJK    READ600     IF YES
          SBN    4           CHECK FOR TRANSFER NOTIFICATION
          ZJN    READ60      IF YES
          LDN    0           ELSE MUST BE ASYNCHRONUS RESPONSE
          RJM    CMDRESP     COMMAND RESPONSE DECODE
          UJN    READ40      LOOP
          SPACE  2
*         INITIALIZE DATA TRANSFER
 READ60   LDML   /TS/P.WSTNF,CTST  CHECK WSTN FLAG
          ZJN    READ65      IF NOT SET, START NEW RECORD
          LDN    0           CLEAR WSTN FLAG
          STML   /TS/P.WSTNF,CTST
          UJN    READ70      CONTINUE CURRENT RECORD

 READ65   RJM    NSI         NON-STOP INITIALIZATION
          LDML   /TS/P.NSCRN,CTST  COMPARE COMMAND REFERENCE NUMBERS
          LMML   RPB+CRN
          ZJN    READ70      IF OK
          LDK    E76         REPORT UNEXPECTED RESPONSE
          RJM    PCER        PREPARE COMMON ERROR RESPONSE
          RJM    CMDTERM     COMMAND TERMINATE (NO RETURN)
          SPACE  2
*         START DATA TRANSFER
 READ70   RJM    SEL         SELECT SLAVE

 READ80   LDN    DATAIN      BUS A DATA IN
          RJM    BCS         BUS CONTROL SEQUENCE
          LDC    H0A81       STREAM, READ AND DMA(I0)
          RJM    FUNC
          ACN    DC          ACTIVATE CHANNEL
          LDN    0           CLEAR CURRENT BURST BYTE COUNT
          STML   /TS/P.CBURBC,CTST

*         DETERMINE BURST CHARACTERISTICS
 READ90   LDML   /TS/P.ILSTP+1,CTST  GET REQUESTED BYTE COUNT THIS PAIR
          STDL   T1          SAVE IT
          ADML   /TS/P.CBURBC,CTST  ADD CURRENT BURST BYTE COUNT
          SBDL   BURSTSZ     SUBTRACT SLAVE BURST SIZE
          ZJN    READ200     IF TRANSFER IS TO BURST BOUNDARY
          PJN    READ300     IF TRANSFER IS GREATER THAN BURST BOUNDARY

*         PROCESS TRANSFER OF LESS THAN BURST BOUNDARY
 READ100  LDN    0           CLEAR PARTIAL L/A PAIR FLAG
          STML   /TS/P.PARLAP,CTST
          LDDL   T1          GET REQUESTED BYTE COUNT THIS PAIR
          ADN    1           ROUND UP (IF LAST PAIR HAS ODD BYTE COUNT)
          SHN    -1          ADJUST TO CHANNEL WORDS
          STDL   WC          SET CHANNEL WORD COUNT
          SHN    1           INCREMENT CURRENT BURST BYTE COUNT
          RAML   /TS/P.CBURBC,CTST
          RJM    INPUT       INPUT THE DATA
          NJN    READ400     IF PARTIAL RECORD
          RJM    GETNP       GET NEXT L/A PAIR
          ZJN    READ400     IF NO MORE L/A PAIRS
          UJN    READ90      CONTINUE TO INPUT

*         PROCESS TRANSFER TO BURST BOUNDARY
 READ200  LDN    0           CLEAR PARTIAL L/A PAIR FLAG
          STML   /TS/P.PARLAP,CTST
          LDDL   T1          GET REQUESTED BYTE COUNT THIS PAIR
          SHN    -1          ADJUST TO CHANNEL WORDS
          STDL   WC          SET CHANNNEL WORD COUNT
          LDDL   BURSTSZ     INCREMENT CURRENT BURST BYTE COUNT
          STML   /TS/P.CBURBC,CTST
          RJM    INPUT       INPUT THE DATA
          UJN    READ400     PROCESS END OF BURST

*         PROCESS TRANSFER OF GREATER THAN BURST BOUNDARY
 READ300  LDDL   BURSTSZ     COMPUTE BYTE COUNT TO BURST BOUNDARY
          SBML   /TS/P.CBURBC,CTST  DECREMENT BY BYTES TRANSFERED ALREADY
          STML   /TS/P.PARLAP,CTST  SET PARTIAL L/A PAIR FLAG
          SHN    -1          ADJUST TO CHANNEL WORDS
          STDL   WC          SET CHANNEL WORD COUNT
          LDDL   BURSTSZ
          STML   /TS/P.CBURBC,CTST  SET CURRENT BURST BYTE COUNT
          RJM    INPUT       INPUT THE DATA

*         PROCESS END OF BURST
 READ400  RJM    WSID        WAIT FOR SLAVE IN TO DROP
          LDN    0           MASTER ENCODED ENDING STATUS
          RJM    GES         GET ENDING STATUS
          LDDL   STATUS      SAVE SLAVE ENCODED ENDING STATUS
          STML   /TS/P.SLVEES,CTST
          RJM    URECTC      UPDATE RECORD TRANSFER COUNT
          LDML   /TS/P.SLVEES,CTST  CHECK FOR END OF RECORD
          LPN    60B         MASK PAUSE AND TDO BITS
          SBN    20B
          ZJN    READ500     IF END OF RECORD
          RJM    GETNP       GET NEXT L/A PAIR
          ZJN    READ460     IF NO PAIRS LEFT, REPORT ERROR
          LDML   /TS/P.SLVEES,CTST  CHECK FOR SLAVE PAUSE
          LPN    60B         MASK PAUSE AND TDO BITS
          ZJK    READ80      IF NO PAUSE
          RJM    DCM         DESELECT SLAVE

 READ440  RJM    WSTN        WAIT FOR SPECIAL TRANSFER NOTIFICATION
          ZJK    READ70      IF NEXT BURST IS READY
          UJK    READ50      PROCESS OTHER INTERRUPT

 READ460  LDK    E505        INVALID LENGTH SPECIFICATION
          RJM    SWFAIL      REPORT ERROR (NO RETURN)
          SPACE  2
*         PROCESS END OF RECORD
 READ500  RJM    DCM         DESELECT SLAVE
          LDML   /TS/P.RTCIP,CTST  INCREMENT RECORD XFER COUNT IN POINTER
          ADN    2
          LPN    7
          STML   /TS/P.RTCIP,CTST
          UJK    READ50      WAIT FOR INTERRUPT
          SPACE  2
*         PROCESS COMMAND COMPLETION
 READ600  AOML   /TS/P.CRN,CTST  INCREMENT COMMAND REFERENCE NUMBER
          SOML   /TS/P.NSRC,CTST  DECREMENT NON-STOP READ COUNTER
          RJM    UREQTC      UPDATE REQUEST TRANSFER COUNTS
          LDML   RPB+MAJST   GET MAJOR STATUS
          LMN    CCS         CHECK FOR SUCCESSFUL
          NJN    READ610     IF NOT
          LDML   /TS/P.CRN,CTST  CHECK THE CRN
          LMML   RPB+CRN
          NJN    READ620     IF MISCOMPARE
          RJM    GBID        GET AND STORE BLOCK ID
          LJM    CMDCOMP     COMMAND COMPLETE

 READ610  LDN    3           EXPECT BLOCK ID OR TAPE MARK
          RJM    CMDRESP     COMMAND RESPONSE DECODE (NO RETURN)

 READ620  LDK    E76         REPORT UNEXPECTED RESPONSE
          RJM    PCER        PREPARE COMMON ERROR RESPONSE
          RJM    CMDTERM     COMMAND TERMINATE (NO RETURN)
          SPACE  4
*         -READ-  COMMAND PACKET
 READCP   DATA   0#000C      PACKET LENGTH
 READCP1  DATA   0#FFFF      COMMAND REFERENCE NUMBER
          CON    OCREAD+CMCHN+OMRF  OP-CODE, CHAIN AND READ FORWARD
 READCP5  DATA   0#FFFF      ADDRESSEE
          CON    CPSCE       SPECIAL COMMAND EXTENT PARAMETER
 READCP9  DATA   0#FFFF        COUNT FIELD UPPER
 READCPB  DATA   0#FFFF        COUNT FIELD LOWER
          EJECT
** NAME - WRITE
*
** PURPOSE - TO PROCESS LOGICIAL WRITE COMMAND.
*            (LOGICIAL COMMAND 51 MODIFIED)
*
** NOTE-- THE ACTUAL DATA TRANSFER WILL BE DONE IN THE
*         OUTPUT 8-BIT DATA LOGICIAL COMMAND 23.
          SPACE  2
 WRITE    BSS                ENTRY

          LDML   /TS/P.NSWC,CTST  CHECK IF FIRST WRITE COMMAND
          NJN    WRITE10     IF NOT

*         INITIALIZE FIRST GROUP OF NON_STOP WRITE COMMANDS
          LDML   /TS/P.CRN,CTST  GET COMMAND REFERENCE NUMBER
          STML   /TS/P.NSCRN,CTST  SET FIRST-1 NON-STOP CRN
          STML   /TS/P.GNSCRN,CTST  SET WORKING GROUP NON-STOP CRN
          LDML   /TS/P.NUMCM,CTST  GET NUMBER OF COMMANDS LEFT
          ADN    1           ADJUST FOR THIS COMMAND
          STML   /TS/P.GNUMCM,CTST  SAVE AS GROUP NUMBER OF CMDS LEFT
          LDML   /TS/P.LASTC,CTST  BUILD PP COMMAND ADDRESS
          SHN    -1
          ADDL   CTST
          ADK    /TS/P.CQB
          STML   /TS/P.GNSCA,CTST  SAVE AS GROUP NON-STOP PP ADDRESS
          ADN    4           SET FIRST NON-STOP COMMAND ADDRESS
          STML   /TS/P.NSCA,CTST
          LDN    4           SEND 4 WRITE COMMANDS IN FIRST GROUP
          RJM    GWRT        GO SEND THE GROUP
 WRITE10  LJM    CMDCOMP     EXIT
          SPACE  4
 GWRT     SUBR               ENTRY/EXIT
          STDL   P5          SET LOOP COUNTER FROM A
*         INITIALIZE THIS GROUP OF NON-STOP WRITE COMMANDS
 GWRT10   LDML   /TS/P.GNUMCM,CTST  CHECK IF ALL DONE
          ZJN    GWRTX       IF YES
          LDML   /TS/P.GNSCA,CTST  GET PP CMD ADDRESS
          STDL   P6          SET WORKING ADDRESS
          LDIL   P6          GET THE COMMAND
          SHN    -8          POSITION COMMAND CODE
          ADC    -LCWRITE    CHECK FOR LOGICIAL WRITE COMMAND
          NJN    GWRTX       IF NOT
          LDML   /TS/P.SN,CTST  GET ADDRESSEE
          STML   WRTCP5      PUT INTO IPI COMMAND PACKET
          RJM    SEL         SELECT THE SLAVE

*         SEND THIS GROUP OF NON-STOP WRITE COMMANDS
 GWRT20   LDN    2           INCREMENT PP ADDRESS TO BYTE COUNT UPPER
          RADL   P6
          LDIL   P6          GET BYTE COUNT UPPER
          STML   WRTCP9      SET IT
          AODL   P6          INCREMENT PP ADDRESS TO BYTE COUNT LOWER
          LDIL   P6          GET BYTE COUNT LOWER
          STML   WRTCPB      SET IT
          AOML   /TS/P.GNSCRN,CTST  INCREMENT GROUP NON-STOP CRN
          STML   WRTCP1      SET IT
          LDC    WRTCP+BYPSD  COMMAND PACKET FWA PLUS BYPASS PARAMETER
          RJM    CPT         COMMAND PACKET TRANSFER
          LDN    5           INCREMENT PP ADDRESS TO NEXT WRITE COMMAND
          RADL   P6
          AOML   /TS/P.NSWC,CTST  INCREMENT NON-STOP WRITE COUNTER
          LCN    2           DECREMENT GROUP NUMBER OF CMDS LEFT
          RAML   /TS/P.GNUMCM,CTST
          ZJN    GWRT30      IF DONE
          SODL   P5          DECREMENT LOOP COUNTER
          ZJN    GWRT30      IF DONE
          LDIL   P6          GET NEXT COMMAND
          SHN    -8          POSITION COMMAND CODE
          ADC    -LCWRITE    CHECK FOR LOGICIAL WRITE
          ZJN    GWRT20      IF YES

 GWRT30   RJM    DCM         DESELECT SLAVE
          LDDL   P6          SAVE WORKING PP CMD ADDRESS
          STML   /TS/P.GNSCA,CTST
          UJK    GWRTX       EXIT
          SPACE  4
*         -WRITE-  COMMAND PACKET
 WRTCP    DATA   0#000C      PACKET LENGTH
 WRTCP1   DATA   0#FFFF      COMMAND REFERENCE NUMBER
          CON    OCWRITE+CMCHN  OP-CODE AND CHAIN
 WRTCP5   DATA   0#FFFF      ADDRESSEE
          CON    CPCE        COMMAND EXTENT PARAMETER
 WRTCP9   DATA   0#FFFF        COUNT (UPPER)
 WRTCPB   DATA   0#FFFF        COUNT (LOWER)
          EJECT
** NAME - STRTC
*
** PURPOSE - TO PERFORM THE LOGICAL COMMAND STORE TRANSFER COUNT.
*            (LOGICIAL COMMAND 61)
          SPACE  2
 STRTC    BSS                ENTRY
          LDN    0           INITIALIZE DIRECT CELLS
          STDL   T1
          STDL   T2
          LDML   /TS/P.XFER,CTST  GET TRANSFER COUNT
          STDL   T3          MOVE TO DIRECT CELLS
          LDML   /TS/P.XFER+1,CTST
          STDL   T4
          LOADF  /TS/P.CURCMD+2,CTST  LOAD R+A FROM COMMAND
          CWDL   T1          STORE TRANSFER COUNT
          LDN    0           CLEAR TRANSFER COUNTERS
          STML   /TS/P.XFER,CTST
          STML   /TS/P.XFER+1,CTST
          LJM    NOSTAT      COMMAND COMPLETE, NO STATUS TO CHECK
          TITLE  COMMAND SUBROUTINES
** NAME - PFORM
*
** PURPOSE - PERFORM PHYSICAL FUNCTION OF FORMAT UNIT
*            (FUNCTION CODE 004)
*
** INPUT - PHYSICAL FUNCTION CODE IN CURRENT TS TABLE
*          LOCATION CURCMD+3.
*
*          FORMAT FUNCTION PARAMETERS (LIKE ATS) ARE LOCATED IN THE
*          SECONDARY ADDRESS FIELD OF THE PERIPHERAL REQUEST.
          SPACE  2
 PFORM    BSS                ENTRY
          LDDL   CLF         CHECK IF CHANNEL IS ALREADY LOCKED
          ZJN    PFORM10     IF YES
          RJM    SCLOCK      LOCK CHANNEL LOCKWORD IN CHANNEL TABLE
 PFORM10  BSS
          RJM    SLVTST      CHECK FOR SLAVE TESTING REQUIRED
          LDML   SLB+/SL/P.SLVTST,SX  CHECK IF ATTRIBUTES REQUIRED
          ZJN    PFORM20     IF NOT
          LDN    1           ENABLE ERROR CORRECTION
          STML   /TS/P.ECSEL,CTST  SAVE SELECTION
          RJM    ATTRIB      SET ATTRIBUTES
          LDN    0
 PFORM20  BSS
          STML   /TS/P.FACSTA,CTST  CLEAR SPECIAL STATUS
          RJM    GFS         GET FACILITY STATUS TO CHECK FOR BUSY
          LDML   /TS/P.FACSTA+1,CTST  CHECK IF AT BOT
          SHN    17-15
          MJN    PFORM30     IF YES THEN DO DENSITY SELECTION
          LDML   SLB+/SL/P.SLVTST,SX  CHECK IF ATTRIBUTES WERE REQUIRED
          ZJN    PFORM60     IF NOT THEN BYPASS DENSITY SELECTION
 PFORM30  BSS
*         GET PARAMETER WORD 2 BIT 8  (DEFINE DENSITY SELECTION)
          LDML   /TS/P.RQB+/RQ/P.SECADR,CTST
          LPN    1           MASK DEFINE BIT
          ZJN    PFORM40     IF NOT SET USE DEFAULT DENSITY
*         GET PARAMETER WORD 2 BITS 7-6  (DENSITY SELECTION)
          LDML   /TS/P.RQB+/RQ/P.SECADR+1,CTST
          SHN    3           POSITION DENSITY SELECT BITS
          MJN    PFORM40     IF 6250 (GCR) SELECTED
          LDN    1           ELSE USE 1600 (PE) DENSITY
          UJN    PFORM50
 PFORM40  BSS
          LDN    2           USE 6250
 PFORM50  BSS
          STML   /TS/P.DENSEL,CTST  SAVE SELECTION
          RJM    OPMODE      SELECT DENSITY
 PFORM60  BSS
          LDN    0           CLEAR SPECIAL STATUS
          STML   /TS/P.FACSTA,CTST
          STML   SLB+/SL/P.SLVTST,SX  CLEAR TESTING/ATTRIBUTES REQUIRED
          RJM    FACTST      CHECK FOR FACILITY TESTING
          UJK    CMDCOMP     COMMAND COMPLETE
          EJECT
** NAME - PREW
*
** PURPOSE - PERFORM PHYSICAL FUNCTION OF REWIND/UNLOAD
*            (FUNCTION CODE X10)
*             X = 0 10 REWIND
*             X = 1 10 UNLOAD
*
** INPUT - PHYSICAL FUNCTION CODE IN CURRENT TS TABLE
*          LOCATION CURCMD+3.
          SPACE  2
 PREW     BSS                ENTRY
          RJM    RFEL        READ FACILITY ERROR LOG
          RJM    GFS         GET FACILITY STATUS ID52
          LDML   /TS/P.CURCMD+3,CTST  GET PHYSICAL FUNCTION CODE
          SHN    17-6
          MJK    PUNL        IF 110 UNLOAD
          AOML   /TS/P.CRN,CTST  INCREMENT COMMAND REFERENCE NUMBER
          STML   PREWCP1
          LDML   /TS/P.SN,CTST  GET SLAVE/FACILITY ADDRESS
          STML   PREWCP5
          LDC    PREWCP      COMMAND PACKET FWA
          RJM    CPT         COMMAND PACKET TRANSFER
 PREW10   LDN    1           SECONDS LIMIT
          RJM    IH          INTERRUPT HANDLER
          LMN    CCS         CHECK FOR COMMAND COMPLETE SUCCESSFUL
          NJN    PREW20      IF NOT
          RJM    RSEL        READ SLAVE ERROR LOG
          LDN    0           CLEAR RESPONSE PACKET LENGTH
          STML   RPB
          LJM    CMDCOMP     COMMAND COMPLETE
 PREW20   LDN    0           DO NOT EXPECT BLOCK ID
          RJM    CMDRESP     COMMAND RESPONSE DECODE
          UJN    PREW10      IF ASYNC RESPONSE
          SPACE  4
*         -POSITION CONTROL-  COMMAND PACKET
 PREWCP   DATA   0#0009      PACKET LENGTH
 PREWCP1  DATA   0#FFFF      COMMAND REFERENCE NUMBER
          CON    OCPOSC      OP-CODE AND END OF CHAIN
 PREWCP5  DATA   0#FFFF      ADDRESSEE
          CON    CPTP        TAPE POSITION PARAMETER
          DATA   0#0800        REWIND
          EJECT
** NAME - PUNL
*
** PURPOSE - PERFORM PHYSICAL FUNCTION OF 110 UNLOAD
*
** INPUT - PHYSICAL FUNCTION CODE IN CURRENT TS TABLE
*          LOCATION CURCMD+3.
          SPACE  2
 PUNL     BSS                ENTRY
          AOML   /TS/P.CRN,CTST  INCREMENT COMMAND REFERENCE NUMBER
          STML   PUNLCP1
          LDML   /TS/P.SN,CTST  GET SLAVE/FACILITY ADDRESS
          STML   PUNLCP5
          LDC    PUNLCP      COMMAND PACKET FWA
          RJM    CPT         COMMAND PACKET TRANSFER
 PUNL10   LDN    1           SECONDS LIMIT
          RJM    IH          INTERRUPT HANDLER
          LMN    CCS         CHECK FOR COMMAND COMPLETE SUCCESSFUL
          NJN    PUNL20      IF NOT
          RJM    RSEL        READ SLAVE ERROR LOG
          LDN    0           CLEAR RESPONSE PACKET LENGTH
          STML   RPB
          LJM    CMDCOMP     COMMAND COMPLETE
 PUNL20   LDN    0           DO NOT EXPECT BLOCK ID
          RJM    CMDRESP     COMMAND RESPONSE DECODE
          UJN    PUNL10      IF ASYNC RESPONSE
          SPACE  4
*         -POSITION CONTROL-  COMMAND PACKET
 PUNLCP   DATA   0#0009      PACKET LENGTH
 PUNLCP1  DATA   0#FFFF      COMMAND REFERENCE NUMBER
          CON    OCPOSC      OP-CODE AND END OF CHAIN
 PUNLCP5  DATA   0#FFFF      ADDRESSEE
          CON    CPTP        TAPE POSITION PARAMETER
          DATA   0#2000        UNLOAD
          EJECT
** NAME - PSPB
*
** PURPOSE - PERFORM PHYSICAL FUNCTION OF SPACE BLOCK FWD/REV
*            (FUNCTION CODE X13)
*             X = 0 13 SPACE BLOCK FORWARD
*             X = 1 13 SPACE BLOCK BACKWARD
*
** INPUT - PHYSICAL FUNCTION CODE IN CURRENT TS TABLE
*          LOCATION CURCMD+3.
          SPACE  2
 PSPB     BSS                ENTRY
          AOML   /TS/P.CRN,CTST  INCREMENT COMMAND REFERENCE NUMBER
          STML   PSPBCP1
          LDML   /TS/P.SN,CTST  GET SLAVE/FACILITY ADDRESS
          STML   PSPBCP5
          LDML   /TS/P.CURCMD+3,CTST  GET PHYSICAL FUNCTION CODE
          SHN    17-6
          PJN    PSPB10      IF 013 (FORWARD) FUNCTION
          LDC    OCREADV+CMCHN+OMRVR  ELSE 113 (REVERSE)
          UJN    PSPB20      CONT.
 PSPB10   LDC    OCREADV+CMCHN+OMRVF
 PSPB20   STML   PSPBCP3     STORE OP-CODE
          LDC    PSPBCP      COMMAND PACKET FWA
          RJM    CPT         COMMAND PACKET TRANSFER
 PSPB30   LDK    150         SECONDS LIMIT (FULL LENGTH TAPE RECORD)
          RJM    IH          INTERRUPT HANDLER
          LMN    CCS         CHECK FOR COMMAND COMPLETE SUCCESSFUL
          NJN    PSPB40      IF NOT SUCCESSFUL
          RJM    GBID        GET BLOCK ID AND STORE INTO BID TABLE
          LJM    CMDCOMP     GOTO COMMAND COMPLETE
 PSPB40   LDN    3           EXPECT BLOCK ID OR END OF EXTENT (TAPE MARK)
          RJM    CMDRESP     COMMAND RESPONSE DECODE
          UJN    PSPB30      IF ASYNC RESPONSE
          SPACE  4
*         -READ VERIFY-  COMMAND PACKET
 PSPBCP   DATA   0#0006      PACKET LENGTH
 PSPBCP1  DATA   0#FFFF      COMMAND REFERENCE NUMBER
 PSPBCP3  CON    OCREADV+CMCHN+OMRVF   OP-CODE AND CHAIN
 PSPBCP5  DATA   0#FFFF      ADDRESSEE
          EJECT
** NAME - PSTM
*
** PURPOSE - PERFORM PHYSICAL FUNCTION OF SEARCH TAPE MARK FWD/REV
*            (FUNCTION CODE X15)
*             X = 015 SEARCH TAPE MARK FORWARD
*             X = 115 SEARCH TAPE MARK BACKWARD
*
** INPUT - PHYSICAL FUNCTION CODE IN CURRENT TS TABLE
*          LOCATION CURCMD+3.
          SPACE  2
 PSTM     BSS                ENTRY
          AOML   /TS/P.CRN,CTST  INCREMENT COMMAND REFERENCE NUMBER
          STML   PSTMCP1
          LDML   /TS/P.SN,CTST  GET SLAVE/FACILITY ADDRESS
          STML   PSTMCP5
          LDML   /TS/P.CURCMD+3,CTST  GET PHYSICAL FUNCTION CODE
          SHN    17-6
          PJN    PSTM10      IF 015 (FORWARD) FUNCTION
          LDC    OCSPACE+CMCHN+OMSFR  ELSE 115 (BACKWARD)
          UJN    PSTM20      CONT.
 PSTM10   LDC    OCSPACE+CMCHN+OMSFF  OP-CODE FWD AND CHAIN
 PSTM20   STML   PSTMCP3     STORE OP-CODE
          LDC    PSTMCP      COMMAND PACKET FWA
          RJM    CPT         COMMAND PACKET TRANSFER
 PSTM30   LDK    150         SECONDS LIMIT (FULL LENGTH TAPE)
          RJM    IH          INTERRUPT HANDLER
          LMN    CCS         CHECK FOR COMMAND COMPLETE SUCCESSFUL
          NJN    PSTM40      IF NOT
          RJM    TMBID       STORE TAPE MARK BLOCK ID
          LDK    /RS/K.LDLIM  SET LOGICIAL DELIMITER STATUS CONDITION
          STML   /TS/P.SCOND,CTST
          LJM    CMDCOMP     GOTO COMMAND COMPLETE
 PSTM40   LDN    2           EXPECT END OF EXTENT (TAPE MARK)
          RJM    CMDRESP     COMMAND RESPONSE DECODE
          UJN    PSTM30      IF ASYNC RESPONSE
          SPACE  4
*         -SPACE FILE MARK-  COMMAND PACKET
 PSTMCP   DATA   0#0006      PACKET LENGTH
 PSTMCP1  DATA   0#FFFF      COMMAND REFERENCE NUMBER
 PSTMCP3  CON    OCSPACE+CMCHN+OMSFF  OP-CODE AND CHAIN
 PSTMCP5  DATA   0#FFFF      ADDRESSEE
          EJECT
** NAME - PWTM
*
** PURPOSE - PERFORM PHYSICAL FUNCTION OF WRITE TAPE MARK
*            (FUNCTION CODE 051)
*
** INPUT - PHYSICAL FUNCTION CODE IN CURRENT TS TABLE
*          LOCATION CURCMD+3.
          SPACE  2
 PWTM     BSS                ENTRY
          AOML   /TS/P.CRN,CTST  INCREMENT COMMAND REFERENCE NUMBER
          STML   PWTMCP1
          LDML   /TS/P.SN,CTST  GET SLAVE/FACILITY ADDRESS
          STML   PWTMCP5
          LDC    PWTMCP      COMMAND PACKET FWA
          RJM    CPT         COMMAND PACKET TRANSFER
 PWTM10   LDN    10          SECONDS LIMIT (INCLUDES ID RECOVERY)
          RJM    IH          INTERRUPT HANDLER
          LMN    CCS         CHECK FOR COMMAND COMPLETE SUCCESSFUL
          NJN    PWTM20      IF NOT
          RJM    TMBID       STORE TAPE MARK BLOCK ID
          LDK    /RS/K.LDLIM  SET LOGICIAL DELIMITER STATUS CONDITION
          STML   /TS/P.SCOND,CTST
          LJM    CMDCOMP     GOTO COMMAND COMPLETE
 PWTM20   LDN    2           EXPECT END OF EXTENT (TAPE MARK)
          RJM    CMDRESP     COMMAND RESPONSE DECODE
          UJN    PWTM10      IF ASYNC RESPONSE
          SPACE  4
*         -RECORD POSITION-  COMMAND PACKET
 PWTMCP   DATA   0#0009      PACKET LENGTH
 PWTMCP1  DATA   0#FFFF      COMMAND REFERENCE NUMBER
          CON    OCRECP      OP-CODE, NO CHAIN
 PWTMCP5  DATA   0#FFFF      ADDRESSEE
          CON    CPTM        TAPE MARK PARAMETER
          DATA   0#8000        FILE MARK
          EJECT
** NAME - PERS
*
** PURPOSE - PERFORM PHYSICAL FUNCTION OF ERASE TAPE
*            (FUNCTION CODE X52)
*             X = 052 - ERASE GAP
*             X = 252 - DATA SECURITY ERASE
*
** INPUT - PHYSICAL FUNCTION CODE IN CURRENT TS TABLE
*          LOCATION CURCMD+3.
          SPACE  2
 PERS     BSS                ENTRY
          LDML   /TS/P.CURCMD+3,CTST  GET PHYSICAL FUNCTION CODE
          SHN    17-7
          MJK    PDSE        IF 252 DATA SECURITY ERASE FUNCTION
          AOML   /TS/P.CRN,CTST  INCREMENT COMMAND REFERENCE NUMBER
          STML   PERSCP1
          LDML   /TS/P.SN,CTST  GET SLAVE/FACILITY ADDRESS
          STML   PERSCP5
          LDC    PERSCP      COMMAND PACKET FWA
          RJM    CPT         COMMAND PACKET TRANSFER
 PERS10   LDN    10          SECONDS LIMIT (INCLUDES ID RECOVERY)
          RJM    IH          INTERRUPT HANDLER
          LMN    CCS         CHECK FOR COMMAND COMPLETE SUCCESSFUL
          ZJK    CMDCOMP     IF YES, GOTO COMMAND COMPLETE
          LDN    0           DO NOT EXPECT BLOCK ID
          RJM    CMDRESP     COMMAND RESPONSE DECODE
          UJN    PERS10      IF ASYNC RESPONSE
          SPACE  4
*         -ERASE-  COMMAND PACKET
 PERSCP   DATA   0#0006      PACKET LENGTH
 PERSCP1  DATA   0#FFFF      COMMAND REFERENCE NUMBER
          CON    OCERASE+OMGAP  OP-CODE, NO CHAIN AND GAP ERASE
 PERSCP5  DATA   0#FFFF      ADDRESSEE
          EJECT
** NAME - PDSE
*
** PURPOSE - PERFORM PHYSICAL FUNCTION OF DATA SECURITY ERASE
*            (FUNCTION CODE 252)
*
** INPUT - PHYSICAL FUNCTION CODE IN CURRENT TS TABLE
*          LOCATION CURCMD+3.
          SPACE  2
 PDSE     BSS                ENTRY
          RJM    GFS         GET FACILITY STATUS ID52
          AOML   /TS/P.CRN,CTST  INCREMENT COMMAND REFERENCE NUMBER
          STML   PDSECP1
          LDML   /TS/P.SN,CTST  GET SLAVE/FACILITY ADDRESS
          STML   PDSECP5
          LDC    PDSECP      COMMAND PACKET FWA
          RJM    CPT         COMMAND PACKET TRANSFER
 PDSE10   LDN    10          SECONDS LIMIT (INCLUDES ID RECOVERY)
          RJM    IH          INTERRUPT HANDLER
          LMN    CCS         CHECK FOR COMMAND COMPLETE SUCCESSFUL
          NJN    PDSE20      IF NOT
          LDN    0           CLEAR IPI RESPONSE LENGTH
          STML   RPB
          LJM    CMDCOMP     COMMAND COMPLETE
 PDSE20   LDN    0           DO NOT EXPECT BLOCK ID
          RJM    CMDRESP     COMMAND RESPONSE DECODE
          UJN    PDSE10      IF ASYNC RESPONSE
          SPACE  4
*         -ERASE-  COMMAND PACKET
 PDSECP   DATA   0#0006      PACKET LENGTH
 PDSECP1  DATA   0#FFFF      COMMAND REFERENCE NUMBER
          CON    OCERASE+OMDSE  OP-CODE, NO CHAIN AND DSE
 PDSECP5  DATA   0#FFFF      ADDRESSEE
          TITLE  SUPPORT SUBROUTINES
** NAME-- SCANT
*
** PURPOSE-- SCAN TS TABLES
*
** EXIT-- A =  0 NEXT TS TABLE NOT IN USE
*         A = NZ NEXT TS TABLE IN USE
          SPACE  2
 SCANT    SUBR               ENTRY/EXIT
          RJM    SNXTAB      SELECT NEXT SLAVE TS TABLE
          LPDL   TIU         MASK WITH TS TABLES IN USE
          UJN    SCANTX      EXIT
          SPACE  5,20
** NAME-- SNXTAB
*
** PURPOSE-- SELECT NEXT SLAVE TS TABLE
*
** ENTRY-- CTST = CURRENT TS TABLE IN USE
*
** EXIT-- A = NEXT TS TABLE BIT ADDRESS
*         CTST = NEXT TS TABLE INDEX
          SPACE  2
 SNXTAB   SUBR               ENTRY/EXIT
          LDDL   CTST        GET CURRENT TS TABLE IN USE
          SBML   TS1         CHECK IF TS1 IN USE
          ZJN    SNXTAB2     IF TS2 IS NEXT
          ADK    -P.TS       CHECK IF TS2 IN USE
          ZJN    SNXTAB3     IF TS3 IS NEXT
*                            ELSE TS2 IS NEXT

 SNXTAB2  LDN    1           USE TS2 NEXT
          UJN    SNXTAB9     CONT.

 SNXTAB3  LDN    2           USE TS3 NEXT

 SNXTAB9  STDL   T1          SAVE INDEX INTO NEXT TS TABLE TO USE
          LDML   TS1,T1      GET NEXT TS TABLE ADDRESS
          STDL   CTST
          LDML   SELT,T1     USE SLAVE BIT ADDRESS TABLE
          UJN    SNXTABX     EXIT
          SPACE  2
          ERRNZ  2-MCSLV     IF NUMBER OF SLAVE TS TABLES CHANGES
          SPACE  5,20
** NAME-- SCANAS
*
** PURPOSE-- SCAN ALL SLAVES FOR A NEW LOCKABLE REQUEST
*
** EXIT-- A =  0 NO NEW REQUESTS
*         A = NZ NEW REQUEST FOUND, UNIT AND UIT REQUEST QUEUE LOCKED
*
** NOTE-- NREQSN = SLAVE NUMBER THAT HAS REQUEST ACTIVE
*         NREQFN = FACILITY NUMBER THAT HAS REQUEST ACTIVE
          SPACE  2
 SCANAS   SUBR               ENTRY/EXIT
          LDDL   SLVN        START SEARCH FROM LAST SLAVE USED
          LPN    SLVPCH-1    MASK IT
          STML   NREQSN
          LDDL   FACN        START SEARCH FROM LAST FACILITY+1
          ADN    1
          LPN    FACPSL-1    MASK IT
          STML   NREQFN
          LDN    SLVPCH      LOOP COUNT
          STDL   P1

 SCANAS5  LDN    0           DISABLE SCANING SLAVE IF FACILITY LOCKED
          RJM    SCANS       SCAN ALL FACILITITES ON THE SLAVE
          NJN    SCANASX     FOUND ONE, EXIT A=NZ

          SODL   P1          CHECK FOR DONE
          ZJN    SCANASX     IF YES, EXIT A=0

          AOML   NREQSN      INCREMENT TO NEXT SLAVE
          LPN    SLVPCH-1    MASK IT
          STML   NREQSN

          LDN    0           START FROM FIRST FACILITY THIS TIME
          STML   NREQFN

          UJN    SCANAS5     SCAN NEXT SLAVE
          SPACE  2
          ERRNZ  8-FACPSL    IF FACILITIES PER SLAVE CHANGES
          ERRNZ  8-SLVPCH    IF SLAVES PER CHANNEL CHANGES
          SPACE  5,20
** NAME-- SCANS
*
** PURPOSE-- SCAN ALL FACILITIES ON A SLAVE FOR A ACTIVE REQUEST
*
** ENTRY--A =  0 DO NOT SCAN A SLAVE THAT HAS A FACILITY LOCKED
*         A = NZ SCAN A SLAVE THAT HAS A FACILITY LOCKED
*
** EXIT-- A =  0 NO NEW REQUESTS
*         A = NZ NEW REQUEST FOUND, UNIT AND UIT REQUEST QUEUE LOCKED
*
** USES-- T1-T6, P2-P5
*
** NOTE-- NREQSN = SLAVE NUMBER THAT HAS REQUEST ACTIVE
*         NREQFN = FACILITY NUMBER THAT HAS REQUEST ACTIVE
          SPACE  2
 SCANS0   LDN    0           EXIT, NO NEW REQUEST

 SCANS    SUBR               ENTRY/EXIT
          STML   SCANSA      SAVE ENTRY PARAMETER
          LDML   NREQSN      GET SLAVE NUMBER TO SEARCH
          SHN    2           BUILD SLAVE TABLE INDEX
          STDL   P3          P3 = SX INDEX
          LDML   SLB+/SL/P.FBA,P3  CHECK FOR ANY FACILITIES CONFIGURED
          ZJN    SCANSX      IF NONE,  EXIT A=0
          LDML   SCANSA      CHECK IF SCAN IS ENABLED FOR LOCKED FACILITY
          NJN    SCANS5      IF YES, CONTINUE
          LDML   SLB+/SL/P.FACLCK,P3  CHECK IF A FACILITY IS LOCKED
          SHN    -6
          NJN    SCANS0      IF YES, DO NOT SCAN THIS SLAVE

 SCANS5   LDDL   UX          SAVE THE ORIGINAL UX
          STDL   P5          P5 = ORIGINAL UX
          LDN    FACPSL
          STDL   P2          P2 = LOOP COUNT

 SCANS10  LDDL   P3          BUILD UNITS TABLE INDEX
          SHN    3
          STDL   P4
          LDML   NREQFN
          SHN    2
          RADL   P4          P4 = UX INDEX
          LDML   UNITS+/UN/P.LU,P4  CHECK IF FACILITY IS CONFIGURED
          ZJK    SCANS60     IF NOT
          LOADR  UNITS+/UN/P.UIT,P4  LOAD REFORMATTED R+A OF UIT
          ERRNZ  /UIT/C.DSABLE
          CRDL   T1          READ UNIT STATUS INTO T2
          ADN    /UIT/C.NEXT  OFFSET TO NEXT REQUEST RMA
          CRDL   T3          READ NEXT REQUEST RMA WORD
          LDDL   T2          CHECK IF UNIT IS DISABLED
          ERRNZ  /UIT/P.DSABLE-1
          SHN    18-16+/UIT/L.DSABLE
          MJK    SCANS60     IF UNIT IS DISABLED
          LDDL   T5          CHECK HALF 1 OF REQUEST RMA
          ADDL   T6          AND HALF 2 OF REQUEST RMA
          ZJK    SCANS60     IF NO REQUEST
          LDML   SLB+/SL/P.FACLCK,P3  CHECK IF SLAVE HAS A FACILITY LOCKED
          SHN    -6
          ZJN    SCANS20     IF NONE
          LDML   SLB+/SL/P.CURFAC,P3  CHECK IF SAME FACILITY AS SCANED
          LPN    17B
          SBML   NREQFN
          ZJK    SCANS60     IF YES

*         TRY TO LOCK UNIT AND REQUEST QUEUE THEN VERIFY ACTIVE REQUEST
 SCANS20  LDDL   P4          SET UX = P4
          STDL   UX          LOCK ROUTINES USE UX
          RJM    SULOCK      TRY TO SET UNIT LOCKWORD
          NJK    SCANS60     IF COULD NOT GET THE LOCK
          RJM    SQLOCK      TRY TO SET REQUEST QUEUE LOCKWORD
          NJK    SCANS50     IF COULD NOT GET THE LOCK
          LOADR  UNITS+/UN/P.UIT,P4  LOAD REFORMATTED R+A OF UIT
          CRDL   T1          READ UNIT STATUS INTO T2
          ADN    /UIT/C.NEXT  OFFSET TO NEXT REQUEST RMA
          CRDL   T3          READ NEXT REQUEST RMA WORD
          LDDL   T2          VERIFY IF UNIT IS DISABLED
          SHN    18-16+/UIT/L.DSABLE
          MJN    SCANS40     IF UNIT IS DISABLED
          LDDL   T5          VERIFY HALF 1 OF REQUEST RMA
          ADDL   T6          AND HALF 2 OF REQUEST RMA
          ZJK    SCANS40     IF NOT VALID LOCKED REQUEST
          LDN    1           SET FACILITY LOCKED IN SL TABLE
          SHN    6
          STML   SLB+/SL/P.FACLCK,P3
          LDML   NREQFN      SET FACILITY NUMBER LOCKED
          LPN    17B
          RAML   SLB+/SL/P.CURFAC,P3
          LDDL   P5          RESTORE ORIGINAL UX
          STDL   UX
          LDN    1
          UJK    SCANSX      EXIT WITH REQUEST FOUND AND LOCKED, A=NZ

 SCANS40  RJM    CQLOCK      UNLOCK UNIT REQUEST QUEUE LOCKWORD

 SCANS50  RJM    CULOCK      UNLOCK UNIT LOCKWORD

 SCANS60  SODL   P2          CHECK FOR DONE SEARCHING
          ZJN    SCANS70     IF YES
          LDML   NREQFN      INCREMENT FACILITY NUMBER
          ADN    1
          LPN    FACPSL-1    MASK IT
          STML   NREQFN
          UJK    SCANS10     SEARCH AGAIN

 SCANS70  LDDL   P5          RESORE ORIGINAL UX
          STDL   UX
          LDN    0
          UJK    SCANSX      EXIT A=0, NONE FOUND

 SCANSA   BSSZ   1           SAVED ENTRY PARAMETER
          SPACE  2
          ERRNZ  4-P.SL      IF SL CHANGES
          ERRNZ  4-P.UN      IF UN CHANGES
          ERRNZ  32-FACPSL*P.UN  IF UNITS TABLE CHANGES
          ERRNZ  8-FACPSL    IF FACILITIES PER SLAVE CHANGES
          SPACE  4
 NREQSN   DATA   0           NEXT REQUEST SLAVE NUMBER
 NREQFN   DATA   0           NEXT REQUEST FACILITY NUMBER
          SPACE  5,20
** NAME-- NEXTCMD
*
** PURPOSE-- GET THE NEXT COMMAND TO PROCESS
*
** ENTRY-- A = BYTE INCREMENT VALUE FOR LASTC OFFSET
*              0=FIRST COMMAND
*              8=NEXT COMMAND
          SPACE  2
 NEXTCMD  SUBR               ENTRY/EXIT
          RAML   /TS/P.LASTC,CTST  INCREMENT COMMAND OFFSET
          SHN    -1          ADJUST TO PP WORD OFFSET
          ADDL   CTST        BUILD SOURCE ADDRESS
          ADK    /TS/P.CQB
          STML   NXTCA
          LDN    0           INITIALIZE LOOP COUNTER
          STDL   T1
          LDDL   CTST        INITIALIZE DESTINATION ADDRESS INDEX
          STDL   T2

 NXTC10   LDML   *,T1        GET THE NEXT COMMAND
 NXTCA    EQU    *-1
          STML   /TS/P.CURCMD,T2  PUT INTO TS TABLE CURRENT COMMAND
          AODL   T1          CHECK FOR DONE
          SBN    4
          ZJN    NEXTCMDX    IF YES, EXIT
          AODL   T2          INCREMENT DESTINATION ADDRESS INDEX
          UJN    NXTC10      LOOP
          SPACE  5,20
** NAME-- SWITCH
*
** PURPOSE-- SWITCH PROCESSING TO OTHER TS TABLES AS REQUIRED
*
** EXIT-- RETURN TO CALLER IF NO OTHER TS TABLES IN USE,
*         ELSE PROCESS OTHER TS TABLES.
          SPACE  2
 SWITCH   SUBR               ENTRY/EXIT

          LDDL   INITFLG     CHECK FOR INITIALIZATION
          NJN    SWITCHX     IF YES, EXIT

 SWI05    LDML   TNTAB       CHECK NUMBER OF SLAVE TS TABLES SUPPORTED
          SBN    1
          ZJN    SWITCHX     IF ONLY 1, RETURN TO CALLER
          LDML   SWITCH      GET CURRENT CALLERS RETURN ADDRESS
          STML   SLB+/SL/P.SIU,SX  SAVE ADDRESS IN SLAVE IN USE FLAG
          RJM    SAVETAB     SAVE CURRENT TS TABLE DIRECT CELLS

 SWI10    RJM    SCANT       SCAN NEXT SLAVE TS TABLE
          ZJN    SWI20       IF NOT IN USE
          RJM    RELDTAB     RELOAD THIS TS TABLE DIRECT CELLS
          LDML   SLB+/SL/P.SIU,SX  GET RETURN ADDRESS
          STML   SWITCH      STORE AS EXIT ADDRESS
          UJK    SWITCHX     GO PROCESS A TS TABLE

 SWI20    LDDL   ASYNCP      CHECK IF ASYNC PROCESSING
          ADDL   PPREQF       OR PP REQUEST WAITING
          ADDL   MALREQF      OR MALET WANTING THE CHANNEL
          NJN    SWI10       IF YES, BYPASS LOOKING FOR NEW REQUESTS
          RJM    SCANAS      SCAN ALL SLAVES FOR NEW REQUESTS
          ZJN    SWI10       IF NONE
          RJM    INITNR      INITIALIZE THE NEW REQUEST
          LDC    DOUR30      STARTING ADDRESS FOR NEW REQUEST
          STML   SWITCH      SIMULATE A SWITCH CALL FROM NEW REQUEST
          UJK    SWI05       SWITCH TO NEXT TS TABLE

 TNTAB    DATA   0           TOTAL SLAVE TS TABLES SUPPORTED (PLUGGED)
          SPACE  5,20
** NAME-- ERRCHK
*
** PURPOSE-- CHECK FOR ALERT MASK STATUS CONDITIONS
*
** EXIT-- A = 0 IF NO MASKABLE ERRORS
*         A =NZ IF MASKABLE ERRORS
          SPACE  2
 ERRCHK   SUBR               ENTRY/EXIT
          LDML   /TS/P.SCOND,CTST  GET CURRENT STATUS CONDITIONS
          LPML   /TS/P.RQB+/RQ/P.LONGB,CTST  MASK WITH REQUEST ALERT MASK
          ZJN    ERRCHKX     IF NONE, EXIT A=0

          RJM    PAR         PREPARE ABNORMAL RESPONSE
          LDK    /RS/K.ABALRT  SET ABNORMAL ALERT
          STML   RS+/RS/P.ABALRT
          LDML   /TS/P.SCOND,CTST  GET CONDITIONS
          LPML   /TS/P.RQB+/RQ/P.LONGB,CTST  MASK THEM AGAIN
          STML   RS+/RS/P.LNGBLK  SET MASKED ALERT CONDITIONS
          RJM    CDUNIT      CHECK FOR DOWNING UNIT
          LDN    1
          UJN    ERRCHKX     ERROR EXIT, A=NZ
          SPACE  5,20
** NAME-- IODONE
*
** PURPOSE-- PROCESS IO REQUEST DONE
*
** ENTRY-- RESPONSE ALREADY GENERATED AND CDUNIT CALLED
*          IF NEEDED.
*
** EXIT-- *MAIN* IF NO OTHER NEW REQUESTS OR THIS REQUEST
*         IS NOT CHAINED.
*         *DOUR20* IF NEW OR CHAINED REQUEST IS PROCESSABLE.
          SPACE  2
 IODONE   BSS                ENTRY ONLY
          RJM    RESP        SEND THE PREPARED RESPONSE
          RJM    CKPPRQ      CHECK FOR EXISTING OR NEW PP REQUEST
          NJN    IODONE10    IF YES
          RJM    CKCREQ      CHECK FOR EXISTING OR NEW MALET CH REQUEST
          ZJN    IODONE20    IF NOT

 IODONE10 RJM    CLREQ       CLEAR UNIT REQUEST ACTIVE
          LJM    MAIN        GO TO MAIN IDLE LOOP

*         CHECK IF UNIT IS NOW DOWN OR CHAINED REQUEST
 IODONE20 LOADR  UNITS+/UN/P.UIT,UX  LOAD REFORMATTED R+A OF UIT
          ERRNZ  /UIT/C.DSABLE
          CRDL   T1          READ UNIT STATUS INTO T2
          ADN    /UIT/C.NEXT  OFFSET TO NEXT REQUEST RMA
          CRDL   T3          READ NEXT REQUEST RMA WORD
          LDDL   T2          CHECK IF UNIT IS DISABLED
          ERRNZ  /UIT/P.DSABLE-1
          SHN    18-16+/UIT/L.DSABLE
          MJN    IODONE10    IF UNIT IS DISABLED
          LDDL   T5          CHECK HALF 1 OF REQUEST RMA
          ADDL   T6          AND HALF 2 OF REQUEST RMA
          ZJN    IODONE10    IF NO CHAINED REQUEST
          RJM    CFC         CHECK IF FACILITY STILL CHAINED
          STDL   ASYNCP      CLEAR ASYNCHRONUS PROCESSING FLAG
          LDDL   TSLVS       CHECK IF MORE THAN 1 SLAVE CONFIGURED
          SBN    1
          NJK    IODONE60    IF YES

*         CHECK FOR ACTIVE REQUESTS ON OTHER UNITS OF THIS SLAVE
 IODONE30 LDDL   SLVN        PREPARE FOR SCAN
          STML   NREQSN      SLAVE NUMBER TO SCAN
          LDDL   FACN        START SCAN FROM NEXT UNIT NUMBER
          ADN    1
          LPN    FACPSL-1    MASK IT
          STML   NREQFN      FACILITY NUMBER TO SCAN FIRST
          LDN    1           ENABLE SCAN WITH LOCKED FACILITY
          RJM    SCANS       SCAN SLAVE FOR LOCKABLE REQUESTS
          NJK    IODONE40    IF ONE FOUND, PROCESS THE OTHER REQUEST
          RJM    CLRPTS      CLEAR PARTIAL TS TABLE
          RJM    SQLOCK      TRY TO SET UIT REQUEST QUEUE LOCK AGAIN
          NJK    IODONE10    IF COULD NOT SET LOCK
*         VERIFY CHAINED REQUEST WHILE QUEUE IS LOCKED
          LOADR  UNITS+/UN/P.UIT,UX  LOAD REFORMATTED R+A OF UIT
          ERRNZ  /UIT/C.DSABLE
          CRDL   T1          READ UNIT STATUS INTO T2
          ADN    /UIT/C.NEXT  OFFSET TO NEXT REQUEST RMA
          CRDL   T3          READ NEXT REQUEST RMA WORD
          LDDL   T2          CHECK IF UNIT IS DISABLED
          ERRNZ  /UIT/P.DSABLE-1
          SHN    18-16+/UIT/L.DSABLE
          MJK    IODONE10    IF UNIT IS DISABLED
          LDDL   T5          CHECK HALF 1 OF REQUEST RMA
          ADDL   T6          AND HALF 2 OF REQUEST RMA
          ZJK    IODONE10    IF NO CHAINED REQUEST
          RJM    LDTS        LOAD CHAINED REQUEST AND UNLOCK QUEUE
          LDN    70B         SET ASYNCHRONUS PROCESSING FLAG
          STDL   ASYNCP        SO SWITCH WILL NOT START A NEW REQUEST
          RJM    SWITCH      SWITCH, IN CASE ANY WAITING CLASS 2 INTS
          LDN    0           CLEAR ASYNCHRONUS PROCESSING FLAG
          STDL   ASYNCP
          LDML   /TS/P.NUMCM,CTST  DECREMENT NUMBER OF COMMANDS
          SBN    2
          STML   /TS/P.NUMCM,CTST
          LDN    8           BYPASS FORMAT COMMAND
          RJM    NEXTCMD     GET NEXT COMMAND
          LJM    CMDEXEC     GO EXECUTE THE COMMAND

*         PROCESS A DIFFERENT UNIT REQUEST
 IODONE40 RJM    CULOCK      UNLOCK OLD UNIT LOCKWORD
          RJM    CLRPTS      CLEAR PARTIAL TS TABLE
          UJK    DOUR20      GO PROCESS NEW REQUEST

*         CHECK FOR REQUESTS ON OTHER SLAVES
 IODONE60 LDDL   SLVN        START SCAN FROM NEXT SLAVE NUMBER
          ADN    1
          LPN    SLVPCH-1    MASK IT
          STML   NREQSN      SLAVE NUMBER TO SCAN FIRST
          LDN    0           FACILITY NUMBER TO SCAN FIRST
          STML   NREQFN
          LDN    SLVPCH-1    LOOP COUNT MINUS CURRENT SLAVE
          STDL   P1          P1 = LOOP COUNTER

 IODONE70 LDN    0           DISABLE SCAN IF A FACILITY IS LOCKED
          RJM    SCANS       SCAN SLAVE FOR NEW LOCKABLE REQUEST
          ZJN    IODONE80    IF NONE FOUND
          LDML   SLB+/SL/P.FACLCK,SX  CLEAR ORIGINAL FACILITY LOCK
          LPN    17B
          STML   SLB+/SL/P.FACLCK,SX
          UJK    IODONE40    GO PROCESS NEW REQUEST

 IODONE80 SODL   P1          DECRECMENT LOOP COUNT
          ZJK    IODONE30    IF ALL OTHER SLAVES SCANED
          AOML   NREQSN      INCREMENT SLAVE NUMBER
          LPN    SLVPCH-1    MASK IT
          STML   NREQSN
          LDN    0
          STML   NREQFN      START SCAN FROM FACILITY 0
          UJN    IODONE70    LOOP
          ERRNZ  8-FACPSL    IF FACILITIES PER SLAVE CHANGES
          ERRNZ  8-SLVPCH    IF SLAVES PER CHANNEL CHANGES
          SPACE  5,20
** NAME-- CMDRESP
*
** PURPOSE-- COMMAND RESPONSE DECODE
*
** INPUT-- RPB HAS COMMAND RESPONSE PACKET
*          A = 0 DO NOT EXPECT BLOCK ID
*          A = 1 EXPECT BLOCK ID, IF NOT ERROR
*          A = 2 EXPECT END OF EXTENT (TAPE MARK), IF NOT ERROR
*          A = 3 EXPECT EITHER BLOCK ID OR END OF EXTENT, IF NOT ERROR
          SPACE  2
 CMDRESP  SUBR               ENTRY/EXIT
          STML   /TS/P.BIDEF,CTST  SAVE BLOCK ID EXPECTED FLAG
          LDN    0
          STDL   P1          CLEAR ERROR FLAG
          STML   /TS/P.SCOND,CTST  CLEAR ALERT CONDITIONS FLAG
          LDML   RPB+MAJST   DECODE RESPONSE TYPE
          SHN    -4
          LPN    0#F
          SBN    CC          CHECK FOR COMMAND COMPLETION
          ZJN    CMDR100     IF YES
          SBN    AR-CC       CHECK FOR ASYNCHRONUS
          ZJK    CMDR200     IF YES
          SBN    TN-AR       CHECK FOR TRANSFER NOTIFICATION
          ZJK    CMDR300     IF YES
          UJK    CMDR476     UNDEFINED RESPONSE TYPE (E76)
          SPACE  2
*         PROCESS COMMAND COMPLETION RESPONSE TYPE
 CMDR100  LDML   /TS/P.CRN,CTST  COMPARE COMMAND REFERENCE NUMBERS
          LMML   RPB+CRN
          NJK    CMDR476     REPORT UNEXPECTED STATUS (E76)

          LDML   RPB+MAJST   DECODE MAJOR STATUS
          SHN    LSCS        CHECK FOR CONDITIONAL
          PJK    CMDR130     IF NOT
          LDK    ID29        SEARCH FOR FAC CONDITIONAL PARAMETER
          RJM    SFP
          PJN    CMDR110     IF FOUND
          LDK    ID19        ELSE SEARCH FOR SLAVE CONDITIONAL PARAMETER
          RJM    SFP
          PJN    CMDR110     IF FOUND
          UJK    CMDR476     REPORT UNEXPECTED STATUS (E76)

 CMDR110  LDML   RPB+6,T3    DECODE CONDITIONAL OCTETS 1 AND 2
          STDL   T1          SAVE IT
          LPC    0#7002      CHECK FOR ERRORS
          ZJN    CMDR115     IF NOT
          AODL   P1          SET ERROR FLAG

 CMDR115  LDDL   T1          CHECK FOR ON-THE-FLY CORRECTION
          LPN    0#8
          ZJN    CMDR120     IF NOT
          AOML   /TS/P.OTFC,CTST  REPORT ON-THE-FLY CORRECTION

 CMDR120  LDML   RPB+7,T3    DECODE CONDITIONAL OCTETS 3 AND 4
          SHN    -8          POSITION OCTET 3
          STDL   T1          SAVE OCTET 3
          LPN    1           CHECK FOR MASTER TERMINATED TRANSFER
          ZJN    CMDR125     IF NOT
          AODL   P1          SET ERROR FLAG

 CMDR125  LDDL   T1          GET OCTET 3
          LPN    0#10        CHECK FOR EOM WARNING (EOT)
          ZJN    CMDR130     IF NOT
          LDK    /RS/K.PDLIM  SET PHYSICAL DELIMITER IN STATUS CONDITIONS
          RAML   /TS/P.SCOND,CTST

 CMDR130  LDML   RPB+MAJST   CHECK FOR OTHER MAJOR STATUS BITS
          LPC    0#F805
          ZJK    CMDR165     IF NONE

          SHN    LSI         CHECK FOR INCOMPLETE
          PJK    CMDR160     IF NOT
          LDK    ID2A        SEARCH FOR INCOMPLETE PARAMETER
          RJM    SFP
          MJK    CMDR476     IF NOT FOUND REPORT ERROR (E76)

          LDML   RPB+7,T3    DECODE INCOMPLETE OCTETS 3 AND 4
          STDL   T1          SAVE IT
          SHN    -8          POSITION OCTET 3
          LPK    0#8C        CHECK FOR ERRORS
          ZJN    CMDR132     IF NOT
          AODL   P1          SET ERROR FLAG

 CMDR132  LDDL   T1          CHECK FOR BLOCK LENGTH DIFFERENCE
          SHN    -8          POSITION OCTET 3
          LPN    0#10        MASK IT
          ZJN    CMDR140     IF NOT SET
          LDML   RPB+OPCD    CHECK IF READ OPERATION
          SHN    -8          POSITION OP-CODE
          SBN    0#10
          ZJN    CMDR134     IF YES
          AODL   P1          SET ERROR FLAG
          UJN    CMDR140     CONT.

 CMDR134  LDK    ID32        SEARCH FOR RESPONSE EXTENT
          RJM    SFP
          MJK    CMDR476     IF PARAMETER NOT FOUND  (E76)
          LDML   RPB+6,T3    CHECK FOR SHORT OR LONG RECORD
          ADML   RPB+7,T3
          NJN    CMDR140     IF SHORT BLOCK, OK
          LDK    /RS/K.LNGBLK  SET LONG BLOCK IN STATUS CONDITIONS
          RAML   /TS/P.SCOND,CTST

 CMDR140  LDDL   T1          GET OCTET 3 AND 4
          SHN    17-14       CHECK FOR EOM WARNING (EOT)
          PJN    CMDR150     IF NOT
          LDK    /RS/K.PDLIM  SET PHYSICAL DELIMITER IN STATUS CONDITIONS
          RAML   /TS/P.SCOND,CTST

 CMDR150  LDDL   T1          GET OCTETS 3 AND 4
          SHN    17-13       CHECK FOR END OF EXTENT (TM) DETECTED
          PJN    CMDR160     IF NOT
          LDK    /RS/K.LDLIM  SET LOGICIAL DELIMITER IN STATUS CONDITIONS
          RAML   /TS/P.SCOND,CTST

 CMDR160  LDML   RPB+MAJST   CHECK FOR OTHER STATUS BITS
          LPC    0#F800
          ZJN    CMDR162     IF NOT
          AODL   P1          SET ERROR FLAG

 CMDR162  LDML   RPB+MAJST   CHECK FOR COMMAND ABORT
          LPN    1
          ZJN    CMDR165     IF NOT
          AOML   /TS/P.CHAIN,CTST  SET COMMAND CHAINING ABORT FLAG

 CMDR165  LDDL   P1          CHECK IF ERROR FLAG IS SET
          NJK    CMDR400     IF YES, BYPASS TM OR BID
          LDML   /TS/P.BIDEF,CTST  CHECK FOR BID OR TM EXPECTED
          ZJK    CMDR195     IF NOT GOTO COMMAND COMPLETE
          SBN    1           CHECK FOR BID EXPECTED
          ZJN    CMDR170     IF YES
          SBN    1           CHECK FOR END OF EXTENT (TM) EXPECTED
          ZJN    CMDR180     IF YES

          LDML   /TS/P.SCOND,CTST  ELSE EITHER
          LPK    /RS/K.LDLIM
          NJK    CMDR190     IF END OF EXTENT FOUND

 CMDR170  LDK    IDD0        SEARCH FOR BLOCK ID PARAMETER
          RJM    SFP
          MJK    CMDR478     IF NOT FOUND REPORT ERROR (E78)
          RJM    GBID        PUT BLOCK ID INTO TABLE
          UJN    CMDR195     GOTO COMMAND COMPLETE

 CMDR180  LDML   /TS/P.SCOND,CTST  CHECK FOR END OF EXTENT DETECTED
          LPK    /RS/K.LDLIM
          NJK    CMDR190     IF YES
*         CHECK FOR X15 OR 051 ATS PHYSICAL FUNCTIONS
          LDML   /TS/P.CURCMD+3,CTST
          LPC    77B         MASK MAJOR FUNCTION CODE BITS
          SBN    F.STM       CHECK FOR SEARCH TAPE MARK (X15)
          ZJN    CMDR185     IF YES
          SBN    F.WTM-F.STM  CHECK FOR WRITE TAPE MARK (X15)
          NJK    CMDR490     IF NOT, REPORT ERROR (E90)

 CMDR185  LDK    /RS/K.LDLIM  SET LOGICIAL DELIMITER IN STATUS CONDITIONS
          RAML   /TS/P.SCOND,CTST

 CMDR190  RJM    TMBID       SET END OF EXTENT IN BLOCK ID TABLE

 CMDR195  LDDL   P1          CHECK IF ERROR FLAG IS SET
          NJN    CMDR400     IF YES
          LJM    CMDCOMP     ELSE,  GOTO COMMAND COMPLETE
          SPACE  4
*         PROCESSING ASYNCHRONUS RESPONSE TYPE
 CMDR200  BSS
          LDML   RPB+SLAD    CHECK FOR FACILITY ASYNC RESPONSE
          LPDL   FF
          LMDL   FF
          NJK    CMDRESPX    IF YES, RETURN TO CALLER
          RJM    PCER        PREPARE COMMON ERROR RESPONSE
          LDK    R.UNS       CHANGE TO UNSOLICITED
          STML   RS+/RS/P.RC
          LDN    0           SET LOGICIAL UNIT NUMBER = 0
          STML   RS+/RS/P.LU
          RJM    RESP        SEND RESPONSE
          UJK    CMDRESPX    NOW RETURN TO CALLER
          SPACE  4
*         PROCESS TRANSFER NOTIFICATION RESPONSE TYPE
 CMDR300  UJN    CMDR476     REPORT UNEXPECTED STATUS (E76)
          SPACE  4
*         ERROR CODES
 CMDR400  LDN    E00         CPU MUST DETERMINE
          UJN    CMDR500

 CMDR476  LDK    E76         UNEXPECTED STATUS
          UJN    CMDR500

 CMDR478  LDDL   P1          CHECK IF ERROR FLAG IS SET
          NJN    CMDR400     IF YES
          LDK    E78         ELSE, NO BLOCK ID RETURNED
          UJN    CMDR500

 CMDR490  LDDL   P1          CHECK IF ERROR FLAG IS SET
          NJN    CMDR400     IF YES
          LDK    E90         ELSE, NO END OF EXTENT STATUS

 CMDR500  RJM    PCER        PREPARE COMMON ERROR RESPONSE
          LDML   /TS/P.SCOND,CTST  GET CURRENT STATUS CONDITIONS
          LPML   /TS/P.RQB+/RQ/P.LONGB,CTST  MASK WITH REQUEST ALERT MASK
          ZJN    CMDR510     IF NONE ACTIVE

          STML   RS+/RS/P.LNGBLK  SET MASKED CONDITIONS

          LDK    /RS/K.ABALRT  SET ABNORMAL ALERT BIT
          STML   RS+/RS/P.ABALRT

 CMDR510  LDDL   P1          CHECK IF ERROR FLAG IS SET
          ZJN    CMDR520     IF NOT
          LDML   RS+/RS/P.ERRID  CHECK IF ERROR ID IS NONZERO
          NJN    CMDR520     IF YES

          LDK    /RS/K.HDWR  SET HARDWARE MALFUNCTION BIT
          RAML   RS+/RS/P.ABALRT

 CMDR520  RJM    CMDTERM     COMMAND TERMINATE  (NO RETURN)
          SPACE  5,20
** NAME-- ATTRIB
*
** PURPOSE-- SEND ATTRIBUTE COMMAND TO SLAVE
*
** INPUT-- (/TS/P.ECSEL,CTST) =
*              0 DO NOTHING
*              1 ERROR CORRECTION ENABLED
*              2 ERROR CORRECTION DISABLED
*
** NOTE-- IF A SUBROUTINE CALLS THIS SUBROUTINE IT MUST SAVE ITS RETURN
*         ADDRESS BECAUSE A TS TABLE SWITCH WILL OCCUR.
          SPACE  2
 ATT1     LDML   /TS/P.SATTR,CTST  RESTORE RETURN ADDRESS
          STML   ATTRIB

 ATTRIB   SUBR               ENTRY/EXIT
          LDML   ATTRIB      SAVE RETURN ADDRESS
          STML   /TS/P.SATTR,CTST
          LDML   /TS/P.ECSEL,CTST  CHECK FOR SELECTION
          ZJN    ATTRIBX     IF NOT DEFINED EXIT
          SBN    1
          ZJN    ATT10       IF ERROR CORRECTION ENABLED
          LDC    0#8000      DISABLE ERROR CORRECTION PARAM
          UJN    ATT20       CONT.
 ATT10    LDC    0#C000      ENABLE ERROR CORRECTION PARAM
 ATT20    STML   ATTCP9      STORE PARAMETER
          AOML   /TS/P.CRN,CTST  INCREMENT COMMAND REFERENCE NUMBER
          STML   ATTCP1
          LDML   /TS/P.SN,CTST  GET SLAVE ADDRESS
          SHN    -8
          SHN    8
          ADDL   FF          NO FACILITY ADDRESS
          STML   ATTCP5
          LDC    ATTCP       COMMAND PACKET FWA
          RJM    CPT         COMMAND PACKET TRANSFER
 ATT30    LDN    1           SECONDS LIMIT
          RJM    IH          INTERRUPT HANDLER
          LMN    CCS         CHECK FOR COMMAND COMPLETE SUCCESSFUL
          ZJK    ATT1        IF YES, EXIT
          LDN    0           DO NOT EXPECT BLOCK ID
          RJM    CMDRESP     COMMAND RESPONSE DECODE
          UJN    ATT30       IF ASYNC RESPONSE
          SPACE  4
*         -ATTRIBUTES-  COMMAND PACKET
 ATTCP    DATA   0#0025      PACKET LENGTH
 ATTCP1   DATA   0#FFFF      COMMAND REFERENCE NUMBER
          CON    OCATT+OMAL  OP-CODE, LOAD AND NO CHAINING
 ATTCP5   DATA   0#FFFF      ADDRESSEE (NO FACILITY)
          CON    CPSRB       SLAVE RECONFIGURATION BIT PARAMETER
 ATTCP9   DATA   0#FF00        C000=EC ENABLED, 8000=EC DISABLED
          CON    CPSRF       SLAVE RECONFIGURATION FIELD PARAMETER
          DATA   0,0,0,0       OCTETS 01-08
          DATA   0,0,0,0              09-10
 ATTCP1D  CON    BURST                11-12 GENERATE CLASS 2 INTERRUPTS
          DATA   0                    13-14
 ATTCP21  CON    BURST                15-16 DATA BURST SIZE
          CON    CPBID       ENABLE/DISABLE BID PARAMETER
          DATA   0#8000        BID ENABLED
          SPACE  5,20
** NAME-- OPMODE
*
** PURPOSE-- SEND OPMODE COMMAND TO SLAVE/FACILITY
*
** INPUT-- (/TS/P.DENSEL,CTST) =
*              0 DO NOTHING
*              1 SELECT 1600 (PE) OPERATION
*              2 SELECT 6250 (GCR) OPERATION
*
** NOTE-- IF A SUBROUTINE CALLS THIS SUBROUTINE IT MUST SAVE ITS RETURN
*         ADDRESS BECAUSE A TS TABLE SWITCH WILL OCCUR.
          SPACE  2
 OPM1     LDML   /TS/P.SOPMO,CTST  RESTORE RETURN ADDRESS
          STML   OPMODE

 OPMODE   SUBR               ENTRY/EXIT
          LDML   OPMODE      SAVE RETURN ADDRESS
          STML   /TS/P.SOPMO,CTST
          LDML   /TS/P.DENSEL,CTST  CHECK FOR SELECTION
          ZJN    OPMODEX     IF NOT DEFINED EXIT
          SBN    1
          ZJN    OPM10       IF 1600 (PE)
          LDC    0#030C      SET 6250 (GCR) PARAMETERS
          STML   OPMCP13
          LDC    0#186A
          STML   OPMCP15
          UJN    OPM20       CONT.
 OPM10    LDC    0#0607      SET 1600 (PE) PARAMETERS
          STML   OPMCP13
          LDC    0#0640
          STML   OPMCP15
 OPM20    AOML   /TS/P.CRN,CTST  INCREMENT COMMAND REFERENCE NUMBER
          STML   OPMCP1
          LDML   /TS/P.SN,CTST  GET SLAVE/FACILITY ADDRESS
          STML   OPMCP5
          LDC    OPMCP       COMMAND PACKET FWA
          RJM    CPT         COMMAND PACKET TRANSFER
 OPM30    LDN    1           SECONDS LIMIT
          RJM    IH          INTERRUPT HANDLER
          LMN    CCS         CHECK IF COMMAND COMPLETE SUCCESSFUL
          ZJK    OPM1        IF YES, EXIT
          LDN    0           DO NOT EXPECT BLOCK ID
          RJM    CMDRESP     COMMAND RESPONSE DECODE
          UJN    OPM30       IF ASYNC RESPONSE
          SPACE  4
*         -OPERATING MODE-  COMMAND PACKET
 OPMCP    DATA   0#0016      PACKET LENGTH
 OPMCP1   DATA   0#FFFF      COMMAND REFERENCE NUMBER
          CON    OCOM+CMCHN+OMOMS  OP-CODE, CHAIN AND SET
 OPMCP5   DATA   0#FFFF      ADDRESSEE
          CON    CPTMB       TAPE MODE BIT PARAMETER
          DATA   0#0000
          DATA   0#0100        DISABLE COMPRESSION
          CON    CPTMF       TAPE MODE FIELD PARAMETER
          DATA   0#0000
          DATA   0#0000
 OPMCP13  DATA   0#FFFF        PE=0607, GCR=030C
 OPMCP15  DATA   0#FFFF        PE=0640, GCR=186A
          SPACE  5,20
** NAME-- GBID
*
** PURPOSE-- GET BLOCK ID FROM RESPONSE PACKET
*            AND STORE INTO CURRENT TS BIDB BUFFER.
          SPACE  2
 GBID     SUBR               ENTRY/EXIT
          LDK    IDD0        FIND BLOCK ID PARAMETER IN RESPONSE PACKET
          RJM    SFP         SEARCH FOR PARAMETER
          MJN    GBID10      IF NOT FOUND
          LDK    /TS/P.BIDB  BUILD DESTINATION ADDRESS
          ADDL   CTST        CURRENT TS TABLE BASE ADDRESS
          ADML   /TS/P.BIDBP,CTST  BLOCK ID BUFFER POINTER
          STML   GBIDA       SET DESTINATION ADDRESS
          LDML   RPB+6,T3    GET BLOCK ID VALUE
          SHN    3           POSITION IT LIKE ATS BID
          STML   *           PUT INTO BLOCK ID BUFFER
 GBIDA    EQU    *-1
          AOML   /TS/P.BIDBP,CTST  INCREMENT POINTER
          UJN    GBIDX       EXIT

 GBID10   RJM    PAR         PREPARE ABNORMAL RESPONSE
          LDK    E78         NO BLOCK ID PARAMETER RETURNED
          STML   RS+/RS/P.ERRID
          RJM    CMDTERM     TERMINATE COMMAND (NO RETURN)
          SPACE  5,10
** NAME-- CFC
*
** PURPOSE-- CHECK FOR CHAINING STILL ACTIVE
*
** EXIT-- A = 0
*
** NOTE-- IF A SUBROUTINE CALLS THIS SUBROUTINE IT MUST SAVE ITS RETURN
*         ADDRESS BECAUSE A TS TABLE SWITCH WILL OCCUR.
          SPACE  2
 CFC      SUBR               ENTRY/EXIT
          LDML   /TS/P.CHAIN,CTST  GET CHAIN FLAG
          ZJN    CFCX        IF NOT ACTIVE EXIT
          STDL   ASYNCP      SET ASYNCHRONUS PROCESSING FLAG
          LDML   CFC         SAVE RETURN ADDRESS
          STML   /TS/P.SCFC,CTST
          RJM    LIR         LOGICIAL INTERFACE RESET TO CLEAR CHAINING
          LDML   /TS/P.SCFC,CTST  RESTORE RETURN ADDRESS
          STML   CFC
          LDN    0           CLEAR RESPONSE PACKET LENGTH
          STML   RPB
          UJN    CFCX        EXIT
          SPACE  5,20
** NAME-- TMBID
*
** PURPOSE-- SET TAPE MARK BLOCK ID INTO BLOACK ID BUFFER.
          SPACE  2
 TMBID    SUBR               ENTRY/EXIT
          LDK    /TS/P.BIDB  BUILD DESTINATION ADDRESS
          ADDL   CTST        CURRENT TS TABLE BASE ADDRESS
          ADML   /TS/P.BIDBP,CTST  BLOCK ID BUFFER POINTER
          STML   TMBIDA      SET DESTINATION ADDRESS
          LDN    0#01        TAPE MARK IDENTIFIER
          STML   *           PUT INTO BLOCK ID BUFFER
 TMBIDA   EQU    *-1
          AOML   /TS/P.BIDBP,CTST  INCREMENT POINTER
          UJN    TMBIDX      EXIT
          SPACE  5,20
** NAME-- GFS
*
** PURPOSE-- GET FACILITY STATUS ID52 FOR RESPONSE.
*
** NOTE-- IF A SUBROUTINE CALLS THIS SUBROUTINE IT MUST SAVE ITS RETURN
*         ADDRESS BECAUSE A TS TABLE SWITCH WILL OCCUR.
          SPACE  2
 GFS1     LDML   /TS/P.SGFS,CTST  RESTORE RETURN ADDRESS
          STML   GFS

 GFS      SUBR               ENTRY/EXIT
          LDML   /TS/P.FACSTA,CTST  CHECK IF ALREADY SET
          NJN    GFSX        IF YES
          LDML   GFS         SAVE RETURN ADDRESS
          STML   /TS/P.SGFS,CTST
          AOML   /TS/P.CRN,CTST  INCREMENT COMMAND REFERENCE NUMBER
          STML   GFSCP1
          LDML   /TS/P.SN,CTST  ADDRESSEE
          STML   GFSCP5
          SHN    -8          BUILD SLAVE PARAMETER
          SHN    8
          ADDL   FF
          STML   GFSCP9
          LDC    GFSCP       COMMAND PACKET FWA
          RJM    CPT         COMMAND PACKET TRANSFER

 GFS10    LDN    1           SECONDS LIMIT
          RJM    IH          INTERRUPT HANDLER
          LMN    CCS         CHECK FOR SUCCESSFUL
          ZJN    GFS20       IF YES
          LDN    0           DO NOT EXPECT BID
          RJM    CMDRESP     COMMAND RESPONSE DECODE
          UJN    GFS10       IF ASYNC RESPONSE

 GFS20    LDK    ID52        LOCATE PARAM 52
          RJM    SFP         SEARCH FOR PARAMETER
          MJN    GFS30       IF NOT FOUND
          LDML   RPB+5,T3    SAVE PARAMETERS IN TS TABLE
          STML   /TS/P.FACSTA,CTST
          LDML   RPB+6,T3
          STML   /TS/P.FACSTA+1,CTST
          LDN    0           CLEAR RESPONSE PACKET LENGTH
          STML   RPB
          UJK    GFS1        EXIT

 GFS30    LDK    E76         REPORT UNEXPECTED STATUS
          RJM    PCER        PREPARE COMMON ERROR RESPONSE
          RJM    CMDTERM     COMMAND TERMINATE (NO RETURN)
          SPACE  2,10
*         -REPORT ADDRESSEE STATUS-  COMMAND PACKET
 GFSCP    DATA   0#000B      PACKET LENGTH
 GFSCP1   DATA   0#FFFF      COMMAND REFERENCE NUMBER
          CON    OCRAS+OMRASC  OP-CODE AND CONDITION
 GFSCP5   DATA   0#FFFF      ADDRESSEE
          CON    CPPM        PORT MASK PARAMETER
 GFSCP9   DATA   0#00FF        SLAVE ADDRESS
          DATA   0#0100        PORT MASK
          SPACE  5,20
** NAME-- RSEL
*
** PURPOSE-- READ SLAVE ERROR LOG TO PREVENT IT
*            FROM OVERFLOWING.
*
** NOTE-- IF A SUBROUTINE CALLS THIS SUBROUTINE IT MUST SAVE ITS RETURN
*         ADDRESS BECAUSE A TS TABLE SWITCH WILL OCCUR.
          SPACE  2
 RSEL1    LDML   /TS/P.SRSEL,CTST  RESTORE RETURN ADDRESS
          STML   RSEL

 RSEL     SUBR               ENTRY/EXIT
          LDML   RSEL        SAVE RETURN ADDRESS
          STML   /TS/P.SRSEL,CTST
          LDML   RELCP3      CLEAR CHAINING COMMON MODIFIER
          LPC    0#FF0F
          STML   RELCP3
          LDML   /TS/P.SN,CTST  GET SLAVE ADDRESS
          SHN    -8
          SHN    8
          ADDL   FF          NO FACILITY ADDRESS
          STML   RELCP5
          RJM    REL         READ THE SLAVE ERROR LOG
          UJN    RSEL1       EXIT
          SPACE  4,15
** NAME-- RFEL
*
** PURPOSE-- READ FACILITY ERROR LOG TO PREVENT IT
*            FROM OVERFLOWING.
*
** NOTE-- IF A SUBROUTINE CALLS THIS SUBROUTINE IT MUST SAVE ITS RETURN
*         ADDRESS BECAUSE A TS TABLE SWITCH WILL OCCUR.
          SPACE  2
 RFEL1    LDML   /TS/P.SRFEL,CTST  RESTORE RETURN ADDRESS
          STML   RFEL

 RFEL     SUBR               ENTRY/EXIT
          LDML   RFEL        SAVE RETURN ADDRESS
          STML   /TS/P.SRFEL,CTST
          LDML   RELCP3      SET CHAINING COMMON MODIFIER
          LPC    0#FF0F
          ADN    CMCHN
          STML   RELCP3
          LDML   /TS/P.SN,CTST  GET SLAVE/FACILITY ADDRESS
          STML   RELCP5
          RJM    REL         READ THE FACILITY ERROR LOG
          UJN    RFEL1       EXIT
          SPACE  5,20
** NAME-- NSI
*
** PURPOSE-- NON-STOP INITIALIZATION FOR READ OR OUTPUT 8-BIT DATA COMMANDS.
*
** INPUT-- (/TS/P.NSCA,CTST) HAS CURRENT PP COMMAND ADDRESS TO SET UP.
*
** OUTPUT-- (/TS/P.ILSTL,CTST) HAS NUMBER OF INDIRECT LENGTH/ADDRESS PAIRS
*           (/TS/P.ILSTA,CTST) HAS RMA (UNFORMATTED) OF INDIRECT LEN/ADD PAIR
*           (/TS/P.ILSTP,CTST) HAS INDIRECT LENGTH/ADDRESS PAIR
*           (/TS/P.NSCRN,CTST) HAS UPDATED NON-STOP CMD REFERENCE NUMBER
*           ((/TS/P.RTCB,CTST)+(/TS/P.RTCIP,CTST)) REC XFER COUNT CLEARED
*
** NOTE-- IF THE COMMAND DOES NOT HAVE THE INDIRECT ADDRESS BIT SET, THE
*         COMMAND LENGTH/ADDRESS IS MOVED INTO (/TS/P.ILSTP,CTST) AND
*         (/TS/P.ILSTL,CTST) IS SET TO 1. (/TS/P.ILSTA,CTST) IS NOT SET.
          SPACE  2
 NSI10    AODL   P4          INCREMENT PP ADDRESS
          LDIL   P4          GET NUMBER OF PAIRS
          SHN    -3
          STML   /TS/P.ILSTL,CTST
          AODL   P4          INCREMENT PP ADDRESS
          LDIL   P4          SET RMA OF FIRST PAIR
          STML   /TS/P.ILSTA,CTST
          AODL   P4
          LDIL   P4
          STML   /TS/P.ILSTA+1,CTST
          LDK    /TS/P.ILSTP  BUILD CRML PP ADDRESS
          ADDL   CTST
          STML   NSIA
          LOADF  /TS/P.ILSTA,CTST  SET R+A OF FIRST PAIR
          CRML   *,ONE       READ THE FIRST INDIRECT LEN/ADD PAIR
 NSIA     EQU    *-1

 NSI20    LDN    8           INCREMENT TO NEXT NON-STOP COMMAND ADDRESS
          RAML   /TS/P.NSCA,CTST


 NSI      SUBR               ENTRY/EXIT


          LDK    /TS/P.RTCB  BUILD CURRENT REC XFER COUNT ADDRESS
          ADDL   CTST
          ADML   /TS/P.RTCIP,CTST  INCREMENT WITH IN POINTER
          STML   NSIB        SAVE IT (UPPER HALF)
          ADN    1           BUILD LOWER HALF ADDRESS
          STML   NSIC
          LDN    0           CLEAR CURRENT REC XFER COUNTER
          STML   *           UPPER HALF
 NSIB     EQU    *-1
          STML   *           LOWER HALF
 NSIC     EQU    *-1

          AOML   /TS/P.NSCRN,CTST  UPDATE NON-STOP COMMAND REFERENCE NUMBER
          LDML   /TS/P.NSCA,CTST  GET NON-STOP COMMAND PP ADDRESS
          STDL   P4          SAVE IT
          LDIL   P4          GET COMMAND
          LPC    INDFLG      CHECK FOR INDIRECT BIT
          NJK    NSI10       IF YES

*         ELSE PROCESS DIRECT
          LDN    1           SET NUMBER OF PAIRS
          STML   /TS/P.ILSTL,CTST
          AODL   P4          INCREMENT PP ADDRESS
          LDIL   P4          GET LENGTH/ADDRESS
          STML   /TS/P.ILSTP+1,CTST
          AODL   P4
          LDIL   P4
          STML   /TS/P.ILSTP+2,CTST
          AODL   P4
          LDIL   P4
          STML   /TS/P.ILSTP+3,CTST
          UJK    NSI20       EXIT
          SPACE  5,20
** NAME-- URECTC
*
** PURPOSE-- UPDATE RECORD TRANSFER COUNT
*
** INPUT-- (/TS/P.CBURBC,CTST) = CURRENT BURST BYTE COUNT
*          (/TS/P.RESBC,CTST)  = RESIDUAL BYTE COUNT
*          (/TS/P.SLVEES,CTST) = SLAVE ENCODED ENDING STATUS
*          (/TS/P.RTCIP,CTST)  = REC XFER COUNT BUFFER IN POINTER
*
** OUTPUT--(/TS/P.RTCB,CTST)+IN POINTER=UPDATED BY ACTUAL TRANSFER COUNT
*           A = 0  ALL DATA TRANSFERED
*               NZ RESIDUAL BYTE COUNT
          SPACE  2
 URECTC   SUBR               ENTRY/EXIT
          LDML   /TS/P.CBURBC,CTST  GET CURRENT BURST BYTE COUNT
          SBML   /TS/P.RESBC,CTST  DECREMENT BY RESIDUAL BYTE COUNT
          STDL   T1          SAVE IT
          LDML   /TS/P.SLVEES,CTST  CHECK FOR ODD OR EVEN TRANSFER
          LPN    0#F
          LMN    0#F
          NJN    URECTC2     IF EVEN TRANSFER
          SODL   T1          DECREMENT COUNT BY 1 ON ODD TRANSFERS

 URECTC2  LDK    /TS/P.RTCB  BUILD REC XFER COUNTER BUFFER ADDRESS
          ADDL   CTST
          ADML   /TS/P.RTCIP,CTST  ADJUST WITH IN POINTER
          STML   URECTCA     SAVE UPPER HALF ADDRESS
          ADN    1
          STML   URECTCB     SAVE LOWER HALF ADDRESS

          LDDL   T1          GET CURRENT TRANSFER COUNT
          RAML   *           UPDATE LOWER HALF
 URECTCB  EQU    *-1
          SHN    -16         ADJUST FOR CARRY BIT
          RAML   *           UPDATE UPPER HALF
 URECTCA  EQU    *-1

          LDML   /TS/P.RESBC,CTST  (A) = RESIDUAL BYTE COUNT
          UJN    URECTCX     EXIT
          SPACE  5,20
** NAME-- UREQTC
*
** PURPOSE-- UPDATE REQUEST TRANSFER COUNT
*
** INPUT-- (/TS/P.RTCB,CTST)+OUT POINTER = THIS RECORD XFER COUNT
*
** OUTPUT--(/TS/P.XFER,CTST) UPDATED BY RECORD TRANSFER COUNT
          SPACE  2
 UREQTC   SUBR               ENTRY/EXIT

          LDK    /TS/P.RTCB  BUILD RECORD XFER COUNT BUFFER ADDRESS
          ADDL   CTST
          ADML   /TS/P.RTCOP,CTST  ADJUST WITH OUT POINTER
          STML   UREQTCB     SAVE UPPER HALF ADDRESS
          ADN    1
          STML   UREQTCA     SAVE LOWER HALF ADDRESS

          LDML   *           GET RECORD XFER COUNT LOWER
 UREQTCA  EQU    *-1
          RAML   /TS/P.XFER+1,CTST  UPDATE REQUEST XFER COUNT LOWER
          SHN    -16         ADJUST FOR CARRY BIT
          ADML   *           ADD RECORD XFER COUNT UPPER
 UREQTCB  EQU    *-1
          RAML   /TS/P.XFER,CTST  UPDATE REQUEST XFER COUNT UPPER

          LDML   /TS/P.RTCOP,CTST  INCREMENT OUT POINTER
          ADN    2
          LPN    7
          STML   /TS/P.RTCOP,CTST

          UJN    UREQTCX     EXIT
          SPACE  5,30
** NAME-- GETNP
*
** PURPOSE-- GET NEXT LENGTH/ADDRESS PAIR
*
** INPUT-- (/TS/P.PARLAP,CTST) = PARTIAL L/A PAIR FLAG
*
** OUTPUT--(/TS/P.ILSTL,CTST) INDIRECT L/A PAIR LENGTH DECREMENTED
*          (/TS/P.ILSTA,CTST) INDIRECT L/A PAIR RMA UPDATED
*          (/TS/P.ILSTP,CTST) NEW INDIRECT L/A PAIR
*           A =  0 NO MORE L/A PAIRS
*               NZ VALID L/A PAIR
          SPACE  2
 GETNP    SUBR               ENTRY/EXIT
          LDML   /TS/P.PARLAP,CTST  CHECK FOR PARTIAL L/A PAIR
          NJN    GETNP10     IF YES
          SOML   /TS/P.ILSTL,CTST  DECREMENT NUMBER OF L/A PAIRS
          ZJN    GETNPX      EXIT IF NONE LEFT
          LDN    8           UPDATE L/A PAIR (UNFORMATTED) RMA
          RAML   /TS/P.ILSTA+1,CTST
          SHN    -16
          RAML   /TS/P.ILSTA,CTST
          LDK    /TS/P.ILSTP  BUILD CRML PP ADDRESS
          ADDL   CTST
          STML   GETNPA
          LOADF  /TS/P.ILSTA,CTST  SET R+A OF NEXT PAIR
          CRML   *,ONE       GET THE NEXT L/A PAIR
 GETNPA   EQU    *-1
          LDN    1           SET A = NZ
          UJN    GETNPX      EXIT

*         PROCESS PARTIAL L/A PAIR STILL ACTIVE
 GETNP10  STDL   T1          SAVE BYTES ALREADY USED FROM THIS PAIR
          LDML   /TS/P.ILSTP+1,CTST  DECREMENT L/A PAIR DATA LENGTH
          SBDL   T1
          STML   /TS/P.ILSTP+1,CTST
          LDDL   T1          INCREMENT L/A PAIR DATA (UNFORMATTED) RMA
          RAML   /TS/P.ILSTP+3,CTST
          SHN    -16
          RAML   /TS/P.ILSTP+2,CTST
          LDN    2           SET A = NZ
          UJK    GETNPX      EXIT
          SPACE  5,20
** NAME-- WSTN
*
** PURPOSE-- WAIT FOR SPECIAL TRANSFER NOTIFICATION
*
** NOTE -- THE SLAVE ONLY GENERATES A CLASS 2 RESPONSE
*          PACKET ON THE FIRST TRANSFER NOTIFICATION.
*
*          IF A SUBROUTINE CALLS THIS SUBROUTINE IT MUST SAVE ITS RETURN
*          ADDRESS BECAUSE A TS TABLE SWITCH WILL OCCUR.
*
** EXIT -- A =  0  SPECIAL CLASS 2 INTERRUPT ACTIVE
*            = NZ  CLASS 1 OR 3 INTERRUPT ACTIVE
*          WSTNF IS SET WITH (A) ON EXIT
          SPACE  2
 WSTN1    STML   /TS/P.WSTNF,CTST  SET WSTN FLAG WITH EXIT VALUE

 WSTN     SUBR               ENTRY/EXIT
          LDN    10          SECONDS LIMITS (INCLUDES ID RECOVERY)
          STML   /TS/P.SECLIM,CTST
          RJM    UC          UPDATE THE TIME CLOCK
          LDDL   CLSEC       SET CURRENT TIME IN SECONDS
          STML   /TS/P.CLK,CTST
          LDML   WSTN        SAVE RETURN ADDRESS
          STML   /TS/P.SWSTN,CTST

 WSTN10   RJM    SWITCH      SWITCH TO OTHER TS TABLES
          LDML   /TS/P.SWSTN,CTST  RESTORE RETURN ADDRESS
          STML   WSTN
          LDN    2           REQUEST CLASS 2 INTERRUPT
          RJM    RI          REQUEST INTERRUPTS
          LDML   SELT,SLVN   CHECK IF INTERRUPT IS FROM THIS SLAVE
          LPDL   STATUS
          ZJN    WSTN15      IF NOT
          LDN    0
          UJN    WSTN1       EXIT A = 0

 WSTN15   LDN    5           REQUEST CLASS 1 OR 3 INTERRUPTS
          RJM    RI          REQUEST INTERRUPTS
          LDML   SELT,SLVN   CHECK IF INTERRUPT IS FROM THIS SLAVE
          LPDL   STATUS
          ZJN    WSTN20      IF NONE ACTIVE
          LDN    1
          UJK    WSTN1       CLASS 1 OR 3 ACTIVE, EXIT A = NZ

 WSTN20   RJM    UC          UPDATE THE TIME CLOCK
          LDDL   CLSEC       GET CURRENT SECONDS
          SBML   /TS/P.CLK,CTST  ELAPSED SECONDS
          PJN    WSTN30      IF CLOCK HAS NOT WRAPPED
          ADK    0#10000

 WSTN30   SBML   /TS/P.SECLIM,CTST  CHECK IF TIME LIMIT EXPIRED
          MJK    WSTN10      IF NOT
          LDK    E38         NO SLAVE INTERRUPT
          RJM    PCER        PREPARE COMMON ERROR RESPONSE
          RJM    EP          ERROR PROCESSING (NO RETURN)
          SPACE  5,20
** NAME-- SPLOCK
*
** PURPOSE-- SETS THE PP REQUEST QUEUE LOCK IN THE
*            PP INTERFACE TABLE.
*
** EXIT-- A REGISTER = 0, IF LOCK WAS SUCCESSFULLY SET.
*                     NZ, IF LOCK WAS NOT SET.
          SPACE  2
 SPLOCK   SUBR               ENTRY/EXIT
          LDK    CM.PIT      PP INTERFACE TABLE ADDRESS
          STDL   T7
          LDK    /PIT/C.LOCK OFFSET OF PP QUEUE LOCKWORD
          STDL   T5
          RJM    LOCK        SET THE LOCKWORD
          UJK    SPLOCKX
          SPACE  5,15
** NAME-- CPLOCK
*
** PURPOSE-- CLEARS THE PP REQUEST QUEUE LOCK IN THE
*            PP INTERFACE TABLE.
          SPACE  2
 CPLOCK   SUBR               ENTRY/EXIT
          LDK    CM.PIT      PP INTERFACE TABLE ADDRESS
          STDL   T7
          LDK    /PIT/C.LOCK OFFSET OF PP QUEUE LOCKWORD
          STDL   T5
          RJM    CLOCK       CLEAR THE LOCKWORD
          UJK    CPLOCKX
          SPACE  5,15
** NAME-- SULOCK
*
** PURPOSE-- SETS UNIT LOCKWORD IN UNIT INTERFACE TABLE
*
** EXIT-- A REGISTER = 0, IF LOCK WAS SUCCESSFULLY SET.
*                     NZ, IF LOCK WAS NOT SET.
          SPACE  2
 SULOCK   SUBR               ENTRY/EXIT
          LDK    UNITS+/UN/P.UIT  BUILD ADDRESS OF UIT
          ADDL   UX          INCREMENT BY THE INDEX
          STDL   T7          CURRENT UNIT INTERFACE TABLE ADDRESS
          LDK    /UIT/C.ULOCK  OFFSET OF UNIT LOCKWORD
          STDL   T5
          RJM    LOCK        SET LOCKWORD
          UJK    SULOCKX
          SPACE  5,15
** NAME-- CULOCK
*
** PURPOSE-- CLEARS UNIT LOCKWORD IN UNIT INTERFACE TABLE.
          SPACE  2
 CULOCK   SUBR               ENTRY/EXIT
          LDK    UNITS+/UN/P.UIT  BUILD ADDRESS OF UIT
          ADDL   UX          INCREMENT BY THE INDEX
          STDL   T7          CURRENT UNIT INTERFACE TABLE ADDRESS
          LDK    /UIT/C.ULOCK  OFFSET OF UNIT LOCKWORD
          STDL   T5
          RJM    CLOCK       CLEAR THE LOCKWORD
          UJK    CULOCKX
          SPACE  5,15
** NAME-- SQLOCK
*
** PURPOSE-- SETS THE QUEUE LOCK IN THE UNIT INTERFACE TABLE.
*
** EXIT-- A REGISTER = 0, IF LOCK WAS SUCCESSFULLY SET.
*                     NZ, IF LOCK WAS NOT SET.
          SPACE  2
 SQLOCK   SUBR               ENTRY/EXIT
          LDK    UNITS+/UN/P.UIT  BUILD ADDRESS OF UIT
          ADDL   UX          INCREMENT BY THE INDEX
          STDL   T7          CURRENT UNIT INTERFACE TABLE ADDRESS
          LDK    /UIT/C.QLOCK  OFFSET OF QUEUE LOCKWORD
          STDL   T5
          RJM    LOCK        SET LOCKWORD
          UJK    SQLOCKX
          SPACE  5,15
** NAME-- CQLOCK
*
** PURPOSE-- CLEARS THE QUEUE LOCK IN THE UNIT INTERFACE TABLE.
          SPACE  2
 CQLOCK   SUBR               ENTRY/EXIT
          LDK    UNITS+/UN/P.UIT  BUILD ADDRESS OF UIT
          ADDL   UX          INCREMENT BY THE INDEX
          STDL   T7          CURRENT UNIT INTERFACE TABLE ADDRESS
          LDK    /UIT/C.QLOCK OFFSET OF QUEUE LOCKWORD
          STDL   T5
          RJM    CLOCK       CLEAR THE LOCKWORD
          UJK    CQLOCKX
          SPACE  5,15
** NAME-- SCLOCK
*
** PURPOSE-- SETS THE CHANNEL LOCK.
*
** NOTE-- THIS ROUTINE WILL ONLY RETURN WHEN THE CHANNEL LOCK IS OBTAINED.
          SPACE  2
 SCLOCK   SUBR               ENTRY/EXIT

 SCL10    BSS
          LDK    CM.CHAN     CM ADDRESS OF CHANNEL INTERLOCK TABLE
          STDL   T7
          LDDL   CURCH       CHANNEL NUMBER IS OFFSET IN TABLE
          STDL   T5
          RJM    LOCK        SET LOCKWORD
          NJN    SCL10       IF LOCK WAS NOT SET
          STDL   CLF         CHANNEL LOCK FLAG = LOCKED NOW
          UJK    SCLOCKX     EXIT, LOCK WAS SET
          SPACE  5,15
** NAME-- CCLOCK
*
** PURPOSE-- CLEARS CHANNEL LOCK.
          SPACE  2
 CCLOCK   SUBR               ENTRY/EXIT
          LDDL   CLF         CHECK IF CHANNEL IS LOCKED
          NJN    CCLOCKX     IF NOT RETURN
          LDK    CM.CHAN     CM ADDRESS OF CHANNEL INTERLOCK TABLE
          STDL   T7
          STDL   CLF         CHANNEL LOCK FLAG = NOT LOCKED
          LDDL   CURCH       CHANNEL NUMBER = OFFSET IN TABLE
          STDL   T5
          RJM    CLOCK       CLEAR CHANNEL LOCKWORD
          UJK    CCLOCKX     EXIT
          SPACE  5,30
** NAME-- LOCK
*
** PURPOSE-- SET A LOCKWORD IN CENTRAL MEMORY.
*
** ENTRY--
*         T7 = THE ADDRESS OF THE 3 DIRECT CELLS WHICH CONTAIN
*              THE REFORMATED ADDRESS OF THE CENTRAL MEMORY
*              INTERFACE TABLE.
*         T5 = THE CENTRAL MEMORY WORD OFFSET WITHIN THE
*              INTERFACE TABLE OF THE LOCKWORD.
*
** EXIT--
*         A REGISTER = 0, IF THE LOCK WAS SET.
*         A REGISTER .NE. O, IF THE LOCK COULD NOT BE SET.
*
** USES-- T1-T7
*
** ALGORITHM
*         1. WRITE THE INTERMEDIATE VALUE OF FFFF FFFF 0000 0000,
*            USING A RDSL INSTRUCTION.
*            (SET T1 - T4 = FFFF FFFF 0000 0000,
*            RDSL   T1)
*
*         2. AFTER EXECUTION OF 'RDSL T1',
*            IF T1 - T2 = FFFF FFFF,
*            THEN GO BACK AND EXECUTE STEP 1,
*            ELSE GO TO STEP 3.
*
*         3. IF T1 = 0, WRITE THE PP LOCKWORD TO CENTRAL MEMORY,
*            AS DESCRIBED IN THIS STEP.  ELSE IF T1 .NE. 0, GO TO
*            STEP 4.
*            TO WRITE THE PP LOCKWORD ID:
*            SET T1 - T4 = 8000 0000 0000 PPNO, WHERE PPNO IS THE
*            LOGICAL PP NUMBER OF THIS PP.
*            CWDL   T1.
*            SET THE A REGISTER = 0, AND EXIT.
*
*         4. IF T1 = 8000 AND T4 = PPNO, THIS LOCKWORD WAS ALREADY
*            RESERVED TO THIS PP.
*            RESTORE THE CENTRAL MEMORY LOCATION  (CWDL   T1).
*            SET THE A REGISTER = 0, AND EXIT.
*
*         5. IF T4 .NE. PPNO, THEN THIS LOCKWORD IS RESERVED TO
*            A DIFFERENT PROCESSOR.
*            SET BIT 16 OF THE LOCKWORD THAT WAS READ WITH THE
*            RDSL INSTRUCTION, AND WRITE THE CONTENTS BACK TO
*            CENTRAL MEMORY.
*            THE PURPOSE OF SETTING BIT 16 IS TO REQUEST THE
*            OTHER PROCESSOR TO GIVE UP THE LOCKWORD.
*            LDDL   T2
*            LPC    77777B
*            ADC    100000B
*            STDL   T2
*            CWDL   T1.
*            SET THE A REGISTER .NE. 0, AND EXIT.
          SPACE  4
 LOCK     SUBR               ENTRY/EXIT

* WRITE INTERMEDIATE VALUE OF FFFF FFFF 0000 0000.

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

* CHECK IF RDSL INSTRUCTION WAS SUCCESSFUL.

          LDDL   T1
          ADDL   T4
          ZJN    LOCK40      IF LOCK CAN BE SET

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

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

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

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

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

* SET THE LOCKWORD.

 LOCK40   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    LOCK30      EXIT, A REGISTER = 0
          SPACE  5,20
** NAME-- CLOCK
*
** PURPOSE-- CLEAR A LOCKWORD IN CENTRAL MEMORY.
*
** ENTRY--
*         T7 = THE ADDRESS OF THE 3 DIRECT CELLS WHICH CONTAIN
*              THE REFORMATED ADDRESS OF THE CENTRAL MEMORY
*              INTERFACE TABLE.
*         T5 = THE CENTRAL MEMORY WORD OFFSET WITHIN THE
*              INTERFACE TABLE OF THE LOCKWORD.
*
** EXIT--
*         A REGISTER = 0, IF THE LOCK WAS CLEARED.
*         A REGISTER .NE. O, IF THE LOCK WAS NOT CLEARED.
*
** USES-- T1-T7
*
** ALGORITHM
*         1. WRITE THE INTERMEDIATE VALUE OF FFFF FFFF 0000 0000,
*            USING A RDSL INSTRUCTION.
*            (SET T1 - T4 = FFFF FFFF 0000 0000,
*            RDSL   T1)
*
*         2. AFTER EXECUTION OF 'RDSL T1',
*            IF T1 - T2 = FFFF FFFF,
*            THEN GO BACK AND EXECUTE STEP 1,
*            ELSE GO TO STEP 3.
*
*         3. IF T4 .NE. PPNO, THIS LOCKWORD IS RESERVED TO A
*            DIFFERENT PROCESSOR.
*            RESTORE THE CONTENTS OF THIS CENTRAL MEMORY LOCATION
*            AS IT EXISTED BEFORE THE VALUE FFFF FFFF XXXX XXXX
*            WAS WRITTEN.
*            CWDL   T1.
*            SET THE A REGISTER .NE. 0, AND EXIT.
*
*         4. IF T4 = PPNO, THEN CLEAR THE LOCKWORD IN CENTRAL MEMORY.
*            SET T1 - T4 = 0000 0000 0000 0000.
*            CWDL   T1.
*            SET THE A REGISTER = 0, AND EXIT.
          SPACE  4
 CLOCK    SUBR               ENTRY/EXIT

* WRITE INTERMEDIATE VALUE OF FFFF FFFF 0000 0000.

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

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

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

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

* RESTORE THE ORIGINAL CONTENTS.

          LDDL   T6          CM ADDRESS OF UNIT LOCK.
          LMC    400000B
          CWDL   T1          RESTORE THE ORIGINAL CONTENTS
          LDN    1
 CLK20    UJK    CLOCKX      EXIT, A REGISTER NONZERO

* CLEAR THE LOCKWORD.

 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    CLK20       EXIT, A REGISTER = 0
          SPACE  5,20
** NAME-- SWFAIL
*
** PURPOSE-- REPORT A SOFTWARE FAILURE AND TERMINATE A REQUEST.
*
** ENTRY-- A REGISTER HAS INTERFACE ERROR CODE
*
** EXIT-- TO MAIN IDLE LOOP.
          SPACE  2
 SWFAIL   BSSZ   1           ENTRY ONLY  NO RETURN
          STDL   T7          SAVE ERRID VALUE
          LDN    0           NO IPI STATUS IN RESPONSE
          STML   RPB
          RJM    PAR         PREPARE ABNORMAL RESPONSE
          LDDL   T7
          STML   RS+/RS/P.IEC  INTERFACE ERROR CODE
          LDK    /RS/K.INTERR  INTERFACE ERROR
          STML   RS+/RS/P.INTERR
          LDK    E120        SOFTWARE FAILURE
          STML   RS+/RS/P.ERRID
          RJM    CMDTERM     COMMAND TERMINATE  (NO RETURN)
          SPACE  5,20
** NAME-- SETSX
*
** PURPOSE-- SET SLAVE TABLE INDEX
*
** INPUT--SLVN CONTAINS CURRENT SLAVE ADDRESS
*
** OUTPUT-- SX SET
*           A = FACILITIES CONFIGURED ON THIS SLAVE
          SPACE  3
 SETSX    SUBR               ENTRY/EXIT
          LDDL   SLVN        GET SLAVE NUMBER
          SHN    2           POSITION IT
          STDL   SX          SET IT
          LDML   SLB+/SL/P.FBA,SX  GET CONFIGURED FACILITIES ON THIS SLAVE
          UJK    SETSXX      EXIT
          SPACE  2
          ERRNZ  4-P.SL      IF SL ENTRY IS NOT 4 PP WORDS LONG
          SPACE  5,20
** NAME-- SETUX
*
** PURPOSE-- SET UNITS TABLE INDEX
*
** INPUT--FACN CONTAINS CURRENT FACILITY ADDRESS
*         SX MUST ALREADY BE SET
*
** OUTPUT--UX SET
*          A = LOGICIAL UNIT NUMBER
          SPACE  2
 SETUX    SUBR               ENTRY/EXIT
          LDDL   SX          START WITH SLAVE OFFSET
          SHN    3           REPOSITION IT
          STDL   UX
          LDDL   FACN        GET FACILITY NUMBER
          SHN    2           POSITION IT
          RADL   UX          MERGE IT
          LDML   UNITS+/UN/P.LU,UX  GET LOGICIAL UNIT NUMBER
          UJK    SETUXX      EXIT
          SPACE  2
          ERRNZ  4-P.UN      IF UN ENTRY IS NOT 4 PP WORDS LONG
          ERRNZ  32-FACPSL*P.UN  IF MAX FACILITIES PER SLAVE IS NOT 8
          SPACE  5,20
** NAME-- INITNR
*
** PURPOSE-- INITIALIZE NEW UNIT REQUEST
*
** INPUT--NREQSN = NEW SLAVE NUMBER
*         NREQFN = NEW FACILITY NUMBER
*         CTST   = NEW TS TABLE INDEX
          SPACE  2
 INITNR   SUBR               ENTRY/EXIT
          LDN    0           CLEAR ASYNCHRONUS PROCESSING FLAG
          STDL   ASYNCP
          STML   RPB         CLEAR IPI RESPONSE PACKET BUFFER
          LDML   NREQSN      INIT SLVN
          STDL   SLVN
          RJM    SETSX       INIT SX INDEX
          LDML   NREQFN      INIT FACN
          STDL   FACN
          RJM    SETUX       INIT UX INDEX
          LDC    UNITS+/UN/P.UIT  BUILD POINTER TO UIT REFORMATTED RMA
          ADDL   UX
          STDL   T7          T7 = POINTER TO UIT RMA
          RJM    LDTS        LOAD TS TABLE WITH REQUEST FROM UIT
          LDDL   CTST        CHECK WHICH TS TO USE
          SBML   TS2
          NJN    INITNR1     IF NOT TS2
          LDDL   TIU         SET TS2 BIT IN TS TABLES IN USE
          LPN    75B
          ADN    2
          UJN    INITNR9     CONT.
 INITNR1  BSS
          LDDL   TIU         SET TS3 BIT IN TS TABLES IN USE
          LPN    73B
          ADN    4
 INITNR9  BSS
          STDL   TIU         SAVE UPDATED TS TABLES IN USE
          RJM    INTS        INIT TS TABLE
          UJK    INITNRX     EXIT
          SPACE  5,20
** NAME-- CLREQ
*
** PURPOSE-- CLEAR THE CURRENT REQUEST FROM THE ACTIVE TS TABLE
*            AND UNLOCK UNIT LOCKWORD.
*
** NOTE-- IF A SUBROUTINE CALLS THIS SUBROUTINE IT MUST SAVE ITS RETURN
*         ADDRESS BECAUSE A TS TABLE SWITCH WILL OCCUR.
          SPACE  2
 CLREQ1   LDML   /TS/P.SCLREQ,CTST  RESTORE RETURN ADDRESS
          STML   CLREQ
          RJM    CLRTS       CLEAR TS TABLE

 CLREQ    SUBR               ENTRY/EXIT
          LDML   CLREQ       SAVE RETURN ADDRESS
          STML   /TS/P.SCLREQ,CTST
          LDDL   CTST        CLR TS TABLE IN USE BIT
          SBML   TS1
          ZJN    CLREQ10     IF PP TABLE IN USE
          ADK    -P.TS
          ZJN    CLREQ20     IF TS2 IN USE
          UJN    CLREQ30     IF TS3 IN USE
 CLREQ10  BSS
          LDN    0
          STDL   TIU         CLEAR ALL TS TABLES IN USE
          STDL   ASYNCP      CLEAR ASYNCHRONUS PROCESSING FLAG
          UJN    CLREQ1      EXIT
 CLREQ20  BSS
          RJM    CFC         CHECK FOR CHAINING STILL
          LDDL   TIU         CLEAR TS2 IN USE
          LPN    75B
          UJN    CLREQ90     CONT.
 CLREQ30  BSS
          RJM    CFC         CHECK FOR CHAINING STILL
          LDDL   TIU         CLEAR TS3 IN USE
          LPN    73B
 CLREQ90  BSS
          STDL   TIU         RESTORE TIU
          RJM    CULOCK      UNLOCK UNIT LOCKWORD IN UIT
          LDN    0
          STDL   ASYNCP      CLEAR ASYNCHRONUS PROCESSING FLAG
          STML   RPB         CLR ACTIVE IPI RESPONSE LENGTH
          STML   SLB+/SL/P.SIU,SX  CLR SLAVE IN USE FLAG
          LDML   SLB+/SL/P.FACLCK,SX  CLEAR FACILITY LOCKED FLAG
          LPN    77B
          STML   SLB+/SL/P.FACLCK,SX
          UJK    CLREQ1      EXIT
          SPACE  2
          ERRNZ  2-MCSLV     IF NUMBER OF CONCURRENT SLAVE TS TABLES CHANGE
          SPACE  5,20
** NAME-- SAVETAB
*
** PURPOSE-- SAVE THE CURRENT TS TABLE FOR USE LATER
*
** INPUT--CTST = CURRENT TS TABLE IN USE
          SPACE  2
 SAVETAB  SUBR               ENTRY/EXIT
          LDK    /TS/P.SAVEDC  BUILD DESTINATAION ADDRESS
          ADDL   CTST
          STML   SAVTA
          LDN    0           INIT LOOP COUNTER
          STDL   T1

 SAVT10   LDML   SAVEFWA,T1  GET DIRECT CELL TO SAVE
          STML   *,T1        SAVE IT
 SAVTA    EQU    *-1
          AODL   T1
          SBN    SAVELWA+1-SAVEFWA  CHECK FOR DONE
          NJN    SAVT10      IF NOT, LOOP
          UJN    SAVETABX    ELSE EXIT
          SPACE  5,20
** NAME-- RELDTAB
*
** PURPOSE-- RELOAD A SAVED TS TABLE FOR USE NOW
*
** INPUT--CTST = TS TABLE TO RELOAD
          SPACE  2
 RELDTAB  SUBR               ENTRY/EXIT
          LDK    /TS/P.SAVEDC  BUILD SOURCE ADDRESS
          ADDL   CTST
          STML   RELDTA
          LDN    0           INIT LOOP COUNTER
          STDL   T1

 RELDT10  LDML   *,T1        GET SAVED DIRECT CELL
 RELDTA   EQU    *-1
          STML   SAVEFWA,T1  PUT IT BACK IN DIRECT CELL
          AODL   T1          CHECK FOR DONE
          SBN    SAVELWA+1-SAVEFWA
          NJN    RELDT10     IF NOT, LOOP
          UJN    RELDTABX    ELSE, EXIT
          SPACE  5,20
** NAME-- INTS
*
** PURPOSE-- INITIALIZE TS TABLE
*
** INPUT-- CTST,SLVN AND FACN INITIALIZED
*
          SPACE  2
 INTS     SUBR               ENTRY/EXIT
          LDDL   SLVN        SET SLAVE NUMBER
          SHN    8
          STML   /TS/P.SN,CTST
          LDDL   FACN        SET FACILITY NUMBER
          RAML   /TS/P.FN,CTST
          UJK    INTSX       EXIT
          SPACE  5,20
** NAME-- CLRTS
*
** PURPOSE-- CLEAR TS TABLE
*
** INPUT-- CTST INITIALIZED
*
          SPACE  2
 CLRTS    SUBR               ENTRY/EXIT
          LDK    /TS/P.SAVEDC  NUMBER OF WORDS TO CLEAR
          STDL   T1
          LDDL   CTST        TS TABLE FWA
          STDL   T2

 CLRTS10  LDN    0           CLEAR TS TABLE ENTRY
          STIL   T2
          AODL   T2          INCREMENT ADDRESS
          SODL   T1          DECREMENT COUNTER
          NJN    CLRTS10     LOOP IF NOT DONE
          STML   /TS/P.RQB+/RQ/P.LU,CTST  CLEAR LOGICIAL UNIT NUMBER
          UJN    CLRTSX      EXIT
          SPACE  5,20
** NAME-- CLRPTS
*
** PURPOSE-- CLEAR PARTIAL TS TABLE
*
** INPUT-- CTST INITIALIZED
*
          SPACE  2
 CLRPTS   SUBR               ENTRY/EXIT
          LDN    0           CLEAR SELECTED TS TABLE ENTRIES
          STIL   CTST
          STML   /TS/P.LASTC,CTST
          STML   /TS/P.XFER,CTST
          STML   /TS/P.XFER+1,CTST
          STML   /TS/P.SCOND,CTST
          STML   /TS/P.FACSTA,CTST
          STML   /TS/P.NSWC,CTST
          STML   /TS/P.NSRC,CTST
          STML   /TS/P.OTFC,CTST
          STML   /TS/P.BIDBP,CTST
          STML   /TS/P.RTCIP,CTST
          STML   /TS/P.RTCOP,CTST
          UJN    CLRPTSX     EXIT
          SPACE  5,20
** NAME-- LDTS
*
** PURPOSE-- LOAD TS TABLE WITH CURRENT REQUEST, INITIALIZE TS TABLE
*            ENTRIES AND UPDATE PIT/UIT NEXT PVA-RMA AND UNLOCK QUEUE.
*
** INPUT--T7 = ADDRESS OF REFORMATTED CM ADDRESS OF EITHER PIT OR UIT.
*
          SPACE  2
 LDTS     SUBR               ENTRY/EXIT
*         GET THE PVA/RMA OF THE REQUEST
          LDDL   CTST        BUILD CRML ADDRESS
          ADK    /TS/P.CPVACM
          STML   LDTSA
          LOADR  0,T7        LOAD R AND A OF PIT OR UIT
          ADK    /PIT/C.PPQPVA  OFFSET TO REQUEST PVA/RMA
          CRML   *,TWO       READ THE PVA/RMA OF THE QUEUED REQUEST
                             INTO SELECTED TS TABLE LOCATION CPVACM
 LDTSA    EQU    *-1
*         GET THE REQUEST HEADER
          LDDL   CTST        BUILD CRML/CWML ADDRESSES
          ADK    /TS/P.RQB
          STML   LDTSB
          STML   LDTSC
          ADK    /TS/P.CQB-/TS/P.RQB  ANOTHER CRML ADDRESS
          STML   LDTSD
          LDK    /RQ/C.SECADR+1  LENGTH OF REQUEST HEADER
          STDL   WC
          LOADF  /TS/P.CREQ,CTST  LOAD R AND A OF REQUEST
          CRML   *,WC        READ THE REQUEST HEADER
                             INTO SELECTED TS TABLE LOCATIONS RQB
 LDTSB    EQU    *-1
*         UPDATE THE NEXT PVA/RMA
          LOADR  0,T7        LOAD R AND A OF PIT OR UIT
          ADK    /PIT/C.PPQPVA  OFFSET TO NEXT PVA/RMA
          CWML   *,TWO       RESET TO NEXT PVA/RMA IN PIT OR UIT
 LDTSC    EQU    *-1
*         CLEAR THE PIT/UIT QUEUE LOCKWORD
          LDK    /UIT/C.QLOCK  OFFSET OF QUEUE LOCKWORD
          STDL   T5
          RJM    CLOCK       CLEAR THE PIT/UIT LOCKWORD
*         GET THE REQUEST COMMANDS
          LDML   /TS/P.RQB+/RQ/P.LEN,CTST  REQUEST LENGTH IN BYTES
          SHN    -3          TO CM WORDS
          SBN    /RQ/C.SECADR+1  DECREMENT BY HEADER LENGTH
          ZJN    *           IF NO COMMANDS
          STML   /TS/P.NUMCM,CTST  SAVE NUMBER OF COMMANDS
          STDL   WC
          LOADF  /TS/P.CREQ,CTST  LOAD R AND A OF REQUEST
          ADK    /RQ/C.SECADR+1  OFFSET TO COMMANDS
          CRML   *,WC        READ COMMANDS
                             INTO SELECTED TS TABLE LOCATIONS CQB
 LDTSD    EQU    *-1
          UJK    LDTSX       EXIT
          SPACE  5,20
** NAME-- PTW
*
** PURPOSE-- PATH TEST WRITING
*
** NOTE-- IF A SUBROUTINE CALLS THIS SUBROUTINE IT MUST SAVE ITS RETURN
*         ADDRESS BECAUSE A TS TABLE SWITCH WILL OCCUR.
          SPACE  2
 PTW1     LDML   /TS/P.SPTW,CTST  RESTORE RETURN ADDRESS
          STML   PTW

 PTW      SUBR               ENTRY/EXIT
          LDML   PTW         SAVE RETURN ADDRESS
          STML   /TS/P.SPTW,CTST
          RJM    GDP         GENERATE DATA PATTERN
          AOML   /TS/P.CRN,CTST  INCREMENT COMMAND REFERENCE NUMBER
          STML   PTWCP1
          LDDL   SLVN        BUILD ADDRESSEE
          SHN    8
          ADDL   FF          NO FACILITY ADDRESS
          STML   PTWCP5
          LDN    0           USE BUFFER 0 FIRST
          STML   PTWCPD
          RJM    PTWOD       OUTPUT TO FIRST DATA BUFFER
          AOML   /TS/P.CRN,CTST  INCREMENT COMMAND REFERENCE NUMBER
          STML   PTWCP1
          LDN    1           USE BUFFER 1 NOW
          STML   PTWCPD
          RJM    PTWOD       OUTPUT TO SECOND DATA BUFFER
          UJK    PTW1        EXIT OK
          SPACE  5,20
*         -WRITE TO BUFFER-  COMMAND PACKET
 PTWCP    DATA   0#0014      PACKET LENGTH
 PTWCP1   DATA   0#FFFF      CMD REFERENCE NUMBER
          CON    OCWTB+CMCHN  OP-CODE AND CHAIN
 PTWCP5   DATA   0#00FF      ADDRESSEE
          CON    CPBCE       CMD EXTENT PARAM
          DATA   0#0000       COUNT
          DATA   0#1020       COUNT = 4128(DEC) BYTES
 PTWCPD   DATA   0#0000       DATA ADDRESS = BUFFER 0
          DATA   0#0000       DATA ADDRESS = 0
          CON    CPBA        BUFFER ADDRESS PARAM
          DATA   0#8020       GENERIC, SLAVE DATA BUFFER
          SPACE  5,20
** NAME-- PTR
*
** PURPOSE-- PATH TEST READING
*
** NOTE-- IF A SUBROUTINE CALLS THIS SUBROUTINE IT MUST SAVE ITS RETURN
*         ADDRESS BECAUSE A TS TABLE SWITCH WILL OCCUR.
          SPACE  2
 PTR1     LDML   /TS/P.SPTR,CTST  RESTORE RETURN ADDRESS
          STML   PTR

 PTR      SUBR               ENTRY/EXIT
          LDML   PTR         SAVE RETURN ADDRESS
          STML   /TS/P.SPTR,CTST
          AOML   /TS/P.CRN,CTST  INCREMENT COMMAND REFERENCE NUMBER
          STML   PTRCP1
          LDC    OCRFB+CMCHN  OP-CODE AND CHAIN
          STML   PTRCP3
          LDDL   SLVN        BUILD ADDRESSEE
          SHN    8
          ADDL   FF          NO FACILITY
          STML   PTRCP5
          LDN    0           USE BUFFER 0 FIRST
          STML   PTRCPD
          RJM    PTRID       INPUT FIRST BUFFER
          RJM    VDP         VERIFY DATA PATTERN
          NJN    PTR10       IF DATA ERROR
          AOML   /TS/P.CRN,CTST  INCREMENT COMMAND REFERENCE NUMBER
          STML   PTRCP1
          LDC    OCRFB       OP-CODE AND END OF CHAIN
          STML   PTRCP3
          LDN    1           USE BUFFER 1
          STML   PTRCPD
          RJM    PTRID       INPUT SECOND BUFFER
          RJM    VDP         VERIFY DATA PATTERN
          ZJK    PTR1        IF OK, EXIT
 PTR10    LDK    E110        MASTER-SLAVE DATA INTEGRITY ERROR
          RJM    PCER        PREPARE COMMON ERROR RESPONSE
          RJM    EP          ERROR PROCESSING  (NO RETURN)
          SPACE  5,12
*         -READ FROM BUFFER-  COMMAND PACKET
 PTRCP    DATA   0#0014      PACKET LENGTH
 PTRCP1   DATA   0#FFFF      CMD REFERENCE NUMBER
 PTRCP3   CON    OCRFB+CMCHN  OP-CODE AND CHAIN
 PTRCP5   DATA   0#00FF      ADDRESSEE
          CON    CPBCE       CMD EXTENT PARAM
          DATA   0#0000       COUNT
          DATA   0#1020       COUNT = 4128(DEC) BYTES
 PTRCPD   DATA   0#0000       DATA ADDRESS = BUFFER 0
          DATA   0#0000       DATA ADDRESS = 0
          CON    CPBA        BUFFER ADDRESS PARAM
          DATA   0#8020       GENERIC, SLAVE DATA BUFFER
          SPACE  5,20
** NAME-- GDP
*
** PURPOSE-- GENERATE DATA PATTERN IN CM PP COMMUNICATIONS BUFFER
*
** USES-- T1-T4 = DATA
*         T7 = INCREMENT VALUE
*         T8 = COUNTER
*         P5-P6 = CM RMA
          SPACE  2
 GDP      SUBR               ENTRY/EXIT
          LDDL   CM.COM+1    USE PP COMMUNICATIONS BUFFER
          ADN    /CB/C.PTD   OFFSET TO PATH TEST DATA AREA
          STDL   P6          SAVE IT IN WORKING CELL
          SHN    -16
          ADDL   CM.COM
          STDL   P5          SAVE REST OF RMA
          LDN    4           LOOP COUNT
          STDL   T8
          LDC    0#FFFF      DATA SEED
          UJN    GDP12

*         PATTERN = FFFF 7FFF 3FFF 1FFF
*                   0FFF 07FF 03FF 01FF
*                   00FF 007F 003F 001F
*                   000F 0007 0003 0001
 GDP10    LDDL   T4          CONTINUE FROM LAST VALUE
          SHN    -1
 GDP12    STDL   T1          FIRST PP WORD
          SHN    -1
          STDL   T2          SECOND PP WORD
          SHN    -1
          STDL   T3          THIRD PP WORD
          SHN    -1
          STDL   T4          FOURTH PP WORD
          RJM    GDP100      GO WRITE IT INTO CM
          SODL   T8          CHECK FOR DONE
          NJN    GDP10       IF NOT

          LDC    0#0202      INCREMENT VALUE
          STDL   T7
          LDN    32          LOOP COUNT
          STDL   T8
          LDN    1           SEED = 0001
          UJN    GDP22

*         PATTERN = 0001 0203 ETC. (INCREMENTING 8-BIT PATTERN)
 GDP20    LDDL   T4          CONTINUE FROM LAST VALUE
          ADDL   T7
 GDP22    STDL   T1          FIRST PP WORD
          ADDL   T7
          STDL   T2          SECOND PP WORD
          ADDL   T7
          STDL   T3          THIRD PP WORD
          ADDL   T7
          STDL   T4          FOURTH PP WORD
          RJM    GDP100      GO WRITE IT INTO CM
          SODL   T8          CHECK FOR DONE
          NJN    GDP20       IF NOT

          LDC    0#0101      INCREMENT VALUE
          STDL   T7
          LDC    64          LOOP COUNT
          STDL   T8
          LDN    0           SEED = 0000
          UJN    GDP32

*         PATTERN = 0000 0101 ETC. (DOUBLE BYTE INCREMENTING 8-BIT PATTERN)
 GDP30    LDDL   T4          CONTINUE FROM LAST VALUE
          ADDL   T7
 GDP32    STDL   T1          FIRST PP WORD
          ADDL   T7
          STDL   T2          SECOND PP WORD
          ADDL   T7
          STDL   T3          THIRD PP WORD
          ADDL   T7
          STDL   T4          FOURTH PP WORD
          RJM    GDP100      GO WRITE IT INTO CM
          SODL   T8          CHECK FOR DONE
          NJN    GDP30       IF NOT

          LDC    416         WORD COUNT
          STDL   T8

*         PATTERN = AAAA 5555 AAAA 5555
          LDC    0#AAAA      A = AAAA
          STDL   T1
          STDL   T3
          SHN    -1          A = 5555
          STDL   T2
          STDL   T4
 GDP40    RJM    GDP100      WRITE IT TO CM
          SODL   T8          CHECK FOR DONE
          NJN    GDP40       IF NOT

          UJK    GDPX        EXIT
          SPACE  2
 GDP100   SUBR               ENTRY/EXIT
          LOADC  P5          LOAD R+A
          CWDL   T1          WRITE PATTERN INTO CM
          AODL   P6          UPDATE RMA
          SHN    -16
          RADL   P5
          UJN    GDP100X     EXIT
          SPACE  5,20
** NAME-- VDP
*
** PURPOSE-- VERIFY DATA PATTERN
*
** EXIT-- A = 0  NO ERROR
*             NZ DATA MISCOMPARE ERROR
*
** USES-- T1-T4 = DATA
*         T6 = INCREMENT VALUE
*         T7 = EXPECTED VALUE
*         T8 = COUNTER
*         P5-P6 = CM RMA
          SPACE  2
 VDP      SUBR               ENTRY/EXIT
          LDDL   CM.COM+1    DATA IS IN PP COMMUNICATIONS BUFFER
          ADN    /CB/C.PTD   OFFSET TO PATH TEST DATA
          STDL   P6          SAVE IN WORKING CELL
          SHN    -16
          ADDL   CM.COM
          STDL   P5          REMAINING RMA

          LCN    0
          STDL   T7          SEED = FFFF
          LDN    4           WORD COUNT
          STDL   T8

*         PATTERN = FFFF 7FFF 3FFF 1FFF
*                   0FFF 07FF 03FF 01FF
*                   00FF 007F 003F 001F
*                   000F 0007 0003 0001
 VDP10    RJM    VDP100      GET DATA WORD
          LDDL   T7
          LMDL   T1          COMPARE FIRST PP WORD
          NJN    VDP15       IF ERROR
          LDDL   T7          BUILD NEXT EXPECTED PP WORD
          SHN    -1
          STDL   T7
          LMDL   T2          COMPARE SECOND PP WORD
          NJN    VDP15
          LDDL   T7
          SHN    -1
          STDL   T7
          LMDL   T3          COMPARE THIRD PP WORD
          NJN    VDP15
          LDDL   T7
          SHN    -1
          STDL   T7
          LMDL   T4          COMPARE FOURTH PP WORD
          NJN    VDP15
          LDDL   T7
          SHN    -1
          STDL   T7
          SODL   T8          CHECK FOR DONE
          NJK    VDP10       IF NOT
          UJN    VDP19       CONT.

 VDP15    LJM    VDPX        ERROR EXIT

 VDP19    BSS
          LDC    0#0202      INCREMENT VALUE
          STDL   T6
          LDN    1           SEED = 0001
          STDL   T7
          LDN    32          WORD COUNT
          STDL   T8

*         PATTERN = 0001 0203 ETC. (INCREMENTING 8-BIT PATTERN)
 VDP20    RJM    VDP100      GET DATA WORD
          LDDL   T7          EXPECTED VALUE
          LMDL   T1          COMPARE FIRST PP WORD
          NJN    VDP15       IF ERROR
          LDDL   T6          BUILD NEXT EXPECTED VALUE
          RADL   T7
          LMDL   T2          COMPARE SECOND PP WORD
          NJN    VDP15
          LDDL   T6
          RADL   T7
          LMDL   T3          COMPARE THIRD PP WORD
          NJN    VDP15
          LDDL   T6
          RADL   T7
          LMDL   T4          COMPARE FOURTH PP WORD
          NJN    VDP15
          LDDL   T6
          RADL   T7
          SODL   T8          CHECK FOR DONE
          NJK    VDP20       IF NOT

          LDC    0#0101      INCREMENT VALUE
          STDL   T6
          LDN    0           SEED = 0000
          STDL   T7
          LDC    64          WORD COUNT
          STDL   T8

*         PATTERN = 0000 0101 ETC. (DOUBLE BYTE INCREMENTING 8-BIT PATTERN)
 VDP30    RJM    VDP100      GET DATA WORD
          LDDL   T7          EXPECTED VALUE
          LMDL   T1          COMPARE FIRST PP WORD
          NJN    VDP35       IF ERROR
          LDDL   T6          BUILD NEXT EXPECTED VALUE
          RADL   T7
          LMDL   T2          COMPARE SECOND PP WORD
          NJN    VDP35
          LDDL   T6
          RADL   T7
          LMDL   T3          COMPARE THIRD PP WORD
          NJN    VDP35
          LDDL   T6
          RADL   T7
          LMDL   T4          COMPARE FOURTH PP WORD
          NJN    VDP35
          LDDL   T6
          RADL   T7
          SODL   T8          CHECK FOR DONE
          NJK    VDP30       IF NOT
          UJN    VDP39       CONT.

 VDP35    LJM    VDPX        ERROR EXIT

 VDP39    BSS
          LDC    0#AAAA      A = AAAA
          STDL   T6          T6 = FIRST AND THIRD EXPECTED PP WORDS
          SHN    -1          A = 5555
          STDL   T7          T7 = SECOND AND FOURTH EXPECTED PP WORDS
          LDC    416         WORD COUNT
          STDL   T8

*         PATTERN = AAAA 5555 AAAA 5555
 VDP40    RJM    VDP100      GET CM WORD
          LDDL   T6          GET EXPECTED
          LMDL   T1          COMPARE FIRST
          NJN    VDP35       IF ERROR
          LDDL   T7          GET EXPECTED
          LMDL   T2          COMPARE SECOND
          NJN    VDP35
          LDDL   T6          GET EXPECTED
          LMDL   T3          COMPARE THIRD
          NJN    VDP35
          LDDL   T7          GET EXPECTED
          LMDL   T4          COMPARE FOURTH
          NJN    VDP35
          SODL   T8          CHECK FOR DONE
          NJK    VDP40       IF NOT

          LJM    VDPX        EXIT OK, A=0
          SPACE  2
 VDP100   SUBR               ENTRY/EXIT
          LOADC  P5          LOAD R+A
          CRDL   T1          GET ONE CM WORD
          AODL   P6          UPDATE RMA
          SHN    -16
          RADL   P5
          UJN    VDP100X     EXIT
          SPACE  5,20
** NAME-- RERESP
*
** PURPOSE-- PROCESS RESUME RESPONSE
*
          SPACE  2
 RERESP   SUBR               ENTRY/EXIT
          LDN    0           NO IPI STATUS IN RESPONSE
          STML   RPB
          RJM    PNR         PREPARE NORMAL RESPONSE
          RJM    RESP        SEND RESPONSE
          UJN    RERESPX     EXIT
          SPACE  4,20
** NAME-- PNR
*
** PURPOSE-- PREPARE NORMAL RESPONSE
          SPACE  2
 PNR      SUBR               ENTRY/EXIT
          RJM    BBR         BUILD BASIC RESPONSE
          RJM    MVBID       MOVE BLOCK ID BUFFER TO RESPONSE
          LDK    R.NRM       NORMAL RESPONSE
          STML   RS+/RS/P.RC
          UJK    PNRX        EXIT
          SPACE  4,20
** NAME-- PAR
*
** PURPOSE-- PREPARE ABNORMAL RESPONSE
          SPACE  2
 PAR      SUBR               ENTRY/EXIT
          RJM    BBR         BUILD BASIC RESPONSE
          RJM    MVBID       MOVE BLOCK ID BUFFER TO RESPONSE
          LDK    R.ABN       ABNORMAL RESPONSE
          STML   RS+/RS/P.RC
          UJK    PARX        EXIT
          SPACE  4,10
** NAME-- PUR
*
** PURPOSE-- PREPARE UNSOLICITED RESPONSE
          SPACE  2
 PUR      SUBR               ENTRY/EXIT
          RJM    BBR         BUILD BASIC RESPONSE
          LDK    R.UNS       UNSOLICITED RESPONSE CODE
          STML   RS+/RS/P.RC
          UJK    PURX        EXIT
          SPACE  5,30
** NAME-- BBR
*
** PURPOSE-- BUILD BASIC RESPONSE

 BBR      SUBR               ENTRY/EXIT
          LDN    C.RS-/RS/C.ABALRT  ZERO OUT MOST OF RESPONSE BUFFER
          STDL   T5          NUMBER OF CM ZERO WORDS TO USE
          LOADC  CM.COM      USE PP COMMUNICIATIONS BUFFER
          ADN    /CB/C.ZEROES  START FORM CLEARED AREA
          CRML   RS+/RS/P.ABALRT,T5  CLEAR FROM C.ABALRT TO THE END

          LDML   /TS/P.CPVA,CTST   PVA OF REQUEST
          STML   RS+/RS/P.PVA
          LDML   /TS/P.CPVA+1,CTST
          STML   RS+/RS/P.PVA+1
          LDML   /TS/P.CPVA+2,CTST
          STML   RS+/RS/P.PVA+2

          LDML   /TS/P.CREQ,CTST  RMA OF REQUEST
          STML   RS+/RS/P.REQ
          LDML   /TS/P.CREQ+1,CTST
          STML   RS+/RS/P.REQ+1

          LDK    NRL         NORMAL RESPONSE LENGTH IN BYTES
          STML   RS+/RS/P.RESPL
          LDML   RPB         CHECK IF IPI RESPONSE IS TO BE INCLUDED
          LPC    377B        INSURE VALID LENGTH
          ZJN    BBR10       IF NOT
          ADN    9           INCREMENT FOR PACKET LENGTH BYTES AND
*                            TO ROUND UP TO CM WORD BOUNDARY
          LPK    -7
          RAML   RS+/RS/P.RESPL  INCREMENT RESPONSE LENGTH
 BBR10    LDML   /TS/P.RQB+/RQ/P.LU,CTST  LOGICIAL UNIT NUMBER
          STML   RS+/RS/P.LU

          LDML   /TS/P.RQB+/RQ/P.RECOV,CTST  R/I AND PRIORITY
          STML   RS+/RS/P.RECOV

          LDML   /TS/P.RQB+/RQ/P.LONGB,CTST   ALERT MASK
          STML   RS+/RS/P.LONGB

          LDML   /TS/P.XFER,CTST   BYTES TRANSFERRED
          STML   RS+/RS/P.XFER
          LDML   /TS/P.XFER+1,CTST
          STML   RS+/RS/P.XFER+1

          LDML   /TS/P.CREQ,CTST  CHECK IF A REQUEST IS LOADED
          ADML   /TS/P.CREQ+1,CTST
          ZJK    BBRX        IF NOT BYPASS LAST CMD RMA
          LDML   /TS/P.CREQ+1,CTST  BUILD RMA OF LAST COMMAND
          ADN    B.RQ        OFFSET TO FIRST COMMAND
          ADML   /TS/P.LASTC,CTST
          STML   RS+/RS/P.LASTC+1  2ND HALF RMA
          SHN    -16
          ADML   /TS/P.CREQ,CTST
          STML   RS+/RS/P.LASTC    1ST HALF RMA

          LDML   /TS/P.FACSTA,CTST  MOVE FACILITY STATUS ID52, IF ANY
          ZJK    BBRX        IF NONE, EXIT
          STML   RS+/RS/P.FACSTA
          LDML   /TS/P.FACSTA+1,CTST
          STML   RS+/RS/P.FACSTA+1

          UJK    BBRX        EXIT
* ENSURE THAT THE NUMBER OF ZERO BYTES IN THE PP COMMUNIAATION BUFFER
* IS ENOUGH TO CLEAR THE RESPONSE BUFFER.
          ERRNG  /CB/B.ZEROES-B.RS+/RS/P.ABALRT*2
          SPACE  5,30
** NAME-- MVBID
*
** PURPOSE-- MOVE BLOCK ID FROM TS TABLE TO RESPONSE BUFFER.
*
          SPACE  4
 MVBID    SUBR               ENTRY/EXIT
          LDML   /TS/P.BIDBP,CTST  GET THE POINTER
          ZJN    MVBIDX      IF NONE TO MOVE
          STML   RS+/RS/P.IOR+MBID+1  PUT POINTER IN RESPONSE
          STDL   T1          COUNT TO MOVE
          LDML   /TS/P.OTFC,CTST  GET ON-THE-FLY CORRECTION COUNT
          STML   RS+/RS/P.IOR+MBID  PUT IN RESPONSE
          LDK    /TS/P.BIDB  BUILD SOURCE ADDRESS
          ADDL   CTST
          STDL   T2          T2 HAS SOURCE ADDRESS
          LDK    RS+/RS/P.IOR
          STDL   T3          T3 IS DESTINATION ADDRESS

 MVBID10  LDIL   T2          GET BLOCK ID ENTRY
          STIL   T3          PUT IT INTO RESPONSE
          SODL   T1          DECREMENT COUNT
          ZJN    MVBIDX      IF DONE EXIT
          AODL   T2          INCREMENT SOURCE ADDRESS
          AODL   T3          INCREMENT DESTINATION ADDRESS
          UJN    MVBID10     LOOP
          SPACE  2
          ERRNZ  30-MBID     IF MAX NUMBER OF BLOCK ID CHANGE
          SPACE  5,30
** NAME-- RESP
*
** PURPOSE-- WRITE STATUS BUFFER TO CM RESPONSE BUFFER.
*
** INPUT-- CM.PIT, CM.RS, LIM, /PIT/IN, /PIT/OUT, RS+/RS/P.RESPL
*
** OUTPUT-- /PIT/IN, RESPONSE BUFFER
          SPACE  2
 INP      EQU    P4          IN POINTER
 OUTP     EQU    P5          OUT POINTER
          SPACE  2
 RESP     SUBR               ENTRY/EXIT

* READ IN AND OUT POINTERS OF RESPONSE BUFFER.

 RESP10   LOADC  CM.PIT      LOAD ADDRESS OF PP INTERFACE TABLE
          ADK    /PIT/C.OUT  OFFSET OF OUT POINTER
          CRDL   P2          READ  OUT  POINTER INTO P5
          SBN    /PIT/C.OUT-/PIT/C.IN  OFFSET OF  IN  POINTER
          CRDL   P1          READ  IN  POINTER INTO P4

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

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

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

* WRITE RESPONSE TO CM.

 RESP40   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
          STDL   T5
          LDDL   T2
          ZJN    RESP50      IF ONLY 1 BLOCK WRITE REQUIRED
          LDDL   LIM         FIRST BLOCK WRITE = (LIMIT - IN) WORDS
          SBDL   INP
          SHN    -3
          STDL   T4          NUMBER OF WORDS TO TRANSFER ON 1ST BLOCK
          SHN    2           CONVERT TO NUMBER OF PP WORDS
          ADK    RS
          STML   RESPA       RESPONSE ADDRESS FOR 2ND BLOCK WRITE

 RESP50   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
          SBDL   T4
          ZJN    RESP70      IF ONLY 1 BLOCK WRITE REQUIRED
          STDL   T5          RESPONSE LENGTH - (LIMIT - IN)
          LDDL   T6          LOAD ADDRESS OF RESPONSE BUFFER
          CWML   **,T5       WRITE 2ND PART OF RESPONSE TO CM
 RESPA    EQU    *-1         (BEGINNING OF RESPONSE BUFFER)

 RESP70   LDDL   T1          NEW IN POINTER
          STDL   P4

* SET UP INTERRUPT PROCESSOR INSTRUCTION IF INTERRUPT IS SELECTED.

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

 RESP80   BSS
          LDML   RS+/RS/P.PORT  GET PROCESSOR PORT NUMBER TO INTERRUPT
          SHN    -16+/RS/L.PORT+/RS/N.PORT
          LPK    /RS/M.PORT
          ADK    INPNI       INPN INSTRUCTION

 RESP90   STML   INTPRC

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

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

*  INTERRUPT PROCESSOR.

          LOADC  CM.INT      CM ADDRESS OF INTERRUPT WORD
          CWDL   PPNO-3      SET LAST BYTE NON-ZERO
          LDN    0           SET (A)=0 FOR S0 MAINFRAME

 INTPRC   INPN   1           INTERRUPT OR PSN
          LDN    0           CLEAR IPI RESPONSE LENGTH
          STML   RPB
          LJM    RESPX       EXIT
          SPACE  5,20
** NAME - CHGCH
*
** PURPOSE - CHANGE CHANNEL NUMBER IN CHANNEL INSTRUCTIONS
*
** INPUT - (CURCH) = CHANNEL NUMBER.
*          (A) = CHANNEL TABLE ADDRESS.
*
          SPACE  4
 CHGCH    SUBR               ENTRY/EXIT
          STDL   T1          SET ADDRESS MODIFICATION LIST ADDRESS

 CHG10    LDIL   T1          READ LIST WORD
          ZJN    CHGCHX      IF END OF LIST
          STDL   T2          SET INSTRUCTION ADDRESS
          LDIL   T2          READ INSTRUCTION WORD
          SCN    37B         CLEAR CHANNEL BITS
          LMDL   CURCH       REPLACE WITH NEW CHANNEL
          STIL   T2
          AODL   T1          INCREMENT TO NEXT INSTRUCTION
          UJN    CHG10       LOOP
          SPACE  5,20
** NAME-- SFP
*
** PURPOSE-- SEARCH FOR PARAMETER IDENTIFICATION IN RESPONSE PACKET
*
** INPUT
*         A = ID TO SEARCH FOR
** OUTPUT
*         A = POSITIVE IF ID FOUND
*         T3 = POINTER TO ID IF IT IS FOUND (RPB+5,T3)
          SPACE  2
 SFP      SUBR               ENTRY/EXIT
          STDL   T1          PARAMETER TO SEARCH FOR
          LDN    0
          STDL   T3          POINTER TO ID BEING SEARCHED FOR
          LDML   RPB
          ADN    1
          SHN    -1
          SBN    5           LENGTH OF MINIMUM RESPONSE PACKET
 SFP4     BSS
          STDL   T2          POINTER TO END OF PARAMETERS
          MJN    SFPX        EXIT, NO ID FOUND
          LDML   RPB+5,T3
          LMDL   T1
          LPDL   FF
          ZJN    SFPX        IF ID FOUND
          LDML   RPB+5,T3
          SHN    -9
          ADN    1           ADJUST FOR ODD BYTE
          STDL   T4          WORD LENGTH OF PARAMETER
          RADL   T3          UPDATE POINTER TO ID BEING SEARCHED FOR
          LDDL   T2
          SBDL   T4
          UJN    SFP4
          SPACE  5,20
** NAME-- PCER
*
** PURPOSE-- PREPARE COMMON ERROR RESPONSE
*
** INPUT  A = ERROR ID
          SPACE  2
 PCER     SUBR               ENTRY/EXIT
          STDL   P2
          SBN    E20
          ZJN    PCER10      IF ERROR CODE 20
          SBN    E22-E20
          MJN    PCER20      IF ERROR CODE 0-19, 21
          SBN    E23-E22
          MJN    PCER10      IF ERROR CODE 22
          SBN    E27-E23
          MJN    PCER20      IF ERROR CODE 23-26
          SBN    E29-E27
          MJN    PCER10      IF EC 27 OR 28
          ZJN    PCER20      IF EC 29
          SBN    E30-E29
          NJN    PCER20      IF ERROR CODE 31-XX
 PCER10   BSS
          LDK    H00E1       READ IPI STATUS REGISTER
          RJM    RDRG        READ REGISTER
          STDL   STATUS      SAVE CONTENTS OF STATUS REGISTER
 PCER20   BSS
          LDDL   INITFLG     CHECK IF FROM INITIALIZATION
          ZJN    PCER22      IF NOT
          RJM    PUR         PREPARE UNSOLICITED RESPONSE
          LDK    URC.IN      INITIALIZATION ERROR
          RAML   RS+/RS/P.URC
          UJN    PCER28      CONT.
 PCER22   LDDL   ASYNCP      CHECK IF ASYNCHRONUS PROCESSING
          ZJN    PCER24      IF NOT
          RJM    PUR         PREPARE UNSOLICITED RESPONSE
          UJN    PCER28      CONT.
 PCER24   BSS
          RJM    PAR         PREPARE ABNORMAL RESPONSE
 PCER28   BSS
          LDDL   P2
          NJN    PCER45      IF ERROR ALREADY ISOLATED
          LDK    ID14
          RJM    SFP         SEARCH FOR ID 14
          MJN    PCER30      IF NOT SLAVE INTERVENTION REQUIRED
          LDK    E71
          UJN    PCER45
 PCER30   BSS
          LDK    ID16
          RJM    SFP         SEARCH FOR ID 16
          MJN    PCER35      IF NOT SLAVE MACHINE EXCEPTION
          LDK    E72
          UJN    PCER45
 PCER35   BSS
          LDK    ID17
          RJM    SFP         SEARCH FOR ID 17
          MJN    PCER40      IF NOT SLAVE COMMAND EXCEPTION
          LDK    E73
          UJN    PCER70
 PCER40   BSS
          LDK    ID13
          RJM    SFP         SEARCH FOR PARAMETER
          MJN    PCER50      IF NOT ID13
          LDK    E74         MICROCODE EXECUTION ERROR
 PCER45   BSS
          UJN    PCER70
 PCER50   BSS
          LDK    ID15
          RJM    SFP         SEARCH FOR ID 15
          MJN    PCER60      IF NOT ALTERNATE PORT EXCEPTION
          LDK    E75
          UJN    PCER70
 PCER60   BSS
          LDK    E00         CP MUST ISOLATE THE ERROR
 PCER70   BSS
          STML   RS+/RS/P.ERRID
          LDDL   LF
          STML   RS+/RS/P.FUNTO FAILING FUNCTION IF E01
          LDDL   STATUS      IPI STATUS REGISTER
          STML   RS+/RS/P.STREG
          LDK    H00F1
          RJM    RDRG        READ IPI ERROR REGISTER
          STML   RS+/RS/P.ERREG SAVE ERROR REGISTER
          LDK    H0022       CLEAR IPI ERROR REGISTER
          RJM    FAN
          UJK    PCERX       EXIT
          SPACE  5,20
** NAME-- EP / CMDTERM
*
** PURPOSE-- ERROR PROCESSING
*
** NOTE-- DOES NOT RETURN TO CALLER
          SPACE  2
 CMDTERM  EQU    *
 EP       BSSZ   1           ENTRY
          LDDL   INITFLG     CHECK IF FROM INITIALIZATION
          ADDL   ASYNCP      OR FROM ASYNCHRONUS PROCESSING
          NJN    EP10        IF YES
          RJM    CDUNIT      CHECK IF UNIT IS TO BE DISABLED
 EP10     RJM    RESP        SEND THE RESPONSE
          LDN    76B         SET ASYNCHRONUS PROCESSING FLAG
          STDL   ASYNCP
          AOML   /TS/P.RETRY,CTST  INCREMENT RETRY COUNTER
          SBN    1           CHECK IF FIRST RETRY EXECUTED
          NJN    EP200       IF YES

 EP100    RJM    MCC         MASTER CLEAR CHANNEL
          RJM    LIR         LOGICIAL INTERFACE RESET
          UJN    EP900       CONTINUE

 EP200    SBN    1           CHECK IF SECOND RETRY EXECUTED
          NJN    EP900       IF YES
          LDN    0           CLEAR IPI RESPONSE PACKET BUFFER
          STML   RPB
          RJM    PUR         PREPARE UNSOLICITED RESPONSE
          LDK    E50         EXECUTING CONTROLLER DIAGNOSTICS
          STML   RS+/RS/P.ERRID  SET ERROR ID FIELD
          RJM    RESP        SEND THE RESPONSE
          RJM    ISR         ISSUE SLAVE RESET
          LDN    0           CLEAR IPI RESPONSE PACKET BUFFER
          STML   RPB
          RJM    PUR         PREPARE UNSOLICITED RESPONSE
          LDK    E51         CONTROLLER DIAGNOSTICS PASSED
          STML   RS+/RS/P.ERRID  SET ERROR ID FIELD
          RJM    RESP        SEND THE RESPONSE

 EP900    SBN    1           CHECK IF CLREQ HAS FAILED
          NJN    EP920       IF YES

 EP910    RJM    CLREQ       CLEAR THE REQUEST FROM THE TS TABLE
          LJM    MAIN        GO TO MAIN LOOP

 EP920    LDN    0           CLEAR CHAIN FLAG SO CLREQ WONT FAIL AGAIN
          STML   /TS/P.CHAIN,CTST
          UJN    EP910       GO CLEAR THE REQUEST
          SPACE  5,20
** NAME - SLVTST
*
** PURPOSE - TO CHECK IF SLAVE TESTING IS REQUIRED
*
** NOTE-- IF A SUBROUTINE CALLS THIS SUBROUTINE IT MUST SAVE ITS RETURN
*         ADDRESS BECAUSE A TS TABLE SWITCH WILL OCCUR.
          SPACE  2
 SLVTST   SUBR               ENTRY/EXIT
          LDML   SLB+/SL/P.SLVTST,SX  GET SLAVE TESTING REQUIRED FLAG
          LPN    1           MASK TESTING REQUIRED BIT
          ZJN    SLVTSTX     IF NOT, EXIT
          LDML   SLVTST      SAVE RETURN ADDRESS
          STML   /TS/P.SSLVT,CTST
          LDML   SRTAB,SLVN  CHECK IF SLAVE RESET EVER ISSUED
          ZJN    SLVTST2     IF NOT
          LDN    1           SET RETRY COUNTER
          STML   /TS/P.RETRY,CTST
          RJM    LIR         ISSUE LOGICIAL INTERFACE RESET
          UJN    SLVTST4
 SLVTST2  BSS
          LDN    2           SET RETRY COUNTER
          STML   /TS/P.RETRY,CTST
          RJM    ISR         ISSUE SLAVE RESET
 SLVTST4  BSS
          RJM    PTW         PATH TEST WRITE
          RJM    PTR         PATH TEST READ
          LDN    2           SET ATTRIBUTES REQUIRED FLAG
          STML   SLB+/SL/P.SLVTST,SX
          LDN    0           CLEAR RETRY COUNTER
          STML   /TS/P.RETRY,CTST
          LDML   /TS/P.SSLVT,CTST  RESTORE RETURN ADDRESS
          STML   SLVTST
          UJK    SLVTSTX     EXIT
          SPACE  5,20
** NAME - FACTST
*
** PURPOSE - TO CHECK IF FACILITY TESTING IS REQUIRED
*
** NOTE-- IF A SUBROUTINE CALLS THIS SUBROUTINE IT MUST SAVE ITS RETURN
*         ADDRESS BECAUSE A TS TABLE SWITCH WILL OCCUR.
          SPACE  2
 FACTST0  LDML   UNITS+/UN/P.CTF,UX  CLEAR FACILITY TESTING REQUIRED FLAG
          LPK    -/UN/K.CTF  MASK OUT BIT
          STML   UNITS+/UN/P.CTF,UX
          LDML   /TS/P.SFACT,CTST  RESTORE RETURN ADDRESS
          STML   FACTST


 FACTST   SUBR               ENTRY/EXIT


          LDML   UNITS+/UN/P.CTF,UX  GET FACILITY TESTING REQUIRED FLAG
          LPK    /UN/K.CTF
          ZJN    FACTSTX     IF NOT SET, EXIT
          LDML   FACTST      SAVE RETURN ADDRESS
          STML   /TS/P.SFACT,CTST
          AOML   /TS/P.CRN,CTST  INCREMENT COMMAND REFERENCE NUMBER
          STML   PFDCP1
          LDML   /TS/P.SN,CTST  GET SLAVE AND FACILITY ADDRESS
          STML   PFDCP5
          LDC    PFDCP       COMMAND PACKET FWA
          RJM    CPT         COMMAND PACKET TRANSFER

 FACTST2  LDN    1           SECONDS LIMIT
          RJM    IH          INTERRUPT HANDLER
          LMN    CCS         CHECK IF SUCCESSFUL
          ZJK    FACTST0     IF YES
          LDML   RPB+MAJST   CHECK IF COMMAND COMPLETION RESPONSE
          SHN    -4
          LPN    0#F
          LMN    CC
          ZJN    FACTST4     IF YES, BUT WAS NOT SUCCESSFUL
          LDN    0           DO NOT EXPECT BLOCK ID
          RJM    CMDRESP     PROCESS ASYNCHRONUS RESPONSE
          UJN    FACTST2     WAIT FOR COMMAND COMPLETE RESPONSE

 FACTST4  LDML   RPB+MAJST   CHECK IF DIAGNOSTIC FAILURE
          SHN    LSME          LOOK FOR MACHINE EXCEPTION
          MJN    FACTST6     IF YES
          LDN    0           DO NOT EXPECT BID OR TAPE MARKS
          RJM    CMDRESP     PROCESS RESPONSE (NO RETURN)

 FACTST6  LDK    E61         REPORT DRIVE FAILURE
          RJM    PCER        PREPARE COMMON ERROR RESPONSE
          RJM    CMDTERM     COMMAND TERMINATE  (NO RETURN)
          SPACE  4
*         -PERFORM FACILITY DIAGNOSTICS-  COMMAND PACKET
 PFDCP    DATA   0#0010      PACKET LENGTH
 PFDCP1   DATA   0#FFFF      COMMAND REFERENCE NUMBER
          CON    OCPFD+CMCHN  OP-CODE AND CHAIN
 PFDCP5   DATA   0#FFFF      ADDRESSEE
          DATA   0#0953      FACILITY DIAGNOSTIC PARAMETER
          DATA   0#8000        LOOP WRITE/READ SECTION
          DATA   0#0000        DIAG MODE
          DATA   0#0000        RETRY COUNT
          DATA   0#0001        EXECUTION LOOP COUNT
          SPACE  5,20
** NAME - CDUNIT
*
** PURPOSE - TO SET THE DISABLED UNIT BIT IN THE UIT IF THE MASK BIT IS SET.
*
*  INPUT - RESPONSE BUFFER HEADER ALERT MASK IS IMAGE OF REQUEST
*
** OUTPUT - THE DISABLE UNIT BIT IS SET IN THE STATUS FIELD OF THE UNIT
*           INTERFACE TABLE IF THE ALERT MASK DISABLE BIT WAS SET.
*
          SPACE  2
 CDUNIT   SUBR               ENTRY/EXIT
          LDML   RS+/RS/P.LONGB  CHECK ALERT MASK
          SHN    18-16+/RS/L.DUNIT  DISABLE UNIT BIT TO SIGN POSITION
          PJN    CDUNITX     IF NOT DISABLE UNIT BIT IN ALERT MASK
          LDK    /RS/K.DUNIT   SET UNIT DISABLED BIT IN RESPONSE
          RAML   RS+/RS/P.LNGBLK  SET RESPONSE ALERT CONDITIONS
          LOADR  UNITS+/UN/P.UIT,UX  LOAD R AND A OF UIT
          STDL   T5          SAVE CM ADDRESS
          CRDL   T1          READ UIT UNIT STATUS INTO T2
          LDK    /UIT/K.DSABLE  SET UNIT DISABLED IN UIT STATUS
          STDL   T2
          LDDL   T5          RESTORE CM ADDRESS
          CWDL   T1          UPDATE UIT UNIT STATUS
          UJK    CDUNITX     EXIT
          SPACE  5,20
** NAME-- MR
*
** PURPOSE-- MASTER RESET ALL SLAVES ON THE CHANNEL
          SPACE  2
 MR       SUBR               ENTRY/EXIT
          RJM    MCC         MASTER CLEAR CHANNEL
          LDK    H9213
          RJM    FUNC        BUS A, SET SYNC OUT
          PAUSE  10          MUST DELAY 10 MICROSECONDS MINIMUM
          LDK    H9211
          RJM    FUNC        DROP SYNC OUT
          UJK    MRX
          SPACE  5,20
** NAME--ISR
*
** PURPOSE-- ISSUE SLAVE RESET
*
** NOTE-- IF A SUBROUTINE CALLS THIS SUBROUTINE IT MUST SAVE ITS RETURN
*         ADDRESS BECAUSE A TS TABLE SWITCH WILL OCCUR.
          SPACE  2
 ISR      SUBR               ENTRY/EXIT
          LDML   ISR         SAVE RETURN ADDRESS
          STML   /TS/P.SISR,CTST
          RJM    MCC         MASTER CLEAR CHANNEL
          LDK    H8415       SLAVE RESET
          RJM    IR          ISSUE RESET
          LDK    SRT         SLAVE RESET SECONDS LIMIT
          RJM    IH          INTERRUPT HANDLER
          SHN    -4
          LPN    0#F
          LMK    AR
          NJN    ISR20       IF NOT ASYNCHRONOUS RESPONSE
          LDK    ID16
          RJM    SFP         CHECK FOR MACHINE EXCEPTION
          MJN    ISR20       IF MACHINE EXCEPTION ID NOT FOUND
          LDML   RPB+6,T3
          LPK    0#FEE0
          LMK    0#6000
          NJN    ISR20       IF ERROR
          STML   /TS/P.CHAIN,CTST  CLEAR IPI CHAIN/ABORTED FLAG
          LDML   /TS/P.SISR,CTST  RESTORE RETURN ADDRESS
          STML   ISR
          STML   SRTAB,SLVN  SET SLAVE RESET ISSUED FLAG
          UJK    ISRX
 ISR20    BSS
          LDK    E60         CONTROLLER FAILURE
          RJM    PCER        PREPARE COMMON ERROR RESPONSE
          RJM    EP          ERROR PROCESSING (NO RETURN)
          SPACE  5,20
** NAME-- LIR
*
** PURPOSE-- LOGICAL INTERFACE RESET.
*
** NOTE-- IF A SUBROUTINE CALLS THIS SUBROUTINE IT MUST SAVE ITS RETURN
*         ADDRESS BECAUSE A TS TABLE SWITCH WILL OCCUR.
          SPACE  2
 LIR      SUBR               ENTRY/EXIT
          LDML   LIR         SAVE RETURN ADDRESS
          STML   /TS/P.SLIR,CTST
          LDK    H8215       LOGICAL INTERFACE RESET
          RJM    IR          ISSUE RESET
          LDN    3           SECONDS LIMIT
          RJM    IH          INTERRUPT HANDLER
          SHN    -4
          LPN    0#F
          LMK    AR
          NJN    LIR20       IF NOT ASYNCHRONOUS RESPONSE
          LDK    ID16
          RJM    SFP         CHECK FOR MACHINE EXCEPTION
          MJN    LIR20       IF MACHINE EXCEPTION ID NOT FOUND
          LDML   RPB+6,T3
          LPK    0#FEE0
          LMK    0#6000
          NJN    LIR20       IF ERROR
          STML   /TS/P.CHAIN,CTST  CLEAR IPI CHAIN/ABORTED FLAG
          LDML   /TS/P.SLIR,CTST  RESTORE RETURN ADDRESS
          STML   LIR
          UJK    LIRX
 LIR20    BSS
          LDK    E00         CP MUST DETERMINE ERROR CODE
          RJM    PCER        PREPARE COMMON ERROR RESPONSE
          RJM    EP          ERROR PROCESSING (NO RETURN)
          SPACE  5,20
** NAME-- IR
*
** PURPOSE-- ISSUE INTERFACE RESET TO SLAVE
*
** ENTRY
*         A = 8115  FOR PHYSICAL INTERFACE RESET
*             8215  FOR LOGICAL INTERFACE RESET
*             8415  FOR SLAVE RESET
*         SLVN = SLAVE NUMBER
          SPACE  2
 IR       SUBR               ENTRY/EXIT
          STDL   P2
          RJM    SARF        SET ATTRIBUTES REQUIRED FLAG
          LDDL   SLVN        SLAVE NUMBER
          SHN    12
          ADDL   P2
          RJM    FUNC        SET MASTER OUT
          PAUSE  20
          LDDL   LF          LAST FUNCTION ISSUED
          LMN    2
          RJM    FUNC        SET SYNC OUT
          PAUSE  10
          LDDL   LF
          LMN    2
          RJM    FUNC        DROP SYNC OUT
          LDDL   LF
          LMN    4
          RJM    FUNC        DROP MASTER OUT
          UJK    IRX
          SPACE  5,20
** NAME-- IH
*
** PURPOSE-- INTERRUPT HANDLER.  INPUT THE RESPONSE PACKET.  THROW AWAY
*            ASYNCHRONOUS RESPONSES (UP TO 8) FROM THE FACILITIES.
*
** ENTRY--A = MAXIMUM SECONDS TO WAIT FOR THE INTERRUPT
*
** EXIT
*         A = MAJOR STATUS
*         THE SLAVE IS DESELECTED
*
** NOTE-- IF A SUBROUTINE CALLS THIS SUBROUTINE IT MUST SAVE ITS RETURN
*         ADDRESS BECAUSE A TS TABLE SWITCH WILL OCCUR.
          SPACE  2
 IH       SUBR               ENTRY/EXIT
          ADN    1           ADJUST TIME LIMIT
          STML   /TS/P.SECLIM,CTST  SAVE THE SECONDS LIMIT
          RJM    UC          UPDATE THE CLOCK
          LDDL   CLSEC
          STML   /TS/P.CLK,CTST  SAVE CURRENT CLOCK IN TS TABLE
          LDML   IH          SAVE ROUTINE CALLER
          STML   /TS/P.SIH,CTST
 IH10     BSS
          RJM    SWITCH      SWITCH TO OTHER TS TABLE
          LDML   /TS/P.SIH,CTST  RESTORE RETURN ADDRESS
          STML   IH
          LDN    7           CLASS 1, 2 AND 3 INTERRUPTS
          RJM    RI          REQUEST INTERRUPTS
          LDML   SELT,SLVN   MASK VALUE
          LPDL   STATUS      INTERRUPT STATUS
          NJN    IH15        IF INTERRUPT PRESENT
          RJM    UC          UPDATE CLOCK
          LDDL   CLSEC
          SBML   /TS/P.CLK,CTST
          PJN    IH12        IF CLOCK HAS NOT WRAPPED
          ADK    0#10000
 IH12     BSS
          SBML   /TS/P.SECLIM,CTST
          MJN    IH10        IF TIMEOUT NOT EXPIRED
          LDK    E38         NO SLAVE INTERRUPT
          RJM    PCER        PREPARE COMMON ERROR RESPONSE
          RJM    EP          ERROR PROCESSING (NO RETURN)
 IH15     BSS
          RJM    DTM         DETERMINE TRANSFER MODE
          RJM    SEL         SELECT THE SLAVE
          STDL   CTM         CLEAR CHANGE TRANSFER MODE FLAG
          RJM    RPT         RESPONSE PACKET TRANSFER
          RJM    DCM         DESELECT THE SLAVE
          LDML   RPB+MAJST   MAJOR STATUS
          SHN    -4
          LPN    0#F
          LMK    AR
          NJN    IH20        IF NOT ASYNCHRONOUS RESPONSE
          LDML   RPB+SLAD
          LPDL   FF
          LMDL   FF
          ZJN    IH20        IF ASYNCHRONOUS RESPONSE FOR SLAVE
          LJM    IH10        GO LOOK FOR ANOTHER INTERRUPT
 IH20     BSS
          LDML   RPB+MAJST   MAJOR STATUS
          LJM    IHX
          SPACE  5,20
** NAME-- UC
*
** PURPOSE-- UPDATE CLOCK.  THE CLOCK IS USED TO TIMEOUT COMMANDS
*            ISSUED TO THE SLAVE.
          SPACE  2
 UC       SUBR               ENTRY/EXIT
          LDDL   CLCUR
          STDL   P6          SAVE CURRENT CLOCK
          IAN    14B
          STDL   CLCUR
          SBDL   P6
          PJN    UC5         IF CLOCK HASNT WRAPPED
          ADK    0#10000
 UC5      BSS
          RADL   CLMCS       UPDATE MICROSECOND PORTION OF CLOCK
          LDDL   CLMCS
          ADK    -30000
          MJN    UCX         IF LESS THAN 30 MILLISECONDS
          STDL   CLMCS
          LDN    30
          RADL   CLMLS       UPDATE MILLISECOND PORTION OF CLOCK
          ADK    -1000
          MJN    UCX         IF LESS THAN 1 SECOND
          STDL   CLMLS
          AODL   CLSEC       UPDATE SECOND PORTION OF CLOCK
          UJN    UCX         EXIT
          SPACE  5,20
** NAME-- EFP
*
** PURPOSE-- ERROR FLAG PROCESSING
          SPACE  2
 EFP      DATA   0
          LDK    H00F1       READ IPI ERROR REGISTER
          RJM    RDRG
          SHN    2           TEST BIT 48
          PJN    EFP5        IF NOT BUFFER COUNTER PARITY
          LDK    E31
          UJN    EFP35
 EFP5     BSS
          SHN    2           TEST BIT 50
          PJN    EFP10       IF NOT SYNC COUNTER PARITY
          LDK    E32
          UJN    EFP35
 EFP10    BSS
          SHN    1           TEST BIT 51
          PJN    EFP15       IF NOT PERIOD COUNTER PARITY
          LDK    E03
          UJN    EFP35
 EFP15    BSS
          SHN    1           TEST BIT 52
          MJN    EFP18       IF PARITY ERROR ON FUNCTION
          SHN    1           TEST BIT 53
          PJN    EFP20       IF NOT PARITY ERROR ON FUNCTION
 EFP18    BSS
          LDK    E01         FUNCTION TIMEOUT
          UJN    EFP35
 EFP20    BSS
          SHN    3           TEST BIT 56
          PJN    EFP25       IF NOT LOST DATA
          LDK    E33
          UJN    EFP110
 EFP25    BSS
          SHN    1           TEST BIT 57
          PJN    EFP30       IF NOT UPPER ICI PARITY
          LDK    E04
          UJN    EFP110
 EFP30    BSS
          SHN    1           TEST BIT 58
          PJN    EFP40       IF NOT LOWER ICI PARITY
          LDK    E05
 EFP35    BSS
          UJN    EFP110
 EFP40    BSS
          SHN    1           TEST BIT 59
          PJN    EFP45       IF NOT IPI SEQUENCE ERROR
          LDK    E24
          UJN    EFP110
 EFP45    BSS
          SHN    1           TEST BIT 60
          PJN    EFP50       IF NOT UPPER IPI CHANNEL PARITY
          LDK    E25
          UJN    EFP110
 EFP50    BSS
          SHN    1           TEST BIT 61
          PJN    EFP52       IF NOT LOWER IPI CHANNEL PARITY
          LDK    E26
          UJN    EFP110
 EFP52    SHN    1           TEST BIT 62
          PJN    EFP55       IF NOT ILLEGAL OPERATION
          LDK    E19
          UJN    EFP110
 EFP55    BSS
          LDK    E06         IOU ERROR
 EFP110   BSS
          RJM    PCER        PREPARE COMMON ERROR RESPONSE
          RJM    EP          ERROR PROCESSING (NO RETURN)
          SPACE  5,20
** NAME-- INTERR
*
** PURPOSE-- REPORT AN INTERFACE ERROR
*
** ENTRY-- A REGISTER HAS INTERFACE ERROR CODE
*
** EXIT-- TO MAIN IDLE LOOP WITH IDLFLG FORCED SET.
*         PP WILL ONLY PROCESS IDLE/RESUME COMMANDS.
          SPACE  2
 INTERR   DATA   0
          STDL   T7          SAVE ERROR CODE
          LDN    0           NO IPI STATUS IN RESPONSE
          STML   RPB
          RJM    PUR         PREPARE UNSOLICITED RESPONSE
          LDDL   T7          GET INTERFACE ERROR CODE
          STML   RS+/RS/P.IEC INTERFACE ERROR CODE
          LDK    /RS/K.INTERR  INTERFACE ERROR
          STML   RS+/RS/P.INTERR  ABNORMAL STATUS CODE
          LDK    E120        SOFTWARE FAILURE
          STML   RS+/RS/P.ERRID
          LDK    /RS/K.PDN   PP IDLED
          STML   RS+/RS/P.DOWNST
          RJM    RESP        SEND THE RESPONSE
          LDN    77B         FORCE SET PP IDLE FLAG
          STDL   IDLFLG
          LJM    MAIN        EXIT TO MAIN IDLE LOOP
          SPACE  5,20
** NAME-- SARF
*
** PURPOSE-- SET ATTRIBUTES REQUIRED FLAG
          SPACE  2
 SARF     SUBR               ENTRY/EXIT
          LDML   SLB+/SL/P.SLVTST,SX  GET FLAG WORD
          LPN    1           MASK TESTING REQUIRED
          ADN    2           SET ATTRIBUTES REQUIRED BIT
          STML   SLB+/SL/P.SLVTST,SX  RESTORE FLAG WORD
          UJN    SARFX       EXIT
          TITLE  CHANNEL SUBROUTINES
** NAME-- MCC
*
** PURPOSE-- MASTER CLEAR CHANNEL
          SPACE  2
 MCC      SUBR               ENTRY/EXIT
          MCLR   DC          MASTER CLEAR CHANNEL
          PAUSE  100         ALLOW SLAVE TIME TO DROP LINES
          MCLR   DC          IN CASE SEQUENCE ERROR OCCURRED
          PAUSE  1
          DCN    DC+40B
          CFM    MCC10,DC    CLEAR CHANNEL ERROR FLAG
 MCC10    BSS
          LDK    H7C42       5.00 MB
          RJM    FUNC        SET IPI CHANNEL TRANSFER RATE
          UJN    MCCX
          SPACE  5,20
** NAME-- FUNC
*
** PURPOSE-- ISSUE FUNCTION TO IPI CHANNEL
*
** INPUT-- A REGISTER = FUNCTION CODE.
          SPACE  2
 FUNC     SUBR               ENTRY/EXIT
          DCN    DC+40B      ENSURE CHANNEL IS INACTIVE
                              THE CHANNEL MAY HAVE BEEN LEFT ACTIVE
                              BY A ROUTINE SUCH AS DCM,
                              OR AFTER A REPORTED ERROR.
          CFM    FUNC10,DC   IF CHANNEL ERROR FLAG IS CLEAR
          RJM    EFP         ERROR FLAG PROCESSING (NO RETURN)
 FUNC10   BSS
          FAN    DC          ISSUE THE FUNCTION
          STDL   LF          SAVE FUNCTION CODE
 FH1      IFEQ   FH,1        FUNCTION HISTORY TABLE
          STML   FBUF,FI     SAVE HISTORY OF FUNCTIONS ISSUED
          AODL   FI          INCREMENT FUNCTION BUFFER INDEX
          ADK    -FBUFL
          NJN    FUNC20      IF NOT END OF BUFFER
          STDL   FI          INITIALIZE INDEX
 FUNC20   BSS
 FH1      ENDIF
          CFM    FUNC30,DC   IF CHANNEL ERROR FLAG IS CLEAR
          RJM    EFP         ERROR FLAG PROCESSING (NO RETURN)
 FUNC30   BSS
          IJM    FUNCX,DC    EXIT IF CHANNEL INACTIVE
          LDK    E01         FUNCTION TIMEOUT
          RJM    PCER        PREPARE COMMON ERROR RESPONSE
          RJM    EP          ERROR PROCESSING (NO RETURN)
          SPACE  5,20
** NAME-- FAN
*
** PURPOSE-- SEND A FUNCTION TO THE IPI CHANNEL, BUT DONT
*            PUT THE FUNCTION IN THE FUNCTION HISTORY TABLE
          SPACE  2
 FAN      SUBR               ENTRY/EXIT
          DCN    DC+40B      ENSURE THE CHANNEL IS INACTIVE
                              THE CHANNEL MAY HAVE BEEN LEFT ACTIVE
                              BY A MASTER CLEAR, A ROUTINE SUCH AS
                              DCM, OR AFTER A REPORTED ERROR.
          FAN    DC          SEND THE FUNCTION
          UJN    FANX
          SPACE  5,20
** NAME-- RDRG
*
** PURPOSE-- READ EITHER THE IPI STATUS OR IPI ERROR REGISTER
*
** ENTRY--  A = FUNCTION CODE
          SPACE  2
 RDRG10   BSS
          LDN    0

 RDRG     SUBR               ENTRY/EXIT
          RJM    FAN         SEND FUNCTION
          AJM    RDRG10,DC   IF NO FUNCTION REPLY
          ACN    DC+40B
          EJM    RDRG10,DC   IF WORD COULD NOT BE READ
          IAN    DC
          UJN    RDRGX
          SPACE  5,20
** NAME--RI
*
** PURPOSE-- REQUEST INTERRUPTS FROM ALL SLAVES ON THIS CHANNEL
*
** INPUT-- A = BIT 0 SET CLASS 1
*                  1 SET CLASS 2
*                  2 SET CLASS 3
*
** OUTPUT
*         STATUS - CONTAINS BIT SIGNIFICANT ADDRESS OF SLAVE WITH INTERRUPT
          SPACE  2
 RI       SUBR               ENTRY/EXIT
          LPN    7           MASK CALLER SELECTION
          SHN    8           POSITION THEM
          ADK    H0X15       REQUEST SELECTED INTERRUPTS
          RJM    FUNC        BUS A, MASTER OUT
          PAUSE  20          DELAY
          ACN    DC
          EJM    RI5,DC      IF ERROR
          IAN    DC
          STDL   STATUS      SAVE BIT SIGNIFICANT ADDRESS
          LDDL   LF
          LMN    4
          RJM    FUNC        DROP MASTER OUT
          UJN    RIX         EXIT
 RI5      BSS
          LDK    E02         CHANNEL EMPTY WHEN ACTIVATED
          RJM    PCER        PREPARE COMMAND ERROR RESPONSE
          RJM    EP          ERROR PROCESSING (NO RETURN)
          SPACE  5,15
** NAME-- DTM
*
** PURPOSE-- DETERMINE TRANSFER MODE
*
** OUTPUT
*         STATUS - TRANSFER SETTINGS, BIT 4 = 1 IF DATA STREAMING
*         CTM - USED TO CHANGE TRANSFER MODE WHEN SELECTING
          SPACE  2
 DTM      SUBR               ENTRY/EXIT
          LDDL   SLVN        SLAVE NUMBER
          SHN    12
          ADK    H8025
          RJM    FUNC        REQUEST TRANSFER SETTINGS
          ACN    DC
          LDN    77B
 DTM4     FJM    DTM8,DC     IF SLAVE IN
          SBN    1
          NJN    DTM4        IF TIMEOUT NOT EXPIRED
          LDK    E27         NO SLAVE IN
          UJN    DTM16
 DTM8     IAN    DC
          STDL   STATUS      SAVE TRANSFER SETTING
          SFM    DTM20,DC    IF ERROR FLAG SET
          LPN    0#10
          LMN    0#10
          SHN    7
          STDL   CTM         CHANGE TRANSFER MODE BIT
          LDDL   LF          LAST FUNCTION ISSUED
          LMK    0#54        CODE 7, DROP MASTER OUT
          RJM    FUNC        DROP MASTER OUT
          ACN    DC
          LDN    77B
 DTM12    FJM    DTMX,DC     IF SLAVE IN DROPPED
          SBN    1
          NJN    DTM12       IF TIMEOUT NOT EXPIRED
          LDK    E28         SLAVE IN DID NOT DROP
 DTM16    BSS
          RJM    PCER        PREPARE COMMON ERROR RESPONSE
          RJM    EP          ERROR PROCESSING (NO RETURN)
 DTM20    BSS
          RJM    EFP         ERROR FLAG PROCESSING (NO RETURN)
          SPACE  5,20
** NAME-- SEL
*
** PURPOSE-- SELECT THE SLAVE AND VERIFY THE BIT SIGNIFICANT RESPONSE
*
** INPUT
*         SLVN - SLAVE NUMBER
*         CTM - CHANGE TRANSFER MODE IF BIT 3 SET
*
** OUTPUT-- A = 0 IF NO ERROR
          SPACE  2
 SEL      SUBR               ENTRY/EXIT
          LDDL   SLVN
          SHN    12
          ADDL   CTM         CHANGE TRANSFR MODE MODIFIER
          ADK    H0029
          RJM    FUNC        SET SELECT OUT
          ACN    DC
          LDN    77B
 SEL4     FJM    SEL8,DC     IF SLAVE IN
          SBN    1
          NJN    SEL4        IF TIMEOUT NOT EXPIRED
          LDK    E20         CANT SELECT SLAVE
          UJN    SEL15
 SEL8     IAN    DC
          STDL   STATUS      SAVE BIT SIGNIFICANT RESPONSE
          CFM    SEL10,DC    IF ERROR FLAG IS CLEAR
          RJM    EFP         ERROR FLAG PROCESSING (NO RETURN)
 SEL10    BSS
          LPK    377B
          LMML   SELT,SLVN
          ZJK    SELX        IF BIT SIGNIFICANT RESPONSE CORRECT
          LDK    E21         BIT SIGNIFICANT RESPONSE WRONG
 SEL15    BSS
          RJM    PCER        PREPARE COMMON ERROR RESPONSE
          RJM    EP          ERROR PROCESSING (NO RETURN)
          SPACE  5,20
** NAME-- BCS
*
** PURPOSE-- PERFORM BUS CONTROL SEQUENCE
*
** INPUT
*         A = BUS A BITS 7,6 IN BITS 1,0 OF ACCUMULATOR
*             BIT 7 = 1 IF DATA ELSE RESPONSE OR COMMAND
*             BIT 6 = 1 IF INFORMATION IN
          SPACE  2
 BCS      SUBR               ENTRY/EXIT
          SHN    14
          ADK    H005B
          RJM    FUNC        SET SYNC OUT
          ACN    DC
          LDN    77B
 BCS4     FJM    BCS8,DC     IF SYNC IN
          SBN    1
          NJN    BCS4        IF TIMEOUT NOT EXPIRED
          LDK    E22         NO SYNC IN
          UJN    BCS20
 BCS8     IAN    DC
          STDL   STATUS      SAVE BUS ACKNOWLEDGE STATUS
          SFM    BCS25,DC    IF ERROR FLAG SET
          LPDL   FF
          NJN    BCS16       IF BUS ACKNOWLEDGE IS WRONG
          LDDL   LF          LAST FUNCTION
          LMN    0#32
          RJM    FUNC        DROP SYNC OUT
          ACN    DC
          LDN    77B
 BCS12    FJM    BCSX,DC     IF SYNC IN DROPPED
          SBN    1
          NJN    BCS12       IF TIMEOUT NOT EXPIRED
          LDK    E23         SYNC IN DID NOT DROP
          UJN    BCS20
 BCS16    BSS
          LDK    E37         BUS ACKNOWLEDGE WRONG
 BCS20    BSS
          RJM    PCER        PREPARE COMMON ERROR RESPONSE
          RJM    EP          ERROR PROCESSING (NO RETURN)
 BCS25    BSS
          RJM    EFP         ERROR FLAG PROCESSING (NO RETURN)
          SPACE  5,20
** NAME-- CPT
*
** PURPOSE-- COMMAND PACKET TRANSFER
*
** INPUT-- A = COMMAND PACKET FWA
*              BIT 17 = BYPASS SEL AND DCM SUBROUTINES
          SPACE  2
 CPT30    LDN    EVENOT      USE EVEN OCTET TRANSFER ENCODED STATUS
          RJM    GES         GET ENDING STATUS
          LDDL   CPTBP       CHECK FOR BYPASS DCM
          LPN    1
          NJN    CPT35       IF YES
          RJM    DCM         DESELECT THE SLAVE
 CPT35    BSS
          LDDL   WC
          ZJN    CPT40       IF ALL WORDS TRANSFERRED
          LDK    E29         INCOMPLETE TRANSFER
          RJM    PCER        PREPARE COMMON ERROR RESPONSE
          RJM    EP          ERROR PROCESSING (NO RETURN)

 CPT40    LDML   *           GET COMMAND CODE SENT
 CPTA     EQU    *-1
          LPN    CMCHN       CHECK FOR COMMAND CHAINING
          STML   /TS/P.CHAIN,CTST  SET CHAINING FLAG

 CPT      SUBR               ENTRY/EXIT

          SHN    1           SAVE BYPASS BIT AS BIT 0
          STDL   CPTBP       SAVE IT
          SHN    17          RESTORE ORIGINAL FWA
          STML   CPTC        INITIALIZE INSTRUCTIONS
          STML   CPTD
          ADN    OPCD        ADJUST TO OPCODE
          STML   CPTA        FOR CHAINING FLAG

 KH1      IFEQ   KH,1        COMMAND HISTORY
          SBN    OPCD        RESET ADDRESS
          STML   CPTB        INITIALIZE INSTRUCTION ADDRESS
          LCN    0           INDICATE COMMAND
          STML   HB,HBP
          AODL   HBP         INCREMENT DESTINATION INDEX
          ADN    7           COMPUTE LOOP LIMIT
          STML   CPTE        SET LOOP LIMIT

 CPT10    LDML   *           GET COMMAND WORD
 CPTB     EQU    *-1
          STML   HB,HBP      PUT INTO HISTORY LIST
          AOML   CPTB        INCREMENT SOURCE ADDRESS
          AODL   HBP         INCREMENT DESTINATION INDEX
          SBML   CPTE        CHECK FOR ENTRY LIMIT
          NJN    CPT10       IF NOT, LOOP
          LDDL   HBP         CHECK FOR BUFFER LIMIT
          ADK    -HBL
          MJN    CPT15       IF NOT
          LDN    0           RESET INDEX
          STDL   HBP
 CPT15    BSS
 KH1      ENDIF

          LDDL   CPTBP       CHECK FOR BYPASS SEL
          LPN    1
          NJN    CPT18       IF YES
          RJM    SEL         SELECT THE SLAVE
 CPT18    BSS
          LDK    CMDOUT      BUS A FOR COMMAND
          RJM    BCS         BUS CONTROL SEQUENCE
          LDK    H0381       STREAM, WRITE
          RJM    FUNC        RAISE MASTER OUT
          ACN    DC
          LDML   *           GET PACKET LENGTH
 CPTC     EQU    *-1
          ADN    3
          SHN    -1          CONVERT BYTE COUNT TO WORD COUNT
          OAM    *,DC        SEND COMMAND PACKET
 CPTD     EQU    *-1
          CFM    CPT20,DC    IF CHANNEL ERROR FLAG IS CLEAR
          RJM    EFP         ERROR FLAG PROCESSING (NO RETURN)
 CPT20    BSS
          STDL   WC          SAVE RESIDUAL WORD COUNT
          RJM    WSID        WAIT FOR SLAVE IN TO DROP
          UJK    CPT30
          SPACE  2
 KH1A     IFEQ   KH,1        COMMAND HISTORY
 CPTE     BSSZ   1           LIMIT ADDRESS
 KH1A     ENDIF
          SPACE  5,20
** NAME-- RPT
*
** PURPOSE-- RESPONSE PACKET TRANSFER
*
** OUTPUT
*         RPB - STARTING LOCATION OF RESPONSE PACKET
          SPACE  2
 RPT20    BSS
          STDL   WC          SAVE WORDS NOT TRANSFERRED
 RPT30    BSS
          LDN    EVENOT      USE EVEN OCTET TRANSFER ENCODED STATUS
          RJM    GES         GET ENDING STATUS

 KH2      IFEQ   KH,1        RESPONSE HISTORY
          LCN    77B         INDICATE RESPONSE
          STML   HB,HBP
          LDML   RPB         PACKET LENGTH
          STML   HB+1,HBP
          LDML   RPB+1       COMMAND REFERENCE NUMBER
          STML   HB+2,HBP
          LDML   RPB+2       COMMAND
          STML   HB+3,HBP
          LDML   RPB+3       SLAVE/FACILITY
          STML   HB+4,HBP
          LDML   RPB+4       MAJOR STATUS
          STML   HB+5,HBP
          LDML   RPB+5       PARAMETERS (IF ANY)
          STML   HB+6,HBP
          LDML   RPB+6
          STML   HB+7,HBP
          LDN    8
          RADL   HBP         UPDATE HISTORY BUFFER POINTER
          ADK    -HBL        CHECK IF FULL
          NJN    RPT35       IF NOT FULL YET
          STML   HBP         RESET POINTER
 RPT35    BSS
 KH2      ENDIF

          LDDL   WC
          ZJN    RPTX        IF ALL WORDS TRANSFERRED
          LDK    E29         INCOMPLETE TRANSFER
          RJM    PCER        PREPARE COMMON ERROR RESPONSE
          RJM    EP          ERROR PROCESSING (NO RETURN)

 RPT      SUBR               ENTRY/EXIT

          LDK    RSPIN       BUS A FOR RESPONSE
          RJM    BCS         BUS CONTROL SEQUENCE
          LDK    H0281       STREAM, READ
          RJM    FUNC        SET MASTER OUT
          ACN    DC
          LDN    5
          IAM    RPB,DC      INPUT REQUIRED WORDS
          CFM    RPT2,DC     IF CHANNEL ERROR FLAG IS CLEAR
          RJM    EFP         ERROR FLAG PROCESSING (NO RETURN)
 RPT2     BSS
          NJK    RPT20       IF NOT ALL WORDS RECEIVED
          LDML   RPB         BYTE COUNT MINUS 2
          ADN    3
          SHN    -1
          SBN    5
          ZJN    RPT4        IF ALL WORDS TRANSFERRED
          LPK    377B        PROTECT AGAINST ILLEGAL LENGTH
          IAM    RPB+5,DC    INPUT REMAINING WORDS
          CFM    RPT3,DC     IF CHANNEL ERROR FLAG IS CLEAR
          RJM    EFP         ERROR FLAG PROCESSING (NO RETURN)
 RPT3     BSS
          NJN    RPT2        IF NOT ALL WORDS TRANSFERRED
 RPT4     BSS
          STDL   WC          WORDS NOT TRANSFERRED
          RJM    WSID        WAIT FOR SLAVE IN TO DROP
          UJK    RPT30
          SPACE  5,20
** NAME-- GES
*
** PURPOSE-- GET ENDING STATUS
*
** INPUT-- A = MASTER ENCODED ENDING STATUS IN LOWER 4 BITS
*
** OUTPUT--
*         RETURNS TO CALLING PROGRAM IF STATUS IS READ WITHOUT ERROR
*         AND SUCCESSFUL IS SET IN STATUS
          SPACE  2
 GES      SUBR               ENTRY/EXIT
          SHN    8           POSITION MASTER ENCODED ENDING STATUS
          ADK    H8039       INDICATE SUCCESSFUL IN BUS A
          RJM    FUNC        DROP MASTER OUT
          ACN    DC
          LDK    1470        ABOUT 1.1 MILLISECOND TIMELIMIT
 GES4     FJM    GES8,DC     IF SLAVE IN SET
          SBN    1
          NJN    GES4        IF TIMEOUT NOT EXPIRED
          LDK    E27         SLAVE IN NOT SET
          UJK    GES30
 GES8     IAN    DC
          STDL   STATUS      SAVE ENDING STATUS
          SFM    GES40,DC    IF ERROR FLAG SET
          LPK    0#80
          NJN    GESX        IF SUCCESSFUL
          LDDL   STATUS
          SHN    17-6
          PJN    GES15       IF NOT BUS PARITY
          LDK    E34
          UJN    GES30
 GES15    BSS
          LDDL   STATUS
          LPN    17B
          SBN    2
          MJN    GES25       IF REPORTING -ENDING STATUS WRONG-
          SBN    7
          NJN    GES20       IF NOT -SYNC OUTS NOT EQUAL SYNC INS-
          LDK    E36
          UJN    GES30
 GES20    BSS
          PJN    GES23       IF NOT COMMAND REJECT
 GES22    LDK    E35
          UJN    GES30
 GES23    BSS
          SBN    2
          NJN    GES25       IF NOT INTERNAL SLAVE ERROR
          LDK    E70
          UJN    GES30
 GES25    BSS
          SBN    1           CHECK FOR COMMAND REJECT
          ZJN    GES22       IF YES
          LDK    E39         ENDING STATUS WRONG
 GES30    BSS
          RJM    PCER        PREPARE COMMON ERROR RESPONSE
          RJM    EP          ERROR PROCESSING (NO RETURN)
 GES40    BSS
          RJM    EFP         ERROR FLAG PROCESSING (NO RETURN)
          SPACE  5,20
** NAME-- DCM
*
** PURPOSE-- DESELECT THE SLAVE
          SPACE  2
 DCM1     DCN    DC+40B      DEACTIVATE CHANNEL
          SFM    DCM10,DC    IF CHANNEL ERROR FLAG IS SET

 DCM      SUBR               ENTRY/EXIT
          LDK    H0071
          RJM    FUNC        DROP SELECT OUT
          ACN    DC
          LDN    77B
 DCM4     FJM    DCM1,DC     IF SLAVE IN DROPPED
          SBN    1
          NJN    DCM4        IF TIMEOUT NOT EXPIRED
          SFM    DCM10,DC    IF CHANNEL ERROR FLAG IS SET
          LDK    E28         SLAVE IN DID NOT DROP
          RJM    PCER        PREPARE COMMON ERROR RESPONSE
          RJM    EP          ERROR PROCESSING (NO RETURN)
 DCM10    RJM    EFP         ERROR FLAG PROCESSING (NO RETURN)
          SPACE  5,20
** NAME-- WSID
*
** PURPOSE-- WAIT FOR SLAVE IN TO DROP
*
** EXIT -- RETURN TO CALLER IF SLAVE IN DROPPED BEFORE TIMEOUT.
*          ELSE REPORT ERROR E30 AND DO NOT RETURN TO CALLER.
          SPACE  2
 WSID     SUBR               ENTRY/EXIT
          LDK    MS25        TIMEOUT VALUE (ABOUT 25 MS)
 WSID10   IJM    WSIDX,DC    IF SLAVE IN DROPPED, EXIT
          SBN    1
          NJN    WSID10      IF TIMEOUT NOT EXPIRED
          LDK    E30         CHANNEL STAYED ACTIVE
          RJM    PCER        PREPARE COMMON ERROR RESPONSE
          RJM    EP          ERROR PROCESSING (NO RETURN)
          SPACE  5,20
** NAME-- INPUT
*
** PURPOSE-- INPUT TAPE DATA RECORD
*
** INPUT-- (/TS/P.ILSTP,CTST) HAS CURRENT INDIRECT LENGTH/ADDRESS PAIR
*          (WC) HAS CHANNEL WORD COUNT TO TRANSFER
*
** EXIT -- (/TS/P.RESBC,CTST) HAS RESIDUAL BYTE COUNT OF TRANSFER
*          A = 0  IF FULL TRANSFER
*          A = NZ IF PARTIAL TRANSFER
          SPACE  2
 INPUT    SUBR               ENTRY/EXIT
          LOADF  /TS/P.ILSTP+2,CTST  SET R+A FOR DATA
          CHCM   WC,DC       INPUT THE DATA
          LDDL   WC          SET RESIDUAL IF ANY
          SHN    1           ADJUST TO BYTES
          STML   /TS/P.RESBC,CTST  SAVE RESIDUAL BYTE COUNT
          UJN    INPUTX      EXIT
          SPACE  5,20
** NAME-- OUTPUT
*
** PURPOSE-- OUTPUT TAPE DATA RECORD
*
** INPUT-- (/TS/P.ILSTP,CTST) HAS CURRENT INDIRECT LENGTH/ADDRESS PAIR
*          (WC) HAS CHANNEL WORD COUNT TO TRANSFER
*
** EXIT -- (/TS/P.RESBC,CTST) HAS RESIDUAL BYTE COUNT OF TRANSFER
*          A = 0  IF FULL TRANSFER
*          A = NZ IF PARTIAL TRANSFER
          SPACE  2
 OUTPUT   SUBR               ENTRY/EXIT
          LOADF  /TS/P.ILSTP+2,CTST  SET R+A FOR DATA
          CMCH   WC,DC       OUTPUT THE DATA
          LDDL   WC          SET RESIDUAL IF ANY
          SHN    1           ADJUST TO BYTES
          STML   /TS/P.RESBC,CTST  SAVE RESIDUAL BYTE COUNT
          UJN    OUTPUTX     EXIT
          SPACE  5,20
** NAME-- PTWOD
*
** PURPOSE-- PATH TEST WRITE OUTPUT DATA
*
** NOTE-- IF A SUBROUTINE CALLS THIS SUBROUTINE IT MUST SAVE ITS RETURN
*         ADDRESS BECAUSE A TS TABLE SWITCH WILL OCCUR.
          SPACE  2
 PTWO1    LDML   /TS/P.SPTWOD,CTST  RESTORE RETURN ADDRESS
          STML   PTWOD

 PTWOD    SUBR               ENTRY/EXIT
          LDML   PTWOD       SAVE RETURN ADDRESS
          STML   /TS/P.SPTWOD,CTST
          LDC    PTWCP       COMMAND PACKET FWA
          RJM    CPT         COMMAND PACKET TRANSFER
 PTWO10   LDN    1           SECONDS LIMIT
          RJM    IH          INTERRUPT HANDLER
          LMC    TN*16       CHECK FOR TRANSFER NOTIFICATION
          ZJN    PTWO20      IF YES
          LDML   RPB+MAJST   CHECK FOR ASYNC
          SHN    -4
          LPN    0#F
          LMK    AR
          ZJN    PTWO10      IF YES
          UJK    PTWO50      ELSE REPORT ERROR (E00)
 PTWO20   LDML   /TS/P.CRN,CTST  CHECK IF CMD REFERENCE NUMBERS AGREE
          LMML   RPB+CRN
          NJK    PTWO60      IF NOT, REPORT ERROR (E76)
          RJM    SEL         SELECT SLAVE
          LDN    DATAOUT     BUS A FOR DATA OUT
          RJM    BCS         BUS CONTROL SEQUENCE
          LDC    H0381       STREAM, WRITE
          RJM    FUNC
          ACN    DC
          LDC    4128/2      WORD COUNT
          STDL   WC
          LOADC  CM.COM      LOAD R+A
          ADN    /CB/C.PTD   OFFSET TO PATH TEST DATA
          CMCH   WC,DC       OUTPUT DATA
          RJM    WSID        WAIT FOR SLAVE IN TO DROP
          LDN    EVENOT      EVEN OCTET MASTER ENCODED ENDING STATUS
          RJM    GES         GET ENDING STATUS
          RJM    DCM         DESELECT SLAVE
          LDDL   WC          CHECK RESIDUAL WORD COUNT
          ZJK    PTWO90      IF OK
          LDN    E29         INCOMPLETE TRANSFER
          UJN    PTWO80

 PTWO50   LDN    E00         CP MUST DETERMINE ERROR
          UJN    PTWO80

 PTWO60   LDK    E76         UNEXPECTED RESPONSE

 PTWO80   RJM    PCER        PREPARE COMMON ERROR RESPONSE
          RJM    EP          ERROR PROCESSING (NO RETURN)

 PTWO90   LDN    1           SECONDS LIMIT
          RJM    IH          INTERRUPT HANDLER
          LMN    CCS         CHECK FOR SUCCESSFUL
          ZJK    PTWO1       IF YES, EXIT OK
          LDML   RPB+MAJST   CHECK FOR ASYNC
          SHN    -4
          LPN    0#F
          LMK    AR
          ZJN    PTWO90      IF YES
          UJN    PTWO50      ELSE REPORT ERROR (E00)
          SPACE  5,20
** NAME-- PTRID
*
** PURPOSE-- PATH TEST READ INPUT DATA
*
** NOTE-- IF A SUBROUTINE CALLS THIS SUBROUTINE IT MUST SAVE ITS RETURN
*         ADDRESS BECAUSE A TS TABLE SWITCH WILL OCCUR.
          SPACE  2
 PTRI1    LDML   /TS/P.SPTRID,CTST  RESTORE RETURN ADDRESS
          STML   PTRID

 PTRID    SUBR               ENTRY/EXIT
          LDML   PTRID       SAVE RETURN ADDRESS
          STML   /TS/P.SPTRID,CTST
          LDC    PTRCP       COMMAND PACKET FWA
          RJM    CPT         COMMAND PACKET TRANSFER
 PTRI10   LDN    1           SECONDS LIMIT
          RJM    IH          INTERRUPT HANDLER
          LMC    TN*16       CHECK FOR TRANSFER NOTIFICATION
          ZJN    PTRI20      IF YES
          LDML   RPB+MAJST   CHECK FOR ASYNC
          SHN    -4
          LPN    0#F
          LMK    AR
          ZJN    PTRI10      IF YES
          UJK    PTRI50      ELSE, REPORT ERROR (E00)
 PTRI20   LDML   /TS/P.CRN,CTST  COMPARE COMMAND REFERENCE NUMBERS
          LMML   RPB+CRN
          NJK    PTRI60      IF NOT THE SAME
          RJM    SEL         SELECT SLAVE
          LDN    DATAIN      BUS A FOR DATA IN
          RJM    BCS         BUS CONTROL SEQUENCE
          LDC    H0A81       STREAM, READ, DMA
          RJM    FUNC
          ACN    DC
          LDC    4128/2      WORD COUNT
          STDL   WC
          LOADC  CM.COM      LOAD R+A
          ADN    /CB/C.PTD   OFFSET TO PATH TEST DATA
          CHCM   WC,DC       INPUT THE DATA
          RJM    WSID        WAIT FOR SLAVE IN TO DROP
          LDN    EVENOT      USE EVEN OCTET MASTER ENCODED ENDING STATUS
          RJM    GES         GET ENDING STATUS
          RJM    DCM         DESELECT SLAVE
          LDDL   STATUS      CHECK SLAVE ENCODED ENDING STATUS
          LPN    0#F
          NJN    PTRI80      IF NOT EVEN
          LDDL   WC          CHECK RESIDUAL WORD COUNT
          ZJK    PTRI100     IF OK
          LDN    E29         INCOMPLETE TRANSFER
          UJN    PTRI90
 PTRI50   LDN    E00         CP MUST DETERMINE ERROR
          UJN    PTRI90
 PTRI60   LDK    E76         UNEXPECTED STATUS
          UJN    PTRI90
 PTRI80   LDN    E40         SLAVE ENCODED ENDING STATUS ERROR
 PTRI90   RJM    PCER        PREPARE COMMON ERROR RESPONSE
          RJM    EP          ERROR PROCESSING  (NO RETURN)

 PTRI100  LDN    1           SECONDS LIMIT
          RJM    IH          GET COMMAND COMPLETION
          LMN    CCS         CHECK FOR SUCCESSFUL
          ZJK    PTRI1       IF YES, EXIT
          LDML   RPB+MAJST   CHECK FOR ASYNC
          SHN    -4
          LPN    0#F
          LMK    AR
          ZJN    PTRI100     IF YES
          UJN    PTRI50      ELSE, REPORT ERROR (E00)
          SPACE  5,20
** NAME-- REL
*
** PURPOSE-- READ ERROR LOG
*
** NOTE-- IF A SUBROUTINE CALLS THIS SUBROUTINE IT MUST SAVE ITS RETURN
*         ADDRESS BECAUSE A TS TABLE SWITCH WILL OCCUR.
          SPACE  2
 REL1     LDML   /TS/P.SREL,CTST  RESTORE RETURN ADDRESS
          STML   REL

 REL      SUBR               ENTRY/EXIT
          LDML   REL         SAVE RETURN ADDRESS
          STML   /TS/P.SREL,CTST
          AOML   /TS/P.CRN,CTST  INCREMENT COMMAND REFERENCE NUMBER
          STML   RELCP1
          LDC    RELCP       COMMAND PACKET FWA
          RJM    CPT         COMMAND PACKET TRANSFER
 REL5     LDN    1           SECONDS LIMIT
          RJM    IH          INTERRUPT HANDLER
          LMC    TN*16       CHECK FOR TRANSFER NOTIFICATION
          ZJN    REL8        IF YES
          LDN    0           DO NOT EXPECT BLOCK ID
          RJM    CMDRESP     COMMAND RESPONSE DECODE
          UJN    REL5        IF ASYNC
 REL8     LDML   /TS/P.CRN,CTST  CHECK IF COMMAND REFERENCE NUMBERS AGREE
          LMML   RPB+CRN
          NJK    REL50       IF NOT
          RJM    SEL         SELECT SLAVE
          LDN    DATAIN      BUS A FOR DATA IN
          RJM    BCS         BUS CONTROL SEQUENCE
          LDC    H0281       STREAM AND READ
          RJM    FUNC
          ACN    DC
          LDML   RELCP5      CHECK IF SLAVE OR FACILITY IS SELECTED
          SHN    10
          PJN    REL10       IF FACILITY
          LDN    17          INPUT SLAVE ERROR LOG
          IAM    SLVEL,DC
          UJN    REL20       CONT.
 REL10    LDN    17          INPUT FACILITY ERROR LOG
          IAM    FACEL,DC
 REL20    STDL   WC          SAVE RESIDUAL WORD COUNT
          RJM    WSID        WAIT FOR SLAVE IN TO DROP
          LDN    EVENOT      USE EVEN OCTET MASTER ENCODED ENDING STATUS
          RJM    GES         GET ENDING STATUS
          RJM    DCM         DESELECT SLAVE
          LDDL   WC          CHECK IF INCOMPLETE TRANSFER
          NJN    REL80       IF YES
 REL40    LDN    1           SECONDS LIMIT
          RJM    IH          INTERRUPT HANDLER
          LMN    CCS         CHECK FOR COMMAND COMPLETE SUCCESSFUL
          ZJK    REL1        IF YES  EXIT
          LDN    0           DO NOT EXPECT BLOCK ID
          RJM    CMDRESP     COMMAND RESPONSE DECODE
          UJN    REL40       IF ASYNC

 REL50    LDK    E76         UNEXPECTED STATUS
          UJN    REL90
 REL80    LDN    E29         INCOMPLETE TRANSFER
 REL90    RJM    PCER        PREPARE COMMON ERROR RESPONSE
          RJM    EP          ERROR PROCESSING (NO RETURN)
          SPACE  4
*         -READ ERROR LOG-  COMMAND PACKET
 RELCP    DATA   0#0006      PACKET LENGTH
 RELCP1   DATA   0#FFFF      COMMAND REFERENCE NUMBER
 RELCP3   CON    OCREL+CMCHN+OMRELC  OP-CODE, CLEAR LOG AND CHAIN
 RELCP5   DATA   0#FFFF      ADDRESSEE
          SPACE  2
 V1       IFEQ   VALID,1     VALIDATE CPU TABLES/BUFFERS
          TITLE  VALIDATE CPU TABLES/BUFFERS
** NAME-- CHKPIT
*
** PURPOSE-- CHECK FOR VALID PP INTERFACE TABLE
          SPACE  2
 CHKPIT   SUBR               ENTRY/EXIT
          LDN    0
          STDL   T8
          LDML   PITB+/PIT/P.CBUFL  COMMUNICATION BUFFER LENGTH
          LPN    7
          NJK    CHKP100     IF LENGTH NOT A MULTIPLE OF WORDS

          LDML   PITB+/PIT/P.CBUFL  COMMUNICATION BUFFER LENGTH
          ADK    -B.CB       CHECK IF LONG ENOUGH
          MJK    CHKP100     IF NOT

          AODL   T8
          LDML   PITB+/PIT/P.CBUFL-1  RESERVED WORD OF PP COMMUNICATION
                             BUFFER DESCRIPTOR
          NJK    CHKP100     IF RESERVED WORD NOT ZERO

          AODL   T8
          LDML   PITB+/PIT/P.CBUF+1  COMMUNICATION BUFFER (RMA)
          LPN    7
          NJK    CHKP100     IF PP COMMUNICATION BUFFER NOT A WORD BOUNDARY

          AODL   T8
          LDML   PITB+/PIT/P.PPQPVA-1  RESERVED FIELD OF PP REQUEST
                             QUEUE DESCRIPTOR
          ADML   PITB+/PIT/P.PPQ-1
          NJK    CHKP100     IF RESERVED FIELD NOT ZERO

          AODL   T8
          LDML   PITB+/PIT/P.INT+1  INTERRUPT WORD (RMA)
          LPN    7
          NJK    CHKP100     IF INTERRUPT WORD NOT A WORD BOUNDARY
          AODL   T8
          LDML   PITB+/PIT/P.CHAN+1  CHANNEL TABLE (RMA)
          LPN    7
          NJN    CHKP100     IF CHANNEL TABLE NOT ON A WORD BOUNDARY

          AODL   T8
          LDML   PITB+/PIT/P.IN-3  IN POINTER RESERVED FIELD
          ADML   PITB+/PIT/P.IN-2
          ADML   PITB+/PIT/P.IN-1
          NJN    CHKP100     IF NON ZERO

          AODL   T8
          LDML   PITB+/PIT/P.OUT-3  OUT POINTER RESERVED FIELD
          ADML   PITB+/PIT/P.OUT-2
          ADML   PITB+/PIT/P.OUT-1
          NJN    CHKP100     IF NON ZERO

          AODL   T8
          LDML   PITB+/PIT/P.LIMIT-3  LIMIT POINTER RESERVED FIELD
          ADML   PITB+/PIT/P.LIMIT-2
          ADML   PITB+/PIT/P.LIMIT-1
          ZJK    CHKPITX     IF OK, EXIT

 CHKP100  BSS
          LDML   CHKPA,T8    INTERFACE ERROR CODE
          RJM    INTERR      SEND ERROR TO CM (NO RETURN)

 CHKPA    BSS
          CON    E20B        COMMUNICATION BUFFER LENGTH NOT A
                             MULTIPLE OF WORDS
          CON    E204        RESERVED WORD OF PP COMMUNICATION
                             BUFFER DESCRIPTOR NOT ZERO
          CON    E203        PP COMMUNICATION BUFFER NOT A WORD BOUNDARY
          CON    E205        RESERVED FIELD OF PP REQUEST QUEUE
                             DESCRIPTOR NOT ZERO
          CON    E211        RMA OF INTERRUPT WORD NOT A WORD BOUNDARY
          CON    E212        RMA OF CHANNEL TABLE NOT A WORD BOUNDARY
          CON    E20D        RESERVED FIELD OF IN POINTER IS NOT ZERO
          CON    E20E        RESERVED FIELD OF OUT POINTER IS NOT ZERO
          CON    E20F        RESERVED FIELD OF LIMIT POINTER IS NOT ZERO
          SPACE  5,20
** NAME-- CHKUD
*
** PUPOSE-- CHECK FOR VALID UNIT DESCRIPTOR
*
** ENTRY-- UX IS INDEX INTO UNITS TABLE
*          UNIT DESCRIPTOR IS IN UNITD BUFFER
          SPACE  2
 CHKUD    SUBR               ENTRY/EXIT
          LDML   UNITS+/UN/P.UIT,UX   CHECK IF DUPLICIATE UNIT
          ADML   UNITS+/UN/P.UIT+1,UX
          ZJN    CHKUD10     IF NOT DUPLICIATE UNIT
          LDK    E208
          UJN    CHKUD30     GO REPORT ERROR

 CHKUD10  LDML   UNITD+/UD/P.UQT+1   UNIT INTERFACE TABLE RMA
          LPN    7
          ZJN    CHKUD20     IF OK
          LDK    E209        UNIT INTERFACE TABLE NOT A WORD BOUNDARY
          UJN    CHKUD30     GO REPORT ERROR

 CHKUD20  LDML   UNITD+/UD/P.UNIT  CHECK PHYSICAL UNIT NUMBER
          SHN    -3
          ZJN    CHKUDX      IF OK, EXIT
          LDK    E210        INVALID PHYSICAL UNIT NUMBER

 CHKUD30  RJM    INTERR      SEND ERROR TO CM (NO RETURN)
          SPACE  5,20
** NAME-- CHKRS
*
** PURPOSE-- CHECK FOR VALID PP RESPONSE BUFFER
          SPACE  2
 CHKRS    SUBR               ENTRY/EXIT
          LDML   PITB+/PIT/P.RSBUF-2  RESERVED WORD OF RESPONSE
                             BUFFER DESCRIPTOR
          ADML   PITB+/PIT/P.RSBUF-1
          ADML   PITB+/PIT/P.RSPVA-1
          NJN    CHKR100     IF RESERVED FIELD NOT ZERO

          LDML   PITB+/PIT/P.IN-3  RESERVED FIELD OF IN POINTER
          ADML   PITB+/PIT/P.IN-2
          ADML   PITB+/PIT/P.IN-1
          NJN    CHKR100     IF RESERVED FIELD NOT ZERO

          LDML   PITB+/PIT/P.OUT-3  RESERVED FIELD OF OUT POINTER
          ADML   PITB+/PIT/P.OUT-2
          ADML   PITB+/PIT/P.OUT-1
          NJN    CHKR100     IF RESERVED FIELD NOT ZERO

          LDML   PITB+/PIT/P.LIMIT-3
          ADML   PITB+/PIT/P.LIMIT-2
          ADML   PITB+/PIT/P.LIMIT-1
          ZJK    CHKRSX      IF RESERVED FIELD NOT ZERO

 CHKR100  LDK    E207        RESERVED FIELD NOT ZERO
          RJM    INTERR      REPORT ERROR (NO RETURN)
          SPACE  5,20
** NAME-- CHKUIT
*
** PURPOSE-- CHECK FOR VALID UNIT INTERFACE TABLE
*
** ENTRY-- UIT IS IN THE TS TABLE FOR THE PP
          SPACE  2
 CHKUIT   SUBR               ENTRY/EXIT
          LDN    0
          STDL   T8
          LDML   UITB+/UIT/P.LU   UIT UNIT NUMBER
          LMML   UNITD+/UD/P.LU  UD UNIT NUMBER
          NJN    CUT100      LOGICAL UNIT NUMBER MISMATCH
          AODL   T8
          LDML   UITB+/UIT/P.UBUFL-1  RESERVED FIELD OF UNIT
                             COMMUNICATION BUFFER DESCRIPTOR
          NJN    CUT100      RESERVED FIELD IS NOT ZERO

          AODL   T8
          LDML   UITB+/UIT/P.UBUFL  UNIT COMMUNICATION BUFFER LENGTH
          LPN    7
          NJN    CUT100
          AODL   T8
          LDML   UITB+/UIT/P.UBUF+1  UNIT COMMUNICATION BUFFER
          LPN    7
          NJN    CUT100      NOT A WORD BOUNDARY
          AODL   T8
          LDML   UITB+/UIT/P.NEXTPV-1  RESERVED FIELD OF UNIT
                             REQUEST QUEUE DESCRIPTOR
          ADML   UITB+/UIT/P.NEXT-2
          ADML   UITB+/UIT/P.NEXT-1
          ZJK    CHKUITX     IF OK

 CUT100   LDML   CUTA,T8     INTERFACE ERROR CODE
          RJM    INTERR      SEND ERROR TO CM (NO RETURN)

 CUTA     BSS
          CON    E301        LOGICAL UNIT NUMBER MISMATCH
          CON    E303        RESERVED FIELD OF UNIT COMMUNICATION
                             BUFFER DESCRIPTOR IS NOT ZERO
          CON    E307        UNIT COMMUNICATION BUFFER LENGTH NOT A
                             MULTIPLE OF WORDS
          CON    E302        UNIT COMMUNICATION BUFFER NOT A WORD BOUNDARY
          CON    E305        RESERVED FIELD OF UNIT REQUEST QUEUE
                             DESCRIPTOR IS NOT ZERO
 V1       ENDIF
          TITLE  INITIALIZATION
** NAME-- INIT
*
** PURPOSE-- INITIALIZE DRIVER
*
** INPUT-- DSRTP = CM BYTE-ADDRESS OF THE WORD CONTAINING A POINTER
*                  TO THE PP INTERFACE TABLE.
          SPACE  2
 INIT     BSS                ENTRY POINT

* CLEAR MOST OF PP DIRECT CELLS

          LDK    DCCEND      CLEAR DCCEND DOWN THRU P1
          STDL   T8          SET INDIRECT CELL

 INIT10   LDN    0
          STIL   T8          CLEAR DIRECT CELL
          SODL   T8          CHECK FOR DONE
          PJN    INIT10      IF NOT DONE

* CLEAR PP MEMORY LOCATIONS

*    ON DEADSTART, ALL PP LOCATIONS FROM ENDCODE THRU ENDMEM ARE CLEARED.
*    ON RESUME, ALL THE ABOVE EXCEPT THE PP TS TABLE IS CLEARED.

          LDDL   INITFLG     CHECK IF DEADSTART INITIALIZE
          SBN    2
          ZJN    INIT30      IF RESUME

*         PROCESS DEADSTART INITIALIZE
          LDK    ENDMEM-ENDCODE
          STDL   T1          SET INDEX

 INIT20   LDN    0
          STML   ENDCODE,T1  CLR PP WORD
          SODL   T1          DECREMENT INDEX
          PJN    INIT20      IF NOT DONE LOOP
          UJN    INIT60      CONT.

 INIT30   BSS
*         PROCESS RESUME INITIALIZE
          LDK    ENDMEM-TS-P.TS
          STDL   T1          SET INDEX

 INIT40   LDN    0
          STML   TS+P.TS,T1  CLR PP WORD
          SODL   T1          DECREMENT INDEX
          PJN    INIT40      IF NOT DONE LOOP

          LDK    TS-ENDCODE-1
          STDL   T1          SET INDEX

 INIT50   LDN    0
          STML   ENDCODE,T1  CLR PP WORD
          SODL   T1          DECREMENT INDEX
          PJN    INIT50      IF NOT DONE LOOP

*  READ PP-INTERFACE-TABLE AND UNIT DESCRIPTOR TABLES.  NOTE - THIS IS
*  THE ONLY PLACE THE STATIC FIELDS OF THE PIT AND THE UNIT DESCRIPTOR
*  TABLES ARE READ INTO THE PP.  IF THE UNIT DESCRIPTOR TABLES EVER
*  CONTAIN DYNAMIC FIELDS, THEY MUST BE READ IN WHEN LOOKING FOR UNIT
*  REQUESTS.  ONLY UNIT DESCRIPTORS THAT ARE NOT NULL ENTRIES ARE
*  CONVERETED TO *UN* ENTRIES IN THE PP UNITS TABLE.

 INIT60   LDK    C.PIT       LENGTH OF PIT
          STDL   WC
          REFAD  DSRTP,CM.PIT  REFORMAT CM ADDRESS OF PIT
          LOADC  CM.PIT      LOAD R+A OF PIT
          CRML   PITB,WC     READ PIT

*  REFORMAT ADDRESS OF THE INTERRUPT WORD.

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

*  REFORMAT ADDRESS OF CHANNEL TABLE.

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

*  REFORMAT ADDRESS OF PP COMMUNICATIONS BUFFER

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

*  REFORMAT ADDRESS OF RESPONSE BUFFER.
*  INITIALIZE LIM.

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

          LDML   PITB+/PIT/P.PPNO   SET PP NUMBER
          STDL   PPNO

          LDML   TS1         USE PP TS TABLE
          STDL   CTST

          LDDL   INITFLG     CHECK IF INITIALIZATION IS FROM A RESUME
          SBN    2
          NJN    INIT70      IF NOT
          RJM    RERESP      SEND RESUME RESPONSE
 INIT70   BSS

 V2       IFEQ   VALID,1     VALIDATE CPU TABLES/BUFFERS
          RJM    CHKPIT      VALIDATE PIT
          RJM    CHKRS       VALIDATE RESPONSE BUFFER
 V2       ENDIF

          LDN    0           INITIALIZE LOOP CONTROL
          STDL   T2          NUMBER OF NON-NULL UNIT DESCRIPTORS
          STDL   T4          CM WORD OFFSET INTO UNIT DESCRIPTORS
          LDML   PITB+/PIT/P.UNITC  NUMBER OF UNIT DESCRIPTORS
          STDL   T1
          NJN    INIT80      IF UNITS DEFINED
          LDK    E213        NO DEFINED ACTIVE UNITS
          RJM    INTERR      INTERFACE ERROR (NO RETURN)

 INIT80   LOADC  CM.PIT      LOAD R REGISTER FOR PIT
          ADK    C.PIT       ADVANCE TO START OF UNIT DESCRIPTORS
          ADDL   T4          CM WORD OFFSET OF CURRENT UD
          CRML   UNITD,TWO   READ UD ENTRY INTO PP
          SODL   T1          DECREMENT TOTAL UNIT COUNT FROM PIT
          LDML   UNITD+/UD/P.UQT
          ADML   UNITD+/UD/P.UQT+1
          ZJK    INIT110     IF DUMMY ENTRY, DO NOT COUNT

*         BUILD UNITS AND SLAVE CONFIGURED TABLE INDEXES

          LDML   UNITD+/UD/P.CNTRLR  GET SLAVE NUMBER
          LPN    7B
          SHN    2
          STDL   SX          SET SLAVES CONFIGURED INDEX
          SHN    3
          STDL   UX          SAVE SLAVE OFFSET FOR UNITS TABLE INDEX
          LDML   UNITD+/UD/P.UNIT  GET FACILITY NUMBER
          LPN    7B
          SHN    2
          RADL   UX          SET UNITS TABLE INDEX

* CHECK FOR CHANGES IN SL AND UN
          ERRNZ  4-P.SL      IF SL HAS CHANGED
          ERRNZ  4-P.UN      IF UN HAS CHANGED
          ERRNZ  32-FACPSL*P.UN  IF FACILITIES PER SLAVE HAS CHANGED

 V3       IFEQ   VALID,1     VALIDATE CPU TABLES/BUFFERS
          RJM    CHKUD       VALIDATE UNIT DESCRIPTORS
          LDK    C.UIT       READ IN UIT AND VALIDATE
          STDL   WC          SAVE WORD COUNT
          LOADF  UNITD+/UD/P.UQT
          CRML   UITB,WC     READ UIT INTO PP TS TABLE
          RJM    CHKUIT      VALIDATE UIT
          LDML   UITB+/UIT/P.UTYPE   CHECK UNIT TYPE
          ADK    -T698.1
          ZJN    INIT85      IF OK
          LDK    E306        INVALID UNIT TYPE
          RJM    INTERR      REPORT ERROR  (NO RETURN)
 INIT85   BSS
 V3       ENDIF

* BUILD UNITS TABLE

          LDML   UNITD+/UD/P.LU  LOGICIAL UNIT NUMBER
          STML   UNITS+/UN/P.LU,UX

          LOADF  UNITD+/UD/P.UQT  REFORMAT AND SAVE UIT RMA
          STML   UNITS+/UN/P.UIT+1,UX  SAVE 2 HALF
          LDML   UNITD+/UD/P.UQT
          STML   UNITS+/UN/P.UIT,UX    SAVE 1 HALF

          LDML   UNITD+/UD/P.CHAN      GET CHANNEL NUMBER
          SHN    /UD/L.CHAN+/UD/N.CHAN+2  POSITION IT
          LPN    37B         MASK IT
          STDL   T3          SAVE IT
          LDDL   T2          CHECK IF FIRST ENTRY
          NJN    INIT90      IF NOT
          LDDL   T3          GET CHANNEL NUMBER
          STDL   CURCH       SET CURRENT CHANNEL

 INIT90   LDDL   T3          COMPARE CHANNEL NUMBERS
          LMDL   CURCH
          ZJN    INIT100     IF THE SAME
          LDK    E20A        INVALID CHANNEL NUMBER
          RJM    INTERR      REPORT ERROR (NO RETURN)

 INIT100  LDML   UNITD+/UD/P.UNIT   GET UNIT NUMBER
          LPN    7B
          STDL   T3          SAVE AS BIT SIGNIFICIANT INDEX
          LMK    /UN/K.CTF   SET CONFIDENCE TESTING REQUIRED FLAG
          STML   UNITS+/UN/P.FN,UX  SET FACILITY NUMBER

          LDML   SELT,T3     GET FACILITY BIT ADDRESS
          LMML   SLB+/SL/P.FBA,SX  MERGE WITH EXISTING FACILITIES
          STML   SLB+/SL/P.FBA,SX  SAVE THE UPDATE

          LDML   UNITD+/UD/P.CNTRLR  GET CONTROLER NUMBER
          LPN    7B
          SHN    /UN/N.FN  POSITION IT
          RAML   UNITS+/UN/P.SN,UX   SET SLAVE NUMBER

          AODL   T2          INCREMENT COUNT OF TOTAL ACTIVE UNITS
          ADK    -MAXUD
          ZJN    INIT120     IF REACHED MAX TABLE SPACE FOR UD-S

 INIT110  LDK    C.UD        INCREMENT TO NEXT CM UD
          RADL   T4
          LDDL   T1          CHECK TOTAL UNITS COUNT FROM PIT
          NJK    INIT80      IF NOT DONE SCANNING UD TABLES

 INIT120  LDDL   T1          CHECK IF MORE UD-S
          ZJN    INIT130     IF NONE LEFT
          LDK    E208        TO MANY CONFIGURED UNITS
          RJM    INTERR      REPORT ERROR  (NO RETURN)

 INIT130  LDDL   T2          RESET NUMBER OF ACTIVE UNITS
          STML   PITB+/PIT/P.UNITC
          NJN    INIT150     IF ANY ACTIVE UNITS DEFINED

          LDN    75B         NO ACTIVE UNITS
          STDL   IDLFLG      FORCE SET IDLE FLAG
*         DO NOT GENERATE ANY RESPONSE, WAIT FOR RESUME COMMAND
          LJM    MAIN        GO TO MAIN

*  INITIALIZE CONFIGURED SLAVES BY BIT ADDRESS (CSLVS)
*  AND TOTAL SLAVES CONFIGURED NUMBER (TSLVS) CELLS.

 INIT150  LDN    MAXSL       INITIALIZE LOOP COUNT
          STDL   T1
          LDN    0           INITIALIZE INDEX
          STDL   T2
          LDN    1           INITIALIZE SLIDING MASK
          STDL   T3
          LDN    0           INITIALIZE CSLVS AND TSLVS CELLS
          STDL   CSLVS
          STDL   TSLVS

 INIT160  LDML   SLB+/SL/P.FBA,T2  CHECK IF SLAVE IS CONFIGURED
          ZJN    INIT170     IF NOT
          LDDL   T3          SET CONFIGURED SLAVE BIT
          RADL   CSLVS
          AODL   TSLVS       INCREMENT TOTAL SLAVES CONFIGURED

 INIT170  LDDL   T3          SLIDE MASK
          SHN    1
          STDL   T3
          LDN    P.SL        INCREMENT INDEX
          RADL   T2
          SODL   T1          CHECK FOR DONE
          NJN    INIT160     IF NOT

* INITIALIZE SLAVE TS TABLES USABLE

          LDN    MCSLV       MAXIMUM CONCURRENT SLAVES TO SUPPORT
          SBDL   TSLVS       TOTAL CONFIGURED SLAVES
          MJN    INIT180     USE MAXIMUM VALUE
          LDDL   TSLVS       ELSE USE TOTAL SLAVES CONFIGURED
          UJN    INIT190

 INIT180  LDN    MCSLV       SET MAXIMUM VALUE

 INIT190  BSS
          STML   TNTAB       SAVE TOTAL NUMBER OF SLAVE TABLES TO SUPPORT

*  INITIALIZE CHANNEL INSTRUCTIONS.

          LDK    CONCH       MODIFY CHANNEL INSTRUCTIONS
          RJM    CHGCH

*  CLEAR PP COMMUNICATIONS BUFFER

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

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

* CLEAR REMAINING DIRECT CELLS

          LDN    T8          STARTING ADDRESS
          STDL   T1          SET INDIRECT CELL

 INIT210  LDN    0
          STIL   T1          CLEAR DIRECT CELL
          SODL   T1          CHECK FOR DONE
          PJN    INIT210     IF NOT
          LDN    0           CLEAR THE LAST CELL
          STDL   T1

*  EXIT TO MAIN IDLE LOOP

          LJM    MAIN        EXIT
          TITLE  PP TABLES AND BUFFERS
 CONCH    BSS                CHANNEL MODIFICATION LIST
 TDC+40B  HERE
 T40B+DC  HERE
 TDC      HERE
          CON    0           END OF TABLE
          SPACE  2
* BIT SIGNIFICANT SELECTION ADDRESS TABLE
 SELT     DATA   1,2,4,8
          DATA   16,32,64,128

          ERRNZ  8-SLVPCH    IF NUMBER OF SLAVES PER CHANNEL CHANGES
          SPACE  2
* SLAVE RESET EXECUTED TABLE,  INDEXED BY SLAVE ADDRESS
 SRTAB    BSSZ   MAXSL       NON ZERO ENTRY = SLAVE RESET EXECUTED
          SPACE  2
* TS TABLE ADDRESSES
 TS1      CON    TS          PP TS TABLE
 TS2      CON    TS+1*P.TS   FIRST SLAVE TS TABLE
 TS3      CON    TS+2*P.TS   NEXT TABLE

          ERRNZ  3-MAXTS     IF NUMBER OF TS TABLES CHANGE

 SCRATCH  BSSZ   100         SCRATCH AREA

 SLVEL    BSSZ   20          SLAVE ERROR LOG BUFFER
 FACEL    BSSZ   20          FACILITY ERROR LOG BUFFER
          SPACE  2
 ENDCODE  EQU    *           END OF PP CODE AREA
          SPACE  2
 FH2      IFEQ   FH,1        FUNCTION HISTORY TABLE
*
*         WORKING MEMORY
*
 FBUF     BSSZ   64          FUNCTION HISTORY BUFFER
 FBUFL    EQU    *-FBUF      FUNCTION HISTORY BUFFER LENGTH
          SPACE  2
 FH2      ENDIF
 KH3      IFEQ   KH,1        COMMAND/RESPONSE HISTORY
 HB       BSSZ   256         IPI COMMAND/RESPONSE HISTORY BUFFER
*         HB LENGTH MUST BE A MULTIPLE OF 8
 HBL      EQU    *-HB        HISTORY BUFFER LENGTH
 KH3      ENDIF
          SPACE  4
*
*         CHECK FOR BUFFER OVERLAP
*
          ERRNG  STRTBUF-*
          EJECT
          END
/EOR
