          IDENT  TAPE
          CIPPU
          TITLE  TAPE
          COMMENT *SMD* LVL=04
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC. 1992

*copyc iodmac1 "record definition macros"
*copyc iodmac2 "load/store macros"
*copyc iodmac3 "general macros"
*copyc iodmac4 "general macros"

* PP TABLE.

 PT       RECORD PACKED

 PPNO     PPWORD             PP NUMBER
 PART     PPWORD             PARTNER PP NUMBER
 PIT      RMA                PP INTERFACE TABLE ADDRESS (RMA)
 PITPVA   STRUCT 24          PP INTERFACE TABLE ADDRESS (PVA)

 PT       RECEND
          SPACE  6
* PP INTERFACE TABLE
 PIT      RECORD PACKED

 PPNO     PPWORD             PP NUMBER
 FLU      PPWORD             FIRST LOGICAL UNIT
 UNITC    PPWORD             NUMBER OF UNITS
          ALIGN  0,64
 INT      RMA                INTERRUPT WORD (RMA)
 CHAN     RMA                CHANNEL TABLE (RMA)
          PPWORD             UNUSED
 CBUFL    PPWORD             COMMUNICATION BUFFER LENGTH
 CBUF     RMA                COMMUNICATION BUFFER (RMA)
 LOCK     BOOLEAN            PP REQUEST QUEUE LOCK
          ALIGN  48,64
 LOCKPP   PPWORD             PP REQUEST QUEUE LOCK OWNER
          ALIGN  16,64
 PPQPVA   STRUCT 6           NEXT QUEUED PP REQUEST (PVA)
          ALIGN  32,64
 PPQ      RMA                NEXT QUEUED PP REQUEST (RMA)
          ALIGN  16,64
 RSPVA    STRUCT 14          RESPONSE BUFFER (PVA)
          ALIGN  32,64
 RSBUF    RMA                RESPONSE BUFFER (RMA)
          ALIGN  48,64
 IN       PPWORD             IN POINTER
          ALIGN  48,64
 OUT      PPWORD             OUT POINTER
          ALIGN  48,64
 LIMIT    PPWORD             LIMIT POINTER

 PIT      RECEND
          SPACE  6
* UNIT DESCRIPTORS.

 UD       RECORD PACKED

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

 UD       RECEND
          SPACE  6
* UNIT INTERFACE TABLE

 UIT      RECORD PACKED

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

          MASKP  DSABLE
 K.DSABLE EQU    MSK

 UIT      RECEND
          SPACE  6
* PP REQUESTS.

 RQ       RECORD PACKED

          ALIGN  16,64
 NEXTPV   STRUCT 6           NEXT REQUEST ON UNIT QUEUE (PVA)
          ALIGN  32,64
 NEXT     RMA                NEXT REQUEST ON UNIT QUEUE (RMA)
 LEN      PPWORD             REQUEST LENGTH
 LU       PPWORD             LOGICAL UNIT
 RECOV    SUBRANGE 0,3       ERROR RECOVERY OPTIONS
                               0 - ATTEMPT RECOVERY
                               1 - SUPPRESS RECOVERY, TERMINATE WITH
                                    ABNORMAL STATUS.
                               2 - RESERVED FOR FUTURE USE.
                               3 - SUPPRESS RECOVERY, CONTINUE THE REQUEST
                                    IGNORING ERROR CONDITIONS.
 INT      BOOLEAN            INTERRUPT CPU (IF SET)
 PORT     SUBRANGE 0,37B     MEMORY PORT USED FOR INTERRUPTS
          ALIGN  40,64
 PRIOR    SUBRANGE 0,377B    PRIORITY
          ALIGN  48,64
 LONGB    BOOLEAN            LONG INPUT BLOCK
          ALIGN  0,64
 SECADR   INTEGER            SECONDARY ADDRESS
 CMND     INTEGER            COMMAND SEQUENCE

 RQ       RECEND
          SPACE  6
* PP COMMAND.

 CM       RECORD PACKED

 CODE     SUBRANGE 0,377B    COMMAND CODE
 STOR     BOOLEAN            STORE RESPONSE (IF SET)
 INDIR    BOOLEAN            INDIRECT ADDRESS (IF SET)
          ALIGN  16,64
 LEN      PPWORD             LENGTH OF CM AREA (EITHER DATA AREA OR
                             LENGTH/ADDRESS WORD PAIR LIST)
 RMA      RMA                ADDRESS OF CM AREA
          MGEN   N.CODE
 M.CODE   EQU    MASK$

 CM       RECEND
          SPACE  6
* PP RESPONSE.

 RS       RECORD PACKED

          ALIGN  16,64
 PVA      STRUCT 6           PVA OF REQUEST
          ALIGN  32,64
 REQ      RMA                RMA OF REQUEST
 RESPL    PPWORD             RESPONSE LENGTH  (8-BIT BYTES)
 LU       PPWORD             LOGICAL UNIT
 RECOV    SUBRANGE 0,3       ERROR RECOVERY OPTIONS (FROM REQUEST)
 INT      BOOLEAN            INTERRUPT CPU (IF SET)
 PORT     SUBRANGE 0,37B     MEMORY PORT USED FOR INTERRUPTS
          ALIGN  40,64
 PRIOR    SUBRANGE 0,377B    PRIORITY
          ALIGN  48,64
          ALIGN  48,64       ALERT MASK
 LONGB    BOOLEAN            LONG INPUT BLOCK
          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.  EX: UNIT NOT READY,
                             UNIT NOT CONNECTED.
 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
          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)
          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
          ALIGN  0,64
 XFER     STRUCT 4           TRANSFER COUNT
 LASTC    RMA                LAST COMMAND (RMA)
 RESBID   STRUCT 60          AREA CONTAINING INDIVIDUAL BID RESPONSES FOR THE REQUEST
 CORCNT   STRUCT 2           COUNT OF ON THE FLY CORRECTIONS BY THE TAPE HARDWARE
 RESCNT   STRUCT 2           COUNT OF INDIVIDUAL BID RESPONSES FOR THIS REQUEST
 GSTAT    SUBRANGE 0,1777B   MAPPED STATUS WORD 1
 CHFL     BOOLEAN            CHARACTER FILL
          SUBRANGE 0,37B
 MSTAT    STRUCT 30          MAPPED STATUS WORDS 2 THROUGH 16

*THE EXTENDED STATUS AREA IS DEFINED TO PROVIDE THE LONG BLOCK FLUSHING BUFFER
* OF 24 DECIMAL PP WORDS THAT STARTS AT GSTAT.  WE ONLY NEED AN ADDITIONAL 8
* BYTES (4 PP WORDS), SO WE HAVE 32 DECIMAL BYTES (16 PP WORDS) THAT COULD BE
* OBTAINED IF SPACE BECOMES CRITICAL. WE ONLY OBTAIN EXTENDED STATUS ON AN ERROR.

 XSTAT    STRUCT 40          CMTS/ISMT EXTENDED STATUS AREA (5 CM WORDS)

          MASKP  INT
 K.INT    EQU    MSK
          MGEN   N.PORT
 M.PORT   EQU    MASK$
          MASKP  ABALRT
 K.ABALRT EQU    MSK
          MASKP  HDWR
 K.HDWR   EQU    MSK
          MASKP  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  CHFL
 K.CHFL   EQU    MSK
          MASKP  CHERO
 K.CHERO  EQU    MSK

 RS       RECEND
          SPACE  6
* PP COMMUNICATION BUFFER.

 CB       RECORD PACKED

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

 CONTRL   STRUCT 8           LOAD CONTROLWARE COMMAND
 CMCMD    STRUCT 8           CONTROL MODULE COMMAND
 CWPVA    STRUCT 24          CONTROLWARE RMA LIST PVA
 CMPVA    STRUCT 24          CONTROL MODULE RMA LIST PVA
 COMM     STRUCT 16          MASTER/SLAVE COMMUNICATION AREA
 SCRAT    STRUCT 16          SCRATCH AREA (SINGLE OR DUAL MASTER ONLY)
 ZEROES   STRUCT 120         120 BYTES (15 CM WORDS) OF ZERO


          MASKP  SLAVE
K.SLAVE   EQU    MSK


 CB       RECEND
          SPACE  6
* RESPONSE CODES.
 R.UNS    EQU    0           UNSOLICITED RESPONSE
 R.INT    EQU    40000B      INTERMEDIATE RESPONSE
 R.NRM    EQU    100000B     NORMAL REQUEST TERMINATION
 R.ABN    EQU    140000B     ABNORMAL REQUEST TERMINATION
 R.RCV    EQU    10000B      RECOVERED ERROR CAUSED RESPONSE
 R.FLG    EQU    20000B      FLAG FIELD CAUSED RESPONSE

* 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
          EJECT
 TP       EQU    0           CHANNEL NUMBER
 DSC      EQU    0           DST-DSP COMMUNICATIONS CHANNEL

 ALERT    EQU    4000B       ALERT CONDITION IN WORD 1 OF HARDWARE STATUS
 EOT      EQU    10B         END OF TAPE INDICATOR IN WORD 1 OF STATUS
 BUSY     EQU    2           BUSY INDICATOR IN WORD 1 OF STATUS
 BOT      EQU    4           BEGINNING OF TAPE INDICATOR IN WORD 1 OF STATUS
 TPMARK   EQU    20B         TAPE MARK INDICATOR IN WORD 1 OF STATUS
 CFILL    EQU    40B         CHARACTER FILL INDICATOR IN WORD 1 OF STATUS
 LOSTD    EQU    4000B       LOST DATA INDICATOR IN WORD 3 OF STATUS
 TPERR    EQU    3777B       HARDWARE ERROR BITS IN WORD 3 OF STATUS

 TIMERR   EQU    400B        TIMEOUT INTERFACE ERROR CODE BASE
 PITERR   EQU    1000B       PIT INTERFACE ERROR CODE BASE
 UITERR   EQU    1400B       UIT INTERFACE ERROR CODE BASE
 RQHERR   EQU    2000B       REQUEST HEADER INTERFACE ERROR CODE BASE
 CMDERR   EQU    2400B       COMMAND SEQUENCE INTERFACE ERROR CODE BASE

 F.RU67   EQU    1           RELEASE CONNECTED UNIT COMMAND FOR 67X
 F.FU67   EQU    4           FORMAT 67X TAPE COMMAND
 F.GS67   EQU    12B         GENERAL STATUS FUNCTION FOR 67X TAPES
 F.READ   EQU    40B         READ FORWARD
 F.MCLR   EQU    414B        MASTER CLEAR
 WRCMD    EQU    50B         WRITE HARDWARE FUNCTION FOR 67X TAPES
 SWRCMD   EQU    250B        SHORT WRITE HARDWARE FUNCTION FOR 67X TAPES
 F.MCLEAR EQU    100000B     MASTER CLEAR CIO ADAPTER BOARD
 F.WRCR   EQU    111000B     WRITE CONTROL REGISTER OF CIO ADAPTER
 F.RDESR  EQU    112000B     READ ERROR STATUS REGISTER OF CIO ADAPTER

 L.GS67   EQU    16          LENGTH OF STATUS IN 67X IN PP WORDS
 PITLEN   EQU    C.PIT+C.UD*8  LENGTH OF PP INTERFACE TABLE IN CM WORDS

 T639.1   EQU    16          UIT UNIT TYPE FOR 639-1 TAPE DRIVE
 T698     EQU    17          UIT UNIT TYPE FOR 698-XX TAPE DRIVE

 PJNI     EQU    0600B       PJN INSTRUCTION
 PSNI     EQU    2400B       PSN INSTRUCTION
 RJMI     EQU    0200B       RJM INSTRUCTION
 NJNI     EQU    0500B       NJN INSTRUCTION
 LDNI     EQU    1400B       LDN INSTRUCTION
 LDCI     EQU    2000B       LDC INSTRUCTION
 INPNI    EQU    102600B     INPN INSTRUCTION
 CRMLI    EQU    106100B     CRML INSTRUCTION
 CWMLI    EQU    106300B     CWML INSTRUCTION

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

 MAXIND   EQU    5           MAX INDIRECT LIST LENGTH
 MAXREQ   EQU    65          MAX REQUEST LENGTH IN CM WORDS
 ENDMEM   EQU    7777B       LARGEST PP MEMORY ADDRESS
 IOBUFLNG EQU    2064        LENGTH OF I/O BUFFER
 STIOBUF  EQU    ENDMEM-IOBUFLNG  STARTING ADDRESS OF I/O BUFFER
 DUALBUFL EQU    480         LENGTH OF DUAL PP I/O BUFFER IN PP WORDS
 DUALBUF  EQU    ENDMEM-DUALBUFL  STARTING ADDRESS OF DUAL PP I/O BUFFER
 WDCOUNT  EQU    640         640 CHANNEL WORDS = 960 BYTES
 NCCOMD   EQU    376B        NEW CHANNEL COMMAND
 HSHAKC   EQU    377B        HAND SHAKE COMMAND
 NORMRES  EQU    B.RS-5*8    LENGTH OF RESPONSE BUFFER IN BYTES (WITHOUT SENSE BYTES)

 FUNCCMD  EQU    40B         PHYSICAL COMMAND - FUNCTION (20 HEX)
 PWRTCMD  EQU    43B         PHYSICAL COMMAND - OUTPUT 8-BIT DATA (23 HEX)
 IDLCMD   EQU    4           PP IDLE COMMAND
 RSUMCMD  EQU    5           PP RESUME COMMAND
 LCREAD   EQU    101B        LOCICAL READ RECORD OF 8-BIT DATA (41 HEX)
 LCSTC    EQU    141B        LOGICAL COMMAND STORE TRANSFER COUNT (61 HEX)

 ERC101   EQU    1           PP REQUEST QUEUE LOCKWORD TIMEOUT
 ERC102   EQU    ERC101+1    UNIT REQUEST QUEUE LOCKWORD TIMEOUT
 ERC103   EQU    ERC102+1    UNIT LOCKWORD TIMEOUT
 ERC104   EQU    ERC103+1    CHANNEL LOCKWORD TIMEOUT
 ERC105   EQU    ERC104+1    BUFFER POOL LOCKWORD TIMEOUT
 ERC106   EQU    ERC105+1    UNIT HARDWARE RESERVE TIMEOUT
 ERC107   EQU    ERC106+1    CONTROLLER HARDWARE RESERVE TIMEOUT
 ERC201   EQU    1           RESERVED FIELD OF PP INT TBL HEAD NOT 0
 ERC202   EQU    ERC201+1    RMA OF UNIT ACTIVITY MASK NOT A WORD BOUNDARY
 ERC203   EQU    ERC202+1    RMA OF PP COMM BUF NOT A WORD BOUNDARY
 ERC204   EQU    ERC203+1    RESERVED FIELD OF PP COMM DESCRIPTOR NOT 0
 ERC205   EQU    ERC204+1    RESERVED FIELD OF QUEUE DESCRIPTOR NOT 0
 ERC206   EQU    ERC205+1    RMA OF NEXT PP NOT A WORD BOUNDARY
 ERC207   EQU    ERC206+1    RESERVED FIELD OF RESP BUF DESCRIPTOR NOT 0
 ERC208   EQU    ERC207+1    LOGICAL UNIT OUT OF RANGE
 ERC209   EQU    ERC208+1    RMA OF UIT NOT A WORD BOUNDARY
 ERC20A   EQU    ERC209+1    INVALID CHANNEL NUMBER IN UNIT DESCRIPTOR
 ERC301   EQU    1           LOGICAL UNIT NUMBER MISMATCH
 ERC302   EQU    ERC301+1    RMA OF UNIT COMM BUF NOT A WORD BOUNDARY
 ERC303   EQU    ERC302+1    RESERVED FIELD OF UNIT COMM BUF DESCRIPTOR NOT 0
 ERC304   EQU    ERC303+1    RMA OF NEXT UNIT REQUEST NOT WORD BOUNDARY
 ERC305   EQU    ERC304+1    RESERVED FIELD OF QUEUE DESCRIPTOR NOT 0
 ERC306   EQU    ERC305+1    RESERVED FIELD IN HEADER NOT ZERO
 ERC307   EQU    ERC306+1    ILLEGAL DEVICE TYPE
 ERC401   EQU    1           RMA OF NEXT REQUEST NOT A WORD BOUNDARY
 ERC402   EQU    ERC401+1    REQUEST LENGTH NOT A MULTIPLE OF 8 BYTES
 ERC403   EQU    ERC402+1    REQUEST LENGTH IS LESS THAN FOURTY BYTES
 ERC404   EQU    ERC403+1    LOGICAL UNIT NO .NE. UNIT NO IN INTERFACE TBL
 ERC405   EQU    ERC404+1    RESERVED LINKAGE FIELD IS NOT ZERO
 ERC406   EQU    ERC405+1    INVALID RECOVERY/INTERFACE SELECTIONS
 ERC407   EQU    ERC406+1    INVALID PRIORITY SELECTION
 ERC408   EQU    ERC407+1    INVALID SECONDARY ADDRESS
 ERC409   EQU    ERC408+1    INVALID ALERT CONDITION
 ERC40A   EQU    ERC409+1    REQUEST LENGTH TOO LARGE > 224 BYTES
 ERC501   EQU    1           INVALID COMMAND CODE
 ERC502   EQU    ERC501+1    INVALID FLAG SELECTION
 ERC503   EQU    ERC502+1    INVALID FUNCTION
 ERC504   EQU    ERC503+1    FUNCTION NOT SUPPORTED BY HARDWARE
 ERC505   EQU    ERC504+1    INVALID LENGTH SPECIFICATION IN COMMAND
 ERC506   EQU    ERC505+1    INVALID ADDRESS SPECIFICATION IN COMMAND
 ERC507   EQU    ERC506+1    INVALID LENGTH SPECIFICATION IN INDIRECT LIST
 ERC508   EQU    ERC507+1    INVALID ADDRESS SPECIFICATION IN INDIRECT LIST
 ERC509   EQU    ERC508+1    PP COMMAND NOT ALLOWED IN REQUEST TO A UNIT
 ERC50A   EQU    ERC509+1    INVALID SEQUENCE OF COMMANDS
 ERC50B   EQU    ERC50A+1    INVALID PARAMETER SPECIFICATION
 ERC50C   EQU    ERC50B+1    RESERVED FIELD IN INDIRECT LIST NOT 0
          SPACE  4,20
**        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
          EJECT
* DIRECT CELLS

 T0       CON    INIT-1      START OF INITIALIZATION ROUTINE

 T1       BSSZ   1           SCRATCH CELLS
 T2       BSSZ   1
 T3       BSSZ   1
 T4       BSSZ   1
 T5       BSSZ   1
 T6       BSSZ   1
 T7       BSSZ   1
 P1       BSSZ   1
 P2       BSSZ   1
 P3       BSSZ   1
 P4       BSSZ   1
 P5       BSSZ   1
 WC       BSSZ   1           CM WORD COUNT
 CMADR    BSSZ   3           CENTRAL MEMORY ADDRESS
 IDLFLG   BSSZ   1           PP IDLE FLAG, IF NONZERO ONLY PP REQUESTS ARE DONE.
 BIDINDX  BSSZ   1           INDEX INTO AREA CONTAINING INDIVIDUAL BID RESPONSES
 CHLOCK   BSSZ   1           CHANNEL LOCK FLAG
 CMDADR   BSSZ   1           ADDRESS OF ACTIVE COMMAND
 CMDNO    BSSZ   1           NO OF REMAINING COMMANDS
 LSTLEN   BSSZ   1           LENGTH OF INDIRECT LIST
          BSSZ   1           SPARE
          BSSZ   1           SPARE
 TRNCNT   BSSZ   4           TOTAL TRANSFER COUNT IN BYTES
 BYTCNT   BSSZ   1           NUMBER OF BYTES TO TRANSFER THIS I/O
 IOCNT    BSSZ   1           NUMBER OF PP WORDS TO TRANSFER THIS I/O
 UDPNT    BSSZ   1           UNIT DESCRIPTOR POINTER
 UNITP    BSSZ   1           UNIT POINTER
 MOTION   BSSZ   1           TAPE MOTION FLAG
 LIM      BSSZ   1           LIMIT OF RESPONSE BUFFER
 CONFLG   BSSZ   1           UNIT CONNECTED FLAG
 LONG     BSSZ   1           LONG INPUT BLOCK FLAG
 CM.CHAN  BSSZ   3           CM ADDRESS OF CHANNEL TABLE
 CM.COM   BSSZ   3           CM ADDRESS OF PP COMMUNICATION BUFFER - IF DUAL PP,
*                            THIS IS ALWAYS THE MASTERS PP COMMUNICATION BUFFER
 CM.RS    BSSZ   3           CM ADDRESS OF RESPONSE BUFFER
 CM.PIT   BSSZ   3           CM ADDRESS OF PP INTERFACE TABLE
 CM.UIT   BSSZ   3           CM ADDRESS OF UNIT INTERFACE TABLE
 CM.INT   BSSZ   3           CM ADDRESS OF INTERRUPT TABLE
 SETUPF   BSSZ   1           FLAG TO INDICATE DATA ALREADY IN PP (ON WRITE)
 ON       CON    1           CONSTANT ONE (DO NOT CHANGE THIS CELL)
 TW       CON    2           CONSTANT TWO (DO NOT CHANGE THIS CELL)
 DSRTP    CON    0           REAL MEMORY WORD-ADDRESS OF PIT
          CON    1
          BSSZ   1           SPARE
 RDFLG    BSSZ   1           SET NONZERO IF READ COMMAND
 PPNO     CON    5           LOGICAL PP NUMBER
 ID       CON    177777B     IDENTIFICATION

          ERRNZ  DSRTP-72B   MUST BE AT LOCATION 72

 LASTFC   EQU    DSRTP       LAST FUNCTION CODE
 LASTFC1  EQU    DSRTP+1     LAST NON-STATUS FUNCTION
          EJECT
          ORG    100B
*
* PP MONITOR
*
          SPACE  4
 TAPE     BSS    0
 MAIN     RJM    PPREQ       CHECK FOR ANY PP REQUESTS
          ZJN    MAIN010     IF NO PP REQUESTS, CHECK IF ANY UNIT REQ
 MAIN05   LJM    DORQ        PROCESS THE PP/UNIT REQUEST
*         *DORQ* RETURNS DIRECTLY TO *MAIN*.

 MAIN010  LDD    IDLFLG      GET IDLE FLAG
          NJN    MAIN020     IF IDLE FLAG SET, RELOOP
          RJM    UNITRQ      CHECK FOR, SKIP UNIT REQUEST CHECK
          NJN    MAIN05      IF THERE IS A UNIT REQUEST
 MAIN020  RJM    CKCHREQ     CHECK IF CHANNEL REQUESTED
          UJN    MAIN        LOOP FOR REQUESTS
          EJECT
** NAME - PPREQ
*
** PURPOSE - TO DETERMINE IF THERE ARE ANY PP REQUESTS TO PROCESS.  IF THERE
*            ARE, THE FIRST ONE IS COPIED INTO PP MEMORY.
*
** OUTPUT - A=0 IF NO PP REQUESTS.
*           A .NE. 0 IF THERE IS A PP REQUEST TO PROCESS.
*           IF THERE IS A REQUEST, (CMDNO) = NUMBER OF COMMANDS.
          SPACE   4
 NOPPQ    LDN    PPLK+40B    UNLOCK PP REQUEST QUEUE
          RJM    SCLK
 NOPPQ1   LDN    0           SET EXIT FOR NO REQUESTS FOUND

 PPREQ    SUBR               ENTRY/EXIT
          LOADC  CM.PIT      LOAD A AND R FOR PIT
          ADN    /PIT/C.PPQ
          CRDL   T1          READ REQUEST RMA FROM PIT
          LDDL   T3          HALF 1 OF REQUEST RMA
          ADDL   T4          HALF 2 OF REQUEST RMA
          ZJN    PPREQX      IF NO REQUEST QUEUED
          LDN    PPLK        LOCK PP REQUEST QUEUE
          RJM    SCLK
          NJK    NOPPQ1      RETURN IF PP REQUEST QUEUE ALREADY LOCKED
          LOADC  CM.PIT      CM ADDRESS TO A AND R FOR READ
          ADN    /PIT/C.PPQPVA
          CRML   PPTBL+/PIT/P.PPQPVA-1,TW  READ IN REQUEST PVA/RMA FROM PIT
          LDML   PPTBL+/PIT/P.PPQ  GET HALF 1 OF RMA OF 1ST REQUEST
          ADML   PPTBL+/PIT/P.PPQ+1
          ZJK    NOPPQ       IF RMA = 0 NO PP REQUEST QUEUED
          LDK    /RQ/C.CMND  LENGTH OF REQUEST HEADER
          STDL   WC
          LOADF  PPTBL+/PIT/P.PPQ  CM ADDRESS OF REQUEST TO A AND R
          CRML   REQBUF,WC   READ PP REQUEST HEADER
          LDML   REQBUF+/RQ/P.LEN  REQUEST LENGTH IN BYTES
          SHN    -3          REQUEST LENGTH IN CM WORDS
          SBN    /RQ/C.CMND  SUBTRACT HEADER LENGTH
          STDL   CMDNO       NUMBER OF COMMANDS THIS REQUEST
          LDDL   CMADR+2     READ COMMANDS FROM CM
          ADN    /RQ/C.CMND
          LMC    400000B
          CRML   CMDBUF,CMDNO
          LOADC  CM.PIT      SET A AND R TO PP INTERFACE TABLE
          ADN    /PIT/C.PPQPVA  SET A AND R TO PVA IN PP INTERFACE TABLE
          CWML   REQBUF+/RQ/P.NEXTPV-1,TW  RESET PVA AND RMA TO NEXT PVA AND RMA
          LDN    PPLK+40B    UNLOCK PP REQUEST QUEUE
          RJM    SCLK
          LDC    PPTBL+/PIT/P.PPQPVA-1  SET PIT PVA/RMA PP BUFFER ADDRESS
          STML   RESPSUA
          RJM    RESPSU      SET UP RESPONSE BUFFER
          LDN    1           SET GOT REQUEST FLAG
          UJK    PPREQX      EXIT
          EJECT
** NAME - UNITRQ
*
** PURPOSE - TO DETERMINE IF THERE ANY REQUESTS ON THE UNIT QUEUES.
*
** OUTPUT - A = 0 IF THERE ARE NO UNIT REQUESTS.
*           A .NE. 0 IF THERE IS A UNIT REQUEST TO PROCESS.
*           IF THERE IS A REQUEST, (CMDNO) = NUMBER OF COMMANDS.
          SPACE  4
 UQEMPT   LDN    0           SET NO UNIT REQUESTS

 UNITRQ   SUBR               ENTRY/EXIT
          LDML   PPTBL+/PIT/P.UNITC  GET NUMBER OF UNITS
          STDL   P1          SAVE FOR LOOP CONTROL

 UQLOOP   SODL   P1          DECREMENT LOOP CONTROL COUNTER
          MJN    UQEMPT      EXIT IF ALL UNITS CHECKED AND NO FINDS
          AODL   UNITP       INCREMENT UNIT POINTER
          SBML   PPTBL+/PIT/P.UNITC  SUBTRACT MAX UNIT NUMBER
          MJN    UQ2         SKIP IF NO RAP AROUND
          LDN    0           RESET POINTER TO START OF UNIT LIST
          STDL   UNITP
 UQ2      LDDL   UNITP       GET UNIT POINTER
          SHN    3           MULT BY 8 SINCE UNIT DESCRIPTOR 8 PP WORDS LONG
          STDL   UDPNT       SAVE POINTER INTO UNIT DESCRIPTOR

*         PRESET HAS TAKEN NULL UNIT DESCRIPTORS OUT OF THE PP COPY OF THE
*         UNIT DESCRIPTORS FOR THIS PIT.
*
*         LDML   UNITD+/UD/P.UQT,UDPNT  GET RMA UPPER HALF
*         ADML   UNITD+/UD/P.UQT+1,UDPNT  ADD RMA LOWER HALF
*         ZJK    UQLOOP      IF DUMMY ENTRY, LOOP TO NEXT ENTRY

          LOADF  UNITD+/UD/P.UQT,UDPNT  REFORMAT AND LOAD CM ADDRESS OF UIT
          STDL   CM.UIT+2    SAVE CM ADDRESS OF UIT
          SRD    CM.UIT
          ERRNZ  /UIT/C.DSABLE
          CRDL   T1          READ UNIT STATUS WORD FROM UIT
          ADN    /UIT/C.NEXT
          CRDL   T3          READ NEXT REQUEST RMA
          LDDL   T2          STATUS FIELD
          ERRNZ  /UIT/P.DSABLE-1
          SHN    18-16+/UIT/L.DSABLE
          MJN    UQLOOP      IF UNIT DISABLED
          LDDL   T5          HALF 1 OF REQUEST RMA
          ADDL   T6          HALF 2 OF REQUEST RMA
          ZJK    UQLOOP      IF NO REQUEST QUEUED
          LDDL   CONFLG      CHECK IF ANY UNIT CURRENTLY CONNECTED
          ZJN    UQ2.1       IF NO UNIT CONNECTED
          LPN    77B
          LMDL   UNITP
          ZJN    UQ2.2       IF CONNECTED UNIT IS SAME AS CURRENT REQUEST
 UQ2.1    LDN    UILK        LOCK UNIT INTERFACE TABLE
          RJM    SCLK
          NJK    UQLOOP      GO TO NEXT UNIT IF THIS ONE IS LOCKED
          LDDL   CONFLG
          ZJN    UQ2.2       IF NO UNIT CURRENTLY CONNECTED
          RJM    REL         RELEASE PREVIOUSLY CONNECTED UNIT
 UQ2.2    LDN    QULK        LOCK UNIT REQUEST QUEUE
          RJM    SCLK
          NJN    TRYNX1      GO TO NEXT UNIT IF THIS ONE LOCKED
          LDN    C.UIT       SET LENGTH OF UIT
          STDL   WC
          LOADC  CM.UIT      SET A AND R TO ADDR OF UIT
          CRML   UITBUF,WC   READ IN UNIT INTERFACE TABLE
          LDML   UITBUF+/UIT/P.DSABLE  GET UNIT STATUS
          SHN    18-16+/UIT/L.DSABLE
          MJN    TRYNXT      IF UNIT DISABLED
          LDML   UITBUF+/UIT/P.NEXT  HALF 1 OF RMA FOR REQUEST
          ADML   UITBUF+/UIT/P.NEXT+1  IF RMA=0 NO REQUEST QUEUED
          NJN    UQ3         IF REQUEST IS QUEUED
 TRYNXT   LDN    QULK+40B    UNLOCK UNIT REQUEST QUEUE
          RJM    SCLK
 TRYNX1   LDDL   CONFLG
          NJN    UQ2.3       IF UNIT ALREADY CONNECTED
          LDN    UILK+40B    UNLOCK UNIT INTERFACE TABLE
          RJM    SCLK
 UQ2.3    LJM    UQLOOP      LOOP TO NEXT UNIT

 UQ3      LDK    /RQ/C.CMND  LENGTH OF REQUEST HEADER
          STDL   WC          SAVE LENGTH FOR CM READ
          LOADF  UITBUF+/UIT/P.NEXT  SET A AND R TO ADDR OF REQUEST
          CRML   REQBUF,WC   READ REQUEST HEADER
          LOADC  CM.UIT      SET A AND R TO ADDRESS OF UIT
          ADN    /UIT/C.NEXTPV  POINT TO PVA
          CWML   REQBUF+/RQ/P.NEXTPV-1,TW  RESET PVA AND RMA OF NEXT REQUEST
          LDN    QULK+40B    UNLOCK UNIT REQUEST QUEUE
          RJM    SCLK
          LDML   REQBUF+/RQ/P.LEN  REQUEST LENGTH IN BYTES
          SHN    -3          REQUEST LENGTH IN CM WORDS
          SBN    /RQ/C.CMND  SUBTRACT HEADER LENGTH
          STDL   CMDNO       NUMBER OF COMMANDS THIS REQUEST
          LOADF  UITBUF+/UIT/P.NEXT
          ADN    /RQ/C.CMND
          CRML   CMDBUF,CMDNO
          LDC    UITBUF+/UIT/P.NEXTPV-1  SET UIT PVA/RMA PP BUFFER ADDRESS
          STML   RESPSUA
          RJM    RESPSU      SET UP RESPONSE BUFFER
          LDN    0
          STDL   BIDINDX     CLEAR INDEX INTO BID RESPONSE AREA
          LDML   UNITD+/UD/P.CNTRLR,UDPNT  SET EQUIPMENT NUMBER
          LPN    7
          SHN    9
          STML   FUNA
          LDN    1           SET GOT REQUEST FLAG
          UJK    UNITRQX     RETURN
          EJECT
** NAME - DORQ
*
** PURPOSE - PERFORM THE REQUIRED REQUEST.
*
** INPUT - REQUEST IN REQBUF.
*          (CMDNO) = NUMBER OF COMMANDS IN REQUEST.
*
** OUTPUT - REQUEST PROCESSED AND RESPONSE PLACED IN RESPONSE BUFFER.
*
          SPACE  4
 DORQ     BSS    0           ENTRY
          LDC    CMDBUF      ADDRESS OF FIRST COMMAND IN REQUEST
          STDL   CMDADR      INITIALIZE COMMAND ADDRESS
          LDN    0
          STDL   TRNCNT+3    INITIALIZE TRANSFER COUNT
          STDL   TRNCNT+2
          STDL   RDFLG       INITIALIZE READ FLAG
          STDL   MOTION      INITIALIZE MOTION FLAG
          STDL   LONG        INITIALIZE LONG INPUT BLOCK FLAG
*         LDC    PSNI        SET TO INPUT 16 STATUS WORDS
          STML   RDSTATA
 DORQ5    LDIL   CMDADR      GET COMMAND AND FLAGS
          SHN    -8          SHIFT OFF FLAGS
          STDL   T2          SAVE COMMAND
          LDN    0           INITIALIZE TABLE INDEX
          STDL   T1
 DORQ10   LDML   DORQA,T1    COMPARE TABLE ENTRY WITH CURRENT COMMAND
          LMDL   T2
          ZJN    DORQ20      IF FOUND REQUESTED COMMAND
          LDN    2           INCREMENT INDEX
          RADL   T1
          LMN    DORQAL
          NJN    DORQ10      IF NOT END OF TABLE
          UJN    *           IF END OF TABLE, NON-SUPPORTED COMMAND

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

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

          LJM    **          PROCESS COMMAND
 DORQB    EQU    *-1

**        AFTER COMMAND IS PROCESSED, THE COMMAND PROCESSOR ROUTINE WILL
*         RETURN TO *CMDONE* IF STATUS IS REQUIRED OR TO *NOSTAT* IF
*         STATUS IS NOT REQUIRED.  IF THE COMMAND IS AN OUTPUT DATA OR LOGICAL
*         READ, THE PROCESSOR WILL RETURN TO *CMDONE1*.

 CMDONE   RJM    GTSTAT      GET STATUS
          RJM    ERRCHK      CHECK FOR ERRORS

 CMDONE1  LDML   RESBUF+/RS/P.GSTAT+2  FETCH DETAILED STATUS
          NJN    CMD5        IF HARDWARE OR MEDIA ERROR
          LDDL   LASTFC1     GET LAST NON-STATUS FUNCTION
          SBN    13B
          ZJN    CMD7        IF FORSPACE
          SBN    40B-13B
          ZJN    CMD7        IF READ (SHOULD ONLY BE FORWARD READ TYPE)
          LPN    77B         MASK FOR ANY TYPE WRITE
          SBN    50B-40B
          ZJN    CMD9        IF WRITE TYPE
          SBN    51B-50B
          NJN    CMD11       IF NOT WRITE TAPE MARK FUNCTION
 CMD1     LDN    1           SET FILE MARK STATUS IN BID RESPONSE
 CMD3     STML   RESBID,BIDINDX  UPDATE BID RESPONSE AREA
          AOD    BIDINDX     INCREMENT INDEX INTO BID RESPONSE AREA
          STML   RESCNT      SET PRESENT BID RESPONSE AREA COUNT
 CMD5     UJN    CMD11

 CMD7     LDM    RESBUF+/RS/P.GSTAT  FETCH GENERAL STATUS
          LPN    20B         MASK FILE MARK STATUS
          NJN    CMD1        IF FILE MARK STATUS
 CMD9     LDM    RESBUF+/RS/P.GSTAT+3
          LPC    3000B       MASK OFF DOUBLE/SINGLE TRACK CORRECTION STATUS
          ZJN    CMD10       IF NO ON THE FLY HARDWARE CORRECTION
          AOM    CORCNT      INCREMENT HARDWARE CORRECTION COUNT
 CMD10    LDM    RESBUF+/RS/P.GSTAT+1  FETCH BID FOR THIS OPERATION
          UJN    CMD3        UPDATE BID RESPONSE AREA

 CMD11    LDDL   P2          FETCH FATAL ERROR FLAG FROM ERRCHK
          NJK    FAIL        IF STATUS BAD, GO TO FAIL
 NOSTAT   LDIL   CMDADR      GET COMMAND AND FLAGS
          LPC    STRSP       MASK OFF STORE TRANSFER COUNT FLAG
          ZJN    NOSTR       JUMP IF STORE RESPONSE NOT REQUIRED
          LDC    R.FLG
          RAML   RESBUF+/RS/P.RC  SET FLAG RESPONSE BIT
 NOSTR    BSS
          SODL   CMDNO       DECREMENT COMMAND COUNTER BY 1
          ZJN    DORQ1       GO TO COMPLETE REQUEST
          LDML   RESBUF+/RS/P.RC  CHECK IF INTERMEDIATE RESPONSE REQUIRED
          ZJN    NOST1       IF NO INTERMEDIATE RESPONSE
          LDC    R.INT       SET INTERMEDIATE RESPONSE FLAG
          RAML   RESBUF+/RS/P.RC
          RJM    RESP        STORE A RESPONSE
          RJM    RESPSU      SET UP RESPONSE BUFFER
 NOST1    BSS
          LDN    4           POINT TO THE NEXT COMMAND 4PP WORDS = COMMAND
          RADL   CMDADR
          UJK    DORQ5       RELOOP TO PERFORM NEXT COMMAND

 DORQ1    LDC    R.NRM
          RAML   RESBUF+/RS/P.RC  SET NORMAL REQUEST TERMINATION INDICATOR
 DORQ2    RJM    IODONE      TERMINATE REQUEST
          UJK    MAIN        RETURN TO MAIN LOOP

 FAIL     LDML   RESBUF+/RS/P.LONGB  CHECK ALERT MASK IF UNIT IS TO BE DISABLED
          SHN    18-16+/RS/L.DUNIT  DISABLE UNIT BIT TO SIGN POSITION
          PJN    FAIL1       IF NOT DISABLE UNIT BIT IN ALERT MASK
          LDC    /RS/K.DUNIT   SET UNIT DISABLED BIT IN RESPONSE
          RAML   RESBUF+/RS/P.LNGBLK  SET RESPONSE ALERT CONDITIONS
          LDC    /UIT/K.DSABLE  SET UNIT DISABLED IN UIT STATUS
          RAML   UITBUF+/UIT/P.DSABLE
          LOADC  CM.UIT
          CWML   UITBUF,ON   UPDATE FIRST WORD OF UIT
 FAIL1    LDC    R.ABN
          STML   RESBUF+/RS/P.RC  SET ABNORMAL TERMINATION RESPONSE
          UJN    DORQ2       TERMINATE REQUEST


**        THE FOLLOWING TABLE CONTAINS ONE ENTRY FOR EACH SUPPORTED COMMAND
*         OF THE TAPE SUBSYSTEM.  THE SECOND WORD OF EACH ENTRY IS THE ADDRESS
*         OF THE COMMAND PROCESSOR ROUTINE.

 DORQA    BSS    0
          CON    FUNCCMD,FUNC     PHYSICAL COMMAND - FUNCTION
 DORQC    CON    PWRTCMD,OUT8D    PHYSICAL COMMAND - OUTPUT 8-BIT DATA
*         CON    PWRTCMD,DOUT8D   (DUAL PP MASTER)
 DORQD    CON    LCREAD,READ      LOGICAL READ COMMAND
*         CON    LCREAD,DREAD     (DUAL PP MASTER)
 DORQE    CON    LCSTC,STRTC      LOCIGAL STORE TRANSFER COUNT
*         CON    LCSTC,DSTRTC     (DUAL PP MASTER)
          CON    IDLCMD,DOPPRQ    IDLE PP COMMAND
          CON    RSUMCMD,DOPPRQ   RESUME COMMAND
 DORQAL   EQU    *-DORQA     LENGTH OF TABLE
          EJECT
** NAME - DOPPRQ
*
** PURPOSE - PERFORM A PP REQUEST.
*
** INPUT - (T2) = COMMAND.
*
** OUTPUT - COMMAND PROCESSED.
*
** NOTE - THE ONLY PP REQUESTS CURRENTLY SUPPORTED ARE IDLE AND RESUME.
*
          SPACE  4
 DOPPRQ   BSS
          LDDL   T2          GET COMMAND
          SBN    RSUMCMD
          ZJN    DOPP10      IF RESUME COMMAND CLEAR IDLE FLAG
          RJM    CCLOCK      RELEASE CONNECTED UNIT AND CLEAR CHANNEL LOCK
          LDN    1           SET PP IDLE
 DOPP10   STDL   IDLFLG
          UJK    NOSTAT      GO TO DO NEXT COMMAND
          EJECT
** NAME - FUNC
*
** PURPOSE - TO PERFORM THE PHYSICAL COMMAND FUNCTION.
*
** INPUT -  (CMDADR) = ADDRESS OF COMMAND.
*
** OUTPUT - FUNCTION ISSUED IF NOT WRITE OR FORMAT.
*
          SPACE  4
 FUNC     BSS
          LDML   3,CMDADR    GET HARDWARE FUNCTION TO BE ISSUED
          SBN    F.FU67
          ZJK    FORMATU     IF FORMAT UNIT COMMAND GO TO FORMAT UNIT ROUTINE
          SBN    WRCMD-F.FU67
          ZJN    FUNC10      IF WRITE FUNCTION
          ADC    WRCMD-SWRCMD
          ZJN    FUNC10      IF SHORT WRITE FUNCTION
          LDML   3,CMDADR    GET HARDWARE FUNCTION TO BE ISSUED
          LMN    10B
          NJN    FUNC5       IF NOT REWIND FUNCTION
          LDML   RESBUF+/RS/P.GSTAT  GEN STATUS FROM FORMAT FUNCTION
          LPN    BOT
          ZJN    FUNC5       IF NOT AT LOAD POINT
          LJM    CMDONE1     RETURN FORMAT CONNECT STATUS

 FUNC5    LDN    0           SET TO INPUT 16 STATUS WORDS
          STML   RDSTATA
          LDML   3,CMDADR    GET HARDWARE FUNCTION TO BE ISSUED
          RJM    DOFUNC      DO FUNCTION
          UJK    CMDONE      GO TO DO NEXT COMMAND

 FUNC10   LDDL   MOTION
          ZJN    FUNC20      IF MOTION NOT STARTED
          LJM    NOSTAT      PROCESS NEXT COMMAND

 FUNC20   LJM    WRITE       PROCESS WRITE FUNCTION
*         LJM    DWRITE      (DUAL PP MASTER)
 FUNCA    EQU    *-1
          SPACE  4
 CONCHM   BSS    0           CHECK FOR CHANNEL INSTRUCTIONS SO FAR
 TTP+40B  HERE
 T40B+TP  HERE
 TTP      HERE
 CONCHML  EQU    *

          ERRNZ  CONCHML-CONCHM  ERROR IF ANY CHANNEL INSTRUCTIONS SO FAR
          EJECT
**        THE FOLLOWING AREA (LOCATIONS *DUALOV* THRU *EDUALOV*) IS
*         OVERLAID WITH DUAL PP VERSIONS OF THE ROUTINES IF THIS PP
*         IS THE MASTER IN A DUAL PP CONFIGURATION.


 DUALOV   EQU    *           DUAL PP OVERLAID AREA
          SPACE  4
** NAME - READ
*
** PURPOSE - PROCESS LOGICAL READ COMMAND.
*
** INPUT - (CMDADR) = ADDRESS OF COMMAND.
*
          SPACE   4
 READ     BSS
          AODL   RDFLG       SET READ COMMAND FLAG
          LDD    MOTION      CHECK TAPE MOTION FLAG
          NJN    READ5       IF TAPE ALREADY MOVING
          LDN    F.READ      ISSUE READ FUNCTION
          RJM    DOFUNC
          ACN    TP          ACTIVATE CHANNEL
 READ5    LDDL   CMDADR      SET CURRENT COMMAND ADDRESS
          STDL   T4
          RJM    SETUP       SET UP FOR READ
          LDN    0           CLEAR MOTION AHEAD FLAG
          STDL   MOTION
          STDL   LONG        CLEAR LONG INPUT FLAG
          LDDL   IOCNT       NUMBER OF 12-BIT CHANNEL WORDS
          IAPM   IOBUF,TP    INPUT DATA
          STDL   P1          SAVE RESIDUAL WORD COUNT IF ANY
          NJN    READ9       IF SHORT BLOCK
 READ7    LDN    32          CONTINUE INPUT TO CHECK FOR LONG INPUT BLOCK
          IAPM   RESBUF+/RS/P.GSTAT,TP  USE STATUS AREA AS TEMP BUFFER
          SBN    32
          ZJN    READ9       IF END OF DATA
          LMC    -0          COUNT CHANNEL WORDS INPUT
          RADL   LONG        NON-ZERO INDICATES LONG INPUT BLOCK
          UJN    READ7       CONTINUE INPUT

 READ9    DCN    40B+TP      DISCONNECT THE CHANNEL
          SFM    CPETERM,TP  CHECK AND CLEAR CHANNEL PARITY FLAG
          LDDL   LONG        ADD LONG INPUT BLOCK COUNT TO CHANNEL COUNT
          RADL   IOCNT
          SBDL   P1          SUBTRACT RESIDUAL WORD COUNT IF ANY
          STDL   IOCNT       ACTUAL CHANNEL WORDS INPUT
          SHN    1           MULTIPLY BY 3/2 AND ROUND DOWN
          ADDL   IOCNT
          SHN    -1
          ZJN    READ20      IF NO DATA READ
          RADL   TRNCNT+3    UPDATE TOTAL TRANSFER COUNT THIS REQUEST
          LDDL   CMDADR      SET ADDR OR LENGTH/ADDR PAIR FOR CURRENT OPERATION
          STDL   T4
          RJM    INLPR       WRITE DATA TO CM USING INDIRECT LIST
 READ20   RJM    GTSTAT      WAIT FOR END OF OPERATION
          RJM    CKFL        CHECK FOR CHARACTER FILL

*         CHECK IF LAST VALID 12-BIT CHANNEL WORD HAD AN EXTRA BYTE.
*         EXAMPLE  IF REQUESTED BYTE COUNT = 5 AND THE TAPE RECORD
*                  HAD 6 BYTES, THE LAST 12-BIT CHANNEL WORD
*                  WOULD CONTAIN THE SIXTH BYTE (CHARACTER FILL=0)
*                  AND NOT BE DETECTED AS A LONG BLOCK CONDITION.
*         THIS CONDITION CAN ONLY OCCUR IF REQUESTED BYTE COUNT IS ODD.

          LDDL   BYTCNT      GET REQUESTED BYTE COUNT
          SBDL   TRNCNT+3    COMPARE WITH ACTUAL BYTE COUNT
          PJN    READ30      IF NOT LONG BLOCK CONDITION
          LDN    2
          STDL   LONG        SET LONG BLOCK FLAG
 READ30   BSS
          RJM    ERRCHK      CHECK FOR ERRORS OR TERMINATION CONDITION
          LDDL   P2          CHECK IF ERROR OR TERMINATION CONDITION OCCURRED
          NJN    READ40      IF ERRORS OR TERMINATION CONDITION
          LDDL   CMDNO       COMMANDS REMAINING
          SBN    2
          ZJN    READ60      IF NO MORE POSSIBLE READ COMMANDS
          LDN    F.READ      START TAPE FOR NEXT BLOCK
          RJM    DOFUNC
          ACN    TP          ACTIVATE CHANNEL
          AODL   MOTION      SET TAPE MOTION FLAG
          UJN    READ50      PROCESS NEXT COMMAND

 READ40   LOADF  6,CMDADR    SET TRANSFER COUNT FOR ERROR BLOCK
          CWDL   TRNCNT
 READ50   LJM    CMDONE1     RETURN TO PROCESS NEXT COMMAND

*         THE PURPOSE OF THE FOLLOWING CODE IS TO REDUCE THE TIME BETWEEN
*         MULTIPLE REQUESTS.  BY RETURNING THE TRANSFER COUNT FOR THE LAST
*         READ HERE, THE NORMAL REQUEST PROCESSOR PATH IS AVOIDED FOR THE
*         LAST COMMAND (WHICH IS ALWAYS A STORE TRANSFER COUNT FOR READS).

 READ60   SODL   CMDNO       DECREMENT REMAINING COMMANDS (CAUSE EXIT FROM *DORQ*)
          LDN    4           ADVANCE TO LAST COMMAND (STORE TRANSFER COUNT)
          RADL   CMDADR
          LOADF  2,CMDADR    RETURN TRANSFER COUNT FOR LAST READ
          CWDL   TRNCNT
          LDN    0           CLEAR TRANSFER COUNT
          STDL   TRNCNT+3
          LJM    CMDONE1     RETURN
          EJECT
** NAME - WRITE
*
** PURPOSE - TO GET WRITE DATA FROM CENTRAL MEMORY AND ISSUE WRITE FUNCTION.
*
** INPUT - (CMDADR) = ADDRESS OF COMMAND.
*
          SPACE   4
 WRITE    BSS    0           ENTRY
          LDDL   SETUPF      CHECK IF DATA ALREADY IN PP
          NJN    WRITE10     IF DATA ALREADY READ INTO PP
          LDDL   CMDADR      SET LENGTH/ADDRESS PAIR TO CURRENT COMMAND + 1
          ADN    4
          STDL   T4
          RJM    SETUP       SET UP FOR WRITE OPERATION
          RJM    INLPR       READ DATA FROM CM USING INDIRECT LIST
 WRITE10  LDML   3,CMDADR    GET HARDWARE FUNCTION
          RJM    DOFUNC      ISSUE WRITE FUNCTION
          ACN    TP          ACTIVATE CHANNEL
          LJM    NOSTAT      PROCESS NEXT COMMAND
          EJECT
** NAME - SETUP
*
** PURPOSE - SET UP FOR READ OR WRITE OPERATION.
*
** INPUT - (T4) = COMMAND ADDRESS FOR OPERATION TO SET UP.
*
** OUTPUT - (BYTCNT) = BYTE COUNT OF BLOCK.
*           (IOCNT) = CHANNEL WORD COUNT OF BLOCK.
*           (T4) = UNCHANGED FROM ENTRY.
*           (LSTLEN) = LENGTH OF INDIRECT LIST.
*           (INLPRA-1) SET TO CORRECT INSTRUCTION TO READ/WRITE CM.
*           INDIRECT LIST READ INTO PP BUFFER.
*
** NOTE - IN THE CASE OF A COMMAND WITHOUT THE INDIRECT BIT SET,
*         THE LENGTH/ADDRESS PAIR IS MOVED TO THE INDIRECT BUFFER
*         AND (LSTLEN) = 1.  THIS IS DONE SO THE CODE THAT READS
*         AND WRITES CENTRAL MEMORY CAN BE COMMON WHETHER THE
*         INDIRECT BIT IS SET OR NOT.
          SPACE  4
*  READ INDIRECT LIST INTO INDLST

 SETUP10  LOADF  2,T4        SET UP CM ADDRESS IN A AND R
          CRML   INDLST,T5   READ INDIRECT LIST
          LDN    0
          STDL   BYTCNT      INITIALIZE BYTE COUNT
          STDL   T6          INITIALIZE INDEX
 SETUP15  LDML   INDLST+1,T6  ADD LIST ENTRY BYTE COUNT TO TOTAL
          RADL   BYTCNT
          LDN    4           INCREMENT TO NEXT LIST LENGTH FIELD
          RADL   T6
          SODL   T5
          NJN    SETUP15     IF NOT END OF LIST
 SETUP20  RJM    CBYTE       CONVERT BYTE COUNT TO CHANNEL COUNT
          LDDL   RDFLG
          ZJN    SETUP30     IF NOT READ OPERATION (I.E. WRITE)
          LDC    CWMLI-CRMLI  SET TO WRITE DATA TO CM
 SETUP30  ADC    CRMLI+WC    SET TO READ DATA FROM CM
          STML   INLPRA-1

 SETUP    SUBR               ENTRY/EXIT
          LDM    1,T4        SET BYTE COUNT IF NOT INDIRECT
          STDL   BYTCNT
          SHN    -3          SET LIST LENGTH IF INDIRECT
          STDL   LSTLEN
          STDL   T5
          LDIL   T4          CHECK IF INDIRECT ADDRESSING
          LPC    INDFLG
          NJK    SETUP10     IF INDIRECT LIST
          LDN    1           SET LIST LENGTH TO ONE
          STDL   LSTLEN
          LDML   1,T4        MOVE COMMAND LENGTH/ADDRESS TO INDIRECT BUFFER
          STML   INDLST+1
          LDML   2,T4
          STML   INDLST+2
          LDML   3,T4
          STML   INDLST+3
          LJM    SETUP20     CONVERT BYTE COUNT TO CHANNEL COUNT
          EJECT
** NAME - OUT8D
*
** PURPOSE - TO PERFORM THE PHYSICAL COMMAND OUTPUT 8-BIT DATA.
*
** INPUT - (CMDADR) = ADDRESS OF COMMAND.
*
          SPACE  4
 OUT8D    BSS    0           ENTRY
          LDDL   IOCNT       NUMBER OF 12-BIT CHANNEL WORDS
          OAPM   IOBUF,TP    OUTPUT DATA
          FJM    *,TP        WAIT UNTIL DONE
          DCN    40B+TP      DISCONNECT THE CHANNEL
          SFM    OUTCPE,TP   CHECK AND CLEAR CHANNEL PARITY ON OUTPUT
          NJK    WLATE       JUMP IF LATE ACKNOWLEDGE
          LDDL   BYTCNT      GET TRANSFER COUNT

 WEXIT    RADL   TRNCNT+3    UPDATE TOTAL TRANSFER COUNT THIS REQUEST
          SHN    -16
          RADL   TRNCNT+2
          LDDL   CMDNO       CHECK REMAINING COMMAND COUNT
          SBN    1
          STDL   MOTION      INDICATE SETUP PERFORMED OR NOT
          ZJN    OUT8D20     IF NO MORE COMMANDS THIS REQUEST
          LDDL   CMDADR      SETUP FOR NEXT WRITE
          ADN    8
 OUT8D5   STDL   T4
          RJM    SETUP       SET UP FOR NEXT WRITE
          RJM    INLPR       READ NEXT BLOCK FROM CM
 OUT8D10  RJM    GTSTAT      WAIT FOR END OF OPERATION
          RJM    ERRCHK      CHECK FOR ERRORS OR TERMINATION CONDITION
          NJN    OUT8D15     IF ERRORS OR TERMINATION CONDITION
          LDDL   MOTION
          ZJN    OUT8D15     IF SETUP AND READ DATA NOT PERFORMED
          LDML   7,CMDADR    GET WRITE FUNCTION FOR NEXT BLOCK
          RJM    DOFUNC      ISSUE FUNCTION
          ACN    TP          ACTIVATE CHANNEL
 OUT8D15  LJM    CMDONE1     PROCESS WRITE COMPLETION

 WLATE    STDL   T2          SAVE RESIDUAL TRANSFER COUNT
          LDDL   IOCNT       GET ORIGIONAL WORD COUNT
          SBDL   T2          SUBTRACT RESIDUAL WORD COUNT TO GIVE WORDS
                             TRANSFERED
          STDL   IOCNT       RESET WORDS TRANSFERED THIS COMMAND
          SHN    1           GET BYTE COUNT THIS COMMAND
          ADDL   IOCNT       (MULTIPLY BY 3/2 AND ROUND DOWN)
          SHN    -1
          UJK    WEXIT       RETURN

*         CHECK IF PENDING REQUEST AND IF ONE EXISTS, READ THE DATA INTO THE
*         PP IN ORDER TO MAINTAIN STREAMING ON MULTIPLE REQUESTS.

 OUT8D20  LOADC  CM.UIT      CHECK IF PENDING REQUEST
          ADN    /UIT/C.NEXT
          CRDL   T1
          LDDL   T3
          ADDL   T4
          ZJN    OUT8D30     IF NO PENDING REQUEST
          LOADF  T3          LOAD CM ADDRESS OF REQUEST
          ADN    /RQ/C.LEN
          CRDL   T1          REQUEST LENGTH
          ADN    /RQ/C.CMND-/RQ/C.LEN+2
          CRML   OUT8DA,ON   THIRD COMMAND OF REQUEST
          LDDL   T1          CHECK REQUEST LENGTH
          SBN    /RQ/C.CMND*8+3*8
          PJN    OUT8D40     IF REQUEST HAS AT LEAST 3 COMMANDS
 OUT8D30  LDN    0           SET FLAG INDICATING NO DATA IN PP
          STDL   SETUPF
          LJM    OUT8D10     OBTAIN STATUS FROM PREVIOUS WRITE

 OUT8D40  LDML   OUT8DA      CHECK THIRD COMMAND
          SHN    -8
          LMN    PWRTCMD
          NJN    OUT8D30     IF THIRD COMMAND NOT OUTPUT DATA
          AODL   SETUPF      SET FLAG INDICATING DATA IN PP
          LDC    OUT8DA      SET ADDRESS OF COMMAND
          LJM    OUT8D5      READ DATA INTO PP

 OUT8DA   BSSZ   4           THIRD COMMAND OF NEXT REQUEST
          EJECT
** NAME - STRTC
*
** PURPOSE - TO PERFORM THE LOGICAL COMMAND STORE TRANSFER COUNT.
*
** INPUT - (CMDADR) = ADDRESS OF COMMAND.
*
          SPACE  4
 STRTC    BSS
          LOADF  2,CMDADR    CM ADDRESS TO A AND R
          CWDL   TRNCNT      SEND TRANSFER COUNT TO CM
          LDN    0
          STDL   TRNCNT+3    CLEAR TRANSFER COUNT
          UJK    NOSTAT      PROCESS NEXT COMMAND
          EJECT
** NAME - INLPR
*
** PURPOSE - INDIRECT LIST PROCESSING - READ DATA FROM/WRITE DATA TO CM
*            USING THE INDIRECT LIST OF LENGTH/ADDRESS PAIRS.
*
** INPUT - (T4) = ADDRESS OF LENGTH/ADDRESS PAIR FOR CURRENT OPERATION.
*          (INLPRA-1) = SET TO CORRECT INSTRUCTION TO READ/WRITE CM.
*          (LSTLEN) = LENGTH OF INDIRECT LIST IN CM WORDS.
*          INDIRECT LIST READ INTO BUFFER *INDLST*.
*
** OUTPUT - IF WRITE OPERATION, DATA READ INTO PP FROM CM.
*           IF READ OPERATION, DATA WRITTEN FROM PP TO CM.
*
          SPACE  4
 INLPR    SUBR               ENTRY/EXIT
          LDDL   LSTLEN      SET LENGTH OF INDIRECT LIST
          STDL   T5          INITIALIZE LOOP CONTROL
          LDC    IOBUF       GET ADDRESS OF IO BUFFER
          STML   INLPRA      SET UP 1ST ADDRESS FOR CM READ
          LDC    INDLST      GET ADDRESS OF INDIRECT LIST

 INLPR10  STDL   T6          SET INDIRECT COMMAND POINTER
          LDML   1,T6        GET LENGTH IN BYTES
          ZJN    INLPRX      IF END OF RMA LIST
          ADN    7
          SHN    -3          CONVERT LENGTH TO CM WORDS
          STDL   WC          SAVE LENGTH FOR CM READ
          LOADF  2,T6        CM ADDRESS TO A AND R FOR CM READ
          CRML   **,WC       READ DATA FROM CM
*         CWML   **,WC       (WRITE DATA TO CM)
 INLPRA   EQU    *-1
          SODL   T5          DECREMENT LOOP COUNTER BY 1
          ZJK    INLPRX      RETURN IF DONE
          LDML   1,T6        GET LENGTH OF INDIRECT IN BYTES
          SHN    -1          CONVERT LENGTH TO PP WORDS
          RAML   INLPRA      RESET ADDRESS FOR NEXT CM READ
          LDDL   T6
          ADN    4           POINT TO NEXT INDIRECT IN LIST
          UJK    INLPR10     RELOOP FOR NEXT CM READ
          SPACE  4
 CONCHS   BSS    0           CHANNEL TABLE FOR SINGLE PP
 TTP+40B  HERE
 T40B+TP  HERE
 TTP      HERE
          CON    0           END OF TABLE


 EDUALOV  EQU    *           END OF OVERLAID AREA
 DUALOVL  EQU    EDUALOV-DUALOV  LENGTH OF ALLOWABLE OVERLAID AREA
          EJECT
**        NOTE - ROUTINES AND TABLES FROM LOCATION *EDUALOV* TO *ENDDUAL*
*                MAY BE USED BY THE SLAVE PP IN A DUAL PP CONFIGURATION.
          SPACE  4
** NAME - FORMATU
*
** PURPOSE - TO FORMAT A TAPE UNIT OR CONTROLLER (CONNECT)
*
** INPUT -
*
** OUTPUT -
          SPACE  4
 FORM50   LDC    PJNI+RDSTAT1-RDSTATA  RESET TO INPUT ONLY 4 STATUS WORDS
          STML   RDSTATA
          LJM    NOSTAT       PROCESS NEXT COMMAND

 FORMATU  BSS
          LDDL   CHLOCK
          NJN    FORM40      IF CHANNEL LOCK SET
 FORM20   LDN    CHLK        SET CHANNEL LOCK
          RJM    SCLK
          NJN    FORM20      IF CHANNEL LOCK NOT OBTAINED
          AOD    CHLOCK      SET CHANNEL CURRENTLY LOCKED
          UJN    FORM40      CHECK IF UNIT CONNECTED
*         LDC    F.MCLEAR    (CIO CHANNEL - MASTER CLEAR ADAPTER)
 FORMB    EQU    *-1
          CON    0           LOWER 12 BITS OF F.MCLEAR FUNCTION
          RJM    CHFUNC
          ZJN    FORM30      IF ERROR ON FUNCTION
          LDC    F.WRCR      WRITE CONTROL REGISTER
          RJM    CHFUNC
 FORM30   ZJK    FUNTERM     IF ERROR ON FUNCTION
          ACN    TP
          LDN    1           SET TO OUTPUT 1 WORD
          OAM    FORMC,TP
          DCN    40B+TP
 FORM40   LDDL   CONFLG      CHECK IF UNIT ALREADY CONNECTED
          NJN    FORM50      IF UNIT ALREADY CONNECTED
          LDDL   UNITP       SET UNIT CONNECTED FLAG
          LMC    4000B
          STDL   CONFLG
          LDDL   CM.UIT      SAVE UIT ADDRESS FOR ROUTINE *REL*
          STML   RELA
          LDDL   CM.UIT+1
          STML   RELA+1
          LDDL   CM.UIT+2
          STML   RELA+2
          LDN    F.FU67      GET FORMAT FUNCTION FOR 67X TAPE CONTROLLER
          RJM    DOFUNC      ISSUE THE FORMAT FUNCTION
          LDML   UNITD+/UD/P.UNIT,UDPNT  GET PHYSICAL UNIT NUMBER
          LPN    17B         RESTRICT UNIT NUMBER TO 4 BITS
          SHN    4           MOVE TO CORRECT LOCATION IN FORMBUF
          RAML   FORMBUF     INSERT UNIT NUMBER IN FORMAT PARAMETERS
          LDN    3           GET LENGTH OF PARAMETERS (IN PP WORDS)
          ACN    TP          ACTIVATE THE CHANNEL
          OAPM   FORMBUF,TP  OUTPUT THE FORMAT PARAMETERS
          FJM    *,TP        WAIT UNTIL DONE
          DCN    40B+TP      DISCONNECT THE CHANNEL
          SFM    OUTCPE,TP   CHECK AND CLEAR CHANNEL PARITY ON OUTPUT
          RJM    GTSTAT      OBTAIN STATUS
          LDML   RESBUF+/RS/P.GSTAT+2  DETAILED STATUS
          LPC    777B
          NJN    FORM45      IF FATAL CONNECT ERROR
*         NJN    FORM60      (CMTS CONTROLLER)
 FORME    EQU    *-1
          LDML   RESBUF+/RS/P.GSTAT  CHECK IF UNIT BUSY
          LPN    BUSY
          ZJK    FORM50      IF UNIT NOT BUSY
          LDN    32B         SET BUSY INDICATION IN WORD 3 OF STATUS
          STML   RESBUF+/RS/P.GSTAT+2
          LDML   RESBUF+/RS/P.GSTAT  ENSURE ALERT BIT SET
          LPC    3777B
          LMC    4000B
          STML   RESBUF+/RS/P.GSTAT
          UJN    FORM45      RETURN ERROR

 FORM60   LMN    2           CHECK IF ERROR CODE 2
          NJN    FORM45      IF NOT ERROR CODE 2
          LDN    32B         SET UNIT BUSY (ERROR CODE 32B)
          STML   RESBUF+/RS/P.GSTAT+2
 FORM45   LDK    /RS/K.HDWR
          STML   RESBUF+/RS/P.HDWR  SET RESPONSE
          UJK    FAIL        ABNORMAL TERMINATE

 OUTCPE   RJM    GTSTAT      OBTAIN STATUS
          LDK    /RS/K.CHERO  SET CHANNEL PARITY ON OUTPUT
          UJK    CPETERM1    SET RESPONSE AND EXIT

 FORMC    CON    400B        PARAMETER FOR WRITE CONTROL REGISTER

          ERRNZ  /RS/P.CHERO-/RS/P.CHERR  IF K.CHERO BIT NOT IN SAME WORD AS K.CHERR

          EJECT
** NAME - CKFL
*
** PURPOSE - CHECK FOR CHARACTER FILL.  IF SET, DECREMENT
*            BYTE COUNT.
*
          SPACE  4
 CKFL     SUBR               ENTRY/EXIT
          LDN    0
          STDL   RDFLG       CLEAR READ FLAG
          LDML   RESBUF+/RS/P.CHFL  CHECK IF CHARACTER FILL IS SET
          LPK    /RS/K.CHFL
          ZJK    CKFLX       IF NO CHARACTER FILL
          LDDL   TRNCNT+3
          ZJN    CKFLX       IF NO DATA READ (PROBABLY TAPE MARK)
          SODL   TRNCNT+3    DECREMENT TRANSFER COUNT
          UJK    CKFLX
          EJECT
** NAME - GTSTAT
*
** PURPOSE - TO GET THE GENERAL AND DETAILED STATUS FOR A 67X TAPE UNIT.
*
          SPACE  4
 GTSTAT   SUBR               ENTRY/EXIT
 GTSTATA  UJN    GTSTAT5     SET EOP WAIT TIME
*         RJM    WCLEAR      (DUAL PP MASTER - SYNC UP WITH SLAVE)
          CON    WCLEAR
 GTSTAT5  LDC    110         SET OUTER LOOP TIME
          STDL   T2
 GTSTAT10 LCN    0           EOP WAIT TIME
          STDL   T1          SET WAIT COUNTER
 STATLP1  LDN    F.GS67      GET GENERAL STATUS FUNCTION FOR 67X
          RJM    DOFUNC      ISSUE GENERAL STATUS FUNCTION
 STALOOP  ACN    TP          ACTIVATE CHANNEL
          LDN    10          WAIT 10 USEC ON 4X PPU SPEED
 STATLP2  FJM    RDSTAT,TP   JUMP WHEN 1ST WORD IS AVAILABLE
          SBN    1
          NJN    STATLP2     IF NOT TIMEOUT
          DCN    TP+40B      DISCONNECT THE CHANNEL
          SODL   T1          DECREMENT WAIT TIME
          NJN    STATLP1     RELOOP TO REISSUE THE STATUS FUNCTION
          SODL   T2          DECREMENT OUTER LOOP TIME
          NJN    GTSTAT10    IF NOT TIMEOUT
          LDK    /RS/K.HDWR
          UJK    FUNTERM  TERMINATE ON NO END OF OPERATION

 RDSTAT   LDN    4           SET FIRST 4 STATUS WORDS
          IAM    RESBUF+/RS/P.GSTAT,TP  INPUT GENERAL STATUS TO RESPONSE BUFFER
          LDML   RESBUF+/RS/P.GSTAT  CHECK FOR ALERT
          SHN    17-11
 RDSTATA  PJN    RDSTAT1     IF NO ALERT
*         PSN                (NOT READ OR WRITE)
          LDN    L.GS67-4    INPUT REMAINDER OF STATUS
          IAM    RESBUF+/RS/P.GSTAT+4,TP
 RDSTAT1  DCN    TP+40B
          CFM    GTSTATX,TP  CHECK AND CLEAR CHANNEL PARITY ON INPUT

*         ALL CHANNEL PARITY ERRORS ARE PROCESSED AT THIS POINT.

 CPETERM  LDC    /RS/K.CHERR  REPORT CHANNEL PARITY ON INPUT
 CPETERM1 STML   RESBUF+/RS/P.CHERR  REPORT CHANNEL PARITY ON INPUT/OUTPUT
          UJN    CPETERM2    RETURN RESPONSE TO CM
*         LDC    F.RDESR     (CONCURRENT CHANNEL - READ ERROR STATUS REGISTER)
 CPETERMA EQU    *-1
          CON    2000B       LOWER 12 BITS OF F.RDESR FUNCTION
          RJM    CHFUNC
          ZJK    FUNTERM     IF FUNCTION TIMEOUT
          ACN    TP          INPUT ERROR STATUS REGISTER
          IAN    TP
          DCN    40B+TP
          STML   RESBUF+/RS/P.IEC  RETURN REGISTER IN RESPONSE BUFFER
 CPETERM2 UJK    FAIL        RETURN RESPONSE TO CM
          EJECT
** NAME - ERRCHK
*
** PURPOSE - SET ALERT CONDITIONS AND ABNORMAL STATUS FIELDS FOR TAPE.
*
** OUTPUT - (P2) = 0 IF NO ABNORMAL CONDITION.
*           (P2) NON-ZERO IF ERROR DETECTED.
*           (A) = 0 IF NO ERRORS OR TERMINATION CONDITION.
*
          SPACE  4
 ERRCHK   SUBR               ENTRY/EXIT
          LDN    0
          STDL   T1          CLEAR TEMP ALERT CONDITIONS
          STDL   P2          CLEAR TEMP ABNORMAL STATUS
          LDM    RESBUF+/RS/P.GSTAT
          STDL   T4
          LPC    4074B
          ADM    RESBUF+/RS/P.GSTAT+2
          ADDL   LONG
          ZJN    ERRCHKX     IF NO ERRORS TO LOOK AT
          LDDL   LONG
          ZJN    CKPHY       IF NOT LONG INPUT BLOCK
          LDK    /RS/K.LNGBLK  SET LONG INPUT BLOCK CONDITION
          RADL   T1
 CKPHY    LDDL   T4          WORD ONE OF GENERAL STATUS
          LPN    EOT+BOT     MASK OFF PHYSICAL TAPE MARK INDICATORS
          ZJN    CKFMK       SKIP IF NEITHER EOT OR BOT SET
          LDK    /RS/K.PDLIM  SET PHYSICAL DELIMITER
          RADL   T1

 CKFMK    LDDL   T4          WORD ONE OF GENERAL STATUS
          LPN    TPMARK      MASK OFF TAPE MARK INDICATOR
          ZJN    CKLONG      SKIP IF TAPE MARK NOT INDICATED
          LDK    /RS/K.LDLIM  SET LOGICAL DELIMITER
 CKLONG   RADL   T1
          LPML   RESBUF+/RS/P.LONGB  MASK ALERTS WITH ALERT MASK
          STML   RESBUF+/RS/P.LNGBLK  SET ALERT CONDITIONS IN RESPONSE
          ZJN    CKINTER     SKIP IF NO ALERT CONDITIONS ENCOUNTERED
          LDK    /RS/K.ABALRT  SET ABNORMAL ALERT INDICATOR
          RADL   P2

 CKINTER  LDML   RESBUF+/RS/P.GSTAT+2  GET WORD 3 OF HARDWARE STATUS
          ZJN    SETALRT     SKIP IF NO ERRORS ARE INDICATED
          UJN    CHKUS       CHECK STATUS WORD 3

*         LDC    B.RS        (CMTS/ISMT - SET RESPONSE LENGTH)
 ERRCHKA  EQU    *-1
          CON    B.RS
          STML   RESBUF+/RS/P.RESPL  EXTENDED STATUS OVERFLOWS INTO I/O BUF
          LDC    216B        ISSUE ISMT EXTENDED STATUS FUNCTION
*         LDC    312B        (CMTS UNIT)
 ERRCHKB  EQU    *-1
          RJM    DOFUNC
          LDN    18          LENGTH OF EXTENDED 16 BIT STATUS WORDS
*         LDN    20          (CMTS UNIT)
 ERRCHKC  EQU    *-1
          ACN    TP
          IAM    RESBUF+/RS/P.XSTAT,TP  INPUT INTO RESPONSE BUFFER
          DCN    40B+TP
          SFM    CPETERM,TP  CHECK AND CLEAR CHANNEL PARITY ON INPUT
 CHKUS    LDM    RESBUF+/RS/P.GSTAT+2  WORD 3 OF HARDWARE STATUS
          SHN    17-10
          MJN    SETHDWE     IF UNIT CHECK
          LPN    1
          ZJN    SETHDWE     IF NOT LOST DATA
          LDK    /RS/K.DATOV  SET DATA OVERRUN
          UJN    SETALRT

 SETHDWE  LDK    /RS/K.HDWR  SET HARDWARE ERROR
 SETALRT  RADL   P2
          STML   RESBUF+/RS/P.ABALRT  SET ABNORMAL STATUS FIELD IN RESPONSE
          UJK    ERRCHKX     RETURN
          EJECT
** NAME - IODONE
*
** PURPOSE - TO TERMINATE THE PP REQUEST
*
** INPUT -
*
** OUTPUT -
*
          SPACE  4
 IODONE   SUBR               ENTRY/EXIT
          RJM    RESP        SEND RESPONSE TO CPU
          LDDL   CONFLG
          ZJN    IODONEX     IF NO UNIT CONNECTED
          LOADC  CM.UIT      CHECK IF PENDING REQUEST FOR CURRENT UNIT
          ADN    /UIT/C.NEXT
          CRDL   T1
          LDDL   T3
          ADDL   T4
          ZJN    IODONE2     IF NO PENDING REQUEST
          LDML   UITBUF+/UIT/P.DSABLE
          LPC    /UIT/K.DSABLE
          ZJN    IODONE3     IF UNIT NOT DISABLED BY PP
 IODONE2  RJM    REL         RELEASE CURRENT UNIT
 IODONE3  RJM    CKCHREQ     CHECK IF CHANNEL REQUESTED BY MALET
          UJK    IODONEX     RETURN
          EJECT
** NAME - REL
*
* PURPOSE - RELEASE CONNECTED UNIT AND CLEAR *UIT* INTERLOCK.
*
* INPUT - (RELA - RELA+2) = CM ADDRESS OF *UIT* TO CLEAR INTERLOCK.
          SPACE  4
 REL      SUBR               ENTRY/EXIT
          LDN    0           CLEAR CONNECTED FLAG
          STDL   CONFLG
          STDL   SETUPF      INDICATE NO DATA IN PP
          LDN    F.RU67      RELEASE UNIT
          RJM    DOFUNC
          LDN    PULK+40B    RELEASE UNIT INTERLOCK
          RJM    SCLK
          UJN    RELX        RETURN


 RELA     BSSZ   3           CM ADDRESS OF CURRENTLY LOCKED UIT
          EJECT
** NAME - SCLK
*
** PURPOSE - SET/CLEAR SPECIFIED LOCKWORD.
*
** INPUT - (A) = 0000XX IF SET LOCK.
*          (A) = 00004X IF CLEAR LOCK.
*          XX = INDEX INTO TABLE *SCLKA* OF LOCK TO SET/CLEAR.
*
** EXIT - (A) = 0 IF LOCK SUCCESSFULLY SET/CLEARED.
*         (A) .NE. 0 IF LOCK NOT SET/CLEARED.
*
** USES - T1, T2, T5, T7.
          SPACE  4
 SCLK10   RJM    CLOCK       CLEAR INTERLOCK

 SCLK     SUBR               ENTRY/EXIT
          STDL   T2          SAVE ENTRY
          LPN    37B         MASK OFF SET/CLEAR FLAG
          STD    T1
          LDM    SCLKA,T1    SET POINTER TO CM ADDRESS OF LOCKWORD
          STDL   T7
          LDM    SCLKA+1,T1  SET INDEX INTO TABLE
          STDL   T5
          LDDL   T2
          SHN    -5
          NJN    SCLK10      IF CLEAR LOCK
          RJM    LOCK        SET LOCK
          UJK    SCLKX       EXIT


 SCLKA    BSS    0
          LOC    0
 PPLK     CON    CM.PIT,/PIT/C.LOCK  PP REQUEST QUEUE LOCK
 UILK     CON    CM.UIT,/UIT/C.ULOCK  UNIT LOCK IN UNIT INTERFACE TABLE (USED BY *UNITRQ*)
 PULK     CON    RELA,/UIT/C.ULOCK    UNIT LOCK IN UNIT INTERFACE TABLE (USED BY *REL*)
 QULK     CON    CM.UIT,/UIT/C.QLOCK  QUEUE LOCK IN UNIT INTERFACE TABLE
 CHLK     CON    CM.CHAN,0            CHANNEL LOCK
          LOC    *O

 CURCH    EQU    SCLKA+CHLK+1  LOCATION ALWAYS CONTAINS CURRENT CHANNEL NUMBER
          EJECT
** NAME-- LOCK
*
** PURPOSE-- SET A LOCKWORD IN CENTRAL MEMORY.
*
** ENTRY--
*         T7 = THE ADDRESS OF THE 3 DIRECT CELLS WHICH CONTAIN
*              THE REFORMATED ADDRESS OF THE CENTRAL MEMORY
*              INTERFACE TABLE.
*         T5 = THE CENTRAL MEMORY WORD OFFSET WITHIN THE
*              INTERFACE TABLE OF THE LOCKWORD.
*
** EXIT--
*         A REGISTER = 0, IF THE LOCK WAS SET.
*         A REGISTER .NE. O, IF THE LOCK COULD NOT BE SET.
*
** ALGORITHM
*         1. WRITE THE INTERMEDIATE VALUE OF FFFF FFFF 0000 0000,
*            USING A RDSL INSTRUCTION.
*            (SET T1 - T4 = FFFF FFFF 0000 0000,
*            RDSL   T1)
*
*         2. AFTER EXECUTION OF 'RDSL T1',
*            IF T1 - T2 = FFFF FFFF,
*            THEN GO BACK AND EXECUTE STEP 1,
*            ELSE GO TO STEP 3.
*
*         3. IF T1 = 0, WRITE THE PP LOCKWORD TO CENTRAL MEMORY,
*            AS DESCRIBED IN THIS STEP.  ELSE IF T1 .NE. 0, GO TO
*            STEP 4.
*            TO WRITE THE PP LOCKWORD ID:
*            SET T1 - T4 = 8000 0000 0000 PPNO, WHERE PPNO IS THE
*            LOGICAL PP NUMBER OF THIS PP.
*            CWDL   T1.
*            SET THE A REGISTER = 0, AND EXIT.
*
*         4. IF T1 = 8000 AND T4 = PPNO, THIS LOCKWORD WAS ALREADY
*            RESERVED TO THIS PP.
*            RESTORE THE CENTRAL MEMORY LOCATION  (CWDL   T1).
*            SET THE A REGISTER = 0, AND EXIT.
*
*         5. IF T4 .NE. PPNO, THEN THIS LOCKWORD IS RESERVED TO
*            A DIFFERENT PROCESSOR.
*            SET BIT 16 OF THE LOCKWORD THAT WAS READ WITH THE
*            RDSL INSTRUCTION, AND WRITE THE CONTENTS BACK TO
*            CENTRAL MEMORY.
*            THE PURPOSE OF SETTING BIT 16 IS TO REQUEST THE
*            OTHER PROCESSOR TO GIVE UP THE LOCKWORD.
*            LDDL   T2
*            LPC    77777B
*            ADC    100000B
*            STDL   T2
*            CWDL   T1.
*            SET THE A REGISTER .NE. 0, AND EXIT.
          SPACE  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
          EJECT
** NAME-- CLOCK
*
** PURPOSE-- CLEAR A LOCKWORD IN CENTRAL MEMORY.
*
** ENTRY--
*         T7 = THE ADDRESS OF THE 3 DIRECT CELLS WHICH CONTAIN
*              THE REFORMATED ADDRESS OF THE CENTRAL MEMORY
*              INTERFACE TABLE.
*         T5 = THE CENTRAL MEMORY WORD OFFSET WITHIN THE
*              INTERFACE TABLE OF THE LOCKWORD.
*
** EXIT--
*         A REGISTER = 0, IF THE LOCK WAS CLEARED.
*         A REGISTER .NE. O, IF THE LOCK WAS NOT CLEARED.
*
** ALGORITHM
*         1. WRITE THE INTERMEDIATE VALUE OF FFFF FFFF 0000 0000,
*            USING A RDSL INSTRUCTION.
*            (SET T1 - T4 = FFFF FFFF 0000 0000,
*            RDSL   T1)
*
*         2. AFTER EXECUTION OF 'RDSL T1',
*            IF T1 - T2 = FFFF FFFF,
*            THEN GO BACK AND EXECUTE STEP 1,
*            ELSE GO TO STEP 3.
*
*         3. IF T4 .NE. PPNO, THIS LOCKWORD IS RESERVED TO A
*            DIFFERENT PROCESSOR.
*            RESTORE THE CONTENTS OF THIS CENTRAL MEMORY LOCATION
*            AS IT EXISTED BEFORE THE VALUE FFFF FFFF XXXX XXXX
*            WAS WRITTEN.
*            CWDL   T1.
*            SET THE A REGISTER .NE. 0, AND EXIT.
*
*         4. IF T4 = PPNO, THEN CLEAR THE LOCKWORD IN CENTRAL MEMORY.
*            SET T1 - T4 = 0000 0000 0000 0000.
*            CWDL   T1.
*            SET THE A REGISTER = 0, AND EXIT.
          SPACE  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
          EJECT
** NAME-- CCLOCK
*
** PURPOSE-- CLEARS THE CHANNEL LOCK IN THE CM CHANNEL TABLE
*
*  OUTPUT-- THE CHANNEL THAT THIS PP HAD LOCKED, WILL BE UNLOCKED.
*
*
          SPACE  4
 CCLOCK   SUBR               ENTRY/EXIT
          LDDL   CONFLG
          ZJN    CCLOCK1     IF NO UNIT CURRENTLY CONNECTED
          RJM    REL         RELEASE UNIT AND CLEAR UIT LOCK
 CCLOCK1  LDDL   CHLOCK      CHECK IF CHANNEL LOCKED
          ZJN    CCLOCKX     IF CHANNEL NOT LOCKED
          LDN    CHLK+40B    CLEAR CHANNEL LOCK
          RJM    SCLK
          LDN    0           CLEAR CHANNEL LOCK FLAG
          STDL   CHLOCK
          UJK    CCLOCKX     EXIT
          EJECT
** NAME-- CKCHREQ
*
** PURPOSE-- CHECK IF CHANNEL IS REQUESTED BY MALET.  IF SO, RELEASE
*            ANY CONNECTED UNIT AND CHANNEL.
*
          SPACE  4
 CKCHREQ  SUBR               ENTRY/EXIT
          LOADC  CM.CHAN     ADDRESS OF CHANNEL TABLE
          ADML   CURCH       CHANNEL IS INDEX INTO TABLE
          CRDL   T1          READ CHANNEL CM ENTRY
          LDDL   T2          OBTAIN MAINTENANCE BYTES OF CHANNEL WORD
          SHN    17-0        ALIGN MAINTENANCE BIT REQUEST TO SIGN BIT
          PJN    CKCHREQX    IF CHANNEL NOT REQUESTED
          RJM    CCLOCK      CLEAR CHANNEL LOCK
          UJN    CKCHREQX    RETURN
          EJECT
** 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  4
 INP      EQU    P4          IN POINTER
 OUTP     EQU    P5          OUT POINTER
          SPACE  4
 RESP     SUBR               ENTRY/EXIT
          LDDL   TRNCNT+3    GET TRANSFER COUNT
          STML   RESBUF+/RS/P.XFER+1  SET TRANSFER COUNT IN RESPONSE BUFFER
          LDDL   TRNCNT+2
          STML   RESBUF+/RS/P.XFER
          LDDL   CMDADR      GET PP ADDRESS OF LAST COMMAND
          ADC    -REQBUF     GET PP WORDS INTO REQUEST
          SHN    1           CM BYTES INTO REQUEST
          ADML   RESBUF+/RS/P.REQ+1  ADD ON HALF 2 OF REQUEST BUFFER RMA
          STML   RESBUF+/RS/P.LASTC+1  RMA HALF 2 OF LAST COMMAND
          SHN    -16         GET CARRY IF ANY
          ADML   RESBUF+/RS/P.REQ  ADD ON HALF 1 OF REQUEST BUFFER RMA
          STML   RESBUF+/RS/P.LASTC  RMA OF HALF 1 OF LAST COMMAND

* READ IN AND OUT POINTERS OF RESPONSE BUFFER.

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

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

          LDDL   INP
          SBDL   OUTP
          MJN    RESP20      IF IN .LT. OUT
          LDDL   LIM         IN .GE. OUT, SET OUT = OUT + LIMIT
          RADL   OUTP
 RESP20   LDML   RESBUF+/RS/P.RESPL  GET RESPONSE LENGTH
          STDL   T1
          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   RESBUF+/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
          ADC    RESBUF
          STML   RESPA       RESPONSE ADDRESS FOR 2ND BLOCK WRITE
 RESP50   BSS
          LOADC  CM.RS       LOAD CM ADDRESS OF RESPONSE BUFFER
          STDL   T6          SAVE CM ADDRESS
          ADDL   T3          ADD 'IN' OFFSET
          CWML   RESBUF,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
          LMC    400000B
          CWML   **,T5       WRITE 2ND PART OF RESPONSE TO CM
 RESPA    EQU    *-1         (BEGINNING OF RESPONSE BUFFER)
 RESP70   BSS
          LDDL   T1          NEW IN POINTER
          STDL   P4

* SET UP INTERRUPT PROCESSOR INSTRUCTION IF INTERRUPT IS SELECTED.

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

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

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

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

*  INTERRUPT PROCESSOR.

          LOADC  CM.INT      CM ADDRESS OF INTERRUPT WORD
          CWDL   PPNO-3      SET LAST BYTE NON-ZERO
 INTPRC   INPN   1           INTERRUPT OR PSN
          CRDL   T1          ACCESS CM (NEEDED FOR 810/830)
          LJM    RESPX       EXIT
          EJECT
** NAME - RESPSU
*
** PURPOSE - SET UP RESPONSE BUFFER
*
** INPUT - PIT, REQUEST AND (IF UNIT REQUEST) UIT READ INTO PP MEMORY.
*          *RESPSUA* SET UP FOR UIT OR PIT PVA/RMA PP BUFFER ADDRESS.
*
** OUTPUT - NECESSARY INFORMATION PLACED IN REQUEST BUFFER.  THE REMAINDER
*           OF THE BUFFER IS ZEROED OUT.
*
          SPACE  4
 RESPSU   SUBR               ENTRY/EXIT

*         ZERO OUT RESPONSE BUFFER STARTING AT ABNORMAL STATUS FIELD.

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

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

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

*         MOVE CURRENT REQUEST PVA/RMA FROM UIT OR PIT TO RESPONSE BUFFER.
*         *RESPSUA* IS SET UP FOR UIT OR PIT PVA/RMA PP BUFFER ADDRESS.

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


*         ENSURE THAT NUMBER OF ZERO BYTES IN PP COMMUNICATION BUFFER
*         IS ENOUGH TO ZERO THE NECESSARY PORTION OF THE RESP. BUFFER.
*         NOTE THAT WE DO NOT ZERO OUT THE LAST 40 OCTAL BYTES (8 PP WORDS) OF
*          THE EXTENDED STATUS AREA OF THE RESPONSE. WE DO NOT WISH TO TAKE THE
*          TIME AND THE CPU ZEROS AREA IS ONLY 15 CM WORDS IN LENGTH.

          ERRNG  /CB/B.ZEROES+/RS/C.ABALRT*8-/RS/C.XSTAT*8
          EJECT
** NAME - DOFUNC
*
** PURPOSE - ISSUE FUNCTION TO A CONTROLLER.
*
** INPUT - (A) = FUNCTION CODE TO ISSUE.
*
          SPACE  4
 DOFUNC   SUBR               ENTRY/EXIT
          STDL   LASTFC      SAVE FUNCTION CODE
          SBN    F.GS67
          ZJN    FUN1        IF STATUS REQUEST
          ADN    F.GS67
          STDL   LASTFC1     SAVE LAST NON-STATUS FUNCTION
 FUN1     LDC    0           EQUIPMENT NUMBER - SET IN *UNITRQ*
 FUNA     EQU    *-1
          ADDL   LASTFC      ADD FUNCTION CODE TO EQ NUMBER
          AJM    FUN40,TP    JUMP IF CHANNEL ACTIVE
          FAN    TP          ISSUE THE FUNCTION
          LDN    20          TIMEOUT 2-4 SECONDS ON ALL FUNCTIONS
          STDL   T0
 FUN5     LDC    100000      SET FOR MAXIMUM DELAY OF 100 MSEC.
 FUN10    IJM    DOFUNCX,TP  EXIT IF CHANNEL INACTIVE
          SBN    1
          NJN    FUN10       CONTINUE LOOPING UNTIL 100 MSEC EXPIRES
          SODL   T0          DECREMENT TIMEOUT COUNTER
          NJN    FUN5        RELOOP UNTIL TIMEOUT
 FUN40    DCN    40B+TP      DISCONNECT CHANNEL
          LDDL   LASTFC
          LMN    F.RU67
          ZJN    DOFUNCX     IF TIMEOUT OCCURRED ON RELEASE FUNCTION
          LDM    DOFUNC      FETCH CALLERS ADDRESS FOR RNI
          LMC    STALOOP
          ZJN    FUN50       IF GENERAL STATUS FUNCTION REQUEST
          RJM    GTSTAT       OBTAIN STATUS FOR LAST FUNCTION TIMEOUT
          LDML   RESBUF+/RS/P.GSTAT+2  STATUS WORD 3
          ZJN    FUN50       IF STATUS DOES NOT DIAGNOSE ERROR
          LDK    /RS/K.HDWR  SET HARDWARE MALFUNCTION
          UJN    FUNTERM     STORE RESPONSE BIT

 FUN50    LDC    /RS/K.FTO  FUNCTION TIMEOUT RESPONSE
 FUNTERM  STML   RESBUF+/RS/P.FTO  SET ABNORMAL RESPONSE FLAG BITS
          UJK    FAIL       TERMINATE TAPE REQUEST


          ERRNZ  /RS/P.FTO-/RS/P.HDWR  IF K.FTO BIT NOT IN SAME WORD AS K.HDWR
          EJECT
** NAME - CHFUNC
*
** PURPOSE - ISSUE FUNCTION CIO CHANNEL ADAPTER.
*
** INPUT - (A) = FUNCTION CODE TO ISSUE.
*
*
** OUTPUT - (A) = 0 IF FUNCTION REJECT.
          SPACE  4
 CHFUNC   SUBR               ENTRY/EXIT
          DCN    40B+TP
          FAN    TP
          LDC    377777B
 CHFUNC1  IJM    CHFUNCX,TP
          SBN    1
          NJN    CHFUNC1     IF NOT TIMEOUT
          DCN    40B+TP
          UJN    CHFUNCX     RETURN WITH (A) = 0
          EJECT
*         CONVERT BYTE COUNT TO 12-BIT CHANNEL COUNT.
*         MULTIPLY BYTE COUNT BY 2/3 AND ROUND UP.
          SPACE  4
 CBYTE    SUBR               ENTRY/EXIT
          LDN    0
          STDL   IOCNT       CHANNEL COUNT
          LDDL   BYTCNT      BYTE COUNT
          ZJK    CBYTEX      IF ZERO BYTE COUNT
          STDL   T1
          LDN    3           DIVIDE BY 3
          SHN    14
          STDL   T2
 CBY10    BSS                DIVIDE LOOP
          LDDL   IOCNT
          SHN    1
          STDL   IOCNT
          LDDL   T1
          SBDL   T2
          MJN    CBY20
          STDL   T1
          AODL   IOCNT       INCREMENT CHANNEL COUNT
 CBY20    BSS
          LDDL   T2
          SHN    -1
          STDL   T2
          NJN    CBY10       THIS CHECK WILL MULTIPLY BY 2
          LDDL   T1
          ZJK    CBYTEX      IF NO NEED TO ROUND UP
          AODL   IOCNT       ROUND UP IF REMAINDER
          UJK    CBYTEX      EXIT
          EJECT
** NAME-- FORMA
*
** PURPOSE-- FORMAT A CM REAL MEMORY ADDRESS.
*
** CALLING SEQUENCE-- LDC    ADDRESS
*                     RJM    FORMA
*
** INPUT-- - A REGISTER- IS THE ADDRESS OF A 2-WORD CM BYTE ADDRESS.
*
** OUTPUT-- -CMADR- IS THE ADDRESS OF THE RESULTING 3-WORD REFORMATED
*                CM ADDRESS.  THE FORMAT CAN BE USED BY THE LOADC MACRO.
*           -ADDRESS-, WORD 0, BITS 0-13 AND
*                      WORD 1, BITS 3-15, ARE REFORMATTED TO-
*           -CMADR-,   WORD 0, BITS 0-9,
*                      WORD 1, BITS 0-11,
*                      WORD 2, BITS 0-5.
*
          SPACE  4
 FORMA    SUBR               ENTRY/EXIT
          STDL   T1

* REFORMAT CM ADDRESS.

          LDML   1,T1
          LPN    7
          NJN    *           RMA ADDRESS ERROR, TEMPORARY HALT
          LDIL   T1
          LPN    37B
          SHN    16
          LMML   1,T1
          SHN    9
          STD    CMADR+1
          SHN    6
          LPN    77B
          STDL   CMADR+2
          LDIL   T1
          SHN    -5
          STD    CMADR
          LRD    CMADR
          LDDL   CMADR+2
          LMC    400000B
          UJK    FORMAX      EXIT
          EJECT
 CONCH    BSS    0           CHANNEL TABLE FOR SINGLE/DUAL PP MASTER
 TTP+40B  HERE
 T40B+TP  HERE
 TTP      HERE
          CON    0

 PPTBL    BSSZ   P.PIT       PP INTERFACE TABLE
 UNITD    BSSZ   P.UD*8      UNIT DESCRIPTOR PART OF PIT FOR 8 UNITS
*                            NOTE THIS MUST IMMEDIATLY FOLLOW PPTBL
 UITBUF   BSSZ   P.UIT       UNIT INTERFACE TABLE
 INDLST   BSSZ   MAXIND*4    INDIRECT ADDRESS/LENGTH BUFFER
 SPACE    EQU    INDLST+5    USED BY GETBL AND GETCM
 CBUFRMA  EQU    INDLST+6    USED BY GETBL AND GETCM
 NXSPACE  EQU    INDLST+9    SPACE IN THE NEXT BUFFER
 NBUFRMA  EQU    INDLST+10   ADDRESS (RMA) OF NEXT CM BUFFER
 REQBUF   BSSZ   MAXREQ*4    SET REQUEST BUFFER LENGTH
 FORMBUF  EQU    REQBUF+12   FORMAT UNIT DATA IS AT WORD 4 OF REQ BUF
 RESBUF   BSSZ   P.RS        RESPONSE BUFFER LENGTH (MAXIMUM)
 RESBID   EQU    RESBUF+/RS/P.RESBID   BID RESPONSE AREA
 CORCNT   EQU    RESBUF+/RS/P.CORCNT   HARDWARE CORRECTION COUNT
 RESCNT   EQU    RESBUF+/RS/P.RESCNT   BID RESPONSE COUNT
 ENDCODE  EQU    *           ADDRESS OF END OF CODE AND NON I/O BUFFERS
          ERRPL  ENDCODE-IOBUF  ERROR IF CODE AND I/O BUFFERS OVERLAP
          ORG    STIOBUF     PLACE IO BUFFER AT END OF PP MEMORY - DO NOT MOVE
 IOBUF    EQU    *           INPUT/OUTPUT DATA BUFFER
          ERRNZ  IOBUF+IOBUFLNG-7777B

 CMDBUF   EQU    REQBUF+/RQ/P.CMND  COMMAND BUFFER
          ORG    ENDCODE     PLACE FOLLOWING CODE AT END OF RESPONSE BUFFER
          EJECT
**        NOTE - THE CODE AND TABLES FROM HERE TO LOCATION *ENDDUAL* CAN
*                ONLY BE USED BY THE MASTER OR SLAVE PP IN A DUAL PP
*                CONFIGURATION.  A SINGLE PP DRIVER CANNOT COUNT ON THE
*                ROUTINES BEING INTACT EXCEPT AT INITIALIZATION.
          SPACE  4
** NAME - GETBL
*
** PURPOSE - DETERMINE THE RMA(S) OF THE CM BUFFER(S) THAT THIS PP
**           WILL USE DURING A TAPE READ.
*
** INPUT - INIBUF CALLED.
*
** OUTPUT - 6 PP WORD TABLE (CMTABLE)
*
          SPACE  4
 GETBL    SUBR               ENTRY/EXIT
          LDN    0
          STML   SPACE1      INITIALIZE RMA(S) AND LENGTHS FOR THIS READ
          STML   SPACE2
          STML   RMA2.1
          STML   RMA2.2
          LDML   CBUFRMA     RMA OF THE CURRENT CENTRAL BUFFER
          STML   RMA1.1
          LDML   CBUFRMA+1
          STML   RMA1.2
          LDM    NADAMAS     CHECK FOR ZERO SPACE LEFT
          NJN    GETBLX      EXIT - NO SPACE LEFT

          LDML   SPACE       SPACE IN CURRENT BUFFER
          ADC    -DUALBUFL*2
          MJN    GETBL10     IF NOT ENOUGH SPACE IN CURRENT BUFFER
          LDC    DUALBUFL*2
          STML   SPACE1      LENGTH TO BE USED IN BUFFER AT RMA1

 GETBL5   RJM    BUMPIT      RESET THE RMA(S) FOR THE NEXT TIME.
 GETBL7   LJM    GETBLX      EXIT

 GETBL10  LDML   SPACE       SET SPACE THIS RMA.
          STML   SPACE1
          LDC    DUALBUFL*2  DETERMINE HOW MUCH IS NEEDED FROM THE
          SBML   SPACE         NEXT (IF ANY) RMA.
          STDL   T1          T1 = HOW MUCH IS NEEDED
          LDML   NUMBUF      SEE IF THERE ARE ANY MORE BUFFERS
          NJN    GETBL20     THERE IS AT LEAST 1 BUFFER MORE

          AOM    NADAMAS     SET THE -NO MORE SPACE- FLAG
          UJN    GETBL7      EXIT

 GETBL20  LDML   NXSPACE     SPACE AVAILABLE IN THE NEXT BUFFER
          SBDL   T1          SUBTRACT HOW MUCH IS NEEDED
          ZJN    GETBL30     IF EQUAL
          MJN    GETBL40     IF STILL NOT ENOUGH
 GETBL22  LDDL   T1          MORE THAN ENOUGH
          STML   SPACE2      PUT THIS AMOUNT IN THE CMTABLE
 GETBL25  LDML   NBUFRMA     PUT THE SECOND RMA IN THE TABLE
          STML   RMA2.1
          LDML   NBUFRMA+1
          STML   RMA2.2
          LJM    GETBL5      UPDATE THE RMA(S) AND EXIT

 GETBL30  AOM    NADAMAS     SET END OF BUFFERS FLAG
          UJN    GETBL22     SET THE TABLE AND EXIT

 GETBL40  LDML   NXSPACE     NOT ENOUGH WITH 2 RMA-S
          STML   SPACE2      SET IT TO WHAT WE HAVE
          AOM    NADAMAS     SET END OF BUFFERS
          UJN    GETBL25     SET THE RMA AND EXIT
          EJECT
** NAME - GETCM
*
** PURPOSE - GET DATA FROM CENTRAL MEMORY FOR A TAPE WRITE
*
** INPUT -
*
** OUTPUT -
*
** DESCRIPTION - THE IDEA IS TO BUFFER INTO THE PP A -CHUNK- OF DATA
**               FROM CENTRAL MEMORY.  THE PP WORD LABELED -SPACE- HAS
**               THE NUMBER OF BYTES REMAINING IN THIS CM BUFFER.  WORD
**               -NUMBUF- IS THE NUMBER OF CM BUFFERS (INCLUDING THE
**               CURRENT ONE).  THE NEXT BUFFER WILL BE AT -CBUFRMA-
**               PLUS 10B (BUFFERS ARE WORD ALIGNED).  SINCE THIS IS A
**               DUAL PP DRIVER, EACH PP USES EVERY OTHER CHUNK (IE. GET
**               A CHUNK, SKIP A CHUNK).
          SPACE  4
 GETCM    SUBR               ENTRY/EXIT
          LDC    DUALBUFL*2  LENGTH OF THE BUFFER IN BYTES
          SBML   SPACE       SUBTRACT SPACE REMAINING IN THIS BUFFER
          PJN    GETCM1      IF NOT ENOUGH DATA IN THIS CM BUFFER
          LJM    GETCM30     READ DATA FROM CM

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

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

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

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

 GETCM40  LDDL   T6          CONVERT BYTE COUNT TO CHANNEL WORD COUNT
          STDL   BYTCNT      INPUT TO CBYTE ROUTINE
          RJM    CBYTE
          LDM    EODATA      SKIP BUMPIT AT END
          NJN    GETCM50     IF END OF DATA
          RJM    BUMPIT      ADJUST CBUFRMA
 GETCM50  LJM    GETCMX      EXIT
          EJECT
** NAME - WRITCM
*
** PURPOSE - WRITE DATA TO CM DURING A TAPE READ.
*
** INPUT -
*
** OUTPUT -
*
          SPACE  4
 WRITCM30 LDML   SHBYTEC     SET LONG INPUT BLOCK FLAG
          RADL   LONG
          SHN    -16
          ZJN    WRITCMX     IF NO OVERFLOW
          LDN    2           ENSURE COUNT IS NOT 0 OR 1
          STDL   LONG

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

 WRITCM3  LDML   SPACE2      IF SPACE2 = 0 THEN SET SPACE1 = SHBYTEC
          ZJN    WRITCM5
          LDML   SHBYTEC     ELSE SPACE2 = SHBYTEC - SPACE1
          SBML   SPACE1
          STML   SPACE2
          PJN    WRITCM10    IF SECOND RMA INVOLVED
          LDN    0
          STML   SPACE2
          UJN    WRITCM10    PROCESS THE WRITE

 WRITCM5  LDML   SHBYTEC
          STML   SPACE1

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

 WRITCM20 ADN    7           ROUND UP
          SHN    -3          CM WORDS
          STDL   T5
          LOADF  RMA2.1      FORMAT THE SECOND RMA
          CWML   **,T5       WRITE TO THE SECOND BUFFER
 WRITCMA  EQU    *-1
          LJM    WRITCMX     EXIT
          EJECT
** NAME - BUMPIT
*
** PURPOSE - INCREMENT THE LENGTH/ADDRESS RMA
*
** INPUT - NONE
*
** OUTPUT - CBUFRMA POINTS TO NEW BUFFER ADDRESS FOR THIS PP.  SPACE IS
**          SET APPROPRIATELY.
*
          SPACE  4
 BUMPIT   SUBR               ENTRY/EXIT
          LDC    DUALBUFL*4
          STDL   T4
          LDML   SPACE       THIS IS THE SPACE LEFT IN THE CURRENT
*                              BUFFER PRIOR TO THE LAST OPERATION.
          SBDL   T4          SUBTRACT FOR LAST OPERATION AND THE SPACE
*                              USED BY THE PARTNER.
          ZJN    BUMPIT20    IF NOT ENOUGH SPACE IN CURRENT RMA
          MJN    BUMPIT20    IF NOT ENOUGH SPACE IN CURRENT RMA
          STML   SPACE
 BUMPIT15 LDDL   T4          INCREMENT THE CURRENT RMA
          RAML   CBUFRMA+1
          SHN    -16         TAKE CARE OF OVERFLOW
          RAML   CBUFRMA
          UJN    BUMPITX     EXIT

 BUMPIT20 LDDL   T4          COMPUTE HOW MUCH SPACE IS NEEDED FROM NEXT
          SBML   SPACE         RMA (IF ANY)
          STDL   T4
          LDML   NUMBUF      ARE THERE ANY BUFFERS LEFT
          NJN    BUMPIT30    AT LEAST ONE LEFT
 BUMPIT28 AOM    ENTHERE     INDICATE IT ENDS IN THE PARTNER
          LDN    0           SET NO SPACE FOR THIS PP NEXT TIME
          STML   SPACE
          UJK    BUMPITX     EXIT

 BUMPIT30 LDML   INDLST+8    MOVE LENGTH/ADDRESS PAIR TO CURRENT
          STML   INDLST+4      L/A PAIR
          LDML   INDLST+9
          STML   INDLST+5
          LDML   INDLST+10
          STML   INDLST+6
          LDML   INDLST+11
          STML   INDLST+7
          RJM    GTNEWPR     GET NEXT LENGTH/ADDRESS PAIR
          LDDL   T4          IS THERE ENOUGH ROOM IN THIS BUFFER
          SBML   SPACE       THIS IS THE SPACE IN THE NEW BUFFER
          PJN    BUMPIT28    ENDS IN PARTNER

          LDML   SPACE       DECREMENT NEW SPACE BY WHAT IS NEEDED
          SBDL   T4
          STML   SPACE
          LJM    BUMPIT15    ADJUST THE RMA AND EXIT
          EJECT
** NAME - GTNEWPR
*
** PURPOSE - GET THE NEXT LENGTH/ADDRESS PAIR FROM THE INDIRECT
**           LIST.
*
** INPUT - NUMBUF = NUMBER OF THE BUFFER AT NBUFRMA
**         BUFLSTPT = RMA OF PAIR AT NBUFRMA
*
** OUTPUT - NEW LENGTH/ADDRESS PAIR READ OR NBUFRMA ZEROED.
*
          SPACE  4
 GTNEWPR  SUBR               ENTRY/EXIT
          SOML   NUMBUF      DECREMENT THE COUNT OF THE NUMBER OF
          NJN    GTNEWPR1      BUFFERS.
          STML   NBUFRMA     NONE LEFT - ZERO RMA
          STML   NBUFRMA+1
          STML   NXSPACE
          UJN    GTNEWPRX    EXIT

 GTNEWPR1 LDN    10B         INCREMENT THE BUFFER POINTER
          RAML   BUFLSTPT+1
          SHN    -16
          RAML   BUFLSTPT
          LOADF  BUFLSTPT    FORMAT THE ADDRESS IN A AND R
          CRML   INDLST+8,ON   READ IT INTO THE INDIRECT LIST BUFFER
          LDDL   RDFLG
          NJN    GTNEWPRX    IF READ (OR SLAVE PP)
          LDML   NXSPACE     ADD THIS BUFFER TO WRITE BYTE COUNT
          RADL   TRNCNT+3
          SHN    -16
          RADL   TRNCNT+2
          UJN    GTNEWPRX    EXIT
          EJECT
** NAME - WCLEAR
*
** PURPOSE - WAIT FOR THE SLAVE TO COMPLETE
*
** INPUT - NONE
*
** OUTPUT - SLAVE READY FOR NEXT COMMAND
          SPACE  4
WCLEAR    SUBR               ENTRY/EXIT
WCLEAR1   LOADC  CM.COM      LOAD R AND A FOR PP COMMUNICATION BUFFER
          ADN    /CB/C.COMM
          CRDL   T1
          LDDL   T1          SLAVE WILL CLEAR WHEN DONE
          ZJN    WCLEARX     COMPLETE
          LDN    10D         DELAY
          RJM    PAUS
          UJN    WCLEAR1     TRY AGAIN
          EJECT
** NAME - SENCOM
*
** INPUT - ADDR OF COMMAND IN A REGISTER
*
** OUTPUT - COMMAND SENT
          SPACE  4
SENCOM    SUBR               ENTRY/EXIT
          STML   SENCOMA     INSTRUCTION MODIFICATION
          LOADC  CM.COM      LOAD R AND A OF PP COMMUNICATION BUFFER
          ADN    /CB/C.COMM
          CWML   **,ON       SEND THE COMMAND
SENCOMA   EQU    *-1
          UJN    SENCOMX     EXIT
          EJECT
** NAME-- PAUS
*
** PURPOSE-- DELAY PROGRAM EXECUTION FOR A SPECIFIED NUMBER OF
*            MICROSECONDS.
*
** INPUT-- A REGISTER (BITS 00-06) SPECIFIES NUMBER OF MICROSECONDS
*          TO BE DELAYED.
*
          SPACE  4
 PAUS     SUBR               ENTRY/EXIT
 PAUS10   SBN    1           EACH ITERATION OF THIS SBN-NJN LOOP
          PSN
          PSN
          NJN    PAUS10      UTILIZES 1 MICROSECOND
          UJK    PAUSX
          EJECT
**  NAME - INIBUF
*
**  PURPOSE - ESTABLISH THE VALUES THAT WILL BE USED BY THE
**            GETCM AND GETBL SUBROUTINES.
*
**  INPUT - (T4) = ADDR OF LENGTH/ADDR PAIR FOR READ/WRITE TO INITIALIZE.
*
**  OUTPUT - SPACE = THE AMOUNT OF SPACE LEFT IN THE CURRENT CM
**                   BUFFER.
**           CBUFRMA = THE RMA OF THE CURRENT BUFFER.
**           NBUFRMA =  "   "  "   "  NEXT       "
**           BUFLSTPT = THE RMA POINTER TO THE CM ADDRESS OF THE LAST
**                     LENGTH/ADDRESS PAIR CURRENTLY IN PP MEMORY.
**           NUMBUF = THE NUMBER OF LENGTH/ADDRESS PAIRS ASSOCIATED
**                    WITH THIS COMMAND.
          SPACE  4
 INIBUF   SUBR               ENTRY/EXIT
          LDN    0           INITIALIZE SOME FLAGS
          STM    EODATA
          STM    ENTHERE
          STM    NADAMAS
          LDC    DUALBUFL*2  INITIALIZE SHORT BYTE COUNT
          STML   SHBYTEC
          LDIL   T4          GET COMMAND AND FLAGS
          LPC    INDFLG      GET THE INDIRECT FLAG (BIT 6)
          NJN    INIBUF1     IF INDIRECT LIST
          LDML   2,T4        THERE IS ONLY ONE BUFFER
          STML   CBUFRMA     POINT TO THE BUFFER
          LDML   3,T4        RMA'S ARE 2 PP WORDS LONG
          STML   CBUFRMA+1   STORE BOTH HALVES
          LDML   1,T4        GET THE LENGTH
          STML   SPACE       STORE IT AWAY FOR FUTURE USE
          LDN    0           SET NUMBER OF BUFFERS - 1
          STM    NUMBUF      SET THE BUFFER COUNT
          UJN    INIBUF2     UPDATE TRANSFER COUNT IF WRITE

 INIBUF1  LDML   1,T4        INDIRECT BUFFER LENGTH
          SHN    -3          LENGTH OF BUFFER LIST IS IN BYTES
          SBN    1
          STML   NUMBUF      SET NUMBER OF BUFFERS
          LDML   2,T4        INITIALIZE BUFLSTPT
          STML   BUFLSTPT    THIS WILL BE THE CM ADDRESS (RMA) OF THE LAST
          LDML   3,T4          LENGTH/ADDRESS PAIR CURRENTLY IN PP MEMORY.  IT
          ADN    10B           IS INCREMENTED IN ROUTINE *GTNEWPR*
          STML   BUFLSTPT+1
          SHN    -16
          RAML   BUFLSTPT
          LOADF  2,T4        SET UP ADDRESS OF THE INDIRECT LIST
          CRML   INDLST+4,TW  READ THE FIRST TWO LENGTH/
*                              ADDRESS PAIRS.  NOTE - CBUFRMA IS EQUATED
*                              TO INDLST+6.  SPACE IS EQUATED TO INDLST+5.
 INIBUF2  LDDL   RDFLG
          NJN    INIBUF4     IF READ OPERATION
          LDML   NUMBUF      ADD FIRST TWO BUFFERS TO WRITE BYTE COUNT
          ZJN    INIBUF3     IF ONLY 1 BUFFER
          LDML   NXSPACE     NUMBER OF BYTES IN SECOND BUFFER
 INIBUF3  ADML   SPACE       NUMBER OF BYTES IN FIRST BUFFER
          RADL   TRNCNT+3    UPDATE TRANSFER COUNT
          SHN    -16
          RADL   TRNCNT+2
 INIBUF4  CCF    *,TP        UNCONDITIONALLY CLEAR CHANNEL FLAG
          UJK    INIBUFX     EXIT
          EJECT
**        BUFFERS AND TABLES NEEDED ONLY FOR DUAL PP DRIVER.
          SPACE  4
*         THE FOLLOWING 6 LOCATIONS ARE USED TO PASS RMA(S) AND LENGTH
*         FOR TAPE READS.

 SPACE1   BSSZ   1           SPACE IN BYTES AT RMA1
 RMA1.1   BSSZ   1           FIRST HALF OF FIRST RMA
 RMA1.2   BSSZ   1           SECOND HALF OF FIRST RMA
 SPACE2   BSSZ   1           SPACE IN BYTES OF SECOND RMA
 RMA2.1   BSSZ   1           FIRST HALF OF SECOND RMA
 RMA2.2   BSSZ   1           SECOND HALF OF SECOND RMA
 HNDSHK   VFD    8/HSHAKC,8/0  HANDSHAKE COMMAND
          BSSZ   3           DO NOT SEPARATE THIS FROM HNDSHK
 NCHANC   VFD    8/NCCOMD,8/0  CHANGE CHANNEL COMMAND
          BSSZ   3           DO NOT SEPARATE THIS FROM NCHANC
 NUMBUF   BSSZ   1           NUMBER OF BUFFERS IN INDIRECT LIST
 BUFLSTPT BSSZ   2           POINTER TO THE INDIRECT LIST OF BUFFERS
 NADAMAS  BSSZ   1           NO MORE CM BUFFER SPACE (TAPE READ)
 EODATA   BSSZ   1           END OF DATA FLAG (USED FOR WRITE)
 ENTHERE  BSSZ   1           FUNCTION ENDS IN PARTNER PP FLAG
 AREG     BSSZ   1           A REGISTER CONTENTS AFTER A READ
 SHBYTEC  BSSZ   1           BYTE COUNT ON A SHORT READ
 ENDDUAL  EQU    *           END OF DUAL PP CODE AND NON I/O BUFFERS
          ERRPL  ENDDUAL-DIOBUF  ERROR IF CODE AND I/O BUFFERS OVERLAP
          ORG    DUALBUF
 DIOBUF   EQU    *           DUAL PP I/O BUFFER
          ERRNZ  DIOBUF+DUALBUFL-7777B
          ORG    ENDDUAL     PLACE INITIALIZATION CODE IN BUFFER AREA
          EJECT
**        THE FOLLOWING CODE (FROM LOCATION *DUAL* TO *DUALL) IS MOVED
*         TO LOCATION *DUALOV* IF THIS PP IS A MASTER IN A DUAL PP
*         CONFIGURATION.  NOTE - IF THE PP IS A SLAVE, ROUTINES BETWEEN
*         *DUAL* AND *DUALL* OR *DUALOV* AND *EDUALOV* SHOULD ***NOT***
*         BE REFERENCED OR CALLED.


 DUAL     EQU    *           BEGINNING OF DUAL PP TO BE MOVED
          LOC    DUALOV
          SPACE  4
** NAME - DWRITE
*
** PURPOSE - ISSUE WRITE FUNCTION AND READ FIRST CHUNK FOR DUAL PP.
*
** INPUT - (CMDADR) = ADDRESS OF COMMAND.
*
          SPACE   4
 DWRITE   BSS
          LDML   3,CMDADR    GET HARDWARE FUNCTION
          RJM    DOFUNC      INITIATE TAPE MOTION
          ACN    TP          ACTIVATE CHANNEL
          LDDL   CMDADR      SET LENGTH/ADDRESS PAIR TO CURRENT COMMAND + 1
          ADN    4
          STDL   T4
          RJM    INIBUF      INITIALIZE BUFFER POINTERS
          RJM    GETCM       READ DATA FROM CM FOR FIRST CHUNK
          UJK    NOSTAT      GO TO DO NEXT COMMAND
          EJECT
** NAME - DOUT8D
*
** PURPOSE - TO PERFORM THE LOGICAL COMMAND OUTPUT 8-BIT DATA FOR DUAL PP.
*
** INPUT - (CMDADR) = ADDRESS OF COMMAND.
*
          SPACE  4
 DOUT8D   BSS    0           ENTRY
          LDM    EODATA      CHECK TO SEE IF THE SLAVE MUST BE CALLED
          NJN    DOUT8D1     IF SLAVE NOT NEEDED
          SCF    FLAGERR,TP  TEST AND SET THE CHANNEL FLAG
          LDDL   CMDADR      GET THE COMMAND ADDRESS AND SEND THE
          STML   DOUT8DA      COMMAND TO THE SLAVE
          LOADC  CM.COM      LOAD R AND A OF PP COMMUNICATION BUFFER
          ADN    /CB/C.COMM
          CWML   **,ON       SEND THE COMMAND TO THE SLAVE
 DOUT8DA  EQU    *-1
 DOUT8D1  LDDL   IOCNT       NUMBER OF 12 BIT CHANNEL WORDS
          FJM    *,TP
          OAPM   DIOBUF,TP   WRITE SOME TAPE
          CCF    *,TP        CLEAR CHANNEL FLAG TO START THE SLAVE
          LDM    EODATA      END OF DATA FLAG (SET BY GETCM)
          NJN    DOUT8D3     ENDED HERE - EXIT
          LDM    ENTHERE     IF IT ENDS IN THE SLAVE, WAIT
          NJN    DOUT8D2
          RJM    GETCM       GET MORE DATA TO WRITE
          FCJM   *,TP        WAIT FOR CHANNEL FLAG TO BE SET BY SLAVE
          UJN    DOUT8D1

 DOUT8D2  FCJM   *,TP        WAIT FOR SLAVE TO FINISH
 DOUT8D3  FJM    *,TP        WAIT FOR CHANNEL EMPTY
          DCN    40B+TP
          SFM    OUTCPE,TP   CHECK AND CLEAR CHANNEL PARITY ON OUTPUT
          LDDL   CMDNO       CHECK COMMANDS REMAINING
          SBN    1
          STDL   MOTION      INDICATE NEXT BLOCK SET UP OR NOT
          ZJN    DOUT8D5     IF NO MORE COMMANDS THIS REQUEST
          LDDL   CMDADR      SET UP FOR NEXT WRITE
          ADN    8
          STDL   T4
          RJM    INIBUF      INITIALIZE BUFFER POINTERS FOR NEXT BLOCK
          RJM    GETCM       READ FIRST CHUNK FOR NEXT BLOCK
 DOUT8D5  RJM    GTSTAT      WAIT FOR END OF OPERATION
          RJM    ERRCHK      CHECK FOR ERROR OR TERMINATION CONDITION
          NJN    DOUT8D10    IF ERROR OR TERMINATION CONDITION
          LDDL   MOTION
          ZJN    DOUT8D10    IF INIBUF AND READ DATA NOT PERFORMED
          LDML   7,CMDADR    GET WRITE FUNCTION FOR NEXT BLOCK
          RJM    DOFUNC      ISSUE FUNCTION
          ACN    TP          ACTIVATE CHANNEL
 DOUT8D10 LJM    CMDONE1     PROCESS WRITE COMPLETION

 FLAGERR  BSS    0           CHANNEL FLAG SET WHEN IT SHOULD NOT HAVE
          UJN    *             BEEN.  MASTER/SLAVE COMMUNICATION ASKEW.
          EJECT
** NAME - DREAD
*
** PURPOSE - PROCESS LOGICAL READ COMMAND FOR DUAL PP.
*
** INPUT - (CMDADR) = ADDRESS OF COMMAND.
*
          SPACE  4
 DREAD    BSS    0           ENTRY
          LDDL   MOTION      CHECK TAPE MOTION FLAG
          NJN    DREAD5      IF TAPE ALREADY MOVING
          LDN    F.READ      ISSUE READ FUNCTION
          RJM    DOFUNC
          ACN    TP          ACTIVATE CHANNEL
 DREAD5   LDDL   CMDADR      SET CURRENT COMMAND ADDRESS
          STDL   T4
          STML   DREADA      MODIFY THE WRITE INSTRUCTION
          AODL   RDFLG       SET READ COMMAND FLAG
          RJM    INIBUF      INITIALIZE POINTERS TO CM BUFFERS
          LDN    0           CLEAR TAPE MOTION FLAG
          STDL   MOTION
          STDL   LONG        CLEAR LONG INPUT BLOCK FLAG
          SCF    DREAD40,TP  TEST AND SET THE CHANNEL FLAG
          LOADC  CM.COM      LOAD R AND A OF PP COMMUNICATION BUFFER
          ADN    /CB/C.COMM
          CWML   **,ON       COMMAND GOES TO THE SLAVE
 DREADA   EQU    *-1
 DREAD10  LDC    WDCOUNT     ALWAYS TRY TO READ A FULL BUFFER
          IAPM   DIOBUF,TP   INPUT DATA FROM TAPE
          STM    AREG        SAVE THE CONTENTS OF THE A REGISTER
          CCF    *,TP        CLEAR THE CHANNEL FLAG TO START SLAVE
          NJN    DREAD20     SHORT READ PROCESSING
          RJM    WRITCM      WRITE THE DATA TO CM
          LDC    DUALBUFL*2  UPDATE THE TRANSFER COUNT
          RADL   TRNCNT+3
          SHN    -16
          RADL   TRNCNT+2
          FCJM   *,TP        WAIT FOR THE SLAVE TO SET THE FLAG
          UJN    DREAD10     DO IT ALL OVER AGAIN

 DREAD20  LDC    WDCOUNT     COMPUTE THE ACTUAL BYTE COUNT
          SBM    AREG        NUMBER OF 12 BIT CHANNEL WORDS MOVED
          STD    T5          STORE THIS VALUE TEMPORARILY
          SHN    1           MULTIPLY BY 3/2 TO GET BYTE COUNT
          ADD    T5
          SHN    -1          DONE - NOTE ROUNDED DOWN ON PURPOSE
          STM    SHBYTEC     STORE SHORT BYTE COUNT
          ZJN    DREAD30     IF COUNT = 0
          RADL   TRNCNT+3    UPDATE THE TRANSFER COUNT
          SHN    -16
          RADL   TRNCNT+2    UPDATE THE TRANSFER COUNT
          RJM    WRITCM      WRITE SHORT BUFFER TO CM
 DREAD30  DCN    40B+TP      DISCONNECT THE CHANNEL
          SFM    CPETERM,TP  CHECK AND CLEAR CHANNEL PARITY ON INPUT
          RJM    WCLEAR      WAIT FOR SLAVE TO COMPLETE COMMAND
          LOADC  CM.COM      READ SLAVES TRANSFER COUNT FROM PP COMM. BUFFER
          ADN    /CB/C.COMM+1
          CRDL   T1          T3 - T4 CONTAINS SLAVE TRANSFER COUNT
          LDDL   T4          ADD IT TO MASTER TRANSFER COUNT
          RADL   TRNCNT+3
          SHN    -16
          ADDL   T3
          RADL   TRNCNT+2
          LDDL   T1          SLAVE LONG INPUT BLOCK FLAG
          RADL   LONG
          SHN    -16
          ZJN    DREAD32     IF NOT OVERFLOW
          LDN    2           ENSURE COUNT NOT 0 OR 1
          STDL   LONG
 DREAD32  RJM    GTSTAT      WAIT FOR END OF OPERATION
          RJM    CKFL        CHECK FOR CHARACTER FILL
          LDDL   LONG        CHECK FOR LONG INPUT OF 1 BYTE
          SBN    1
          NJN    DREAD33     IF NOT 1 BYTE TOO LONG
          LDML   RESBUF+/RS/P.CHFL  CHECK FOR CHARACTER FILL
          LPK    /RS/K.CHFL
          ZJN    DREAD33     IF NO CHARACTER FILL
          LDN    0           INDICATE NOT LONG INPUT BLOCK
          STDL   LONG
 DREAD33  RJM    ERRCHK      CHECK FOR ERRORS OR TERMINATION CONDITION
          NJN    DREAD37     IF ERRORS OR TERMINATION CONDITION
          LDDL   CMDNO       COMMANDS REMAINING
          SBN    2
          ZJN    DREAD35     IF NO MORE POSSIBLE READ COMMANDS
          LDN    F.READ      START TAPE FOR NEXT BLOCK
          RJM    DOFUNC
          ACN    TP          ACTIVATE CHANNEL
          AODL   MOTION      SET TAPE MOTION FLAG
 DREAD35  LJM    CMDONE1     PROCESS NEXT COMMAND

 DREAD37  LOADF  6,CMDADR    RETURN TRANSFER COUNT OF ERROR BLOCK
          CWDL   TRNCNT
          UJN    DREAD35     EXIT

 DREAD40  UJN    *           CHANNEL FLAG SET WHEN IT SHOULD NOT BE
          EJECT
** NAME - DSTRTC
*
** PURPOSE - PERFORM LOGICAL COMMAND STORE TRANSFER COUNT FOR DUAL PP.
*
** INPUT - (CMDADR) = ADDRESS OF COMMAND.
*
          SPACE  4
 DSTRTC   BSS
          LOADF  2,CMDADR    CM ADDRESS TO A AND R
          CWDL   TRNCNT      SEND TRANSFER COUNT TO CM
          LDN    0           CLEAR TRANSFER COUNT
          STDL   TRNCNT+2
          STDL   TRNCNT+3
          UJK    NOSTAT      GO TO DO NEXT COMMAND
          EJECT
** NAME - SNEWC
*
** PURPOSE - SEND NEW CHANNEL COMMAND TO SLAVE.
*
** INPUT - (CURCH) = CHANNEL.
          SPACE  4
 SNEWC    SUBR               ENTRY/EXIT
          LDML   CURCH       SET CHANNEL IN COMMAND
          STML   NCHANC+3
          RJM    WCLEAR      ENSURE SLAVE IS READY
          LDC    NCHANC      SEND COMMAND TO SLAVE
          RJM    SENCOM
          UJK    SNEWCX      RETURN
          SPACE  4
 CONCHD   BSS    0           CHANNEL TABLE FOR DUAL MASTER
 TTP+40B  HERE
 T40B+TP  HERE
 TTP      HERE
          CON    0           END OF TABLE


          LOC    *O
 DUALL    EQU    *-DUAL      LENGTH OF MOVED CODE
          ERRNG  DUALOVL-DUALL  CODE TOO LONG FOR OVERLAID AREA
          EJECT
** NAME-- INIT
*
** PURPOSE-- INITIALIZE THE DRIVER AFTER DEADSTART.
*
** INPUT-- DSRTP = CM BYTE-ADDRESS OF THE WORD CONTAINING A POINTER
*                  TO THE PP INTERFACE TABLE.
          SPACE  4
 INIT     BSS

*  PAUSE A SUFFICIENT AMOUNT OF TIME TO PERMIT THE DEADSTART PP
*  TO DISCONNECT ALL CHANNELS.

          PAUSE  125000      DELAY 125 MILLISECONDS
          LDN    1           SET CONSTANTS
          STD    ON
          LDN    2
          STD    TW
          LDN    0           INSURE FLAG ZERO AT LOAD TIME
          STDL   SETUPF

*  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 SAVED
*  IN THE PP COPY.

          LDN    C.PIT       LENGTH OF PIT
          STDL   WC
          REFAD  DSRTP,CM.PIT  REFORMAT AND LOAD CM ADDRESS OF PIT
          CRML   PPTBL,WC    READ PIT

          LDML   PPTBL       SAVE PP NUMBER
          STDL   PPNO

          LDML   PPTBL+/PIT/P.UNITC  NUMBER OF UNIT DESCRIPTORS
          STDL   T1
          ZJK    INIT7       IF NO UNITS DEFINED
          LDN    0           INITIALIZE LOOP CONTROL
          STDL   T2          NUMBER OF NON-NULL UNIT DESCRIPTORS
          STDL   T3          PP WORD OFFSET INTO UNIT DESCRIPTORS
          STDL   T4          CM WORD OFFSET INTO UNIT DESCRIPTORS
 INIT3    LOADC  CM.PIT      LOAD R REGISTER FOR PIT
          ADN    C.PIT       ADVANCE TO START OF UNIT DESCRIPTORS
          ADDL   T4          CM WORD OFFSET OF CURRENT UD
          CRML   UNITD,TW    READ UD ENTRY INTO PP
 INITC    EQU    *-1
          LDML   UNITD+/UD/P.UQT,T3
          ADML   UNITD+/UD/P.UQT+1,T3
          ZJN    INIT5       IF DUMMY ENTRY, DO NOT COUNT
          AODL   T2          INCREMENT COUNT OF ACTIVE UNITS
          SBN    8
          ZJN    INIT6       IF REACHED MAX TABLE SPACE FOR UDS
          LDN    P.UD        INCREMENT TO NEXT PP UD
          RADL   T3
          LDN    P.UD
          RAML   INITC
 INIT5    LDN    C.UD        INCREMENT TO NEXT CM UD
          RADL   T4
          SODL   T1          DECREMENT TOTAL UNITS IN PIT
          NJN    INIT3       IF NOT DONE SCANNING UD TABLES
 INIT6    LDDL   T2          RESET NUMBER OF ACTIVE UNITS
          STML   PPTBL+/PIT/P.UNITC

*  REFORMAT ADDRESS OF RESPONSE BUFFER.
*  INITIALIZE LIM.

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

*  REFORMAT ADDRESS OF THE INTERRUPT WORD.

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

*  REFORMAT ADDRESS OF CHANNEL TABLE.

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

*  DETERMINE IF SINGLE OR DUAL PP.

          REFAD  PPTBL+/PIT/P.CBUF,CM.COM  REFORMAT AND LOAD CM ADDR OF PP COMM. BUFFER
          CRDL   T1          READ FIRST WORD OF COMM. BUFFER
          LDDL   T3          CHECK IF RMA FIELD NON-ZERO
          ADDL   T4
          ZJN    INIT10      IF NO RMA, THIS IS SINGLE PP
          LJM    INIT160     INITIALIZE DRIVER AS DUAL PP

*  INITIALIZE CHANNEL INSTRUCTIONS.
 INIT10   LDML   PPTBL+/PIT/P.UNITC
          ZJK    INIT150     IF NO UNITS DEFINED IN PIT
          LOADF  UNITD+/UD/P.UQT  REFORMAT RMA OF FIRST UIT
          CRML   UITBUF,ON   OBTAIN UIT
          LDML   UNITD+/UD/P.CHAN  OBTAIN PRESENT CHANNEL NUMBER
          SHN    -8
          STML   CURCH
          ZJN    INIT30      IF CHANNEL IS ZERO, NO CHANGE REQUIRED
 INITA    UJN    INIT20      MODIFY CHANNEL INSTRUCTIONS
*         RJM    SNEWC       (DUAL PP MASTER - SEND NEW CHANNEL COMMAND TO SLAVE)
          CON    SNEWC
 INIT20   LDC    CONCH       MODIFY MAIN PROGRAM CHANNEL INSTRUCTIONS
          RJM    CHGCH
          LDC    CONCHS      MODIFY SINGLE PP CHANNEL INSTRUCTIONS
*         LDC    CONCHD      (DUAL PP MASTER)
 INITB    EQU    *-1
          RJM    CHGCH
          LDC    CONCH2      MODIFY INITIALIZATION CHANNEL INSTRUCTIONS
          RJM    CHGCH

*  LOCK CHANNEL IN CHANNEL INTERLOCK TABLE.

 INIT30   LDN    CHLK        SET CHANNEL LOCK
          RJM    SCLK
          NJN    INIT30      IF CHANNEL LOCK NOT OBTAINED
          AOD    CHLOCK      SET CHANNEL CURRENTLY LOCKED
          DCN    40B+TP      UNCONDITIONALLY DISCONNECT CHANNEL

*  MASTER CLEAR CIO ADAPTER IF CONCURRENT CHANNEL

          LOADC  CM.CHAN     DETERMINE CHANNEL TYPE
          ADC    32          INDEX TO CHANNEL CHARACTERISTICS OF CHANNEL TABLE
          ADML   CURCH       CURRENT CHANNEL NUMBER
          CRDL   T1
          LDDL   T1
          SHN    17-15
          PJN    INIT60      IF NOT CONCURRENT CHANNEL
          LDC    LDCI+11B    ENABLE INPUT OF CIO ADAPTER STATUS REGISTER
          STML   CPETERMA
          LDC    LDCI+10B    ENABLE MASTER CLEAR OF CIO ADAPTER
          STML   FORMB
          LDC    F.MCLEAR    MASTER CLEAR ADAPTER
          RJM    CHFUNC
          ZJN    INIT40      IF ERROR ON FUNCTION
          LDC    F.WRCR      WRITE CONTROL REGISTER
          RJM    CHFUNC
          ZJN    INIT40      IF ERROR ON FUNCTION
          ACN    TP
          LDN    1           SET TO OUTPUT 1 WORD
          OAM    FORMC,TP
          DCN    40B+TP
          UJN    INIT60      CHECK UNIT TYPE

 INIT40   LDC    7774B       RETURN FUNCTION TIMEOUT ERROR
          LJM    INIT149

*  CHECK IF LOAD ISMT/CMTS CONTROLWARE MICROCODE.

 INIT60   LDML   UITBUF+/UIT/P.UTYPE  UNIT TYPE
          SBN    T639.1
          ZJN    INIT85      IF ISMT UNIT
          SBN    T698-T639.1
          NJK    INIT150     IF NOT CMTS UNIT

*  MODIFY INSTRUCTIONS FOR CMTS.

          LDC    NJNI+FORM60-FORME  SET ERROR CODE 2 CHECK
          STML   FORME
          LDC    312B        SET EXTENDED STATUS FUNCTION
          STML   ERRCHKB
          LDC    LDNI+20     SET EXTENDED STATUS LENGTH
          STML   ERRCHKC

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

 INIT85   LOADC  CM.COM      LOAD R AND A OF PP COMMUNICATION BUFFER
          ADN    /CB/C.CONTRL  ADD CONTROLWARE POINTER OFFSET
          CRML   CNTCMDW,ON         NOW HAVE LENGTH AND PTR TO ADDRESS/PAIR LIST
          LDML   CNTCMDW
          SHN    -10
          LMN    3
          NJN    INIT85            IF CONTROLWARE LIST NOT READY YET
          DCN    40B+TP

* SEND AUTOLOAD FUNCTION AND ACTIVATE CHANNEL

          LDC    LDCI        SET TO OBTAIN ISMT/CMTS EXTENDED STATUS
          STML   ERRCHKA
          LDML   UNITD+/UD/P.CNTRLR  SET EQUIPMENT NUMBER FOR PRESET FUNCTIONS
          LPN    7
          SHN    9
          STML   INITE
          LDK    F.MCLR
          ADC    0           ADD EQUIPMENT NUMBER
 INITE    EQU    *-1
          FAN    TP
          LCN    0
 INIT87   IJM    INIT89,TP
          PSN
          PSN
          SBN    1             DECREMENT COUNTER
          NJN    INIT87        IF TIMEOUT NOT EXPIRED
          DCN    TP+40B        DISCONNECT CHANNEL
          LDC    7777B         SET ISMT/CMTS AUTOLOAD TIMEOUT CODE
          LJM    INIT149       REPORT STATUS IN UNSOLICITED RESPONSE

 INIT89   PSN
          PSN
          PSN
          ACN    TP

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

 INIT95   LDML   WCT
          SBN    60                 PRESENTLY USE 60 CM BUFFER (240 PP BYTES)
          MJN    INIT100            IF WCT LESS THAN 60 CM BUFFER
          LDN    60
          STDL   WC
          LDML   WCT
          SBDL   WC
          STML   WCT                SET REMAINING WORD COUNT
          LDDL   CMADR+2            SET THE A REGISTER FOR CM ADDRESS OF DATA
          LMC    400000B
          CRML   CNTLBUF,WC
          STDL   CMADR+2            UPDATE ADDRESS TO NEXT DATA
          LDDL   WC
 INIT97   SHN    3
          STDL   BYTCNT             SET BYTE COUNT FOR THIS TRANSFER
          RJM    CBYTE              SET CHANNEL BYTES FOR BYTES IN BUFFER
          LDDL   IOCNT              SET NUMBER OF CHANNEL WORD TO OUTPUT
          OAPM   CNTLBUF,TP         OUTPUT TO ISMT/CMTS ADAPTER
          FJM    *,TP               WAIT TILL LAST WORD TAKEN THIS TRANSFER
          STML   AREGR
          UJN    INIT95             IF MORE DATA THIS ADDRESS LIST

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

 INIT115  LDML   LASTWCT            SET REMAINING WORD COUNT TO OUTPUT
          ADML   WCT
          STDL   WC
          UJN    INIT130            OUTPUT FINAL DATA

 INIT120  LDML   LASTWCT            MUST SEND REMAINING DATA
          STDL   WC
 INIT130  LDD    WC                 MUST OUTPUT FINAL DATA
          ZJN    INIT140            IF LAST ADDRESS CONTAINED FINAL DATA
          SHN    3                  SET NUMBER OF BYTES
          STDL   BYTCNT
          RJM    CBYTE              SET CHANNEL WORDS FOR BYTE COUNT GIVEN
          LDDL   IOCNT              PICK UP NUMBER OF 12 BIT CHANNEL WORDS
          OAPM   CNTLBUF,TP
          FJM    *,TP               WAIT FINAL WORD OFF CHANNEL
          STML   AREGR
 INIT140  DCN    40B+TP
          LDN    F.GS67            ISSUE STATUS FUNCTION
          ADML   INITE             ADD EQUIPMENT NUMBER
          FAN    TP
          LCN    0
 INIT145  IJM    INIT147,TP        TIMEOUT WAITING FOR STATUS
          SBN    1
          NJN    INIT145           IF TIMEOUT NOT COMPLETE
          UJN    INIT149           SEND ISMT/CMTS STATUS OF ZERO ON TIMEOUT

 INIT147  ACN    TP
          IAN    TP                INPUT GENERAL STATUS
          DCN    40B+TP
 INIT149  STM    RESBUF+/RS/P.GSTAT  SET ISMT/CMTS GENERAL STATUS
          LDN    R.UNS             UNSOLICITED RESPONSE CODE
          RAML   RESBUF+/RS/P.RC   SET IN RESPONSE AREA
          LDC    NORMRES           SET LENGTH OF RESPONSE BUFFER
          STML   RESBUF+/RS/P.RESPL
          RJM    RESP              SEND UNSOLICITED RESPONSE
 INIT150  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
 INIT155  LOADC  CM.COM      LOAD R AND A OF COMMUNICATION BUFFER
          ADN    /CB/C.ZEROES-1
          ADDL   T5
          CWDL   T1          ZERO ONE CM WORD
          SODL   T5          DECREMENT INDEX
          NJN    INIT155     IF MORE CM WORDS TO CLEAR
          LJM    TAPE        EXIT TO MAIN LOOP

 WCT      CON    0
 AREGR    CON    5555B
 LASTWCT  CON    4567B
          SPACE  4,6
**  INITIALIZATION FOR DUAL PP.

 INIT160  LDDL   T2          CHECK IF SLAVE BIT IS SET
          LPK    /CB/K.SLAVE
          NJK    INIT180     IF THIS PP IS SLAVE

**  INITIALIZE MAIN CODE INSTRUCTIONS FOR MASTER.

          LDC    RJMI        ENABLE SUBROUTINE CALLS
          STML   GTSTATA
          STML   INITA
          LDC    DWRITE      CHANGE COMMAND PROCESSORS
          STML   FUNCA
          LDC    DOUT8D
          STML   DORQC+1
          LDC    DREAD
          STML   DORQD+1
          LDC    DSTRTC
          STML   DORQE+1
          LDC    CONCHD      CHANGE CHANNEL TABLE ADDRESS
          STML   INITB

*  MOVE DUAL PP MASTER ROUTINES.

          LDN    0           INITIALIZE INDEX
          STD    T1
 INIT170  LDML   DUAL,T1     MOVE INSTRUCTION
          STML   DUALOV,T1
          AODL   T1          INCREMENT INDEX
          LMC    DUALL
          NJN    INIT170     IF MORE CODE TO MOVE

*  WAIT UNTIL SLAVE IS READY.

          LDC    HNDSHK      SEND HANDSHAKE COMMAND
          RJM    SENCOM
 INIT175  LDC    1000D       DELAY
          RJM    PAUS
          LOADC  CM.COM      LOAD R AND A OF PP COMMUNCATION BUFFER
          ADN    /CB/C.COMM
          CRDL   T1
          LDDL   T1
          NJN    INIT175     IF SLAVE NOT READY YET
          LDC    0415B       ID = DM (DUAL MASTER)
          STDL   ID
          LJM    INIT10      LOAD ISMT/CMTS CONTROLWARE IF NECESSARY

**  INITIALIZE DRIVER FOR SLAVE.

 INIT180  LDN    C.PIT       LENGTH OF PP INTERFACE TABLE
          STDL   WC
          REFAD  T3,CM.PIT   SET UP CM.PIT - CM.PIT+2
          CRML   PPTBL,WC    READ MASTER PIT
          REFAD  PPTBL+/PIT/P.CBUF,CM.COM  LOAD CM ADDRESS OF MASTER PP COMM. BUFFER

*  RELOCATE SLAVE CODE.

          LDN    0           INITIALIZE INDEX
          STD    T1
 INIT190  LDML   SLAVE,T1    MOVE INSTRUCTION
          STML   TAPE,T1
          AODL   T1          INCREMENT INDEX
          LMC    LSLAVE
          NJN    INIT190     IF MORE CODE TO MOVE
          AODL   RDFLG       SET TO NOT UPDATE TRANSFER COUNT IN *GTNEWPR*
          LDC    0423B       ID = DS (DUAL SLAVE)
          STDL   ID
          LJM    TAPE        EXIT TO MAIN LOOP


          ERRNZ  TAPE-/SLAVE/TPMAIN  ENTRY POINTS NOT THE SAME
          SPACE  4
 CNTCMDW  BSSZ   4           SECOND WORD OF PP COMM. BUFFER
 CURPAIR  BSSZ   4           LENGTH/ADDRESS FOR ISMT/CMTS CONTROLWARE
          EJECT
** 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
          LMML   CURCH       REPLACE WITH NEW CHANNEL
          STIL   T2
          AODL   T1          INCREMENT TO NEXT INSTRUCTION
          UJN    CHG10       LOOP
          SPACE  4
 CONCH2   BSS                INITIALIZATION CHANNEL MODIFICATION LIST
 TTP+40B  HERE
 T40B+TP  HERE
 TTP      HERE
          CON    0           END OF TABLE

 CNTLBUF  EQU    *           ISMT/CMTS CONTROLWARE BUFFER
          ERRPL  CNTLBUF+240-ENDMEM  BUFFER OVERFLOWS PP


**        NOTE - THE ISMT/CMTS CONTROLWARE BUFFER DESTROYS THE SLAVE
*                PP CODE.  THIS IS ALL RIGHT SINCE ONLY THE MASTER
*                LOADS ISMT/CMTS CONTROLWARE.
          EJECT
 SLAVE    EQU    *
          QUAL   SLAVE
          LOC    TAPE
 TPMAIN   BSS    0
          RJM    UREQ        CHECK FOR REQUEST
          NJN    TPMAIN2     REQUEST FOUND
          LDK    50          WAIT A WHILE
 TPMAIN1  SBN    1
          NJN    TPMAIN1
          UJN    TPMAIN

 TPMAIN2  RJM    INIBUF      INITIALIZE THE BUFFERS
          RJM    DORQ        DO THE REQUEST
          RJM    IODONE      TERMINATE REQUEST
          UJN    TPMAIN      MAIN LOOP
          EJECT
** NAME - UREQ
*
** PURPOSE - CHECK FOR REQUEST FROM MASTER PP
*
** INPUT - NONE
*
** OUTPUT - A = 0  NO REQUEST
*         - A .NE. 0  REQUEST IN CMDBUF
          SPACE  4
 UREQ     SUBR               ENTRY/EXIT
          LOADC  CM.COM      LOAD R AND A OF MASTER PP COMMUNICATION BUFFER
          ADN    /CB/C.COMM
          CRML   CMDBUF,ON
          LDML   CMDBUF      CHECK FOR COMMAND
          SHN    -8          LOOK AT THE COMMAND
          ZJN    UREQX       IF NO COMMAND - EXIT
          ADC    -NCCOMD     CHECK FOR CHANGE CHANNEL COMMAND
          NJN    UREQ15      NOT CHANGE CHANNEL
          LDML   CMDBUF+3    SAVE NEW CHANNEL NUMBER
          STML   //CURCH
          LDC    CONCH       ADDRESS OF CHANNEL TABLE
          RJM    CHGCH       MODIFY CHANNEL INSTRUCTIONS
          UJN    UREQ20      COMPLETE REQUEST

 UREQ15   ADC    NCCOMD-HSHAKC  CHECK FOR THE HANDSHAKE COMMAND
          NJN    UREQX       NOT A HANDSHAKE - MUST BE DATA MOVE
 UREQ20   RJM    IODONE
          LDN    0           SET NO COMMAND TO PROCESS
          UJK    UREQX       EXIT
          EJECT
** NAME - DORQ
*
** PURPOSE - PERFORM THE REQUIRED REQUEST
*
** INPUT - REQUEST IN REQBUF
*
** OUTPUT -
*
          SPACE  4
 DORQ10   RJM    OUT8D       OUTPUT 8-BIT DATA

 DORQ     SUBR               ENTRY/EXIT
          LDML   //CMDBUF    GET COMMAND AND FLAGS
          SHN    -8
          SBN    PWRTCMD
          ZJN    DORQ10      IF OUTPUT 8-BIT DATA
          SBN    LCREAD-PWRTCMD
          NJN    *           IF NOT LOGICAL READ, NON-SUPPORTED COMMAND
          RJM    IN8         INPUT 8-BIT DATA
          UJK    DORQX       EXIT
          EJECT
** NAME - OUT8D
*
** PURPOSE - TO PERFORM THE PHYSICAL COMMAND OUTPUT 8-BIT DATA.
*
** INPUT -
*
** OUTPUT -
          SPACE  4
 OUT8D    SUBR               ENTRY/EXIT
 OUT8D1   RJM    GETCM       GET A BUFFER FULL
          LDDL   IOCNT       NUMBER OF 12 BIT CHANNEL WORDS
          FSJM   *,TP        WAIT FOR FLAG TO GO CLEAR
          FJM    *,TP
          OAPM   DIOBUF,TP   WRITE SOME TAPE
          SCF    FLAGERR,TP  SET THE CHANNEL FLAG TO START THE MASTER
          LDM    EODATA      END OF DATA FLAG (SET BY GETCM)
          ADM    ENTHERE     END IN PARTNER (SET IN BUMPIT)
          ZJN    OUT8D1      IF NOT COMPLETE
          UJK    OUT8DX      EXIT

 FLAGERR  BSS    0           CHANNEL FLAG SET WHEN IT SHOULD NOT HAVE
          UJN    *             BEEN.  MASTER/SLAVE COMMUNICATION
*                              ASKEW.  ABORT TASK.
          EJECT
** NAME - IN8
*
** PURPOSE - TO PERFORM THE PHYSICAL COMMAND INPUT 8-BIT DATA/PARAMETERS.
*
** INPUT -
*
** OUTPUT -
*
          SPACE  4
 IN8      SUBR               ENTRY/EXIT
          LDN    0           CLEAR TRANSFER COUNT
          STML   RCOUNT+2
          STML   RCOUNT+3
          STDL   LONG        CLEAR LONG INPUT BLOCK FLAG
 IN8D1    LDC    WDCOUNT     ALWAYS TRY TO READ A FULL BUFFER
          FSJM   *,TP        WAIT UNTIL FLAG IS CLEAR
          IAPM   DIOBUF,TP   INPUT DATA FROM TAPE
          STML   AREG        SAVE THE CONTENTS OF THE A REGISTER
          SCF    FLAGERR,TP  SET THE FLAG - FIRE UP THE PARTNER
          NJN    IN8D5       PROCESS SHORT READ
          RJM    WRITCM      WRITE THE DATA TO CM
          LDC    DUALBUFL*2  UPDATE THE TRANSFER COUNT
          RAML   RCOUNT+3
          SHN    -16
          RAML   RCOUNT+2
          UJN    IN8D1       DO IT ALL OVER AGAIN

 IN8D5    LDC    WDCOUNT     COMPUTE THE ACTUAL BYTE COUNT
          SBML   AREG        NUMBER OF 12 BIT CHANNEL WORDS MOVED
          STD    T5          STORE THIS VALUE TEMPORARILY
          SHN    1           MULTIPLY BY 3/2 TO GET BYTE COUNT
          ADD    T5
          SHN    -1          DONE - ROUNDED DOWN INTENTIONALLY
          STML   SHBYTEC     STORE BYTE COUNT FOR WRITCM ROUTINE
          ZJN    IN8D10      IF COUNT = 0
          RAML   RCOUNT+3    UPDATE THE TRANSFER COUNT
          SHN    -16
          RAML   RCOUNT+2
          RJM    WRITCM      WRITE DATA TO CENTRAL
 IN8D10   LDDL   LONG        SET LONG INPUT BLOCK INDICATOR FOR MASTER
          STML   RCOUNT
          UJK    IN8X        EXIT
          EJECT
** NAME - IODONE
*
** PURPOSE - TO TERMINATE THE PP REQUEST
*
** INPUT -
*
** OUTPUT -
*
          SPACE  4
 IODONE   SUBR               ENTRY/EXIT
          LOADC  CM.COM      LOAD R AND A OF MASTER PP COMMUNICATION BUFFER
          ADN    /CB/C.COMM
          CWML   ZEROS,TW    ZERO OUT THE COMMAND
          UJK    IODONEX     EXIT


 ZEROS    BSSZ   4           USED TO ZERO THE COMMAND TO SLAVE
 RCOUNT   BSSZ   4           TRANSFER COUNT FOR READ
          EJECT
**  NAME - INIBUF
*
**  PURPOSE - ESTABLISH THE VALUES THAT WILL BE USED BY THE
**            GETCM AND GETBL SUBROUTINES.
*
**  INPUT - REQUEST IN REQBUF
*
**  OUTPUT - SPACE = THE AMOUNT OF SPACE LEFT IN THE CURRENT CM
**                   BUFFER.
**           CBUFRMA = THE RMA OF THE CURRENT BUFFER.
**           NBUFRMA =  "   "  "   "  NEXT       "
**           BUFLSTPT = THE RMA POINTER TO THE CM ADDRESS OF THE LAST
**                     LENGTH/ADDRESS PAIR CURRENTLY IN PP MEMORY.
**           NUMBUF = THE NUMBER OF LENGTH/ADDRESS PAIRS ASSOCIATED
**                    WITH THIS COMMAND.
          SPACE  4
INIBF90   LDC    -DUALBUFL*2    WILL THE SLAVE START IN THE FIRST BUFFER
          RAML   SPACE       ADJUST SPACE (IN BYTES) LEFT THIS BUFFER
          ZJN    INIBF92     MUST START IN NEXT BUFFER
          MJN    INIBF92     DITTO
          LDC    DUALBUFL*2  BEGINNING OFFSET
INIBF91   RAML   CBUFRMA+1   ADJUST THE RMA
          SHN    -16
          RAML   CBUFRMA     TAKE CARE OF OVERFLOW
          UJK    INIBUFX     EXIT

INIBF92   LDML   SPACE       SLAVE STARTS IN SECOND BUFFER
          ZJN    INIBF93     IF COULD BE ZERO - SPECIAL CASE
          LMC    177777B     COMPLEMENT THE NUMBER
INIBF93   STDL   T5          OFFSET INTO SECOND BUFFER
          LDML   NUMBUF      CHECK NUMBER OF RMA LIST ENTRIES
          NJN    INIBF95     IF MORE THAN ONE RMA INDIRECT LIST ENTRY
          STML   SPACE       SET NO BUFFER SPACE FOR THIS PP
          UJN    INIBUFX     EXIT

 INIBF95  LDML   INDLST+8    MOVE LENGTH/ADDRESS PAIR TO CURRENT
          STML   INDLST+4      L/A PAIR
          LDML   INDLST+9
          STML   INDLST+5
          LDML   INDLST+10
          STML   INDLST+6
          LDML   INDLST+11
          STML   INDLST+7
          RJM    GTNEWPR     GET NEXT LENGTH/ADDRESS PAIR
          LDML   SPACE       ADJUST SPACE IN THIS BUFFER
          SBDL   T5
          PJN    INIBF96     IF ENOUGH SPACE FOR MASTER TO FILL
          LDN    0           SET NO BUFFER SPACE FOR THIS PP
INIBF96   STML   SPACE
          LDDL   T5          SPACE MASTER WILL USE IN SECOND BUFFER
          UJK    INIBF91     FINISH UP

INIBUF    SUBR               ENTRY/EXIT
          LDN    0           INITIALIZE SOME FLAGS
          STM    EODATA
          STM    ENTHERE
          STM    NADAMAS
          LDC    DUALBUFL*2  INITIALIZE SHORT BYTE COUNT
          STML   SHBYTEC

          LDC    CMDBUF      SET UP POINTER TO COMMAND
          STD    T4          THIS POINTS TO A INPUT OR OUTPUT COMMAND

          LDIL   T4          GET COMMAND AND FLAGS
          LPC    INDFLG      GET THE INDIRECT FLAG (BIT 6)
          NJN    INIBUF2     READ INDIRECT LIST
          LDML   2,T4        THERE IS ONLY ONE BUFFER
          STML   CBUFRMA     POINT TO THE BUFFER
          LDML   3,T4        RMA'S ARE 2 PP WORDS LONG
          STML   CBUFRMA+1   STORE BOTH HALVES
          LDML   1,T4        GET THE LENGTH
          STML   SPACE       STORE IT AWAY FOR FUTURE USE
          LDN    0           NUMBER OF BUFFERS - 1
          STM    NUMBUF      SET THE BUFFER COUNT
 INIBUF1  LJM    INIBF90

 INIBUF2  LDML   1,T4        NUMBER OF LENGTH - ADDRESS PAIRS
          SHN    -3          DIVIDE BY 8
          SBN    1
          STML   NUMBUF
          LOADF  2,T4        SET UP ADDRESS OF THE INDIRECT LIST
          CRML   INDLST+4,TW   READ THE FIRST TWO LENGTH/
*                              ADDRESS PAIRS.  NOTE - CBUFRMA IS EQUATED
*                              TO INDLST+6.  SPACE IS EQUATED TO INDLST+5.
          LDML   2,T4        INITIALIZE BUFLSTPT
          STML   BUFLSTPT    THERE ARE TWO RMA-S IN CORE.  THIS IS THE CM
          LDML   3,T4          ADDRESS OF THE L/A PAIR OF THE SECOND.
          ADN    10B
          STML   BUFLSTPT+1
          SHN    -16
          RAML   BUFLSTPT
          LJM    INIBF90     COMPLETE INITIALIZATION
          EJECT
** 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
          LMML   CURCH       REPLACE WITH NEW CHANNEL
          STIL   T2
          AODL   T1          INCREMENT TO NEXT INSTRUCTION
          UJN    CHG10       LOOP
          EJECT
 CONCH    BSS
 TTP+40B  HERE
 T40B+TP  HERE
 TTP      HERE
          CON    0

 ESLAVE   EQU    *           END OF SLAVE CODE
          ERRPL  ESLAVE-//EDUALOV  SLAVE HAS OVERFLOWED INTO
*                                  ROUTINES IT MAY USE

          QUAL
          LOC    *O
 ESLAVE   EQU    *
 LSLAVE   EQU    ESLAVE-SLAVE  LENGTH OF THE SLAVE CODE
          ERRPL  ESLAVE-ENDMEM  ERROR IF OVERFLOW PP
          END    TAPE
/EOR

