
          IDENT  TAPB
          CIPPU
          MEMSEL 16
          TITLE  TAPB
          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   ATS/MAPPED STATUS WORD 1
 CHFL     BOOLEAN            CHARACTER FILL
          SUBRANGE 0,37B
 MSTAT    STRUCT 30          ATS/MAPPED STATUS WORDS 2 THRU 16
 XSTAT    STRUCT 40          ISMT/CMTS 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          COMMUNICATION AREA
 SCRAT    STRUCT 16          SCRATCH AREA
 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

 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

 PSNI     EQU    2400B       PSN INSTRUCTION
 INPNI    EQU    102600B     INPN INSTRUCTION

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

 MAXREQ   EQU    65          MAX REQUEST LENGTH IN CM WORDS
 ENDMEM   EQU    37777B      LARGEST PP MEMORY ADDRESS
 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)
          EJECT
 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           NUMBER OF INDIRECT LIST ENTRIES
 RTRNCNT  BSSZ   2           REQUESTED TRANSFER COUNT IN BYTES
 TRNCNT   BSSZ   4           TOTAL ACTUAL TRANSFER COUNT IN BYTES
 WRDCNT   BSSZ   1           WORD COUNT OF REQUESTED I/O OPERATION
 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
 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
 LWRTF    BSSZ   1           LAST WRITE FUNCTION ISSUED
 ON       CON    1           CONSTANT ONE (DO NOT CHANGE THIS CELL)
 TW       CON    2           CONSTANT TWO (DO NOT CHANGE THIS CELL)
 DSRTP    CON    2           REAL MEMORY WORD-ADDRESS OF PIT (PLUGGED)
          CON    0
          BSSZ   1           SPARE
          BSSZ   1           SPARE
 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

*         A ONE WORD READ WITH THE CRDL INSTRUCTION AT THE SAME TIME
*         THE PP IS DEADSTARTED COULD CAUSE AN UNCORRECTED CM ERROR ON
*         AN S0 WITH A 60 NANOSECOND CLOCK.  TO AVOID THIS HARDWARE
*         PROBLEM THE CRML INSTRUCTION IS USED.

          LOADC  CM.PIT      LOAD A AND R FOR PIT
          ADN    /PIT/C.PPQ
          CRML   T1,ON       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
          STD    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   MOTION      INITIALIZE MOTION FLAG
          STDL   LONG        INITIALIZE LONG INPUT BLOCK FLAG
 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
          PSN    0           ALLOW FOR S0 INSTRUCTION MODIFICATION

**        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 WINDOW
 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  PICK UP STATUS WORD 4
          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        STORE BID ENTRY

 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     RJM    CDUNIT      CHECK IF UNIT TO BE DISABLED
          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
          CON    PWRTCMD,OUT8D    PHYSICAL COMMAND - OUTPUT 8-BIT DATA
          CON    LCREAD,READ      LOGICAL READ COMMAND
          CON    LCSTC,STRTC      LOCIGAL STORE TRANSFER COUNT
          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 - CDUNIT
*
** PURPOSE - TO SET THE DISABLED UNIT BIT IN THE UIT IF THE MASK BIT IS SET.
*
*  INPUT - RESPONSE BUFFER HEADER ALERT MASK IS IMAGE OF REQUEST
*
** OUTPUT - THE DISABLE UNIT BIT IS SET IN THE STATUS FIELD OF THE UNIT
*           INTERFACE TABLE IF THE ALERT MASK DISABLE BIT WAS SET.
*
          SPACE  4
 CDUNIT   SUBR               ENTRY/EXIT
          LDML   RESBUF+/RS/P.LONGB  CHECK ALERT MASK
          SHN    18-16+/RS/L.DUNIT  DISABLE UNIT BIT TO SIGN POSITION
          PJN    CDUNITX     IF NOT DISABLE UNIT BIT IN ALERT MASK
          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
          UJN    CDUNITX     EXIT
          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
          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
          EJECT
** NAME - READ
*
** PURPOSE - PROCESS LOGICAL READ COMMAND.
*
** INPUT - (CMDADR) = ADDRESS OF COMMAND.
*
          SPACE   4
 READ     BSS
          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
          STDL   RTRNCNT     CLEAR REQUESTED TRANSFER COUNTERS
          STDL   RTRNCNT+1

*         THE FOLLOWING TWO LINES ARE NEEDED BECAUSE OF 930 INSTRUCTION TIMEOUT.

 READ10   IJM    READ30,TP   IF CHANNEL HAS BEEN INACTIVATED
          EJM    READ10,TP   IF DATA NOT READY YET

 READ15   LDML   INDLIST+1   GET REQUESTED BYTE COUNT
          RADL   RTRNCNT+1   INCREMENT REQUESTED BYTE COUNT
          SHN    -16
          RADL   RTRNCNT
          LDML   INDLIST+1   GET REQUESTED BYTE COUNT
          ADN    1           ADJUST TO CH WORD COUNT
          SHN    -1
          STDL   WRDCNT      SAVE REQUESTED WORD COUNT
          STDL   IOCNT       SAVE CH WORD COUNT
          LOADF  INDLIST+/CM/P.RMA   SET A AND R REGISTERS FOR DATA ADDRESS
          CHCM   IOCNT,TP    INPUT THE DATA
          RJM    UPTCNT      GO UPDATE THE TOTAL TRANSFER COUNT
          NJN    READ30      IF PARTIAL RECORD
          SODL   LSTLEN      DECREMENT NUMBER OF INDIRECT LIST ENTRIES
          ZJN    READ20      IF LIST EXHAUSTED
          LDN    8           UPDATE INDIRECT LIST ADDRESS
          RAML   INDLSTA+1
          SHN    -16
          RAML   INDLSTA
          LOADF  INDLSTA     SET A AND R REGISTERS FOR INDIRECT LIST ADDRESS
          CRML   INDLIST,ON  GET NEXT INDIRECT LIST LENGTH/ADDRESS PAIR
          UJK    READ15      PROCESS NEXT PAIR

 READ20   LDN    24          CONTINUE INPUT TO CHECK FOR LONG BLOCK
          STDL   WRDCNT      SET WORD COUNT TO 24
          IAM    RESBUF+/RS/P.GSTAT,TP   USE STATUS BUFFER AS TEMP BUFFER
          STDL   IOCNT       SAVE RESIDUAL WORD COUNT
          SBN    24
          ZJN    READ30      IF END OF DATA RECORD
          RJM    UPTCNT      UPDATE TRANSFER COUNT
          UJN    READ20      CONTINUE COUNTING

 READ30   DCN    40B+TP      DISCONNECT THE CHANNEL
          SFM    CPETERM,TP  CHECK AND CLEAR CHANNEL PARITY FLAG
          RJM    GTSTAT      WAIT FOR END OF OPERATION
          RJM    CKFL        CHECK FOR CHARACTER FILL AND LONG BLOCK CONDITIONS
          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+2
          STDL   TRNCNT+3
          LJM    CMDONE1     RETURN
          EJECT
** NAME - WRITE
*
** PURPOSE - TO ISSUE WRITE FUNCTION.
*
** INPUT - (CMDADR) = ADDRESS OF COMMAND.
*
          SPACE   4
 WRITE    BSS    0           ENTRY
          LDML   3,CMDADR    GET HARDWARE FUNCTION
          STDL   LWRTF       SAVE LAST WRITE FUNCTION CODE
          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 - (INDLIST) = INDIRECT LIST LENGTH/ADDRESS PAIR
*           (T4) = UNCHANGED FROM ENTRY.
*           (LSTLEN) = NUMBER OF INDIRECT LIST ENTRIES.
*           (INDLSTA) = RMA ADDRESS OF CURRENT INDIRECT LIST ENTRY
*
** NOTE - IN THE CASE OF A COMMAND WITHOUT THE INDIRECT BIT SET,
*         THE LENGTH/ADDRESS PAIR IS MOVED TO THE INDLIST
*         AND (LSTLEN) = 1 AND INDLSTA IS NOT SET.
          SPACE  4
 SETUP10  LDML   2,T4        SET INDIRECT LIST ADDRESS
          STML   INDLSTA
          LDML   3,T4
          STML   INDLSTA+1
          LOADF  INDLSTA     SET A AND R REGISTERS FOR INDIRECT LIST ADDRESS
          CRML   INDLIST,ON  GET FIRST INDIRECT LIST LENGTH/ADDRESS PAIR
          LDML   1,T4        GET BYTE COUNT OF INDIRECT LIST LENGTH
          SHN    -3          ADJUST BYTE COUNT TO NUMBER OF ENTRIES
          STDL   LSTLEN      SET NUMBER OF INDIRECT LIST ENTRIES

 SETUP    SUBR               ENTRY/EXIT
          LDIL   T4          TEST FOR INDIRECT BIT
          LPC    INDFLG
          NJN    SETUP10     IF INDIRECT
          LDN    1
          STDL   LSTLEN      SET NUMBER OF INDIRECT LIST ENTRIES TO 1
          LDML   1,T4        MOVE COMMAND LENGTH/ADDRESS TO INDIRECT BUFFER
          STML   INDLIST+1
          LDML   2,T4
          STML   INDLIST+2
          LDML   3,T4
          STML   INDLIST+3
          UJN    SETUPX      EXIT
          EJECT
** NAME - OUT8D
*
** PURPOSE - TO PERFORM THE PHYSICAL COMMAND OUTPUT 8-BIT DATA.
*
** INPUT - (CMDADR) = ADDRESS OF COMMAND.
*
          SPACE  4
 OUT8D    BSS    0           ENTRY
          LDN    0           CLR MOTION AHEAD
          STDL   MOTION
          LDDL   CMDADR      GET COMMAND ADDRESS IN PP
          STDL   T4
          RJM    SETUP       SETUP FOR WRITE OPERATION

 OUT8D10  LDML   INDLIST+1   GET REQUESTED BYTE COUNT
          ADN    1           ADJUST FOR CHANNEL WORD COUNT
          SHN    -1
          STDL   WRDCNT      SAVE REQUESTED WORD COUNT
          STDL   IOCNT       SAVE CHANNEL WORD COUNT FOR CMCH INSTRUCTION
          LOADF  INDLIST+/CM/P.RMA    SET A AND R REGISTERS FOR DATA CM ADDRESS
          CMCH   IOCNT,TP    OUTPUT THE DATA
          FJM    *,TP        WAIT UNTIL DONE
          RJM    UPTCNT      UPDATE TOTAL TRANSFER COUNT
          NJN    OUT8D20     IF NOT ALL DATA TAKEN
          SODL   LSTLEN      DECREMENT NUMBER OF INDIRECT LIST ENTRIES
          ZJN    OUT8D20     IF LIST EXHAUSTED
          LDN    8           UPDATE INDIRECT LIST ADDRESS
          RAML   INDLSTA+1
          SHN    -16
          RAML   INDLSTA
          LOADF  INDLSTA     SET A AND R REGISTERS TO NEXT INDIRECT LIST PAIR
          CRML   INDLIST,ON  GET THE NEXT LIST ENTRY
          UJN    OUT8D10     CONTINUE

 OUT8D20  DCN    40B+TP      DISCONNECT THE CHANNEL
          SFM    OUTCPE,TP   CHECK AND CLEAR THE CHANNEL PARITY FLAG
          LDDL   LWRTF       CHECK FOR SHORT WRITE FUNCTION
          SHN    10
          PJN    OUT8D25     IF NOT SHORT WRITE FUNCTION
          LDDL   TRNCNT+3    CHECK IF ANY DATA TRANSFERED
          ADDL   TRNCNT+2
          ZJN    OUT8D25     IF NONE, MUST BE HDW FAILURE
          SODL   TRNCNT+3    DECREMENT TRANSFER COUNT BECAUSE SHORT WRITE
          PJN    OUT8D25     IF NOT UNDERFLOW
          LDC    177777B
          STDL   TRNCNT+3    CORRECT 1-S COMPLEMENT RESULT
          SODL   TRNCNT+3    ADJUST MOST SIGNIFICANT BITS
 OUT8D25  BSS
          RJM    GTSTAT      WAIT FOR END OF OPERATION
          RJM    ERRCHK      CHECK FOR ERRORS OR TERMINATION CONDITION
          NJN    OUT8D30     IF ERRORS OR TERMINATION CONDITION
          LDDL   CMDNO       CHECK REMAINING COMMAND COUNT
          SBN    1
          STDL   MOTION      SET MOTION AHEAD IF ANOTHER COMMAND
          ZJN    OUT8D30     IF NO MORE COMMANDS
          LDML   7,CMDADR    GET WRITE FUNCTION CODE FOR NEXT BLOCK
          STDL   LWRTF       SAVE LAST WRITE FUNCTION CODE
          RJM    DOFUNC      ISSUE FUNCTION
          ACN    TP          ACTIVATE THE CHANNEL

 OUT8D30  LJM    CMDONE1     PROCESS WRITE COMPLETION
          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
          STDL   TRNCNT+2
          UJK    NOSTAT      PROCESS NEXT COMMAND
          EJECT
** NAME - UPTCNT
*
** PURPOSE - UPDATE THE TOTAL TRANSFER COUNT
*
** INPUT - (WRDCNT) = REQUESTED WORD COUNT FOR THIS TRANSFER OPERATION.
*          (IOCNT) = RESIDUAL CHANNEL WORD COUNT AFTER TRANSFER OPERATION.
*
** OUTPUT - (TRNCNT+2 AND TRNCNT+3) = UPDATED TOTAL TRANSFER COUNT.
*           (A) = 0 IF FULL TRANSFER
*           (A) = NZ IF PARTIAL TRANSFER
*
          SPACE  4
 UPTCNT   SUBR               ENTRY/EXIT
          LDDL   WRDCNT      GET REQUESTED WORD COUNT
          SBDL   IOCNT       DECR BY RESIDUAL WORD COUNT  IF ANY
          SHN    1           CONVERT TO BYTE COUNT
          RADL   TRNCNT+3    ADD TO TOTAL TRANSFER COUNT
          SHN    -16
          RADL   TRNCNT+2
          LDDL   IOCNT       GET RESIDUAL COUNT
          UJN    UPTCNTX     EXIT
          EJECT
** NAME - FORMATU
*
** PURPOSE - TO FORMAT A TAPE UNIT OR CONTROLLER (CONNECT)
*
** INPUT -
*
** OUTPUT -
          SPACE  4
 FORMATU  BSS
          LDML   UNITD+/UD/P.CHAN,UDPNT
          SHN    -8          RIGHT JUSTIFY CHANNEL IN THE A REG
          STDL   P1          SAVE AS POSSIBLE NEW CHANNEL
          LMML   CURCH
          ZJN    FORM30      IF NOT NEW CHANNEL
          LDDL   CHLOCK
          ZJN    FORM10      IF OLD CHANNEL NOT LOCKED
          RJM    CCLOCK      CLEAR CHANNEL LOCK ON OLD CHANNEL
 FORM10   LDDL   P1          SAVE NEW CHANNEL
          STML   CURCH
          LDC    CONCH       MODIFY CHANNEL INSTRUCTIONS
          RJM    CHGCH
 FORM20   LDN    CHLK        SET CHANNEL LOCK
          RJM    SCLK
          NJN    FORM20      IF CHANNEL LOCK NOT OBTAINED
          AOD    CHLOCK      SET CHANNEL CURRENTLY LOCKED
          UJN    FORM40      PROCESS FORMAT FUNCTION

 FORM30   LDDL   CHLOCK
          ZJN    FORM20      IF CHANNEL NOT LOCKED
 FORM40   LDDL   CONFLG      CHECK IF UNIT ALREADY CONNECTED
          NJK    NOSTAT      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
          SHN    21B-3       ALIGN 1ST 12 BIT FORMAT PARAMETER
          STD    P1
          SHN    -16B
          LPN    17B         PICK UPPER 4 BITS FORMAT WORD 2
          SHN    10B         ALIGN UPPER 4 BITS FORMAT WORD 2
          STD    P2          SET FORMAT PARAMETER 2
          LDML   FORMBUF+1
          SHN    -10B        PICK UP LOWER 8 BITS FORMAT WORD 2
          RAD    P2
          LDML   FORMBUF+1   PICK UP UPPER 8 BITS FORMAT WORD 3
          SHN    4           ALIGN USED BITS OF FORMAT WORD 3
          STD    P3          ONLY UPPER BITS FORMAT WORD 3 ARE USED
          LDN    3           GET LENGTH OF PARAMETERS (IN PP WORDS)
          ACN    TP          ACTIVATE THE CHANNEL
          OAM    P1,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
          LDML   RESBUF+/RS/P.GSTAT  CHECK BUSY BIT
          LPN    BUSY
          ZJK    NOSTAT      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  SET ALERT BIT
          LPC    3777B
          LMC    4000B
          STML   RESBUF+/RS/P.GSTAT
 FORM45   LDK    /RS/K.HDWR
 FORM50   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
          UJN    FORM50      SET RESPONSE AND EXIT

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

          EJECT
** NAME - CKFL
*
** PURPOSE - CHECK FOR CHARACTER FILL.  IF SET, DECREMENT
*            BYTE COUNT.
*            THEN CHECK FOR LONG BLOCK CONDITIONS.
*
          SPACE  4
 CKFL     SUBR               ENTRY/EXIT
          LDML   RESBUF+/RS/P.CHFL  CHECK IF CHARACTER FILL IS SET
          LPK    /RS/K.CHFL
          ZJN    CKFL10      IF NO CHARACTER FILL
          LDDL   TRNCNT+3
          ADDL   TRNCNT+2
          ZJN    CKFLX       IF NO DATA READ (PROBABLY TAPE MARK)
          SODL   TRNCNT+3    DECREMENT TRANSFER COUNT
          PJN    CKFL10      IF NOT UNDERFLOW
          LDC    177777B     CORRECT 1-S COMPLEMENT RESULT
          STDL   TRNCNT+3
          SODL   TRNCNT+2    ADJUST MOST SIGNIFICANT BITS

 CKFL10   LDDL   RTRNCNT     CHECK FOR LONG BLOCK CONDITIONS
          SBDL   TRNCNT+2    CHECK MOST SIGNIFICANT BITS
          MJN    CKFL20      IF LONG BLOCK
          NJN    CKFLX       IF REQUESTED IS GREATER THAN ACTUAL
          LDDL   RTRNCNT+1   CHECK LEAST SIGNIFICANT BITS
          SBDL   TRNCNT+3
          PJN    CKFLX       IF NOT LONG BLOCK  EXIT

 CKFL20   LDN    2           SET LONG BLOCK FLAG
          STDL   LONG
          UJN    CKFLX       EXIT
          EJECT
** NAME - GTSTAT
*
** PURPOSE - TO GET THE GENERAL AND DETAILED STATUS FOR A 67X TAPE UNIT.
*
          SPACE  4
 GTSTAT   SUBR               ENTRY/EXIT
          LDC    250         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    20          WAIT 10 USEC ON 8X 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    16          INPUT ALL 16 STATUS WORDS
          IAM    RESBUF+/RS/P.GSTAT,TP  INPUT GENERAL STATUS TO RESPONSE BUFFER
          DCN    TP+40B
          CFM    GTSTATX,TP  CHECK AND CLEAR CHANNEL PARITY ON INPUT
 CPETERM  LDC    /RS/K.CHERR
          STML   RESBUF+/RS/P.CHERR  REPORT CHANNEL PARITY ON INPUT
          UJK    FAIL       TERMINATE ON FUNCTION PROBLEM
          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

          LDML   UITBUF+/UIT/P.UTYPE  FETCH UIT UNIT TYPE
          SBN    T639.1
          NJN    CHKUS       IF NOT ISMT, CHECK UNIT STATUS

          LDC    B.RS        SET ISMT RESPONSE LENGTH (WITH SENSE BYTES)
          STML   RESBUF+/RS/P.RESPL
          LDC    216B        ISSUE ISMT EXTENDED STATUS FUNCTION
          RJM    DOFUNC
          LDN    18          LENGTH OF EXTENDED 16 BIT STATUS WORDS
          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
          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
          LDN    0           SET (A)=0 FOR S0 MAINFRAME
 INTPRC   INPN   1           INTERRUPT OR PSN
          CRDL   T1          ACCESS CM (NEEDED FOR 810/830)
          LJM    RESPX       EXIT
          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
** 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
          LDC    100         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-- 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
** NAME -- PAUS
*
** PURPOSE-- DELAY PROGRAM EXECUTION FOR A SPECIFIED NUMBER OF
*            MICROSECONDS.
*
** INPUT-- A REGISTER 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 MICRO SECOND
          UJK    PAUSX
          EJECT
 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
 REQBUF   BSSZ   MAXREQ*4    SET REQUEST BUFFER LENGTH
 FORMBUF  EQU    REQBUF+12   FORMAT UNIT DATA IS AT WORD 4 OF REQ BUF
 CMDBUF   EQU    REQBUF+/RQ/P.CMND  COMMAND BUFFER
 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
 INDLSTA  BSSZ   2           CURRENT INDIRECT LIST ADDRESS RMA
 INDLIST  BSSZ   4           INDIRECT LIST LENGTH/ADDRESS PAIR
          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  111000      DELAY 111 MILLISECONDS

* CLEAR REMAINDER OF PP MEMORY  AND BURN ABOUT 14 MILLISECONDS IN THE PROCESS

          LDC    ENDMEM-ENDCODE
          STDL   T1          SET INDEX
 INIT1    LDN    0
          STML   ENDCODE,T1  CLR PP WORD
          SODL   T1          DECREMENT INDEX
          PJN    INIT1       IF NOT DONE LOOP
          LDN    1           SET CONSTANTS
          STD    ON
          LDN    2
          STD    TW

*  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

*  REFORMAT ADDRESS OF PP COMMUNICATIONS BUFFER

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

*  CHECK IF LOAD ISMT CONTROLWARE MICROCODE.

 INIT10   LOADF  UNITD+/UD/P.UQT  REFORMAT RMA OF UIT
          CRML   UITBUF,ON   OBTAIN UIT
          LDML   UITBUF+/UIT/P.UTYPE  UNIT TYPE
          SBN    T639.1
          ZJN    INIT20            IF ISMT
          LDC    7775B             NOT ISMT ERROR CODE
          LJM    INIT149           REPORT STATUS IN UNSOLICITED RESPONSE

*  INITIALIZE CHANNEL INSTRUCTIONS.

 INIT20   LDML   UNITD+/UD/P.CHAN  OBTAIN PRESENT CHANNEL NUMBER
          SHN    -8
          STML   CURCH
          ZJN    INIT30      IF CHANNEL IS ZERO, NO CHANGE REQUIRED
          LDC    CONCH       MODIFY CHANNEL INSTRUCTIONS
          RJM    CHGCH
 INIT30   LDN    CHLK        SET CHANNEL LOCK
          RJM    SCLK
          NJN    INIT30      IF CHANNEL CURRENTLY LOCKED
          AODL   CHLOCK      SET CHANNEL INTERLOCKED FLAG

*  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      INITIALIZE CHANNEL BY DEACTIVATE ATTEMPT
          CFM    INIT86,TP   INITIALIZE CHANNEL ERROR FLAG

* SEND AUTOLOAD FUNCTION AND ACTIVATE CHANNEL

 INIT86   LDK    F.MCLR        AUTOLOAD FUNCTION
          RJM    IFUNC         ISSUE FUNCTION
          ZJN    INIT89        IF FUNCTION ACCEPTED
          LDC    7777B         SET ISMT AUTOLOAD TIMEOUT CODE
          LJM    INIT149       REPORT STATUS IN UNSOLICITED RESPONSE

 INIT89   PSN
          PSN
          PSN
          ACN    TP

 INIT95   LOADF  CNTCMDW+/CM/P.RMA  REFORMAT ADDRESS TO CURRENT PAIR
          CRML   CURPAIR,ON
          LOADF  CURPAIR+/CM/P.RMA
          LDML   CURPAIR+/CM/P.LEN
          ADN    1                  CALCULATE CH WORD COUNT
          SHN    -1
          STDL   IOCNT              SET CH WORD COUNT
          ZJN    INIT140            IF 0 CH WORDS LEFT

          LDDL   CMADR+2            SET A FOR CM ADDRESS OF DATA
          LMC    400000B
          CMCH   IOCNT,TP           OUTPUT BLOCK TO ISMT ADAPTER
          FJM    *,TP               WAIT TILL LAST WORD TAKEN THIS TRANSFER
          LDDL   IOCNT              CHECK REMAINING CH WORD COUNT
          NJN    INIT140            IF NOT ALL TAKEN

          LDML   CNTCMDW+/CM/P.LEN  DECREMENT ADDRESS PAIR COUNT
          SBN    8
          STML   CNTCMDW+/CM/P.LEN  SAVE REMAINING LENGTH
          ZJN    INIT140            IF NO MORE ADDRESS WITH DATA
          LDN    8
          RAML   CNTCMDW+/CM/P.RMA+1  UPDATE ADDRESS TO NEXT DATA AREA
          SHN    -16
          RAML   CNTCMDW+/CM/P.RMA
          UJK    INIT95             DO NEXT BLOCK

 INIT140  DCN    40B+TP
          CFM    INIT145,TP        JUMP IF CH ERROR FLAG IS CLEAR
          LDC    7776B             SET CH ERROR FLAG ERROR CODE
          UJN    INIT149           REPORT STATUS IN UNSOLICITED RESPONSE

 INIT145  LDN    F.GS67            ISSUE STATUS FUNCTION
          RJM    IFUNC             ISSUE FUNCTION
          ZJN    INIT147           IF FUNCTION ACCEPTED
          LDN    0
          UJN    INIT149           SEND ISMT STATUS OF ZERO ON TIMEOUT

 INIT147  ACN    TP
          IAN    TP                INPUT GENERAL STATUS
          DCN    40B+TP
 INIT149  STM    RESBUF+/RS/P.GSTAT  SET ISMT 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
          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
 INIT156  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    INIT156     IF MORE CM WORDS TO CLEAR
          LJM    TAPE        EXIT TO MAIN LOOP
          EJECT
** NAME - IFUNC
*
** PURPOSE - ISSUE AND TIMEOUT INITIALIZATION FUNCTIONS
*
** INPUT - (A) = FUNCTION TO ISSUE
*
** OUTPUT - A = 0  IF FUNCTION ACCEPTED
*         - A .NE. 0  IF FUNCTION TIMEOUT (CHANNEL IS DEACTIVATED)
          SPACE  4
 IFUNC30  LDN    0           SET FUNCTION ACCEPTED

 IFUNC    SUBR               ENTRY/EXIT
          FAN    TP          ISSUE FUNCTION
          LDK    64          OUTER LOOP TIMEOUT
          STDL   T1
 IFUNC10  LCN    0           INNER LOOP TIMEOUT
 IFUNC20  IJM    IFUNC30,TP  IF FUNCTION ACCEPTED
          SBN    1
          NJN    IFUNC20     IF NOT INNER LOOP TIMEOUT
          SODL   T1
          NJN    IFUNC10     IF NOT OUTER LOOP TIMEOUT
          DCN    TP+40B      DISCONNECT CHANNEL
          LDN    1           SET FUNCTION TIMEOUT
          UJN    IFUNCX      RETURN
          SPACE  4
 CNTCMDW  BSSZ   4           SECOND WORD OF PP COMM. BUFFER
 CURPAIR  BSSZ   4           LENGTH/ADDRESS FOR ISMT CONTROLWARE
          SPACE  4
 CONCH    BSS                CHANNEL MODIFICATION LIST
 TTP+40B  HERE
 T40B+TP  HERE
 TTP      HERE
          CON    0           END OF TABLE
          SPACE  4
 ENDCODE  EQU    *           END OF PP CODE AREA
          ERRNG  ENDMEM-ENDCODE
          EJECT
          END    TAPB
/EOR

