Retro1.org codex

          IDENT  1MT,PRS 
          PERIPH
          BASE   MIXED
          SST
*COMMENT  1MT - PPU MAGNETIC TAPE EXECUTIVE.
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992.
          TITLE  1MT - PPU MAGNETIC TAPE EXECUTIVE.
          SPACE  4,10
***       1MT - PPU MAGNETIC TAPE EXECUTIVE.
*         R. E. TATE.        73/01/09.
*         D. D. SADLER.      74/05/01. (MTS)
*         L. C. HAAS.        77/07/15. (BLOCK - ID)
*         R. J. PRIEVE.      77/07/15. (ATS)
*         C. D. ROWE.        92/02/03. (CTS)
          SPACE  4,10
***              1MT - PROCESSES VARIOUS TAPE FUNCTIONS FOR *MAGNET*,
*         THE CPU MAGNETIC TAPE EXECUTIVE.
          SPACE  4,10
***       CALL FORMAT.
*
*         NORMAL CALL -
*
*T,   IR  18/ *1MT*,6/0,12/ 0,12/ CH,12/ CSTA
*
*         CH     TAPE CHANNEL NUMBER.
*         CSTA   CST ADDRESS.
*
*         MAGNET INITIALIZATION CALL -
*
*T   IR   18/ *1MT*,6/0,12/1,24/ ADDR
*
*         ADDR   STATUS WORD ADDRESS.
*
*         STATUS WORD FORMAT -
*
*T        1/A,47/0,12/ IFL
*
*         A      *1MT* ACTIVE (CLEARED UPON COMPLETION).
*         IFL    INITIALIZATION FLAGS.
*                1 = *MAGNET* INITIALIZATION.
*                3 = LEVEL 3 RECOVERY.
          SPACE  4,10
***       ERROR MESSAGES.
*
*         NOTE - MESSAGES ARE ISSUED TO THE ERROR LOG IN THE FORM OF A
*                3 CHARACTER MNEMONIC.  THESE MNEMONICS ARE LISTED IN
*                PARENTHESES.
*
*         *ERASE LIMIT.*                         (ERA)
*
*         THIS MESSAGE IS POSTED IF, (A) IN *PE* OR *GCR*
*         MODE, IF THE CURRENT BLOCK COULD NOT BE RE-WRITTEN PROPERLY
*         AFTER FORTY ERASURES, (APPROXIMATELY 15 FEET OF
*         TAPE), OR (B) IN *NRZI* MODE, THAT THE CURRENT BLOCK
*         COULD NOT BE RE-WRITTEN DUE TO RECEIVING PARITY ERROR(S)
*         AFTER FORTY ATTEMPTS TO ERASE A SINGLE AREA ON TAPE.
*
*
*         *MARGINALLY WRITTEN TAPE.*             (MWT)
*
*         THIS MESSAGE IS POSTED IF SOME OR ALL OF THE PREVIOUS GOOD
*         BLOCKS USED TO CREATE THE RECOVERY BLOCK ID WINDOW CANNOT BE
*         READ WITH ERROR CORRECTION ENABLED DURING REPOSITIONING OF
*         THE TAPE FOR WRITE RECOVERY.
*
*
*         *POSITION LOST.*                       (PLO)
*
*         THIS MESSAGE IS POSTED IF, (A) A BLOCK ID MIS-MATCH
*         OCCURS OR, (B) IF THE BLOCK ID WINDOW IS ALL ONES IT
*         INDICATES THAT A NOS TERMINATOR LABEL MIS-MATCH HAS
*         OCCURRED.  IN EITHER CASE, THE POSITION ON THE TAPE CANNOT
*         BE ESTABLISHED AND THE JOB MUST BE TERMINATED.
*
*
*         *READ ID BURST FAILURE.*               (BFR)
*
*         THIS MESSAGE IS ISSUED TO THE *E,P* DISPLAY IN THE FORM *READ
*         ID BURST* TO INDICATE THAT THE P.E. OR G.C.R. SPECIAL
*         CHARACTERS TO BE READ BY THE SUBSYSTEM AT LOAD POINT IS NOT
*         POSSIBLE.
*
*         WHEN THIS MESSAGE APPEARS, THE FOLLOWING ACTIONS SHOULD BE
*         TAKEN.
*
*         THE OPERATOR SHOULD DISMOUNT THE MAGNETIC TAPE FROM THE
*         UNIT IN QUESTION, CLEAN THE HEAD ASSEMBLY, AND REMOUNT THE
*         MAGNETIC TAPE.  THE OPERATOR SHOULD THEN ENTER *RETRY,EST.*.
*         THE SYSTEM WILL THEN RETRY THE ORIGINAL OPERATION FROM LOAD
*         POINT.  IF NO ERRORS OCCUR, THE JOB WILL CONTINUE NORMAL
*         PROCESSING.  IF THE ORIGINAL PROBLEM PERSISTS, THE MESSAGE
*         *READ ID BURST* WILL AGAIN BE ISSUED TO THE *E,P* DISPLAY.
*         THIS TIME THE OPERATOR OR C.E. SHOULD BE INSTRUCTED TO
*         ENTER *TERMINATE,EST.* TO ABORT THE OPERATION.  THE
*         MESSAGE, *READ ID BURST FAILURE*, WILL APPEAR IN THE
*         DAYFILE.
*
*
*         *REPOSITION CORRECTED ERROR.*          (RCE)
*
*         THIS ERROR LOG MESSAGE IS USED TO ALERT THE C.E. TO
*         THE FACT THAT THE TRANSPORT IS WRITING IN A MARGINAL
*         STATE.  THIS MESSAGE IS INTENDED TO PREVENT THE GENERATION
*         OF MARGINAL TAPE BY THE SUBSYSTEM AND IT-S DEVICES.  THIS
*         MESSAGE IS TO BE CONSIDERED A MARGINAL DRIVE INDICATOR
*         (MDI) BY THE C.E. AND APPROPRIATE ACTION SHOULD BE TAKEN
*         IMMEDIATELY.
*
*
*         *TAPE CLEANER FAULT.*                  (TCF)
*
*         DRIVER DETECTED FAILURE (TRANSPORT ASSIGNED TO JOB) -
*
*         THIS MESSAGE IS ISSUED TO THE *E,P* DISPLAY IN THE
*         FORM *CLEANER FAULT* TO INDICATE THAT THE TAPE CLEANER
*         WAS NOT IN THE STOWED POSITION AFTER A *LOAD* OR A
*         *REWIND*.  THE DRIVER HAS ALREADY UNLOADED THE TRANSPORT
*         AND THE ASSIGNED JOB IS LOOPING WAITING FOR TRANSPORT TO
*         COME *READY* AGAIN AND FOR *RETRY,EST.* TO BE ENTERED AT
*         THE CONSOLE.  IF CORRECTIVE ACTION IS NOT POSSIBLE, THE
*         OPERATOR OR C.E. SHOULD ENTER *TERMINATE,EST.*  TO
*         ABORT THE OPERATION.  THE MESSAGE, *TAPE CLEANER
*         FAULT*, WILL APPEAR IN THE DAYFILE.
*
*         SCANNER DETECTED FAILURE (TRANSPORT UNASSIGNED) -
*
*         SINCE NO JOB HAS BEEN ASSIGNED TO THE TRANSPORT AT THIS
*         POINT, CORRECTIVE ACTION CAN BE INITIATED ON THE FAILING
*         UNIT BY CONTACTING A C.E. AND MOVING THE TAPE REEL TO
*         ANOTHER UNASSIGNED TRANSPORT.  SINCE THE JOB WAS NEVER
*         ASSIGNED TO THE FAILING TRANSPORT, THIS UNASSIGNED
*         TRANSPORT CAN ASSUME THE DUTIES ORIGINALLY INTENDED FOR
*         THE FAILING DEVICE.  IF NO OTHER TRANSPORT IS AVAILABLE,
*         AND CORRECTIVE ACTION IS POSSIBLE, AND COMPLETED, THE
*         TRANSPORT CAN BE RELOADED AND THE JOB SHOULD PROCESS AS
*         IF NO TAPE CLEANER FAULT EVER OCCURRED.
*
*
*         *WRITE ID BURST FAILURE.*              (BFW)
*
*         THIS MESSAGE IS ISSUED TO THE *E,P* DISPLAY IN THE FORM
*         *WRITE ID BURST* TO INDICATE THAT THE P.E. OR G.C.R. SPECIAL
*         CHARACTERS TO BE READ BY THE SUBSYSTEM AT LOAD POINT IS NOT
*         POSSIBLE.
*
*         WHEN THIS MESSAGE APPEARS, THE FOLLOWING ACTIONS SHOULD
*         BE TAKEN.
*
*         THE OPERATOR SHOULD DISMOUNT THE MAGNETIC TAPE FROM THE
*         UNIT IN QUESTION, CLEAN THE HEAD ASSEMBLY, AND REMOUNT THE
*         MAGNETIC TAPE.  THE OPERATOR SHOULD THEN ENTER *RETRY,EST.*.
*         THE SYSTEM WILL THEN RETRY THE ORIGINAL OPERATION FROM LOAD
*         POINT.  IF NO ERRORS OCCUR, THE JOB WILL CONTINUE NORMAL
*         PROCESSING.  IF THE ORIGINAL PROBLEM PERSISTS, THE MESSAGE
*         *WRITE ID BURST* WILL AGAIN BE ISSUED TO THE *E,P* DISPLAY.
*         THIS TIME THE OPERATOR OR C.E. SHOULD BE INSTRUCTED TO
*         DISMOUNT AND REPLACE THE MAGNETIC TAPE REEL.
*
*         WHEN THE NEW REPLACEMENT REEL OF TAPE IS MOUNTED ON THE
*         TRANSPORT AND THE UNIT GOES *READY* AND *RETRY,EST.* HAS
*         BEEN ENTERED AT THE CONSOLE, THE LABELS FROM THE DISREGARDED
*         REEL ARE WRITTEN ON THIS NEW REEL IF LABELED TAPE.  IN
*         ANY CASE, THE EXTERNAL REEL IDENTIFICATION LABEL MUST BE
*         TRANSFERRED TO THE REPLACEMENT REEL.  THE EXTERNAL REEL
*         IDENTIFICATION LABEL ON THE ORIGINAL DEFECTIVE REEL MUST BE
*         REMOVED TO PREVENT DUPLICATE REEL NUMBERS.
*
*         IF THE ORIGINAL PROBLEM HAS BEEN OVERCOME, PROCESSING WILL
*         CONTINUE AS NORMAL.  IF THE PROBLEM PERSISTS, THE OPERATOR
*         OR C.E. SHOULD BE INSTRUCTED TO ENTER *TERMINATE,EST.* TO
*         ABORT THE OPERATION.  THE MESSAGE, *WRITE ID BURST
*         FAILURE*,  WILL APPEAR IN THE DAYFILE.
*
*
*         *WRITE VERIFY FAILURE.*                (WVF)
*
*         THIS MESSAGE IS POSTED IF THE TAPE WAS POSITIONED PROPERLY
*         AND THE BLOCK ID OF THE WINDOW COULD BE READ CORRECTLY, BUT
*         THE GAP AND CURRENT BLOCK CANNOT BE READ.
          SPACE  4,10
***       DEFINITIONS AND ABBREVIATIONS.
*
*         THE FOLLOWING ARE TERMS THAT WILL BE USED THROUGHOUT
*         THIS ROUTINE.
*
*         BID    BLOCK ID.
*
*         BOT    BEGINNING OF TAPE.
*
*         CHUNK  THIS DEFINES THE PORTION OF A BLOCK HANDLED BY EACH
*                PPU DURING LONG BLOCK OPERATIONS.
*
*         CTS    CARTRIDGE TAPE SUBSYSTEM.
*
*         EOT    END OF TAPE.
*
*         LGB    LAST GOOD BLOCK.
*
*         PCL    PROGRAMMABLE CLIPPING LEVEL.
*
*         TM     TAPE MARK.
*
*         SNB    SYSTEM NOISE BYTE.
*
*         UBC    UNUSED BIT COUNT.  AS USED TO DEFINE THE EXACT NUMBER
*                OF BYTES AND FRAMES TO BE WRITTEN ON OR READ FROM
*                TAPE.
*
*         UDT    UNIT DESCRIPTOR TABLE.  THE AREA OF *MAGNET,S*
*                FIELD LENGTH WHICH CONTAINS THE INFORMATION DESCRIBING
*                EACH TAPE UNIT AND THE CHARACTERISTICS OF THE TAPE
*                BEING PROCESSED.
*
*                EXPLICIT PROCESSOR.  DEFINES A CASE WHERE CERTAIN
*                UNITS CAN ONLY BE SERVICED BY CERTAIN COPIES
*                0F *1MT* DUE TO CONFIGURATION RESTRICTIONS.
          SPACE  4,10
***       PROGRAMMING CONSIDERATIONS.
*
*         IN ORDER TO CONSERVE SPACE, THIS PROGRAM OVERLAYS ITSELF
*         EXTENSIVELY.  IT IS DESIGNED TO MAKE MAXIMUM USE OF AREAS
*         THAT ARE NORMALLY SACRED SUCH AS THE 5 BYTE HEADER
*         ON PPU ROUTINES, FOR EXAMPLE.  PLEASE TAKE DUE CARE
*         WHEN ATTEMPTING MODIFICATIONS.
*
*         READ/WRITE OVERLAY GROUPS MUST BE IN THE FOLLOWING ORDER -
*         MAIN PROCCESOR.
*         LONG BLOCK PROCESSOR.
*         LABEL PROCESSOR.
*         ERROR PROCESSOR MUST BE LAST.
*
*         REMEMBER WHEN READING/WRITING DIRECTLY FROM/TO THE UDT TO BE
*         SURE THAT *1MT* IS AT *MAGNET,S* CONTROL POINT.
*
*         NOTE THE OVERLAY NAMES OF THE FOLLOWING OVERLAYS ARE HARD
*         CODED INTO EXECUTE MACROS. *LOV* CANNOT BE USED TO LOAD
*         THESE OVERLAYS BECAUSE THE CHANNEL MAY NOT BE RESERVED
*         OR CHANNEL PROBLEMS OCCURRED WHICH MUST BE DIAGNOSED
*         BEFORE ATTEMPTING MORE FUNCTIONS.
*         3MA - INITIALIZE TAPE EXECUTIVE.
*         3MB - FUNCTION REJECT PROCESSOR (ALL EXCEPT CTS).
*         3MD - ATS/MTS SPECIAL MESSAGE PROCESSOR.
*
*         USE THE CROSS REFERENCE TABLES WHEN TAGS ARE SHUFFLED.
*         IN PARTICULAR THE TAGS IN READ/WRITE ARE REFERENCED BY LONG
*         BLOCK OVERLAYS AT SEVERAL PLACES.
          SPACE  4,10
***       RESIDENCY RECOMMENDATIONS.
*
*         THE FOLLOWING IS A SUGGESTED ORDER OF PRIORITY FOR MAKING
*         ROUTINES CM OR ALTERNATE LIBRARY RESIDENCE.
*
*         1)     CONTROL POINT/CODED PRESET.
*         2)     READ FUNCTION PROCESSOR.
*         3)     WRITE FUNCTION PROCESSOR.
*         4)     DROP PPU PROCESSOR.
*         5)     1MT ITSELF.
*         6)     *3MB* IF RECOVERY FROM FUNCTION REJECTS DESIRED.
          SPACE  4,10
***       DOCUMENTATION CONVENTIONS.
*
*         TAG CONVENTIONS.
*         ASSUME A ROUTINE NAMED *ABC*.
*         *ABCA* - *ABCZ* WOULD BE CONSTANTS AND INSTRUCTIONS MODIFIED
*         *.EABC* WOULD BE FOR LOCATIONS REFERENCED BY THE ERROR
*                PROCESSOR.
*
*         THE TERM *ATS-TYPE CONTROLLER* MEANS AN ATS, FSC, CMTS OR
*         ISMT CONTROLLER.  IF IT IS NECESSARY TO DISTINGUISH BETWEEN
*         THESE FOUR TYPES, IT WILL BE EXPLICITLY DOCUMENTED.
          SPACE  4,10
**        MISCELLANEOUS SYMBOL DEFINITIONS.
 
 
*CALL     COMPMAC
*CALL     COMSDFS
*CALL     COMSMSC
          SPACE  4,10
**        MICRO DEFINITIONS.
 
 
 VERNUM   MICRO  6,3,+"VER170"+
          SPACE  4,10
**        CCC FUNCTION CODES FOR CTS.
 
 
 F0001    EQU    0001        RELEASE UNIT
 F0002    EQU    0002        CONTINUE
 F0010    EQU    0010        REWIND
 F0110    EQU    0110        REWIND/UNLOAD
 F0012    EQU    0012        GENERAL STATUS
 F0013    EQU    0013        FORESPACE BLOCK
 F0016    EQU    0016        LOCATE BLOCK
 F0113    EQU    0113        BACKSPACE BLOCK
 F0112    EQU    0112        DETAILED STATUS
 F0212    EQU    0212        READ BLOCK ID
 F0312    EQU    0312        READ BUFFERED LOG
 F0020    EQU    0020        CONNECT
 F0220    EQU    0220        CONNECT AND SELECT DATA COMPRESSION
 F0040    EQU    0040        READ FORWARD
 F0140    EQU    0140        READ REVERSE
 F0050    EQU    0050        WRITE
 F0250    EQU    0250        SHORT WRITE
 F0051    EQU    0051        WRITE TAPE MARK
 F0414    EQU    0414        AUTOLOAD
          SPACE  4,10
**        TRACE CODE FOR CTS.
 
 TE       EQU    0           = 1 TO ENABLE TRACE BUFFER
          SPACE  4,10
**        CCC ERROR CODES FOR CTS.
 
 CE001    EQU    1           TRANSPORT NOT ON-LINE
 CE007    EQU    7           DENSITY MARK/BLOCK ID READ FAILURE
 CE012    EQU    12          WRITE ERROR AT LOAD POINT
 CE032    EQU    32          DRIVE BUSY
 CE033    EQU    33          CONTROL UNIT BUSY
 CE051    EQU    51          NO TAPE UNIT CONNECTED
          SPACE  4,10
**        ERPA CODES FOR CTS.
 
 ER33     EQU    0#33        LOAD FAILURE
          SPACE  4,10
**        ASSEMBLY CONSTANTS.
 
 
 QUAL$    EQU    1           DEFINE UNQUALIFIED COMMON DECKS
 BUFC     EQU    2765        BUFFER CONTROL WORD
 BUF      EQU    BUFC+5      FWA DATA BUFFER
 BUFL     EQU    BUF+5000    CONTROL WORD FOR LEVEL NUMBER
 LBBY     EQU    3600        LONG BLOCK BYTES PER INPUT
 BUFB     EQU    3750        SEE NOTE
 LICH     EQU    12          LI FULL CHUNK COUNT
 LIRW     EQU    400         LI REMAINDER IN WORDS
 CH       EQU    TC          TAPE CHANNEL
 ERLA     EQU    7775-2*500  ERROR PROCESSOR LOAD ADDRESS
 ERLB     EQU    7775-1*500  SPECIAL ERROR PROCESSOR LOAD ADDRESS
 BLKS     EQU    40          BLOCKS TO TRANSFER BEFORE REQUEST SWITCH
 BLKX     EQU    3776        BLOCKS TO TRANSFER BEFORE SWITCH (ISMT)
 BLKC     EQU    100         BLOCKS TO TRANSFER BEFORE SWITCH (CTS)
 SBLK     EQU    400         BLOCKS TO SKIP BEFORE CHECKING ERROR FLAG
 LABL     EQU    80D/2       LABEL LENGTH IN BYTES
 CLBL     EQU    81D*8D/12D  MAXIMUM LENGTH OF ANY LABEL BLOCK (CTS)
 LABW     EQU    80D/2/5     CM WORDS IN LABEL
 SLBY     EQU    2400        SKIP LI FORMAT BYTES PER INPUT
 ERAL     EQU    45D         ERASE LIMIT SET TO 15 FEET
 BCKS     EQU    3           NUMBER OF BYTES TO CHECKSUM (POWER OF 2)
 LCKS     EQU    5000        LENGTH TO USE IN CHECKSUM OF LONG BLOCKS
 MXBS     EQU    76          MAXIMUM NUMBER OF CONSECUTIVE BACKSPACES
          ERRPL  MXBS-100    MAXIMUM NUMBER OF BACKSPACES TOO LARGE
 
*         NOTE   BUFB IS BUFFER FOR LONG BLOCK READS AND WRITES
*                AND ALSO THE ORIGIN ADDRESS FOR READ AND WRITE
*                ERROR PROCESSING. INCREASING IT,S VALUE WILL
*                INCREASE THE ALLOWABLE SIZE OF THE READ AND WRITE
*                LONG BLOCK OVERLAYS AND DECREASE THE MAXIMUM
*                LENGTH OF THE ERROR PROCESSORS.
          SPACE  4,10
**        COMMON DECKS.
 
*CALL     COMPCHI
          QUAL   COMSCIO
*CALL     COMSCIO
          QUAL   *
          QUAL   CPS
*CALL     COMSCPS
          QUAL   *
          QUAL   EJT
*CALL     COMSEJT
          QUAL   *
          QUAL   EVT
*CALL     COMSEVT
          QUAL   *
*CALL     COMSPIM
          QUAL   SRU
 MT$      SET    1           ONLY ASSEMBLE MT INCREMENTS
*CALL COMSSRU
          QUAL   *
          QUAL   SSD
*CALL     COMSSSD
          QUAL   *
*CALL     COMSZOL
          LIST   X
          QUAL   MTX
*CALL     COMSMTX
          QUAL   *
          LIST   *
          SPACE  4,10
****      DIRECT LOCATION ASSIGNMENTS.
 
 
          LOC    16
 T8       BSS    1           TEMPORARY
 T9       BSS    1           TEMPORARY
 ED       BSS    1           EQUIPMENT DESCRIPTION
 HP       BSS    1           HARDWARE PARAMETERS
 EO       BSS    1           EST ORDINAL
 ES       BSS    1           EXTENDED STATUS
 DS       BSS    1           DEVICE STATUS
 EI       BSS    1           ERROR ITERATIONS
 WP       BSS    1           BID WINDOW POINTER (MTS/ATS)
 BL       BSS    2           BLOCK COUNT
 UP       BSS    1           USER OPTIONS, FLAGS
 LG       BSS    2           LENGTH OF LAST GOOD RECORD
 EP       BSS    2           ERROR PARAMETERS
 EC       BSS    1           ERROR CODE
 
*         THE FOLLOWING FIVE CELLS ARE NOT WRITTEN BACK TO THE UDT ON
*         REQUEST COMPLETION BECAUSE SOME OVERLAYS USE *WC* AND *OV* AS
*         LOCAL CELLS.
 
 LT       BSS    1           LABEL TYPE, DEVICE TYPE, REQUESTED DENSITY
 SP       BSS    1           SOFTWARE OPTIONS
 FM       BSS    1           TAPE FORMAT AND NOISE BYTE DEFINITION
 WC       BSS    1           CM WORDS PER PRU
 OV       BSS    1           CHUNK COUNT - LONG BLOCKS
          BSS    1           RESERVED
 TB       BSS    1           BLOCK TYPE (READ)
 CF       BSS    1           CHANNEL FLAGS
*                            13 - 10 = RESERVED
*                            7, 6 = 00 - ISMT CONTROLLER
*                                 = 01 - ATS/CMTS/FSC CONTROLLER
*                                 = 10 - MTS CONTROLLER
*                                 = 11 - CTS CONTROLLER
*                            5 - 1 = RESERVED
*                            0 = 64 CHARACTER SET FLAG
          BSS    1           RESERVED
 RS       BSS    1           RETURN STATUS
 FN       BSS    1           FUNCTION NUMBER
 MD       BSS    1           DRIVER MODE FUNCTION
 PA       BSS    1           PARAMETER
 PB       BSS    1           PARAMETER
          BSS    2           (RA AND FL)
 SC       BSS    1           SCRATCH
 BT       BSS    1           BLOCKS TRANSFERRED/OVERLAY ENTRY ADDRESS
 BY       BSS    1           BYTES TO BE PROCESSED
 CN       BSS    5           CM BUFFER
 DF       BSS    1           DROP OUT FLAG (SEE CDO)
          LOC    *O
****
          TITLE  GENERAL USAGE MACROS.
 BUFFER   SPACE  4,10
**        BUFFER - CHECK FOR BUFFER OVERFLOW.
*
*         BUFFER B
*         B      IF DEFINED MEANS CHECK FOR LONG BLOCK BUFFER (BUFB),
*                INSTEAD OF *BUF*.
 
 
          PURGMAC BUFFER
 BUFFER   MACRO  B
          MACREF BUFFER
          USE    BUFFER
          IFC    EQ,*B**,4
          LIST   M
          ERRNG  BUFC-*      OVERFLOWED INTO BUFFER
          LIST   *
          ELSE   3
          LIST   M
          ERRNG  BUFB-*      OVERFLOWED INTO BUFFER
          LIST   *
          ENDM
 CALL     SPACE  4,10
**        CALL - LOAD AND ENTER OVERLAY AT DEFINED ENTRY POINT.
*
*
*         CALL   EPR
*         ENTRY  *EPR* = DESIRED ENTRY POINT AS DEFINED BY ENTRY MACRO.
 
 
          PURGMAC CALL
 
 CALL     MACRO  EPR
          MACREF CALL
          LDN    EPR/10000
          RJM    LOV
          ENDM
 C6364    SPACE  4,10
**        C6463 - GENERATE TABLE FOR MODIFICATION OF CONVERSION TABLES
*         FROM 64 TO 63 CHARACTER SET.
*
*         C6463  MAC,CH,P
*         ENTRY  *MAC* = MACRO TO BE CALLED TO GENERATE CHARACTERS.
*                *CH* = CHARACTER.
*                *P* = IF DEFINED, 1 ADDRESS BYTE AND 2 MODIFICATION
*                BYTES WILL BE GENERATED AND PLACED IN A SEPARATE TABLE.
 
 
 C6463    MACRO  A,B,P
          LOCAL  C,D
 C        BSS    0
          LOC    *O
 D        BSS    0
          LOC    C
          IFC    EQ,*P**
 C63      RMT
          CON    D-1
          A      B
 C63      RMT
          ELSE
 C63P     RMT
          CON    D-2
          A      B
 C63P     RMT
          ENDIF
          ENDM
 ENTRY    SPACE  4,10
**        ENTRY - DEFINE OVERLAY ENTRY POINT.
*
*
*         ENTRY  NAME
*         ENTRY  *NAME* = NAME OF ENTRY ADDRESS.
 
 
          PURGMAC ENTRY
 
 ENTRY    MACRO  NAME
          MACREF ENTRY
          QUAL
 NAME     EQU    *+1R".MA"*10000
          QUAL   ".QNAM"
          ENDM
 ERROVL   SPACE  4,10
**        ERROVL - TEST FOR OVERFLOW INTO ERROR PROCESSOR.
*
*         ERROVL A
*         A      IF DEFINED USE INSTEAD OF ORIGIN ADDRESS FOR OVERFLOW.
 
          PURGMAC ERROVL
 
 
 ERROVL   MACRO  A
          MACREF ERROVL
          IFC    NE,/A//
          LIST   M
          ERRNG  ERLA-A      OVERFLOWED INTO BUFFER
          LIST   *
          ELSE
          LIST   M
          ERRNG  ERLA-*      OVERFLOWED INTO BUFFER
          LIST   *
          ENDIF
          ENDM
 JMP      SPACE  4,10
**        JMP - THREADED JUMP.
*
*
*         JMP    ADDR
*         ENTRY  *ADDR* = JUMP ADDRESS.
 
 
 JMP      MACRO  ADDR
          IF     -DEF,.ADDR,1
 .ADDR    MAX    ADDR,*-40
          IFGT   .ADDR,*-40
          UJN    .ADDR
 .ADDR    SET    *-1
          ELSE   2
 .ADDR    SET    *
          LJM    ADDR
          ENDM
 SADT     SPACE  4,35
**        SADT - SET ADDRESS TABLE MACRO.
*         THIS MACRO WILL GENERATE THE TABLE ENTRIES NECESSARY TO
*         PROVIDE SETTING ADDRESSES IN THE FOLLOWING 24 BIT
*         INSTRUCTION.  ONE, TWO, OR THREE SETS OF TABLE ENTRIES
*         ARE GENERATED DEPENDING ON THE VALUE OF *.IM*.  THE FIRST
*         SET OF TABLE ENTRIES IS FOR THE CURRENT OVERLAY.  THE ONE OR
*         TWO ADDITIONAL ONES WILL BE GENERATED BASED ON THE FOLLOWING-
*
*         IF .IM .NE. 0, A SET OF TABLE ENTRIES IS GENERATED FOR THE
*         ERROR PROCESSORS THAT FOLLOW.
*
*         IF .IM = 2, A SET OF ADDRESSES IS GENERATED FOR THE LONG
*         BLOCK ROUTINE THAT FOLLOWS.
*
*SADT     MACRO  DC,C,BIAS,ABS,SE
*
*         DC = DIRECT CELLS WHERE 17 BIT ADDRESS VALUE IS TO BE TAKEN
*         FROM.
*         CF = IF *C* COMPLEMENT RESULT OF ABOVE.
*         BIAS = VALUE TO BE ADDED TO CONTENTS OF DIRECT CELLS.
*         (MAXIMUM VALUE IS 7)
*         ABS = IF *A* ADD RA TO ADDRESS.
*         SE = IF PRESENT, GENERATE ONLY ONE SET OF TABLE ENTRIES.
*
*         TABLE FORMAT.
*         2 WORDS PER ENTRY.
*
*T        11/ ADDRESS,1/C,6/ DC,3/ BI,1/A,2/
*         C      COMPLEMENT IF SET.
*         DC     POINTER TO DIRECT CELL CONTAINING VALUE.
*         BI     BIAS (AMOUNT TO ADD TO VALUE FROM DIRECT CELLS).
*         A      ABSOLUTE FLAG.
 
 
 SADT     MACRO  DC,CF,BIAS,ABS,SE
          LOCAL  Z,X
          QUAL
 Z        BSS    0
          ERRNG  3777-Z      ADDRESS TOO LARGE FOR MODIFICATION TABLE
          QUAL   ".QNAM"
 X        BSS    0
 SADT     RMT
          VFD    11/X
          IFC    EQ,*CF*C*,2
          VFD    1/1         COMPLEMENT FLAG
          ELSE   3
          VFD    1/0
          IFC    NE,*CF**,1
          ERR    INCORRECT COMPLEMENT FLAG
          VFD    6/DC
          VFD    3/BIAS
          IFC    EQ,*ABS*A*,2
          VFD    1/1
          ELSE   3
          VFD    1/0
          IFC    NE,*ABS**,1
          ERR    INCORRECT ABSOLUTE FLAG
          VFD    2/0
          RMT
 .L1      IFEQ   .IM,2
 SLBP     RMT
          VFD    11/Z
 .L2      IFC    EQ,*CF*C*
          VFD    1/1         COMPLEMENT FLAG
 .L2      ELSE
          VFD    1/0
 .L2      ENDIF
          VFD    6/DC
          VFD    3/BIAS
 .L3      IFC    EQ,*ABS*A*
          VFD    1/1
 .L3      ELSE
          VFD    1/0
 .L3      ENDIF
          VFD    2/0
          RMT
 .L1      ENDIF
 .S1      IFNE   .IM,0
 .S6      IFC    EQ,$SE$$
 
*         MAKE ERROR OVERLAY TABLE.
 
          ERRNG  BUFB-Z      ADDRESS OVERFLOWS ERROR OVERLAY
 SERR     RMT
          VFD    11/Z
 .S2      IFC    EQ,*CF*C*
          VFD    1/1         COMPLEMENT FLAG
 .S2      ELSE
          VFD    1/0
 .S2      ENDIF
          VFD    6/DC
          VFD    3/BIAS
 .S3      IFC    EQ,*ABS*A*
          VFD    1/1
 .S3      ELSE
          VFD    1/0
 .S3      ENDIF
          VFD    2/0
          RMT
 
*         MAKE MTS ERROR OVERLAY TABLE.
 
 SMER     RMT
          VFD    11/Z
 .S4      IFC    EQ,*CF*C*
          VFD    1/1
 .S4      ELSE
          VFD    1/0
 .S4      ENDIF
          VFD    6/DC
          VFD    3/BIAS
 .S5      IFC    EQ,*ABS*A*
          VFD    1/1
 .S5      ELSE
          VFD    1/0
 .S5      ENDIF
          VFD    2/0
          RMT
 .S6      ENDIF
 .S1      ENDIF
          ENDM
          SPACE  4,10
**        THE FOLLOWING CONSTANTS ARE USED IN CALLING THE INSTRUCTION
*         MODIFICATION MACRO TO DEFINE THE RELATIVE ADDRESS WHERE THE
*         VALUES WILL BE SET.
 
          LOC    T2
 .FT      BSS    2           FIRST
 .LM      BSS    2           LIMIT
 .FE      BSS    2           FET ADDRESS
 .LF      BSS    2           LIMIT - FIRST
 .BS      BSS    2           BLOCK SIZE
          LOC    *O
 TSAD     SPACE  4,10
**        TSAD - DEFINE SET ADDRESS TABLE.
*         TABLE IS TERMINATED BY A 0 WORD.
*
*
*LOC      TSAD   B
*         ENTRY  *LOC* = FWA OF SET ADDRESS TABLE.
*                *B* = IF PRESENT NAME OF REMOTE CODE.
 
 
          MACRO  TSAD,A,B
 A        BSS    0
 SADT     HERE
          IFC    NE,*B**,1
 B        HERE
          CON    0           TERMINATE TABLE
          ENDM
          TITLE  OVERLAY COMMUNICATION MACROS.
*         OVERLAY CONTROL.
 
 
 .NA      SET    0
 ADNAM    SPACE  4,10
**        ADNAM - ADVANCE OVERLAY NAME MACRO.
*         ADVANCES OVERLAY NAME.
 
 
          PURGMAC ADNAM
 ADNAM    MACRO
 .NA      SET    .NA+1
 .MA      MICRO  .NA,1, ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789
 .OA      MICRO  1,3, 3M".MA"
          ENDM
 OVERLAY  SPACE  4,15
**        OVERLAY - GENERATE OVERLAY CONSTANTS.
*
*         NOTE   AT PRESET TIME IN AN OVERLAY THE UNIT MAY OR MAY
*                NOT BE CONNECTED DEPENDING ON WHETHER THE CHANNEL
*                IS DEDICATED.  THUS, NO CHANNEL OPERATIONS CAN BE DONE
*                IN PRESET.  ALSO ABNORMAL ERROR EXITS MUST BE DONE
*                BY FIRST COMPLETING THE OVERLAY LOAD.  FOR EXAMPLE
*                SEE THE BEGINNING OF PRESET IN THE WRITE OVERLAY.
*
*         OVERLAY (TEXT),LDA,PRS,QN
*         ENTRY  *TEXT* = TEXT OF SUBTITLE.
*                *LDA* = LOAD ADDRESS.  (IF ABSENT ASSUMES *OVL*.
*                *PRS* = IF PRESENT DO NOT GENERATE CALL TO *PRS*.
*                *QN* = QUALIFIER NAME.  (OVERLAY NAME IF ABSENT.)
 
 
          PURGMAC OVERLAY
 
 OVERLAY  MACRO  TEXT,LDA,P,QN
          LOCAL  A
          USE OVERLAY
          QUAL
          ADNAM              ADVANCE OVERLAY NAME
          IFC    NE,*QN**,3
 .QNAM    MICRO  1,, QN
          QUAL   QN
          ELSE   2
 .QNAM    MICRO  1,, ".OA"
          QUAL   ".OA"
          TTL    1MT/".OA" - TEXT
          TITLE
 LOAD     MICRO  1,3,*OVL*
          IFC    NE,*LDA**,1
 LOAD     MICRO  1,,*LDA*
          IDENT  ".OA","LOAD"  TEXT
*COMMENT  1MT - TEXT
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992.
          ORG    "LOAD"
          IFC    EQ,*P**
 PRSX     LJM    *
          LJM    PRS
          ENDIF
 .IM      SET    0           DESELECT ERROR PROCESSOR INSTRUCTION LIST
          ENDM
          SPACE  4,10
**        MAKE SURE THAT 1MT SYMBOL *LBBY* IS 5 TIMES GREATER
*         THAN COMSMTX SYMBOL *LBWD*.
 
 
 ASCK     EQU    /MTX/LBWD*5
          ERRNZ  ASCK-LBBY   IF LONG BLOCK DEFINITIONS OUT OF SYNC
          TITLE  MAIN PROGRAM.
 1MT      SPACE  4,10
**        1MT - MAIN PROGRAM.
 
 
          ORG    PPFW
 PRS      LJM    /PRESET/PRS  PRESET MAIN PROGRAM
 RET      EQU    PRS
 RET      SPACE  4,10
**        RET - STANDARD RETURN POINTS.
*
*         CALLS  CEC, UAD.
 
 
*         RET - SET FET COMPLETE. (A) = FET COMPETION CODE.
 
*RET      RJM    CEC         SET FET COMPLETE (SETUP IN PRESET)
 
*         RET1 - NORMAL COMPLETION.
 
 RET1     LDN    /MTX/NCP
          UJN    RET5        RETURN NORMAL COMPLETION STATUS
 
*         RET2 - REQUEUE.
 
 RET2     LDN    0
          UJN    RET5        REQUEUE REQUEST
 
*         RET3 - RETURN WITH ERROR. (A) = ERROR CODE.
 
 RET3     STD    EC
 
*         RET4 - RETURN WITH ERROR. (EC) = ERROR CODE.
 
 RET4     LDN    /MTX/ERR
*         UJN    RET5        RETURN ERROR STATUS
 
*         RET5 - RETURN.  (A) = COMPLETION STATUS.
 
 RET5     STD    RS
          LDN    0           DO NOT SET FET COMPLETE
          RJM    CEC         CHANGE TO MAGNET CP
          LDN    /MTX/UERC-/MTX/UST5+1  SET WORD COUNT FOR WRITE
          STD    T2
          RJM    UAD         SET UDT ADDRESS
          ADN    /MTX/UST5
          CWM    DNCV,T2
          SBN    -/MTX/UST1+/MTX/UERC+1
          CWM    ED,TR
          SBN    -/MTX/UXRQ+/MTX/UST1+3
          CWD    RS
*         LJM    PNR         PROCESS NEXT REQUEST
          TITLE  PROCESS NEXT REQUEST.
 PNR      SPACE  4,10
**        PNR - PROCESS NEXT REQUEST.
*
*         ENTRY  (BT) = 0.
*
*         CALLS  CDO, CON, *CPP*, *DPP*, EXR, LOV, PIC, REL, UAD.
*
*         MACROS CALL, MONITOR.
 
 
 PNR      RJM    CDO         CHECK DROP OUT CONDITIONS
 PNR1     LDN    PPAL        CHECK PPU AVAILABILITY
          CRD    CM
          LDN    /MTX/UNITL  UPDATE UDT ADDRESS
 PNR2     RAM    UADA
          LMC    *           (LWA+1 OF UDT)
 PNRA     EQU    *-1
          NJN    PNR3        IF NOT END OF UDT
          LDC    -*          - LENGTH OF UDT
 PNRB     EQU    *-1
          UJN    PNR2        RECYCLE THROUGH UDT,S
 
*         REENTRY FROM ERROR ON CTS UNIT RELEASE.
 
 PNR3     RJM    REL         RELEASE LAST RESERVED UNIT
          LDD    CM+4
 PNRC     EQU    *-1
*         LDN    0           (FORCE DROP OUT)
          ZJN    PNR5        IF ALL PP-S IN USE
          LDM    UADA
          LMC    *           (STARTING UDT ADDRESS)
 PNRD     EQU    *-1
          NJN    PNR4        IF NOT END OF A PASS
 PNRE     LDN    0
          ZJN    PNR5        IF NO ACTIVITIES PERFORMED
          SOM    PNRE        RESET ACTIVITY COUNT
 PNR4     LDD    DF
          ZJN    PNR6        IF NO DROP OUT
 
*         ENTER HERE (VIA *RJM*) TO HANG PP.
 
 HNG      CON    0           ENTRY
*         MONITOR  HNGM      HANG PP
 
*         ENTER HERE TO DROP PPU.
 
 PNR5     CALL   DPP         DROP PPU
 
*         PROCESS UNIT.  (A) = 0.
*         ENTRY MADE HERE FROM PRS.
*         IF DROP OUT FORCED THE FOLLOWING CODE UP TO THE START OF
*         RESIDENT SUBROUTINES MAY BE OVERLAID.
*
*         FIRST 30D BYTES ARE USED FOR FUNCTION REJECT PARAMETERS.
 
 .OVLR    BSS    0           OVERLAY RESIDENT ADDRESS
 
 PNR6     STD    RS          INDICATE NO FUNCTION FOR ERROR PROCESSING
          RJM    UAD         SET UNIT CONNECT INFORMATION
          ADN    /MTX/UST1
          CRD    ED
          ADK    /MTX/UVRI-/MTX/UST1  GET ASSIGNED EJT ORDINAL
          CRD    CN
          SFA    EST,EO
          ADK    EQDE
          CRD    CM
          LDD    CM
          LPN    3
          LMN    /CPS/DWES
          ZJN    PNR9        IF UNIT DOWN
          LDD    CM+1        CHECK PRIMARY CHANNEL
          CHTE   *+1
          LMC    CH+4000
          ZJN    PNR8        IF UNIT ACCESSIBLE
 PNRF     UJN    PNR7        CHECK SECONDARY CHANNEL
*         SHN    21-12       (CTS UNIT)
          PJN    PNR11       IF PRIMARY CHANNEL NOT DOWN
 PNR7     LDD    CM+2        CHECK SECONDARY CHANNEL
          CHTE   *+1
          LMC    CH+4000
          NJN    PNR11       IF UNIT NOT ACCESSIBLE
 PNR8     RJM    CON         CONNECT UNIT
 PNRG     EQU    *-1
*         RJM    PIC         (CTS)
 PNR9     ZJN    PNR12       IF NOT CONNECTED
          SFA    EJT,CN
          ADK    JSNE
          CRD    CM
          LDD    ED          CLEAR JOB ROLLED OUT
          SCN    1
          STD    ED
          LDD    CM+4
          LPC    176
          LMN    /EJT/EXJS*2
          ZJN    PNR10       IF JOB EXECUTING OR UNIT NOT ASSIGNED
          AOD    ED          SET JOB ROLLED OUT
 PNR10    RJM    UAD
          ADK    /MTX/UXRQ   GET REQUEST
          CRD    RS
          ADK    /MTX/UST1-/MTX/UXRQ  UPDATE UNIT STATUS AND JOB STATUS
          CWD    ED
          LDD    RS
 PNR11    NJN    PNR13       IF REQUEST ALREADY IN PROGRESS OR COMPLETE
          LDD    FN
 PNR12    ZJN    PNR13       IF NO REQUEST
          LPN    77
          SBN    /MTX/MDFN
          PJN    PNR13       IF NOT *1MT* REQUEST
          LDM    UADA        SET UDT ADDRESS
          STD    CM+1
          LDD    DS          SET BUSY STATUS
          STD    CM+2
          MONITOR  TDRM      SET REQUEST IN PROGRESS
          LDD    CM+4
          NJN    PNR14       IF REQUEST IN PROGRESS SET
 PNR13    LJM    PNR1        PROCESS NEXT REQUEST
 
*         CAUTION - THE FOLLOWING CODE DESTROYS SC, BT, AND BY.
*         SC AND BT SHOULD NOT BE REUSED UNTIL AFTER *CPP* PRESET.
 
 PNR14    LDD    MA          GET FUNCTION TABLE ENTRY
          CRD    SC
          ADN    1           GET *ASCM* PARAMETERS
          CRD    CN
          RJM    UAD         GET UDT INFORMATION
          ADK    /MTX/UXRQ
          CRD    RS
          ADK    /MTX/UCIB-/MTX/UXRQ
          CRM    CIOE,ON
          ADK    /MTX/UST2-/MTX/UCIB-1
          CRM    EI,TR
          ADK    /MTX/UST5-/MTX/UST4-1
          CRM    DNCV,ON
          ADK    /MTX/UERC-/MTX/UST5-1
          CRM    ECNT,ON
 PNRH     SBN    /MTX/UERC-/MTX/UDS4+1
*         UJN    PNR15       (CTS UNIT)
          CRM    MTSF,TR
 PNR15    LDD    OA          SET *ASCM* PARAMETERS FOR *EXR* CALL
          CWD    CN
          LDN    ZERL        CLEAR ADDRESS MODIFICATION LIST
          CRD    CN
          LDD    SC          LOAD OVERLAY
          SHN    -6
          RJM    LOV
          LDD    SC
          LPN    17
          ZJN    PNR16       IF NO SECOND OVERLAY
          SHN    6
          ADM    NAME        LOAD OVERLAY
          SHN    -6
          RJM    LOV
 PNR16    CALL   CPP         LOAD SPECIAL PROCESSOR AND ENTER ROUTINE
 PNRI     BSS    0           USED TO DETECT IF *CPP* CALLED FROM HERE
          TITLE  RESIDENT SUBROUTINES.
 CDO      SPACE  4,10
**        CDO - CHECK DROP OUT CONDITIONS.
*         CHECKS MOVE FLAG, ROLLOUT FLAG, BLOCKS TRANSFERRED,
*         AND CHANNEL REQUESTED.
*
*         EXIT   (A) = (DF) = 0, IF NO DROP OUT NEEDED.
*
*         USES   CM - CM+4.
 
 
 CDO1     LDN    1           SET DROP OUT
 CDO2     STD    DF
 
 CDO      SUBR               ENTRY/EXIT
          LDN    CMCL        CHECK MOVE FLAG
          CRD    CM
          LDD    CM
          SHN    7
          LMD    CP
          ZJN    CDO1        IF MOVE FLAG
          LDD    CP          CHECK ROLLOUT FLAG
          ADN    STSW
          CRD    CM
          LDD    CM+2
          LPN    1
          NJN    CDO1        IF ROLLOUT FLAG
          LDD    BT
          LPC    3777
          ADC    -BLKS
 CDOC     EQU    *-1
*         ADC    -BLKX       (FOR ISMT)
*         ADC    -BLKC       (FOR CTS)
          PJN    CDO1        IF MAXIMUM BLOCKS TRANSFERRED
 CDOA     LDC    **          CHECK IF CHANNEL REQUESTED
          CRD    CM
 CDOB     LDD    CM+**
          SHN    -13
          UJN    CDO2        STORE DROP OUT FLAG
 CEC      SPACE  4,10
**        CEC - CHANGE TO MAGNET CONTROL POINT.
*
*         ENTRY  (A) = FET COMPLETION STATUS.
*
*         EXIT   (BT) = 0.
*                (CP) = RESTORED TO MAGNET,S CP ADDRESS.
*
*         USES   BT, CM+1 - CM+4, CN - CN+4.
*
*         MACROS MONITOR.
 
 
 CEC      SUBR               ENTRY/EXIT
          STD    CM+4        SAVE FET COMPLETION STATUS
          SHN    -14
          LMC    **          INCLUDE SRU INCREMENT VALUE
 CECA     EQU    *-1
          STD    CM+3
 CECB     LDN    0
          ZJN    CEC2        IF AT MAGNET CP
          SOM    CECB        CLEAR CP CHANGED FLAG
 CEC1     LDD    OA          CHECK FOR PENDING *DRCM* FUNCTION
          CRD    CN
          LDD    CN
          NJN    CEC1        IF FUNCTION PENDING
          LDM    UADA        SET *UDT* ADDRESS
          STD    CM+1
          LDD    BT          SET BLOCKS TRANSFERRED
          STD    CM+2
          MONITOR TIOM       CHANGE TO MAGNET CONTROL POINT
*         LDN    0
 CEC2     STD    BT          CLEAR BLOCKS TRANSFERRED FOR *CDO* CHECK
          UJN    CECX        RETURN
 LOV      SPACE  4,10
**        LOV - LOAD OVERLAY.
*
*         ENTRY  (A) = THIRD CHARACTER OF OVERLAY NAME.
*                *ASCM* FUNCTION PARAMETERS IN OUTPUT REGISTER IF PLD
*                  ALREADY SEARCHED.
*
*         USES   T5, CM - CM+4.
*
*         CALLS  EXR.
 
 
 LOV      SUBR               ENTRY/EXIT
          STD    T5          SAVE OVERLAY NAME
 LOV1     LDD    OA          CHECK FOR PENDING FUNCTION
          CRD    CM
          LDD    CM
          SBN    ASCM+1
          ERRNZ  ASCM-1
          PJN    LOV1        IF FUNCTION PENDING
          LDD    T5          LOAD OVERLAY
          LMC    2L3M
          RJM    EXR
          UJN    LOVX        RETURN
 MCH      SPACE  4,10
**        MCH - MODIFY CHANNELS.
*
*         ENTRY  (A) = ADDRESS OF CHANNEL TABLE.
*
*         USES   T1, T2.
 
 
 MCH1     STD    T2
 MCHB     LDN    0           (PRESET TO PROPER INCREMENT/DECREMENT)
          RAI    T2
          AOD    T1
 MCH2     LDI    T1
          NJN    MCH1        IF MORE CHANNELS TO MODIFY
 
 MCH      SUBR               ENTRY/EXIT
 MCHA     STD    T1
*         UJN    MCHX        (PRS - NO CHANNEL MODIFICATION REQUIRED)
          UJN    MCH2        MODIFY CHANNEL INSTRUCTIONS
 REL      SPACE  4,10
**        REL - RELEASE UNIT.
*
*         ENTRY  (RELA) .NE. 0, UNIT CONNECTED.
*
*         CALLS  FCN.
 
 
 REL      SUBR               ENTRY/EXIT
          LDC    0
 RELA     EQU    *-1
          ZJN    RELX        IF NO UNIT CONNECTED
          LDN    F0001       RELEASE UNIT
          RJM    FCN
          STM    RELA        CLEAR CONNECTED FLAG
          UJN    RELX        RETURN
 ITM      SPACE  4,10
**        ITM - INITIATE TAPE MOTION.
*
*         ENTRY  (ITMA) = TAPE MOTION FUNCTION.
*
*         EXIT   WITH CHANNEL ACTIVE.
*
*         CALLS  FCN.
 
 
 ITM      SUBR               ENTRY/EXIT
          LDC    F0040       READ FORWARD
*         LDC    F0140       READ BACKWARD
*         LDC    F0050       WRITE EVEN FRAME COUNT (MTS)/WRITE (ATS)
*         LDC    F0250       WRITE ODD FRAME COUNT/SHORT WRITE
 ITMA     EQU    *-1
          RJM    FCN
          ACN    CH
          UJN    ITMX        RETURN
 UAD      SPACE  4,10
**        UAD - UNIT DESCRIPTOR TABLE ADDRESS.
*
*         ENTRY  (UADA) = CURRENT UDT ADDRESS.
*
*         EXIT   (A) = UDT ABSOLUTE ADDRESS.
 
 
 UAD      SUBR               ENTRY/EXIT
          LDD    RA
          SHN    6
          ADC    0           UDT ADDRESS
 UADA     EQU    *-1
          UJN    UADX        RETURN
          SPACE  4,10
**        COMMON DECKS.
 
 
 EJT$     EQU    1           ASSEMBLE EJT CODE
 IFP$     EQU    1           SET REMOTE INITIALIZATION
*CALL     COMPGFP
          TITLE  EQUIPMENT PROCESSING SUBROUTINES.
 ERR      SPACE  4,10
**        ERR - ERROR PROCESSOR.
*
*         FOR CTS THIS ROUTINE AND THE REMAINING ROUTINES IN *1MT*
*         ARE OVERLAYED WITH CODE BEGINNING AT */PRESET/CEP*.
*
*         (A) = ERROR CODE IF NOT CALLED FROM MAIN PROGRAM.
*
*         CALLS  *EMM*, MCC.
*
*         MACROS CALL.
 
 
 ERR      CON    0
          RJM    MCC         MASTER CLEAR CHANNEL
          CALL   EMM         LOAD ERROR PROCESSING OVERLAY
 .EERR    BSS    0
 FCN      SPACE  4,15
**        FCN - PROCESS FUNCTION.
*
*         ENTRY  (A) = FUNCTION.
*
*         EXIT   (A) = 0.
*                (FCND) = FUNCTION ISSUED.
*
*         USES   T6.
*
*         CALLS  STC, *3MB*.
*
*         MACROS EXECUTE.
 
 
 FCN      SUBR               ENTRY/EXIT
          ADC    0           ADD EQUIPMENT NUMBER
 FCNA     EQU    *-1
          FAN    CH          FUNCTION EQUIPMENT
          STM    FCND        SAVE FUNCTION
          RJM    STC         STATUS CHANNEL
          ZJN    FCNX        IF NO REJECT
 FCN1     STD    T6          INITIALIZE *3MB* RESIDENCE FLAG
*         CON    0           (ERROR ALREADY ENCOUNTERED)
 FCNC     EQU    *-1
          EXECUTE 3MB        CALL FUNCTION REJECT PROCESSOR
 
 
 FCND     CON    0           FUNCTION ISSUED
 MCC      SPACE  4,10
**        MCC - MASTER CLEAR MTS/ATS CHANNEL.
*         DISCONNECT CHANNEL AND ISSUE STOP TAPE MOTION FUNCTION.
*
*         ENTRY  (A) = ERROR CODE.
*
*         EXIT   (A) = 0.
*                (EC) = ERROR CODE.
*
*         CALLS  FCN.
 
 
 MCC      SUBR               ENTRY/EXIT
          STD    EC          SAVE ERROR CODE
          DCN    CH+40
 MCCA     LDN    11          STOP TAPE MOTION
*         UJN    MCCX        (PROCESSING FATAL FUNCTION REJECT)
          RJM    FCN
          UJN    MCCX        RETURN
          TITLE  MTS/ATS CONTROLLER DEPENDENT SUBROUTINES.
 CON      SPACE  4,15
**        CON - PERFORM INITIAL CONNECT.
*
*         ENTRY  (CM+4) = BYTE 4 OF EST ENTRY *EQDE* WORD.
*                (CN) = EJT ORDINAL OF ASSIGNED JOB.
*
*         EXIT   (A) = 0 IF UNIT RESERVED.
*                (A) .NE. 0 IF UNIT CONNECTED.
*                (CN) = EJT ORDINAL OF ASSIGNED JOB.
*
*         ERROR  EXIT TO *FCN1* IF CONNECT REJECT.
*
*         USES   EC.
*
*         CALLS  ERR, FCN, STW, UAD.
 
 
 CON6     AOM    RELA        SET CONNECTED FLAG
 
 CON      SUBR               ENTRY/EXIT
          RJM    UAD
          ADK    /MTX/UDS1   READ DETAILED STATUS
          CRM    MTDS,TR
          LDD    CM+4        SET UNIT AND EQUIPMENT
          LPC    7017
          LMN    20          MERGE IN FUNCTION
          FAN    CH          ISSUE FUNCTION
 CONA     LDC    60          SET DELAY
*         LDC    144         (2X PPU SPEED)
*         LDC    300         (4X PPU SPEED)
*         LDC    777777      (NOT MTS)
 CON1     IJM    CON2,CH     IF FUNCTION ACCEPTED
          SBN    1
          NJN    CON1        IF NOT TIMEOUT
          DCN    CH+40
 CON2     LDN    0           STATUS DEVICE
          RJM    STW
 .ECUI    BSS    0
          SHN    21-13
 CON3     PJN    CON6        IF CONNECTED
          LDM    MTDS        CHECK RESERVE STATUS
          LPN    77
 CONB     ZJN    CON4        IF NOT POSSIBLE UNIT RESERVE ERROR
*         ZJN    CON5        (ATS CONTROLLER)
          LMN    2
          ZJN    CONX        IF UNIT RESERVED
 CON4     LDN    /MTX/CRJ    CONNECT REJECT
          STD    EC
          LJM    //FCN1      PROCESS CONNECT REJECT
 
*         IF A UNIT CHECK OCCURS WITH NO ERROR CODE IN *MTDS*
*         BITS 0 - 6, THE UNIT IS CONNECTED. THE UNIT CHECK
*         ERRORS (OTHER THAN LOAD CHECK) ARE IGNORED HERE BUT
*         DETECTED BY *SED* FUNCTION.
 
 CON5     RJM    FCN         CLEAR TRANSITORY ERRORS
          LDM    ATUS+1
          LPN    1
          ZJN    CON3        IF NOT LOAD CHECK ERROR
          LDN    /MTX/LCH    ISSUE *LOAD CHECK* MESSAGE
          RJM    ERR         PROCESS ERROR
 CUI      SPACE  4,15
**        CUI - FORMAT UNIT AND/OR PERFORM NON-INITIAL CONNECT.
*
*         ERROR  EXIT TO *CON4* IF CONNECT REJECT.
*
*         USES   T7.
*
*         CALLS  FCN, STW.
 
 
 CUI3     AOM    RELA        SET CONNECTED FLAG
 
 CUI      SUBR               ENTRY/EXIT
 CUI1     LDN    30          ISSUE FORMAT UNIT FUNCTION
*         LDN    4           (ATS UNIT)
 CUIB     EQU    *-1
          RJM    FCN
          ACN    CH
 CUIC     LDN    2           OUTPUT PARAMETERS
*         LDN    3           (ATS UNIT)
          OAM    MTSF,CH
          FJM    *,CH        WAIT FOR PARAMETERS TO BE TAKEN
          DCN    CH+40
          LDN    0           STATUS DEVICE
          RJM    STW
          SHN    21-13
          PJN    CUI3        IF GOOD CONNECT
 CUIE     UJN    CUI2        MTS UNIT
*         LDM    MTDS        (ATS UNIT)
          CON    MTDS
          LPN    77
          ZJN    CUI3        IF NOT CONNECT ERROR
 CUI2     LJM    CON4        PROCESS CONNECT REJECT
 DTS      SPACE  4,10
**        DTS - GET MTS/ATS DETAILED STATUS AND ATS UNIT STATUS.
*
*         CALLS  FCN.
 
 
 DTS1     LDN    6           INPUT UNIT STATUS
          IAM    ATUS,CH
 
 DTS      SUBR               ENTRY/EXIT
          LDC    112
          RJM    FCN         ISSUE STATUS FUNCTION
          ACN    CH
          LDN    10
          IAM    MTDS,CH
 DTSA     UJN    DTSX        RETURN
*         UJN    DTS1        (ATS CONTROLLER)
 STC      SPACE  4,10
**        STC - STATUS CHANNEL.
*
*         EXIT   (A) = 0 IF NO FUNCTION REJECT.
*                    = 1 IF FUNCTION REJECT.
*                (STCB) = (A).
*
*         USES   T0.
 
 
 STC2     SHN    -21
          STM    STCB
 
 STC      SUBR               ENTRY/EXIT
 STCA     LDN    77          PRESET TIMEOUT
*         LDN    6           (MTS CONTROLLER)
*         LDN    20          (ISMT CONTROLLER)
          STD    T0
 STC1     IJM    STC2,CH     IF FUNCTION ACCEPTED
          ADN    1
          PJN    STC1        CONTINUE WAIT
          SOD    T0
          PJN    STC1        IF NOT TIMEOUT
          DCN    CH+40
          UJN    STC2        EXIT
 
 
 STCB     CON    0           CHANNEL STATUS
 STW      SPACE  4,15
**        STW - STATUS AND WAIT COMPLETION.
*
*         ENTRY  (A) = 0 IF WAIT END OF OPERATION.
*                    = 2 IF WAIT NOT BUSY.
*
*         EXIT   (UBWB) = BYTE 2 OF GENERAL STATUS (BLOCK ID).
*                (A) = (DS) = GENERAL STATUS.
*
*         USES   DS, T1.
*
*         CALLS  DTS, ERR, FCN.
 
 
 STW4     IAN    CH+40
          STD    DS          SAVE STATUS
          IAN    CH+40
          STM    UBWB        SAVE BID
          UJN    STW4.1      DISCONNECT CHANNEL
*         LDN    2           (READ/WRITE IN PROGRESS)
 STWE     EQU    *-1
          IAM    MTDS,CH     READ SINGLE TRACK CORRECTION STATUS
 STW4.1   DCN    CH+40
          LDD    DS
          SHN    21-13
          PJN    STW5        IF NO ALERT
          RJM    DTS         READ DETAILED STATUS
 STW5     LDD    DS          CHECK FOR READY
          LPC    0           WAIT END OF OPERATION
*         LPC    2           (WAIT FOR NOT BUSY)
 STWD     EQU    *-1
          NJN    STW3        WAIT COMPLETION
          LDD    DS
 
 STW      SUBR               ENTRY/EXIT
          STM    STWD        SET STATUS MASK
          LCN    0           SET EOP DELAY LIMIT
          STD    T1
 STW1     LDN    12          ISSUE STATUS FUNCTION
          RJM    FCN
          ACN    CH
          LDN    6           DELAY FOR EOP
*         LDN    14          (2X PPU SPEED)
*         LDN    30          (4X PPU SPEED)
 STWA     EQU    *-1
 STW2     FJM    STW4,CH     IF EOP
          SBN    1
          NJN    STW2        IF NOT TIME OUT
          DCN    CH+40
 STW3     SOD    T1
          NJN    STW1        IF NOT END OF EOP DELAY
          LDN    /MTX/WEO
          RJM    ERR         PROCESS ERROR
*         RJM    WFC2        (EXIT DURING BACKSPACE)
*         RJM    WNB2        (EXIT DURING CONTROLLED BACKSPACE)
*         LJM    /READ/MRD5  (NO EOP ON INITIAL LABEL CHECK)
 STWC     EQU    *-1
 UBW      SPACE  4,10
**        UBW - UPDATE BLOCK ID WINDOW.
*
*         ENTRY  CORRECT ROUTINE LOADED FOR FORWARD OR REVERSE.
*                (UBWB) = BID BYTE TO ENTER IN WINDOW.
*                (WP) = POINTS TO LAST GOOD BID BYTE.
*
*         EXIT   (WP) UPDATED.
*                (UBWB) ENTERED IN WINDOW.
 
 
 UBW      SUBR               ENTRY/EXIT
 UBWA     BSS    0           START OF OVERLAID AREA
          AOD    WP
          LPN    7
          STD    WP
          LDM    UBWB
          STM    BIDW,WP
 UBWAL    EQU    *-UBWA      LENGTH OF OVERLAID AREA
          UJN    UBWX        RETURN
 
 
 UBWB     CON    4           CURRENT BLOCK ID
 WEO      SPACE  4,10
**        WEO - WAIT END OF OPERATION.
*
*         ENTRY  (WEOA) = STATUS MASK.
*                (WEOB) = COMPLETION STATUS TO BE EXPECTED.
*
*         EXIT   (A, 11 -  0) = DEVICE STATUS MASKED AND ORED.
*
*         CALLS  STW.
 
 
 WEO1     LPC    4435        READ TO END OF REEL
*         LPC    4425        READ LABELS
*         LPC    4635        WRITE TO END OF REEL
*         LPC    4625        WRITE LABELS
 WEOA     EQU    *-1
          LMC    1           READ
*         LMC    201         WRITE
 WEOB     EQU    *-1
 
 WEO      SUBR               ENTRY/EXIT
          LDN    0
          RJM    STW         STATUS DEVICE
          UJN    WEO1        EXIT
 
          BSS    6           PAD FOR CTS CHANNEL ROUTINES
 
 DNCV     EQU    *           DENSITY AND CONVERSION MODE
 ERSC     EQU    DNCV+1      ERROR SUB-CODE
 MTDS     EQU    DNCV+5      DETAILED STATUS
 CTSD     EQU    MTDS        CTS DETAILED STATUS
 ATUS     EQU    MTDS+10     ATS UNIT STATUS
 MTSF     EQU    MTDS+3*5    UNIT FORMAT PARAMETERS
 BIDW     EQU    MTDS+4*5    BLOCK ID WINDOW
 CTGS     EQU    CTSD+34     CTS GENERAL STATUS WORD 2
 ECNT     EQU    DNCV+7*5    CORRECTED ERROR COUNTERS
          SPACE  4,10
          USE    OVERLAY
 CIOE     EQU    ECNT+5      CIO EXTERNAL REQUESTS
 FETO     EQU    CIOE+1      FET OPTIONS FROM FIRST BYTE 1
 LNUM     EQU    FETO+1      LEVEL NUMBER FROM/FOR FET
 OVL      EQU    LNUM+1+5    MAIN OVERLAY LOAD ADDRESS
 STER     EQU    OVL-5       STATUS WHEN ERROR DETECTED
 NAME     EQU    OVL-4       NAME OF OVERLAY LOADED
 BNEU     EQU    NAME        UPPER 2 BLOCK LENGTH DIGITS (LI FORMAT)
 BNEI     EQU    OVL-3       BLOCK SEQUENCE INFORMATION (3 WORDS)
 PRS      TITLE  PRESET STORAGE.
 PRS      SPACE  4,10
**        PRS - PRESET PROGRAM.
*
*         CALLS  IFP, MCH, *3MA*.
*
*         MACROS DCHAN, EXECUTE, RCHAN.
 
 
          QUAL   PRESET
 
 PRS      RJM    IFP         INITIALIZE *COMPGFP*
          LDD    IR+2
          ZJN    PRS1        IF NORMAL CALL
          EXECUTE  3MA       INITIALIZE MAGNET
 
*         SET UDT ACCESS, CONTROLLER TYPE, AND CHARACTER SET.
 
 PRS1     LDC    RJMI        SET PROGRAM RETURN
          STM    //RET
          LDC    //CEC
          STM    //RET+1
          LDD    RA          GET UNIT DESCRIPTOR TABLE POINTERS
          SHN    6
          ADN    /MTX/UBUF
          CRD    CM
          ADK    -/MTX/UBUF
          ADD    IR+4
          ADK    /MTX/CPST   GET PROCESSOR STATUS
          CRD    CN
          LDD    CM+2        SET LWA+1 OF UDT
          STM    PNRA
          SBD    CM+4        SET LENGTH OF UDT
          LMC    -0
          STM    PNRB
          LDD    CM+4        SET FWA OF UDT
          STM    PNRD
          LDD    CN+4        SET STARTING UDT ADDRESS
          STM    UADA
          LDD    CN+3        SET CONTROLLER TYPE
          LPC    300
          STD    CF
          SHN    -6
          STD    T8
          LDN    IPRL        SET 63/64 CHARACTER SET FLAG
          CRD    CM
          LDD    CM+2
          LPN    1
          RAD    CF
 
*         PRESET CHANNEL ACCESS.
 
          LDC    CHTP        GET FWA CHANNEL INTERLOCK TABLE
          CRD    CM
          LDD    CM+2
          SHN    14
          ADD    CM+3
          SBN    1
          STM    CDOA+1
          SHN    -14
          RAM    CDOA
          LDD    IR+3        SET CHANNEL
          STD    T4
          SBN    CH
          NJN    PRS2        IF CHANNEL MODIFICATION NEEDED
          LDM    PRSA        DISABLE MODIFICATION
          STM    MCHA
          UJN    PRS4        SEARCH CHANNEL TABLE
 
 PRS2     PJN    PRS3        IF INCREMENT TO ASSEMBLED IN CHANNEL
          LMC    -0
          ADC    LCNI-LDNI
 PRS3     RAM    MCHB
          LDC    TCHS        MODIFY CHANNELS
          RJM    MCH
 PRS4     AOM    CDOA+1      ADVANCE CHANNEL TABLE ADDRESS
          SHN    -14
          RAM    CDOA
          LCN    5
          RAD    T4
          PJN    PRS4        IF NOT CORRECT WORD
          ADN    5           SET CORRECT BYTE IN CHANNEL TABLE
          RAM    CDOB
 
*         PRESET CTS CONTROLLER.
 
          LDD    T8
          LMN    3
          NJN    PRS6        IF NOT CTS CONTROLLER
          LDK    CCRL-1
          STD    T1          LENGTH OF CODE TO MOVE
 PRS5     LDM    .CEP,T1
          STM    ERR,T1
          SOD    T1
          PJN    PRS5        IF MORE CODE TO MOVE
          LDC    CCRA
          RJM    MCH         MODIFY CHANNEL INSTRUCTIONS
          LDC    SHNI+21-12
          STM    PNRF        SET PRIMARY CHANNEL STATUS CHECK
          LDC    PIC
          STM    PNRG        ENTRY TO INITIAL CONNECT
          LDC    UJNI+PNR15-PNRH  SKIP READ OF MTS/ATS UNIT PARAMETERS
          STM    PNRH
          LJM    PRS8        REQUEST CHANNEL
 
*         PRESET MTS OR ATS CONTROLLER.
 
 PRS6     LDD    CN+3        SET EQUIPMENT CONTROLLER NUMBER
          LPC    7000
          STM    FCNA
          LDM    PRSG,T8
          STM    STCA        SET FUNCTION TIMEOUT DELAY
          LDM    DLYA
          LPN    14
          ZJN    PRS7        IF 1X PPU SPEED
          SHN    -2
          STD    T1          SET PP SPEED INDEX
          LDM    PRSD-1,T1   INCREASE WAIT EOP DELAY
          STM    STWA
          LDM    PRSF-1,T1   INCREASE DELAY AFTER CONNECT
          STM    CONA+1
 PRS7     LDD    T8
          LMN    2
          ZJN    PRS8        IF MTS CONTROLLER
 
*         PRESET ATS CONTROLLER.
 
          ERRNG  CONB-CON5+37
          LDN    CON5-CON4
          RAM    CONB
          LDM    PRSC
          STM    DTSA
          LDC    LDNI+4
          STM    CUIB
          LDC    LDMI
          STM    CUIE
          AOM    CUIC
          LCN    0           INCREASE CONNECT DELAY
          STM    CONA+1
          LPN    77
          RAM    CONA
 
*         REQUEST CHANNEL AND ENTER MAIN PROGRAM.
 
          CHTE   *+1
 PRS8     LDC    CH+4000     REQUEST REPLY IF CHANNEL DOWN
          RCHAN              REQUEST CHANNEL
          LDD    CM+1
          SHN    21-13
          PJN    PRS9        IF CHANNEL NOT DOWN
          LDD    CN
          LPC    3777        CLEAR *1MT* ACTIVE
          STD    CN
          LDN    ZERL
          CRD    CM
          LDD    RA
          SHN    6
          ADD    IR+4
          ADK    /MTX/CPST   UPDATE *1MT* STATUS
          CWD    CN
          ADK    /MTX/CUAC-/MTX/CPST  CLEAR ALL UNIT ACCESS FLAGS
          CWD    CM
          MONITOR  DPPM      DROP PP
          LJM    PPR         EXIT TO PP RESIDENT
 
 PRS9     IJM    PRS10,CH    IF CHANNEL NOT ACTIVE
          DCN    CH+40
 PRS10    LDN    0
          STD    DF          PRESET DROP OUT FLAG
          LJM    PNR6        RETURN TO PROCESS UNIT
 
 
 PRSA     BSS    0
          LOC    MCHA
          UJN    MCHX        RETURN
          LOC    *O
 
 PRSC     BSS    0
          LOC    DTSA
          UJN    DTS1        INPUT UNIT STATUS
          LOC    *O
 
 PRSD     BSS    0           WAIT EOP DELAY
          LOC    1
          CON    LDNI+30     4X PPU SPEED
          CON    LDNI+14     2X PPU SPEED
          LOC    *O
 
 PRSF     BSS    0           DELAY AFTER CONNECT
          LOC    1
          CON    300         4X PPU SPEED
          CON    144         2X PPU SPEED
          LOC    *O
 
 PRSG     BSS    0           FUNCTION TIMEOUT DELAY
          LDN    20          ISMT
          LDN    77          ATS
          LDN    6           MTS
          SPACE  4,10
**        *COMPGFP* REMOTE CODE.
 
 
 IFP      HERE
          SPACE  4,10
**        CHANNEL TABLE.
 
 
 TCHS     CHTB
 
 CEP      SPACE  4,15
**        CEP - CTS ERROR PROCESSOR.
*
*         ENTRY  (A) = ERROR CODE.
*
*         EXIT   TO *CCP*.
*
*         MACROS CALL.
 
 
*         THIS IS THE START OF CTS ROUTINES THAT ARE MOVED BY PRESET
*         TO *ERR*.
 
 .CEP     BSS    0
          LOC    ERR
 CEP      CON    0           ENTRY
          ERRNZ  CEP-ERR     IF ENTRY POINTS NOT THE SAME
          STD    EC          SAVE ERROR CODE
          CALL   CCP         CTS CHANNEL ERROR PROCESSOR (NO RETURN)
 ICF      SPACE  4,10
**        ICF - ISSUE CCC/CTS FUNCTION.
*
*         ENTRY  (A) = FUNCTION.
*
*         EXIT   (A) = 0.
*                (ICFA) = THE FUNCTION THAT WAS ISSUED.
*                TO *ERR* IF FUNCTION REJECT.
 
 
 ICF2     LDN    0
          BSSZ   FCNX-*      TO KEEP ENTRY POINTS THE SAME
 
 ICF      SUBR               ENTRY/EXIT
          DCN    CH+40       ENSURE CHANNEL IS INACTIVE
          STM    ICFA        SAVE FUNCTION
          FAN    CH          ISSUE THE FUNCTION
          LDN    17          TIMEOUT 4 SECONDS ON ALL FUNCTIONS
          STD    T0
 ICF0     LCN    0
 ICF1     IJM    ICF2,CH     IF FUNCTION REPLY RECEIVED
          SBN    1
          NJN    ICF1        IF TIMEOUT NOT EXPIRED
          SOD    T0
          NJN    ICF0        IF TIMEOUT NOT EXPIRED
          LDN    /MTX/FRJ    FUNCTION REJECT
          RJM    ERR         SAVE ERROR CODE (NO RETURN)
 
 
 ICFA     CON    0           FUNCTION ISSUED
 PIC      SPACE  4,15
**        PIC - PERFORM INITIAL CTS CONNECT.
*
*         ENTRY  (CM+4) = BYTE 4 OF EST ENTRY *EQDE* WORD.
*                (CN) = EJT ORDINAL OF ASSIGNED JOB.
*
*         EXIT   (A) .NE. 0 IF UNIT CONNECTED.
*                (A) .EQ. 0 IF CONTROL UNIT BUSY.
*                (CN) = EJT ORDINAL OF ASSIGNED JOB.
*
*         USES   T2.
*
*         CALLS  CCU, UAD.
 
 
 PIC      SUBR               ENTRY/EXIT
          LDN    6
          STD    T2
          RJM    UAD
          ADK    /MTX/UDS1   READ DETAILED STATUS
          CRM    CTSD,T2
          LDN    0
          STM    PICA
          LDC    LDNI+F0002  SEND CONTINUE IF COMMAND RETRY
          STM    /PRESET/GPSC
          LDD    CM+4        SET UNIT NUMBER
          LPN    17
          LMN    F0020
          STM    CCUA
          RJM    CCU         CONNECT CTS UNIT
          UJN    PICX        RETURN
 
 
 PICA     DATA   0           IF 0, LOCATE BLOCK NOT NECESSARY
 CCU      SPACE  4,10
**        CCU - CONNECT CTS UNIT.
*
*         ENTRY  (CCUA) = CONNECT FUNCTION CODE AND UNIT NUMBER.
*
*         EXIT   (A) = 0 IF UNIT RESERVED TO ANOTHER CONTROLLER.
*                TO *CEP* IF CONNECT REJECT.
*
*         CALLS  GPS, ICF.
 
 
 CCU3     AOM    RELA        SET CONNECTED FLAG
 
 CCU      SUBR               ENTRY/EXIT
          LDC    F0020
*         LDC    F0220       (COMPRESSION MODE SELECTED)
 CCUA     EQU    *-1         (CONNECT UNIT FUNCTION CODE)
          RJM    ICF         ISSUE CTS FUNCTION
 CCU1     LDN    0           WAIT FOR END OF OPERATION
          RJM    GPS         GET AND PROCESS GENERAL STATUS
          MJN    CCU1        IF COMMAND RETRY
          SHN    21-13
          PJN    CCU3        IF ALERT NOT SET
          LDM    CTGS        GENERAL STATUS WORD 2
          SHN    21-13
          PJN    CCU3        IF NOT CCC ERROR CODE
          SHN    13-21
          LPC    177
          SBN    CE001
          ZJN    CCU2        IF CONNECT REJECT
          SBN    CE032-CE001
          ZJN    CCUX        IF DRIVE BUSY OR RESERVED
          SBN    CE033-CE032
          ZJN    CCUX        IF CONTROL UNIT BUSY
          SBN    CE051-CE033
          NJN    CCU3        IF NOT CONNECT REJECT
 CCU2     LDN    /MTX/CRJ    CONNECT REJECT
          RJM    CEP         REPORT ERROR (NO RETURN)
 GPS      SPACE  4,15
**        GPS - GET AND PROCESS GENERAL STATUS.
*         THIS ROUTINE WAITS UP TO 3.5 MINUTES FOR END OF OPERATION.
*         IF RETRY IS SET, IT WAITS UP TO 18 MINUTES FOR THE CONTINUE
*         BIT TO SET.  IT IS ASSUMED THAT THE CONTROLLER HAS A
*         MAXIMUM NUMBER OF COMMAND RETRIES ALLOWED.
*
*         ENTRY  (A) = 0 IF WAIT FOR END OF OPERATION.
*                (A) = 2 IF WAIT NOT BUSY.
*
*         EXIT   (A) = (DS) = GENERAL STATUS.
*                (A) .LE. 0 IF CONTINUE ISSUED.
*                TO *ERR* IF TIMEOUT OR CHANNEL MALFUNCTION.
*                (CTGS) = GENERAL STATUS WORD 2 IF ALERT SET.
*                (CTSD-CTSD+25) = DETAILED STATUS IF ALERT SET.
*
*         USES   T1, T2.
*
*         CALLS  ICF.
 
 
 GPS10    DCN    CH+40
          LDD    DS
          LPC    0           WAIT END OF OPERATION
 GPSB     EQU    *-1
*         LPC    2           WAIT NOT BUSY
          NJN    GPS5        IF NOT COMPLETE
          LDD    DS
 
 GPS      SUBR               ENTRY/EXIT
          STM    GPSB
          LDK    960D        OUTER LOOP TIMER
          STD    T2
 GPS1     LCN    0           INNER LOOP TIMER
          STD    T1
 GPS2     LDN    F0012       GENERAL STATUS
          RJM    ICF         ISSUE CTS FUNCTION
          ACN    CH
          LDN    12
 GPS3     FJM    GPS6,CH     IF GENERAL STATUS RECEIVED
 GPS4     SBN    1
          NJN    GPS3        IF NOT TIMEOUT
 GPS5     SOD    T1
          NJN    GPS2        IF NOT TIMEOUT FOR INNER LOOP
          SOD    T2
          NJN    GPS1        IF NOT TIMEOUT FOR OUTER LOOP
          LDN    /MTX/WEO    END OF OPERATION TIMEOUT
          RJM    ERR         PROCESS ERROR (NO RETURN)
 
 GPS6     IAN    CH
          STD    DS          SAVE GENERAL STATUS WORD 1
          SFM    GPS9,CH     IF CHANNEL PARITY ERROR
          LDD    DS
          SHN    21-13
          PJP    GPS10       IF ALERT NOT SET
          SHN    21-12-21+13
          PJN    GPS7        IF NOT COMMAND RETRY
          LDN    F0002       CONTINUE
 GPSC     EQU    *-1
*         UJN    GPS6.1      (WRITE)
          RJM    ICF         ISSUE CTS FUNCTION
 GPS6.1   LCN    0
          UJP    GPSX        RETURN
 
 GPS7     SHN    21-6-21+12
          PJN    GPS8        IF NOT RETRY IN PROGRESS
          LDK    460D
          SBN    1
          NJN    *-1         IF 230 MICROSECOND DELAY NOT COMPLETE
          UJP    GPS5        CHECK FOR INNER LOOP TIMEOUT
 
 GPS8     LDN    1
          IAM    CTGS,CH     READ GENERAL STATUS WORD 2
          NJN    GPS9        IF STATUS WORD NOT RECEIVED
          LDC    F0112       DETAILED STATUS
          RJM    ICF         ISSUE CTS FUNCTION
          ACN    CH
          LDN    26D
          IAM    CTSD,CH
          NJN    GPS9        IF NOT ALL WORDS RECEIVED
          CFM    GPS10,CH    IF NO CHANNEL ERROR
 GPS9     LDN    /MTX/CMF    CHANNEL MALFUNCTION
 GPS9.1   RJM    ERR         PROCESS ERROR (NO RETURN)
 RBI      SPACE  4,10
**        RBI - READ BLOCK ID.
*
*         EXIT   (BIDW+1, BIDW+2) = CURRENT BLOCK ID.
*                TO *ERR* IF ERROR.
*
*         USES   T3.
*
*         CALLS  GPS, ICF.
 
 
 RBI      SUBR               ENTRY/EXIT
          LDC    F0212       READ BLOCK ID
          RJM    ICF         ISSUE CTS FUNCTION
 RBI1     ACN    CH
          LDN    10
          IAM    BIDW,CH     INPUT BLOCK ID INFORMATION
          STD    T3          WORDS NOT TRANSFERRED
          LDN    0           WAIT FOR END OF OPERATION
          RJM    GPS         GET AND PROCESS GENERAL STATUS
          MJN    RBI1        IF COMMAND RETRY
          SHN    21-13
          MJN    RBI2        IF ALERT SET
          LDD    T3
          ZJN    RBIX        IF ALL WORDS TRANSFERRED
          UJN    GPS9        REPORT CHANNEL MALFUNCTION
 
 RBI2     LDN    /MTX/STE    STATUS ERROR
          UJN    GPS9.1      REPORT ERROR
 RCU      SPACE  4,15
**        RCU - RECONNECT UNIT.
*
*         RELOADING THE CCC BREAKS THE HARDWARE RESERVE TO THE UNIT
*         MAKING A RECONNECT NECESSARY.  IN A DUAL ACCESS CONFIGURATION
*         THE DRIVE COULD BE RESERVED, SO RETRIES ARE NECESSARY.  IF
*         THE DRIVE IS STILL RESERVED AFTER ALL RETRIES, THE CALLING
*         ROUTINE WILL REPORT AN ERROR WHEN THE NEXT COMMAND TO THE
*         CCC FAILS.
*
*         USES   T3.
*
*         CALLS  CCU.
 
 
 RCU      SUBR               ENTRY/EXIT
          LDN    77
          STD    T3
 RCU1     RJM    CCU         CONNECT CTS UNIT
          NJN    RCUX        IF CONNECTED
          SOD    T3
          NJN    RCU1        IF MORE RETRIES
          UJN    RCUX        RETURN
 WFE      SPACE  4,10
**        WFE - WAIT FOR END OF OPERATION FOR CTS.
*
*         ENTRY  (WFEA) = STATUS MASK.
*                (WFEB) = EXPECTED GENERAL STATUS.
*
*         EXIT   (A) = 0 IF COMPLETION STATUS AS EXPECTED.
*
*         CALLS  GPS.
 
 
 WFE      SUBR               ENTRY/EXIT
 WFE1     LDN    0           WAIT FOR END OF OPERATION
          RJM    GPS         GET AND PROCESS GENERAL STATUS
          LPC    406125      READ
 WFEA     EQU    *-1
*         LPC    406331      WRITE
*         LPC    406321      WRITE LABEL
          LMC    1           READ
 WFEB     EQU    *-1
*         LMC    201         WRITE
          UJN    WFEX        RETURN
          ERRNG  DNCV-*      CTS CHANNEL ROUTINES TOO LONG
          LOC    *O
 CCRL     EQU    *-.CEP      LENGTH OF CHANNEL ROUTINES
 
 
 CCRA     CHTB               CHANNEL TABLE FOR CTS ROUTINES
 
          QUAL
          OVERLAY (INITIALIZE TAPE EXECUTIVE.),PPFW
          SPACE  4,10
**        DIRECT CELL ASSIGNMENTS.
 
 
 CA       EQU    30          CHANNEL NUMBER
 PL       EQU    31          FIRMWARE BUFFER LENGTH
 EQ       EQU    33          EQUIPMENT (CONTROLLER) NUMBER
 AB       EQU    40          FIRMWARE NAME
          SPACE  4,10
***       MAGNET INITIALIZATION DAYFILE MESSAGES.
*
*         FATAL DAYFILE MESSAGES.
*
*         C00, T0 MTS CONVERSION TABLE LOAD ERROR.
*         C00, T0 ATS CONVERSION TABLE LOAD ERROR.
*         C00, T0 FSC CONVERSION TABLE LOAD ERROR.
*         C00, T0 698 CONVERSION TABLE LOAD ERROR.
*         C00, 639 FIRMWARE LOAD ERRORS.
*         C00, MTS FIRMWARE LOAD ERRORS.
*         C00, FSC FIRMWARE LOAD ERRORS.
*         C00, 698 FIRMWARE LOAD ERRORS.
*         C00, CTS FIRMWARE LOAD ERRORS.
*         MORE THAN 8 TAPE CHANNELS.
*         MTS FIRMWARE NOT FOUND.
*         FSC FIRMWARE NOT FOUND.
*         639 FIRMWARE NOT FOUND.
*         698 FIRMWARE NOT FOUND.
*         CTS FIRMWARE NOT FOUND.
*         NO TAPE EQUIPMENT.
*         TWO CONTROLLER TYPES ON SAME CHANNEL.
*
*         INFORMATIVE DAYFILE MESSAGES.
*
*         MT000, C00, TURNED OFF.
*         NT000, C00, 200 IPS GCR DRIVE ON 1X PPS.
*         MTS FIRMWARE LOAD, PART NO.- 12345678.
*         FSC FIRMWARE LOAD, PART NO.- 12345678.
*         639 FIRMWARE LOAD, PART NO.- 12345678.
*         698 FIRMWARE LOAD, PART NO.- 12345678.
*         CTS FIRMWARE LOAD, MB468-DXX.
 ITE      SPACE  4,10
**        ITE - INITIALIZE TAPE EXECUTIVE.
*
*         SETS UP CP AND DESCRIBES CONFIGURATION TO *MAGNET*.
*
*         CALLS  BCT, BDW, EST, LBC.
*
*         MACROS MONITOR.
 
 
 ITE      RJM    EST         PRE-PROCESS EST
          RJM    LBC         LOAD FIRMWARE AND CONVERSION TABLES
          RJM    BDW         BUILD EQUIPMENT DEFINITION WORDS
          RJM    BCT         BUILD CHANNEL STATUS TABLE
 ITE1     LDN    ZERL        SET INITIALIZATION COMPLETE
          CRD    CM
          LDD    IR+3
          SHN    6
          ADD    RA
          SHN    6
          ADD    IR+4
          CWD    CM
          MONITOR DPPM       DROP PPU
          LJM    PPR         EXIT TO PP RESIDENT
          SPACE  4,10
**        COMMON DECKS.
 
 
*CALL     COMPC2D
*CALL     COMPCLD
*CALL     COMPRNS
          CTEXT  MTS CONVERSION MACROS AND TABLES.
 MTTR     SPACE  4,10
**        MTTR - GENERATE MTS CONVERSION MEMORY CODE.
*
*         THIS MACRO GENERATES THE CODE FOR THE MTS
*         TAPE CONTROLLER FOR  DATA CONVERSION.
*         DATA GENERATED INCLUDES BIT 6 (INCORRECT CODE)
*         AND BIT 9 (LOAD LAST FLAG).
*
*
*         MTTR   CH,I,L
*         ENTRY  *CH* = DISPLAY CODE CHARACTER OR 2 OCTAL DIGITS
*                *I* = INCORRECT CODE FLAG.
*                *L* = LOAD LAST FLAG.
 
 
          PURGMAC MTTR
 
 MTTR     MACRO  CH,I,L
 .1       MICRO  2,1, _CH
 .2       MICRO  1,2, _CH
 .3       SET    0
          IFC    EQ,*".1"**,1
 .2       OCTMIC 1R_CH
          IFC    NE,*I**,1
 .3       SET    100B
          IFC    NE,*L**,1
 .3       SET    .3+1000B
          CON    ".2"+.3
          ENDM
 MTBCD    SPACE 4
**        MTBCD - TABLE OF INTERNAL BCD/DISPLAY CODE FOR MTS.
*         FIRST 64 ENTRIES, CONVERT INTERNAL BCD TO DISPLAY CODE.
*         INDEXED BY INTERNAL BCD.
 
 
 MTBCD    BSS    0
          LOC    0
 
          MTTR   0
          MTTR   1
          MTTR   2
          MTTR   3
          MTTR   4
          MTTR   5
          MTTR   6
          MTTR   7
          MTTR   8
          MTTR   9
          MTTR   00          64 CHARACTER SET
          C6463  MTTR,63     (63 CHARACTER SET)
          MTTR   =
          MTTR   64
          MTTR   @
          MTTR   63          64 CHARACTER SET
          C6463  MTTR,00     (63 CHARACTER SET)
          MTTR   [
          MTTR   +
          MTTR   A
          MTTR   B
          MTTR   C
          MTTR   D
          MTTR   E
          MTTR   F
          MTTR   G
          MTTR   H
          MTTR   I
          MTTR   <
          MTTR   .
          MTTR   )
          MTTR   \
          MTTR   ^
          MTTR   ;
          MTTR   -
          MTTR   J
          MTTR   K
          MTTR   L
          MTTR   M
          MTTR   N
          MTTR   O
          MTTR   P
          MTTR   Q
          MTTR   R
          MTTR   !
          MTTR   $
          MTTR   *
          MTTR   '
          MTTR   ?
          MTTR   >
          MTTR   ( )
          MTTR   /
          MTTR   S
          MTTR   T
          MTTR   U
          MTTR   V
          MTTR   W
          MTTR   X
          MTTR   Y
          MTTR   Z
          MTTR   ]
          MTTR   (,)
          MTTR   51
          MTTR   65
          MTTR   #
          MTTR   &
 
          LOC    *O
 MTANS    SPACE 4
**        MTANS - TABLE FOR *ASCII* TO DISPLAY CODE CONVERSION.
*         FIRST 256 ENTRIES, CONVERT *ASCII* TO DISPLAY CODE.
*         INDEXED BY *ASCII* CHARACTER.
 
 
 MTANS    BSS    0
          LOC    0
 
          MTTR   ( )         00        NUL  NULL
          MTTR   ]           01        SOH  START OF HEADING
          MTTR   64          02        STX  START OF TEXT
          MTTR   #           03        ETX  END OF TEXT
          MTTR   $           04        EOT  END OF TRANSMISSION
          MTTR   63          05        ENQ  ENQUIRY (64 CHARACTER SET)
          C6463  MTTR,( )    05        ENQ  ENQUIRY (63 CHARACTER SET)
          MTTR   &           06        ACK  ACKNOWLEDGE
          MTTR   '           07        BEL  BELL
          MTTR   51          08        BS   BACKSPACE
          MTTR   )           09        HT   HORIZONTAL TAB
          MTTR   *           0A        LF   LINE FEED
          MTTR   +           0B        VT   VERTICAL TAB
          MTTR   (,)         0C        FF   FORM FEED
          MTTR   -           0D        CR   CARRIAGE RETURN
          MTTR   .           0E        SO   SHIFT OUT
          MTTR   /           0F        SI   SHIFT IN
 
          MTTR   0           10        DLE  DATA LINK ESCAPE
          MTTR   1           11        DC1  DEVICE CONTROL 1 (X-ON)
          MTTR   2           12        DC2  DEVICE CONTROL 2
          MTTR   3           13        DC3  DEVICE CONTROL 3 (X-OFF)
          MTTR   4           14        DC4  DEVICE CONTROL 4 (STOP)
          MTTR   5           15        NAK  NEGATIVE ACKNOWLEDGE
          MTTR   6           16        SYN  SYNCHRONOUS IDLE
          MTTR   7           17        ETB  END OF TRANSMISSION BLOCK
          MTTR   8           18        CAN  CANCEL
          MTTR   9           19        EM   END OF MEDIUM
          MTTR   00          1A        SUB  SUBSTITUTE (64 CHARACTERS)
          C6463  MTTR,63     1A        SUB  SUBSTITUTE (63 CHARACTERS)
          MTTR   ;           1B        ESC  ESCAPE (DRIVER)
          MTTR   [           1C        FS   FILE SEPARATOR
          MTTR   =           1D        GS   GROUP SEPARATOR
          MTTR   >           1E        RS   RECORD SEPARATOR
          MTTR   ?           1F        US   UNIT SEPARATOR
 
          MTTR   ( ),,L      20             SPACE
          MTTR   !,,L        21             EXCLAMATION POINT
          MTTR   64,,L       22             QUOTATION MARKS
          MTTR   #,,L        23             NUMBER SIGN
          MTTR   $,,L        24        $    DOLLAR SIGN
          MTTR   63,,L       25             PERCENT (64 CHARACTER SET)
          C6463  MTTR,( )    25             PERCENT (63 CHARACTER SET)
          MTTR   &,,L        26             AMPERSAND
          MTTR   ',,L        27             APOSTROPHE
          MTTR   51,,L       28        (    OPENING PARENTHESIS
          MTTR   ),,L        29        )    CLOSING PARENTHESIS
          MTTR   *,,L        2A        *    ASTERISK
          MTTR   +,,L        2B        +    PLUS
          MTTR   (,),,L      2C        ,    COMMA
          MTTR   -,,L        2D        -    HYPHEN (MINUS)
          MTTR   .,,L        2E        .    PERIOD
          MTTR   /,,L        2F        /    SLANT
 
          MTTR   0,,L        30        0
          MTTR   1,,L        31        1
          MTTR   2,,L        32        2
          MTTR   3,,L        33        3
          MTTR   4,,L        34        4
          MTTR   5,,L        35        5
          MTTR   6,,L        36        6
          MTTR   7,,L        37        7
          MTTR   8,,L        38        8
          MTTR   9,,L        39        9
          MTTR   00,,L       3A             COLON (64 CHARACTER SET)
          C6463  MTTR,(63,,L) 3A            COLON (63 CHARACTER SET)
          MTTR   ;,,L        3B             SEMICOLON
          MTTR   <,,L        3C             LESS THAN
          MTTR   =,,L        3D             EQUALS
          MTTR   >,,L        3E             GREATER THAN
          MTTR   ?,,L        3F             QUESTION MARK
 
          MTTR   @,,L        40             COMMERCIAL AT
          MTTR   A,,L        41        A
          MTTR   B,,L        42        B
          MTTR   C,,L        43        C
          MTTR   D,,L        44        D
          MTTR   E,,L        45        E
          MTTR   F,,L        46        F
          MTTR   G,,L        47        G
          MTTR   H,,L        48        H
          MTTR   I,,L        49        I
          MTTR   J,,L        4A        J
          MTTR   K,,L        4B        K
          MTTR   L,,L        4C        L
          MTTR   M,,L        4D        M
          MTTR   N,,L        4E        N
          MTTR   O,,L        4F        0
 
          MTTR   P,,L        50        P
          MTTR   Q,,L        51        Q
          MTTR   R,,L        52        R
          MTTR   S,,L        53        S
          MTTR   T,,L        54        T
          MTTR   U,,L        55        U
          MTTR   V,,L        56        V
          MTTR   W,,L        57        W
          MTTR   X,,L        58        X
          MTTR   Y,,L        59        Y
          MTTR   Z,,L        5A        Z
          MTTR   [,,L        5B             OPENING BRACKET
          MTTR   \,,L        5C             REVERSE SLANT
          MTTR   ],,L        5D             CLOSING BRACKET
          MTTR   ^,,L        5E             CIRCUMFLEX
          MTTR   65,,L       5F             UNDERLINE
 
          MTTR   @           60             GRAVE ACCENT
          MTTR   A           61        A    LC
          MTTR   B           62        B    LC
          MTTR   C           63        C    LC
          MTTR   D           64        D    LC
          MTTR   E           65        E    LC
          MTTR   F           66        F    LC
          MTTR   G           67        G    LC
          MTTR   H           68        H    LC
          MTTR   I           69        I    LC
          MTTR   J           6A        J    LC
          MTTR   K           6B        K    LC
          MTTR   L           6C        L    LC
          MTTR   M           6D        M    LC
          MTTR   N           6E        N    LC
          MTTR   O           6F        O    LC
 
          MTTR   P           70        P    LC
          MTTR   Q           71        Q    LC
          MTTR   R           72        R    LC
          MTTR   S           73        S    LC
          MTTR   T           74        T    LC
          MTTR   U           75        U    LC
          MTTR   V           76        V    LC
          MTTR   W           77        W    LC
          MTTR   X           78        X    LC
          MTTR   Y           79        Y    LC
          MTTR   Z           7A        Z    LC
          MTTR   <           7B             OPENING BRACE
          MTTR   \           7C             VERTICAL LINE
          MTTR   !           7D             CLOSING BRACE
          MTTR   ^           7E             OVERLINE (TILDE)
          MTTR   65          7F        DEL  DELETE
 
          DUP    128,1
          MTTR   00,I        INCORRECT CHARACTER
 
          LOC    *O
 MTEBC    SPACE 4
**        MTEBC - TABLE OF EBCDIC/DISPLAY CODE.
*         CONVERT EBCDIC TO DISPLAY CODE.
*         INDEXED BY EBCDIC CODE VALUE.
 
 
 MTEBC    BSS    0
          LOC    0
 
          MTTR   ( )         00        NUL  NULL
          MTTR   ]           01        SOH  START OF HEADING
          MTTR   64          02        STX  START OF TEXT
          MTTR   #           03        ETX  END OF TEXT
          MTTR   ( )         04
          MTTR   )           05        HT   HORIZONTAL TAB
          MTTR   ( )         06
          MTTR   65          07        DEL  DELETE
          MTTR   ( )         08
          MTTR   ( )         09
          MTTR   ( )         0A
          MTTR   +           0B        VT   VERTICAL TAB
          MTTR   (,)         0C        FF   FORM FEED
          MTTR   -           0D        CR   CARRIAGE RETURN
          MTTR   .           0E        SO   SHIFT OUT
          MTTR   /           0F        SI   SHIFT IN
 
          MTTR   0           10        DLE  DATA LINK ESCAPE
          MTTR   1           11        DC1  DEVICE CONTROL 1 (X-ON)
          MTTR   2           12        DC2  DEVICE CONTROL 2
          MTTR   3           13        DC3  DEVICE CONTROL 3 (X-OFF)
          MTTR   ( )         14
          MTTR   ( )         15
          MTTR   51          16        BS   BACKSPACE
          MTTR   ( )         17
          MTTR   8           18        CAN  CANCEL
          MTTR   9           19        EM   END OF MEDIMUM
          MTTR   ( )         1A
          MTTR   ( )         1B
          MTTR   [           1C        FS   FILE SEPERATOR
          MTTR   =           1D        GS   GROUP SEPERATOR
          MTTR   >           1E        RS   RECORD SEPERATOR
          MTTR   ?           1F        US   UNIT SEPERATOR
 
          MTTR   ( )         20
          MTTR   ( )         21
          MTTR   ( )         22
          MTTR   ( )         23
          MTTR   ( )         24
          MTTR   *           25        LF   LINE FEED
          MTTR   7           26        ETB  END OF TRANSMISSION BLOCK
          MTTR   ;           27        ESC  ESCAPE
          MTTR   ( )         28
          MTTR   ( )         29
          MTTR   ( )         2A
          MTTR   ( )         2B
          MTTR   ( )         2C
          MTTR   63          2D        ENQ  ENQUIRY (64 CHARACTER SET)
          C6463  MTTR,( )    2D        ENQ  ENQUIRY (63 CHARACTER SET)
          MTTR   &           2E        ACK  ACKNOWLEDGE
          MTTR   '           2F        BEL  BELL
 
          MTTR   ( )         30
          MTTR   ( )         31
          MTTR   6           32        SYN  SYNCHROUS IDLE
          MTTR   ( )         33
          MTTR   ( )         34
          MTTR   ( )         35
          MTTR   ( )         36
          MTTR   $           37        EOT  END OF TRANSMISSION
          MTTR   ( )         38
          MTTR   ( )         39
          MTTR   ( )         3A
          MTTR   ( )         3B
          MTTR   4           3C        DC4  DEVICE CONTROL 4
          MTTR   5           3D        NAK  NEGATIVE ACKNOWLEDGE
          MTTR   ( )         3E
          MTTR   00          3F        SUB  SUBSTITUTE (64 CHARACTER SET
          C6463  MTTR,63     3F        SUB  SUBSTITUTE (63 CHARACTER SET
 
          MTTR   ( ),,L      40             SPACE
          MTTR   ( )         41
          MTTR   ( )         42
          MTTR   ( )         43
          MTTR   ( )         44
          MTTR   ( )         45
          MTTR   ( )         46
          MTTR   ( )         47
          MTTR   ( )         48
          MTTR   ( )         49
          MTTR   [,,L        4A             OPENING BRACKET
          MTTR   .,,L        4B        .    PERIOD
          MTTR   <,,L        4C             LESS THAN
          MTTR   51,,L       4D             OPENING PARENTHESIS
          MTTR   +,,L        4E        +    PLUS
          MTTR   !,,L        4F             LOGICAL OR
 
          MTTR   &,,L        50             AMPERSAND
          MTTR   ( )         51
          MTTR   ( )         52
          MTTR   ( )         53
          MTTR   ( )         54
          MTTR   ( )         55
          MTTR   ( )         56
          MTTR   ( )         57
          MTTR   ( )         58
          MTTR   ( )         59
          MTTR   ],,L        5A             CLOSING BRACKET
          MTTR   $,,L        5B        $    DOLLAR SIGN
          MTTR   *,,L        5C        *    ASTERISK
          MTTR   ),,L        5D        )    CLOSING PARENTHESIS
          MTTR   ;,,L        5E             SEMICOLON
          MTTR   ^,,L        5F        NOT  LOGICAL NOT
 
          MTTR   -,,L        60        -    HYPHEN (MINUS)
          MTTR   /,,L        61        /    SLANT
          MTTR   ( )         62
          MTTR   ( )         63
          MTTR   ( )         64
          MTTR   ( )         65
          MTTR   ( )         66
          MTTR   ( )         67
          MTTR   ( )         68
          MTTR   ( )         69
          MTTR   \           6A             VERTICAL LINE
          MTTR   (,),,L      6B        ,    COMMA
          MTTR   63,,L       6C             PERCENT (64 CHARACTER SET)
          C6463  MTTR,( )    6C             PERCENT (63 CHARACTER SET)
          MTTR   65,,L       6D             UNDERSCORE
          MTTR   >,,L        6E             GREATER THAN
          MTTR   ?,,L        6F             QUESTION MARK
 
          MTTR   ( )         70
          MTTR   ( )         71
          MTTR   ( )         72
          MTTR   ( )         73
          MTTR   ( )         74
          MTTR   ( )         75
          MTTR   ( )         76
          MTTR   ( )         77
          MTTR   ( )         78
          MTTR   @           79             GRAVE ACCENT
          MTTR   00,,L       7A             COLON (64 CHARACTER SET)
          C6463  MTTR,(63,,L) 7A            COLON (63 CHARACTER SET)
          MTTR   #,,L        7B             NUMBER SIGN
          MTTR   @,,L        7C             COMMERCIAL AT
          MTTR   ',,L        7D             APOSTROPHE
          MTTR   =,,L        7E        =    EQUALS
          MTTR   64,,L       7F             QUOTATION MARKS
 
          MTTR   ( )         80
          MTTR   A           81        A    LC
          MTTR   B           82        B    LC
          MTTR   C           83        C    LC
          MTTR   D           84        D    LC
          MTTR   E           85        E    LC
          MTTR   F           86        F    LC
          MTTR   G           87        G    LC
          MTTR   H           88        H    LC
          MTTR   I           89        I    LC
          MTTR   ( )         8A
          MTTR   ( )         8B
          MTTR   ( )         8C
          MTTR   ( )         8D
          MTTR   ( )         8E
          MTTR   ( )         8F
 
          MTTR   ( )         90
          MTTR   J           91        J    LC
          MTTR   K           92        K    LC
          MTTR   L           93        L    LC
          MTTR   M           94        M    LC
          MTTR   N           95        N    LC
          MTTR   O           96        O    LC
          MTTR   P           97        P    LC
          MTTR   Q           98        Q    LC
          MTTR   R           99        R    LC
          MTTR   ( )         9A
          MTTR   ( )         9B
          MTTR   ( )         9C
          MTTR   ( )         9D
          MTTR   ( )         9E
          MTTR   ( )         9F
 
          MTTR   ( )         A0
          MTTR   ^           A1             OVERLINE (TILDE)
          MTTR   S           A2        S    LC
          MTTR   T           A3        T    LC
          MTTR   U           A4        U    LC
          MTTR   V           A5        V    LC
          MTTR   W           A6        W    LC
          MTTR   X           A7        X    LC
          MTTR   Y           A8        Y    LC
          MTTR   Z           A9        Z    LC
          MTTR   ( )         AA
          MTTR   ( )         AB
          MTTR   ( )         AC
          MTTR   ( )         AD
          MTTR   ( )         AE
          MTTR   ( )         AF
 
          MTTR   ( )         B0
          MTTR   ( )         B1
          MTTR   ( )         B2
          MTTR   ( )         B3
          MTTR   ( )         B4
          MTTR   ( )         B5
          MTTR   ( )         B6
          MTTR   ( )         B7
          MTTR   ( )         B8
          MTTR   ( )         B9
          MTTR   ( )         BA
          MTTR   ( )         BB
          MTTR   ( )         BC
          MTTR   ( )         BD
          MTTR   ( )         BE
          MTTR   ( )         BF
 
          MTTR   <           C0             OPENING BRACE
          MTTR   A,,L        C1        A
          MTTR   B,,L        C2        B
          MTTR   C,,L        C3        C
          MTTR   D,,L        C4        D
          MTTR   E,,L        C5        E
          MTTR   F,,L        C6        F
          MTTR   G,,L        C7        G
          MTTR   H,,L        C8        H
          MTTR   I,,L        C9        I
          MTTR   ( )         CA
          MTTR   ( )         CB
          MTTR   ( )         CC
          MTTR   ( )         CD
          MTTR   ( )         CE
          MTTR   ( )         CF
 
          MTTR   !           D0             CLOSING BRACE
          MTTR   J,,L        D1        J
          MTTR   K,,L        D2        K
          MTTR   L,,L        D3        L
          MTTR   M,,L        D4        M
          MTTR   N,,L        D5        N
          MTTR   O,,L        D6        O
          MTTR   P,,L        D7        P
          MTTR   Q,,L        D8        Q
          MTTR   R,,L        D9        R
          MTTR   ( )         DA
          MTTR   ( )         DB
          MTTR   ( )         DC
          MTTR   ( )         DD
          MTTR   ( )         DE
          MTTR   ( )         DF
 
          MTTR   \,,L        E0             REVERSE SLANT
          MTTR   ( )         E1
          MTTR   S,,L        E2        S
          MTTR   T,,L        E3        T
          MTTR   U,,L        E4        U
          MTTR   V,,L        E5        V
          MTTR   W,,L        E6        W
          MTTR   X,,L        E7        X
          MTTR   Y,,L        E8        Y
          MTTR   Z,,L        E9        Z
          MTTR   ( )         EA
          MTTR   ( )         EB
          MTTR   ( )         EC
          MTTR   ( )         ED
          MTTR   ( )         EE
          MTTR   ( )         EF
 
          MTTR   0,,L        F0        0
          MTTR   1,,L        F1        1
          MTTR   2,,L        F2        2
          MTTR   3,,L        F3        3
          MTTR   4,,L        F4        4
          MTTR   5,,L        F5        5
          MTTR   6,,L        F6        6
          MTTR   7,,L        F7        7
          MTTR   8,,L        F8        8
          MTTR   9,,L        F9        9
          MTTR   ( )         FA
          MTTR   ( )         FB
          MTTR   ( )         FC
          MTTR   ( )         FD
          MTTR   ( )         FE
          MTTR   ( )         FF
 
          LOC    *O
 
          ENDX
          CTEXT  ATS CONVERSION MACROS AND TABLES. (WRITE)
 ATSW     SPACE  4,10,10
**        ATSW - GENERATE ATS CONVERSION MEMORY FOR WRITE OF
*         6 BIT CHARACTERS.
*
*         THIS MACRO GENERATES THE CODE FOR THE ATS TAPE
*         CONTROLLER FOR OUTPUT OF 6 BIT BCD CHARACTERS.
*
*         ATSW   CH1,CH2
*
*         WHERE  CH1, CH2 = BCD CHARACTER VALUES IN OCTAL. THESE
*         TWO CHARACTERS WILL BE PACKED INTO 1 PP WORD.
 
 
          PURGMAC ATSW
 
 ATSW     MACRO  CH1,CH2
          CON    CH1_CH2
          ENDM
 ATEW     SPACE  4,10,10
**        ATEW - GENERATE ATS CONVERSION TABLE FOR WRITE
*         OF EIGHT BIT CHARACTERS.
*
*         THIS MACRO GENERATES THE CODE FOR ATS TAPE CONTROLLER
*         FOR THE OUTPUT OF 8 BIT CHARACTERS.
*
*         ATEW   CH1,CH2,CH3
*
*         WHERE  CH1, CH2, CH3 = CHARACTER VALUES IN HEXIDECIMAL.
*         THE 3 CHARACTERS WILL BE PACKED INTO 2 PP WORDS.
 
 
          PURGMAC ATEW
 
 ATEW     MACRO  CH1,CH2,CH3
 .1       MICRO  1,1, _CH2
 .2       MICRO  2,1, _CH2
          CON    0#_CH1_".1",0#_".2"_CH3
          ENDM
 ATBCD    SPACE  4,10,10
**        ATBCD - TABLE TO CONVERT DISPLAY TO INTERNAL BCD.
*         EACH PP WORD CONTAINS 2 INTERNAL BCD VALUES.
*         INDEXED BY DISPLAY CODE VALUE / 2.
 
 
 ATBCD    BSS    0
          LOC    0
 
          ATSW   00,21       COLON, A
          C6463  ATSW,(16,21)  (63 CHARACTER SET - COLON, A)
          ATSW   22,23       B, C
          ATSW   24,25       D, E
          ATSW   26,27       F, G
          ATSW   30,31       H, I
          ATSW   41,42       J, K
          ATSW   43,44       L, M
          ATSW   45,46       N, O
          ATSW   47,50       P, Q
          ATSW   51,62       R, S
          ATSW   63,64       T, U
          ATSW   65,66       V, W
          ATSW   67,70       X, Y
          ATSW   71,00       Z, 0
          ATSW   01,02       1, 2
          ATSW   03,04       3, 4
          ATSW   05,06       5, 6
          ATSW   07,10       7, 8
          ATSW   11,20       9, +
          ATSW   40,54       -, *
          ATSW   61,74       /, (
          ATSW   34,53       ), $
          ATSW   13,60       =, SPACE
          ATSW   73,33       ., ,
          ATSW   76,17       #, [
          ATSW   72,16       ],
          C6463  ATSW,(72,00)  (63 CHARACTER SET - ], %)
          ATSW   14,75       ", _
          ATSW   52,77       !, &
          ATSW   55,56       ', ?
          ATSW   32,57       <, >
          ATSW   15,35       @A \
          ATSW   36,37       ^, ;
 
          DUP    96,1
          ATSW   60,60       BLANK FILL REMAINDER OF TABLE
 
          LOC    *O
 ATANS    SPACE  4,10
**        ATANS - TABLE TO CONVERT DISPLAY TO ASCII.
*         EACH 2 PP WORDS CONTAIN 3 ASCII VALUES.
 
 
 ATANS    BSS    0
          LOC    0
 
          ATEW   3A,41,42    COLON, A, B
          C6463  ATEW,(20,41,42),P (63 CHARACTER SET - SPACE, A, B)
          ATEW   43,44,45    C, D, E
          ATEW   46,47,48    F, G, H
          ATEW   49,4A,4B    I, J, K
          ATEW   4C,4D,4E    L, M, N
          ATEW   4F,50,51    O, P, Q
          ATEW   52,53,54    R, S, T
          ATEW   55,56,57    U, V, W
          ATEW   58,59,5A    X, Y, Z
          ATEW   30,31,32    0, 1, 2
          ATEW   33,34,35    3, 4, 5
          ATEW   36,37,38    6, 7, 8
          ATEW   39,2B,2D    9, PLUS, HYPHEN
          ATEW   2A,2F,28    ASTERISK, SLANT, OPENING PAREN
          ATEW   29,24,3D    CLOSING PAREN, DOLLAR SIGN, EQUALS
          ATEW   20,2C,2E    SPACE, PERIOD, COMMA
          ATEW   23,5B,5D    NUMBER SIGN, OPEN BRACKET, CLOSING BRACKET
          ATEW   25,22,5F    PERCENT, QUOTATION MARKS, UNDERLINE
          C6463  ATEW,(3A,22,5F),P (63 CHARACTER SET - PERCENT)
          ATEW   21,26,27    EXCLAMATION POINT, AMPERSAND, APOSTROPHE
          ATEW   3F,3C,3E    QUESTION MARK, LESS THAN, GREATER THAN
          ATEW   40,5C,5E    COMMERICAL AT, REVERSE SLANT, CIRCUMFLEX
          ATEW   3B,20,20    SEMICOLON, SPACE, SPACE
 
          DUP    63,1
          ATEW   20,20,20    BLANK FILL REMAINDER OF TABLE
          CON    400         LAST CHARACTER
 
          LOC    *O
 ATEBC    SPACE  4,10
**        ATEBC - TABLE TO CONVERT DISPLAY TO EBCDIC.
*         EACH 2 PP WORDS CONTAIN 3 EBCDIC VALUES.
 
 
 ATEBC    BSS    0
          LOC    0
 
          ATEW   7A,C1,C2    COLON, A, B
          C6463  ATEW,(00,C1,C2),P (63 CHARACTER SET - COLON, A, B)
          ATEW   C3,C4,C5    C, D, E
          ATEW   C6,C7,C8    F, G, H
          ATEW   C9,D1,D2    I, J, K
          ATEW   D3,D4,D5    L, M, N
          ATEW   D6,D7,D8    O, P, Q
          ATEW   D9,E2,E3    R, S, T
          ATEW   E4,E5,E6    U, V, W
          ATEW   E7,E8,E9    X, Y, Z
          ATEW   F0,F1,F2    0, 1, 2
          ATEW   F3,F4,F5    3, 4, 5
          ATEW   F6,F7,F8    6, 7, 8
          ATEW   F9,4E,60    9, PLUS, HYPHEN
          ATEW   5C,61,4D    ASTERISK, SLANT, OPENING PAREN
          ATEW   5D,5B,7E    CLOSING PAREN, DOLLAR SIGN, EQUALS
          ATEW   40,6B,4B    SPACE, PERIOD, COMMA
          ATEW   7B,4A,5A    NUMBER SIGN, OPEN BRACKET, CLOSING BRACKET
          ATEW   6C,7F,6D    PERCENT, QUOTATION MARKS, UNDERLINE
          C6463  ATEW,(7A,7F,6D),P (63 CHARACTER SET - COLON)
          ATEW   4F,50,7D    EXCLAMATION POINT, AMPERSAND, APOSTROPHE
          ATEW   6F,4C,6E    QUESTION MARK, LESS THAN, GREATER THAN
          ATEW   7C,E0,5F    COMMERCIAL AT, REVERSE SLANT, CIRCUMFLEX
          ATEW   5E,40,40    SEMICOLON, SPACE, SPACE
 
          DUP    63,1
          ATEW   40,40,40    BLANK FILL REMAINDER OF TABLE
          CON    1000        LAST CHARACTER
 
          LOC    *O
          ENDX
          TITLE  INITIALIZATION SUBROUTINES.
 ABT      SPACE  4,10
**        ABT - ABORT.
*
*         ENTRY  (A) = MESSAGE ADDRESS.
*
*         CALLS  DFM.
*
*         MACROS MONITOR.
 
 
 ABT      RJM    DFM         ISSUE MESSAGE
          MONITOR ABTM       ABORT
          LJM    PPR         EXIT TO PP RESIDENT
 ADC      SPACE  4,10
**        ADC - ABORT AND DROP CHANNEL.
*
*         ENTRY  (A) = MESSAGE ADDRESS.
*                (CA) = CHANNEL NUMBER.
*
*         CALLS  C2D, DFM.
*
*         MACROS DCHAN.
 
 
 ADC      STD    AB          SAVE MESSAGE ADDRESS
          LDD    CA          RETURN CHANNEL
          DCHAN
          LDD    CA          SET CHANNEL NUMBER IN MESSAGE
          RJM    C2D
          STM    1,AB
          LDD    AB
          ADC    ERLN
          RJM    DFM         ISSUE MESSAGE TO ERROR LOG
          LDD    AB
          UJN    ABT         ABORT
 BCT      SPACE  4,10
**        BCT - BUILD CHANNEL STATUS TABLE.
*
*         ENTRY  CST ENTRIES PRESET TO ZERO BY MAGNET.
*
*         EXIT   CHANNEL AND CONTROLLER FLAGS SET IN *CPST*.
*
*         USES   T1, CM - CM+4.
 
 
 BCT      SUBR               ENTRY/EXIT
          LDN    0           INITIALIZE CHANNEL INDEX
          STD    T1
 BCT1     LDM    CHLI,T1
          LMC    7777
          ZJN    BCTX        IF END OF CHANNELS
          LDN    ZERL        CLEAR ASSEMBLY
          CRD    CM
          LDM    CHLI,T1     SAVE CHANNEL NUMBER AND CONTROLLER FLAGS
          LPC    340
          NJN    BCT2        IF NOT CMTS CONTROLLER
          LDM    CHLI,T1
          LPC    7437
          LMD    HN
          UJN    BCT3        SET CMTS
 
 BCT2     LDM    CHLI,T1
          LPC    7737
 BCT3     STD    CM+3
          AOD    CM+4        INSURE NON-ZERO ENTRY FOR MAGNET CHECK
          LDD    RA          SET CST ADDRESS
          SHN    6
          ADK    /MTX/CST
          ADD    T1
          ADD    T1
          ERRNZ  /MTX/CSTE-2
          ADK    /MTX/CPST   INITIALIZE PROCESSOR STATUS
          CWD    CM
          AOD    T1          ADVANCE CHANNEL INDEX
          LJM    BCT1        PROCESS NEXT CHANNEL
 BDW      SPACE  4,25
**        BDW - BUILD DEFINITON WORDS.
*
*         RETURNS EQUIPMENT DEFINITION INFORMATION FOR EACH UNIT TO
*         BUFFER AT /MTX/UINT.  THE BUFFER IS TERMINATED WITH A ZERO
*         WORD.
*
*         USES   T5, T7, SC, AB - AB+4, CM - CM+4, CN - CN+4.
*
*         CALLS  CTE.
*
*         MACROS SFA.
*
*         *UINT* ENTRY FORMAT -
*
*T        12/ ED,12/ HP,12/ EO,12/ ATCP,9/0,2/DT,1/R
*
*         ED     *ED* BYTE OF *UST1*.
*         HP     *HP* BYTE OF *UST1*.
*         EO     *EO* BYTE OF *UST1*.
*         ATCP   *AT* DEVICE CONTROL PATH INFORMATION.
*         DT     TAPE DEVICE TYPE.
*         R      RESERVED FOR TAPE DEVICE TYPE EXPANSION.
 
 
*         TERMINATE *UINT*.
 
 BDW3     LDD    RA          WRITE ZERO ENTRY
          SHN    6
          ADC    /MTX/UINT
          ADD    T7
          CWD    CM
 
 BDW      SUBR               ENTRY/EXIT
 
*         INITIALIZE EST SEARCH.
 
          LDN    ESTP        READ EST POINTER
          CRD    CM
          LDD    CM+2        SET LAST EST ORDINAL + 1
          STD    SC
          LDN    0
          STD    T7
          LDN    NOPE-1      INITIALIZE EST ORDINAL FOR SEARCH
          STD    T5
 
*         CHECK FOR TAPE EQUIPMENT.
 
 BDW1     LDN    ZERL        CLEAR ASSEMBLY
          CRD    CM
          AOD    T5          INCREMENT EST ORDINAL
          LMD    SC
          ZJN    BDW3        IF END OF EST
          SFA    EST,T5      READ EST ENTRY
          ADK    EQDE
          CRD    AB
          ADK    EQAE-EQDE
          CRD    CN
          LDD    AB+3        GET EQUIPMENT MNEMONIC
          RJM    CTE         CHECK FOR TAPE EQUIPMENT
          MJN    BDW1        IF NOT TAPE EQUIPMENT
 
*         INITIALIZE *UINT* ENTRY.
 
          SHN    1           SET DEVICE TYPE
          STD    CM+4
          LDD    T5          SET EST ORDINAL
          STD    CM+2
          LDD    AB          SET MTS/ATS/GCR FLAGS
          SHN    -3
          LPN    62
          STD    CM+1
          LDD    AB          SET FSC FLAG
          LPC    100
          RAD    CM+1
          LDD    AB          SET CMTS FLAG
          LPN    4
          SHN    6-2
          RAD    CM+1
          LDM    BDWA,T1     SET CTS AND 9 TRACK STATUS
          RAD    CM+1
          LDD    AB          SET ISMT FLAG
          LPN    10
          SHN    10-3
          RAD    CM+1
          LDD    CN+3        SET ACCESS LEVELS
          LPN    77
          SHN    6
          STD    CM
          LDD    T1
          LMN    /MTX/DVAT
          NJN    BDW2        IF NOT *AT* DEVICE
          LDN    2           SET ACS FLAG
          RAD    CM
          LDD    CN+2        SET CONTROL PATH PARAMETERS
          STD    CM+3
 BDW2     LDD    RA
          SHN    6
          ADC    /MTX/UINT   WRITE DEFINITION TO *MAGNET* BUFFER
          ADD    T7
          CWD    CM
          AOD    T7
          LJM    BDW1        LOOP FOR OTHER UNITS
 
 
*         TABLE TO SET 9 TRACK OR CTS FLAG IN *UST1*.
 
 BDWA     INDEX
          INDEX  /MTX/DVMT,0
          INDEX  /MTX/DVCT,200
          INDEX  /MTX/DVNT,1
          INDEX  /MTX/DVAT,200
          INDEX  /MTX/DVMX
 CCT      SPACE  4,10
**        CCT - CONVERT CONVERSION TABLE. (MTS TABLE TO ATS READ TABLE)
*
*         ENTRY  (A) = ADDRESS OF MTS TABLE.
*                (T1) = TABLE NUMBER.
*
*         EXIT   BFMS CONTAINS ATS READ CONVERSION TABLE.
*
*         USES   T2 - T6.
 
 
 CCT2     LDI    T2          CONVERT BCD TABLE
          STD    T4
          AOD    T2
          LDD    T4
          SHN    6
          ADI    T2
          STM    BFMS,T3
          AOD    T2
          AOD    T3
          LMN    64D/2
          NJN    CCT2        IF MORE CHARACTERS IN TABLE
 CCT3     LDC    2R          SPACE FILL REMAINDER OF TABLE
          STM    BFMS,T3
          AOD    T3
          LMC    128D
          NJN    CCT3        IF MORE CHARACTERS
 
 CCT      SUBR               ENTRY/EXIT
          STD    T2          SAVE TABLE ADDRESS
          LDN    0           INITIALIZE COUNTER
          STD    T3
          LDD    T1
          LMN    3
          ZJN    CCT2        IF BCD LOAD
 
*         PROCESS 8 BIT CONVERSION.
 
 CCT1     LDI    T2          PACK 3 MTS BYTES INTO 2 ATS BYTES
          LPC    177
          STD    T4
          AOD    T2
          LDI    T2
          LPC    177
          STD    T5
          AOD    T2
          LDI    T2
          LPC    177
          STD    T6
          AOD    T2
          LDD    T4          MERGE THE CHARACTERS
          SHN    8D
          ADD    T5
          SHN    -4D
          STM    BFMS,T3
          AOD    T3
          LDD    T5
          SHN    8D
          ADD    T6
          STM    BFMS,T3
          AOD    T3
          ADC    -170D
          MJN    CCT1        IF MORE CHARACTERS TO CONVERT
          LDI    T2          SET LAST PARTIAL BYTE
          LPC    177
          SHN    4D
          STM    BFMS,T3
          LJM    CCTX        RETURN
          SPACE  4,15
**        CHANNEL AND EQUIPMENT DEFINITIONS.
*
*         *CHLI* IS BUILT BY *CCH*, IN THE FOLLOWING FORMAT.
*
*         13-11  EQUIPMENT NUMBER (0 IF CTS CHANNEL).
*         10     RESERVED.
*         7,6,5  CONTROLLER TYPE.
*                000 = CMTS CHANNEL.
*                001 = ISMT CHANNEL.
*                010 = ATS CHANNEL.
*                011 = FSC CHANNEL.
*                100 = MTS CHANNEL.
*                111 = CTS CHANNEL.
*         4-0    CHANNEL NUMBER.
 
 
 CHCN     CON    0           COUNT OF TAPE CHANNELS
 CHLI     CON    -0,-0,-0,-0,-0,-0,-0,-0,-0
 CMD      SPACE  4,10
**        CMD - CHANNEL MODIFICATION.
*
*         ENTRY  (A) = CHANNEL.
*
*         EXIT   (CA) = CHANNEL.
*                (A) = 0 IF CHANNEL RESERVED.
*                (A) .NE. 0 IF CHANNEL DOWN.
*
*         USES   T0, T3.
*
*         MACROS RCHAN.
 
 
 CMD      SUBR               ENTRY/EXIT
          LPN    37
          STD    CA          SET CHANNEL NUMBER
          ADC    4000        REQUEST REPLY IF CHANNEL DOWN
          RCHAN
          LDD    CM+1
          SHN    0-13
          NJN    CMDX        IF CHANNEL DOWN
          LDC    CTAB        MODIFY CHANNELS
          STD    T3
 CMD1     LDI    T3
          ZJN    CMDX        IF END OF CHANNEL TABLE
          STD    T0
          LDI    T0
          SCN    37
          LMD    CA
          STI    T0
          AOD    T3
          UJN    CMD1        CONTINUE MODIFYING CHANNEL INSTRUCTIONS
 CTE      SPACE  4,10
**        CTE - CHECK FOR TAPE EQUIPMENT.
*
*         ENTRY  (A) = EQUIPMENT MNEMONIC.
*
*         EXIT   (A) = TAPE DEVICE TYPE IF TAPE EQUIPMENT.
*                (A) .LT. 0 IF NOT TAPE EQUIPMENT.
*                (T1) = TAPE DEVICE TYPE IF TAPE EQUIPMENT.
*
*         USES   T1.
 
 
 CTE      SUBR               ENTRY/EXIT
          STD    T0
          LDN    /MTX/DVMX
          STD    T1
 CTE1     SOD    T1
          MJN    CTEX        IF ALL ENTRIES CHECKED
          LDD    T0
          LMM    CTEA,T1
          NJN    CTE1        IF NO MATCH
          LDD    T1          SET DEVICE TYPE
          UJN    CTEX        RETURN
 
 
 CTEA     INDEX              DEVICE MNEMONIC TABLE
          INDEX  /MTX/DVMT,2RMT
          INDEX  /MTX/DVCT,2RCT
          INDEX  /MTX/DVNT,2RNT
          INDEX  /MTX/DVAT,2RAT
          INDEX  /MTX/DVMX
 ICF      SPACE  4,10
**        ICF - ISSUE CHANNEL FUNCTION.
*
*         ENTRY  (A) = FUNCTION.
*
*         EXIT   (A) = 0 IF FUNCTION REJECT
*                (A) .NE. 0 IF NOT FUNCTION REJECT.
 
 
 ICF      SUBR               ENTRY/EXIT
          DCN    CH+40
          FAN    CH
          LCN    0
 ICF1     IJM    ICFX,CH     IF FUNCTION ACCEPTED
          SBN    1
          NJN    ICF1        IF NOT TIMED OUT
          DCN    CH+40
          UJN    ICFX        RETURN
 IFL      SPACE  4,10
**        IFL - INITIALIZE FOR FIRMWARE LOAD.
*
*         ENTRY  (A) = 3 CHARACTER ADAPTOR NAME.
*
*         EXIT   (SC) = CHLI-1.
*                THE ADAPTOR NAME IS SET INTO THE APPROPRIATE DAYFILE
*                MESSAGES AND THE FIRMWARE PART NUMBER IS INITIALIZED.
*
*         USES   T1.
 
 
 IFL      SUBR               ENTRY/EXIT
          STM    LBCG+3
          STM    LBCH+1
          STM    LCMC+5
          SHN    -14
          LMC    2L
          STM    LBCG+2      CHANGE MESSAGES
          STM    LBCH
          STM    LCMC+4
          LDC    /MTX/UIBF   SET CM BUFFER ADDRESS
          STM    LBCA
          LDC    ADCI
          STM    LBCA-1
          LDN    3
          STD    T1
 IFL1     LDC    2R00        REINITIALIZE FIRMWARE PART NUMBER
          STM    LBCH+17,T1
          SOD    T1
          PJN    IFL1        IF MORE BYTES TO INITIALIZE
          LDC    CHLI-1      INITIALIZE *CHLI* INDEX
          STD    SC
          LJM    IFLX        RETURN
 ILM      SPACE  4,10
**        ILM - ISSUE FIRMWARE LOADED MESSAGE.
*
*         ENTRY  (ILMA) = 1 IF FIRMWARE LOADED.
*                (LBCH) = MESSAGE.
*
*         EXIT   (ILMA) = 0.
*
*         CALLS  DFM.
 
 
 ILM      SUBR               ENTRY/EXIT
          LDC    0
 ILMA     EQU    *-1
*         LDC    1           (FIRMWARE WAS LOADED)
          ZJN    ILMX        IF FIRMWARE NOT LOADED
          LDC    LBCH+ERLN   ISSUE MESSAGE TO ERRLOG
          RJM    DFM
          STM    ILMA        RESET
          UJN    ILMX        RETURN
 LBC      SPACE  4,15
**        LBC - LOAD BUFFER CONTROLLER.
*
*         LOAD CONTROLWARE TO FSC, ISMT, CMTS, MTS, AND CTS TAPE
*         ADAPTORS.  ALSO LOAD CONVERSION TABLES TO MTS, ATS, FSC, ISMT
*         AND CMTS CONTROLLERS.
*
*         ENTRY  (CHLI) = TABLE OF CHANNELS.
*
*         EXIT   FIRMWARE LOADED.
*
*         ERROR  EXIT TO *ABT* IF FIRMWARE RECORD NOT FOUND.
*
*         USES   CN, EQ, PL, SC, T1, T3 - T7, AB - AB+4, CM - CM+4.
*
*         CALLS  CLD, CMD, ICF, IFL, ILM, LCA, LCM, RNS, *0CT*.
*
*         MACROS DCHAN, DELAY, ENDMS, EXECUTE, SETMS.
 
 
 LBC17    RJM    ILM         ISSUE FIRMWARE LOADED MESSAGE
 
*         INITIALIZE FSC FIRMWARE LOAD.
 
          LDC    3RFSC       INITIALIZE FOR FSC FIRMWARE LOAD
          RJM    IFL
          LDC    ZJNI+LBC15-LBCC
          ERRPL  LBC15-LBCC-40  CHECK JUMP IN RANGE
          STM    LBCC        CHANGE END OF FIRMWARE LOAD
 
*         LOAD FIRMWARE TO ALL FSC ADAPTORS.
 
 LBC18    AOD    SC
          LDI    SC
          LMC    7777
          ZJN    LBC21       IF END OF CHANNELS
          SHN    -5
          LPN    7
          LMN    3&7
          NJN    LBC18       IF NOT FSC
          LDM    ILMA
          ZJN    LBC19       IF FIRMWARE NOT IN CM BUFFER YET
          LJM    LBC10       OUTPUT FIRMWARE TO ADAPTOR
 
 LBC19    AOM    ILMA        INDICATE FIRMWARE IN BUFFER
          LDD    MA
          CWM    LBCI,ON     MOVE RECORD NAME TO DIRECT CELLS
          SBN    1
          CRD    AB
          RJM    CLD         SEARCH LIBRARY DIRECTORY
          NJN    LBC20       IF FIRMWARE RECORD FOUND
          LDC    =C* FSC FIRMWARE NOT FOUND.*
          LJM    ABT         ABORT
 
 LBC20    LJM    LBC6        CONTINUE FIRMWARE RECORD READ
 
 LBC21    RJM    ILM         ISSUE FIRMWARE LOADED MESSAGE
 
*         INITIALIZE CMTS FIRMWARE LOAD.
 
          LDC    3R698       INITIALIZE FOR 698 FIRMWARE LOAD
          RJM    IFL
          LDC    LBC22       SET RETURN ADDRESS
          STM    LBCD
 
*         LOAD FIRMWARE TO ALL CMTS ADAPTORS.
 
 LBC22    AOD    SC
          LDI    SC
          LMC    7777
          ZJN    LBC25       IF END OF CHANNELS
          SHN    -5
          LPN    7
          LMN    0&7
          NJN    LBC22       IF NOT CMTS
          LDM    ILMA
          ZJN    LBC23       IF FIRMWARE NOT IN CM BUFFER YET
          LJM    LBC10       OUTPUT FIRMWARE TO ADAPTOR
 
 LBC23    AOM    ILMA        INDICATE FIRMWARE IN BUFFER
          LDD    MA
          CWM    LBCK,ON     MOVE RECORD NAME TO DIRECT CELLS
          SBN    1
          CRD    AB
          RJM    CLD         SEARCH LIBRARY DIRECTORY
          NJN    LBC24       IF FIRMWARE RECORD FOUND
          LDC    =C* 698 FIRMWARE NOT FOUND.*
          LJM    ABT         ABORT
 
 LBC24    LJM    LBC6        CONTINUE FIRMWARE RECORD READ
 
 LBC25    RJM    ILM         ISSUE FIRMWARE LOADED MESSAGE
 
*         INITIALIZE ISMT FIRMWARE LOAD.
 
          LDC    3R639       INITIALIZE FOR 639 FIRMWARE LOAD
          RJM    IFL
          LDC    LBC26
          STM    LBCD
 
*         LOAD FIRMWARE TO ALL ISMT ADAPTORS.
 
 LBC26    AOD    SC
          LDI    SC
          LMC    7777
          ZJN    LBC29       IF END OF CHANNELS
          SHN    -5
          LPN    7
          LMN    1&7
          NJN    LBC26       IF NOT ISMT
          LDM    ILMA
          ZJN    LBC27       IF FIRMWARE NOT IN CM BUFFER YET
          LJM    LBC10       OUTPUT FIRMWARE TO ADAPTOR
 
 LBC27    AOM    ILMA        INDICATE FIRMWARE IN BUFFER
          LDD    MA
          CWM    LBCJ,ON     MOVE RECORD NAME TO DIRECT CELLS
          SBN    1
          CRD    AB
          RJM    CLD         SEARCH LIBRARY DIRECTORY
          NJN    LBC28       IF FIRMWARE RECORD FOUND
          LDC    =C* 639 FIRMWARE NOT FOUND.*
          LJM    ABT         ABORT
 
 LBC28    LJM    LBC6        CONTINUE FIRMWARE RECORD READ
 
 LBC29    RJM    ILM         ISSUE FIRMWARE LOADED MESSAGE
 
*         LOAD FIRMWARE TO ALL CTS ADAPTERS.
 
          LDC    3RCTS
          RJM    IFL         INITIALIZE FOR FIRMWARE LOAD
 LBC30    AOD    SC
          LDI    SC
          LMC    7777
          ZJP    LBC32       IF END OF CHANNELS
          SHN    -5
          LPN    7
          LMK    7&7
          NJN    LBC30       IF NOT CTS
          AOM    ILMA        SO FIRMWARE LOADED MESSAGE DISPLAYED
          LDI    SC          SET CHANNEL NUMBER
          LPN    37
          STD    CN
          RJM    CMD         REQUEST CHANNEL
          NJN    LBC30       IF CHANNEL DOWN
          LDC    ERLB        SET BUFFER ADDRESS
          STD    CN+1
 LBC30.1  DELAY
          LDD    OA          WAIT OUTPUT REGISTER CLEAR
          CRD    CM
          LDD    CM
          NJN    LBC30.1     IF RECALL STILL PENDING
          EXECUTE  0CT,ERLA+5  LOAD CTS/CCC MICROCODE
          LDD    CN
          NJP    LBC30.2     IF ERROR
          STM    LBCH+17     INDICATE END OF MESSAGE
          LDC    2RMB
          STM    LBCH+12     PUT MB468-D0X IN MESSAGE
          LDC    2R46
          STM    LBCH+13
          LDC    2R8-
          STM    LBCH+14
          LDC    2RD0
          STM    LBCH+15
          LDD    CN+2        GET MICROCODE REVISION
          SHN    6
          ADC    2R0.
          STM    LBCH+16
          LDD    CA
          DCHAN              DROP CHANNEL
          UJP    LBC30       CHECK NEXT CHANNEL
 
 LBC30.2  SHN    0-13
          NJN    LBC31       IF FIRMWARE NOT FOUND
          LDC    LBCG
          LJM    ADC         ABORT FIRMWARE LOAD
 
 LBC31    LDC    =C* CTS FIRMWARE NOT FOUND.*
          LJM    ABT         ABORT
 
 LBC32    RJM    ILM         ISSUE FIRMWARE LOADED MESSAGE
 
 LBC      SUBR               ENTRY/EXIT
          LDC    CHLI-1
          STD    SC
          LDM    DLYA
          LPN    14
          ZJN    LBC2        IF 1X PPU SPEED
          LPN    4
          ZJN    LBC1        IF 2X PP SPEED
 DL2X     EQU    LDCI+40
 DL4X     EQU    LCNI+0
          LDC    DL4X&DL2X   INCREASE DELAY FOR 4X PPU SPEED
 LBC1     LMC    DL2X        INCREASE DELAY FOR 2X PPU SPEED
          STM    LCMB
 
*         LOAD FIRMWARE TO MTS CHANNEL.  ALSO LOAD ATS AND MTS
*         CONVERSION MEMORIES.
 
 LBC2     AOD    SC
          LDI    SC
          LMC    7777
          NJN    LBC3        IF NOT END OF CHANNELS
          LJM    LBC17       PROCESS FSC CHANNELS
 
 LBC3     SHN    -5
          LPN    7
          LMN    4&7
          ZJN    LBC4        IF MTS CHANNEL
          LMN    2&4
          NJN    LBC2        IF NOT ATS CHANNEL
          RJM    LCA         LOAD ATS CONVERSION MEMORIES
          UJN    LBC2        LOOP FOR ALL CHANNELS
 
 LBC4     LDM    ILMA
          ZJN    LBC5        IF FIRMWARE NOT IN CM BUFFER YET
          LJM    LBC10       OUTPUT FIRMWARE TO CONTROLLER
 
 LBC5     AOM    ILMA        INDICATE FIRMWARE IN BUFFER
          LDD    MA
          CWM    LBCF,ON     MOVE RECORD NAME TO DIRECT CELLS
          SBN    1
          CRD    AB
          RJM    CLD         SEARCH LIBRARY DIRECTORY
          NJN    LBC6        IF FIRMWARE RECORD FOUND
          LDC    =C* MTS FIRMWARE NOT FOUND.*
          LJM    ABT         ABORT
 
 LBC6     CRD    AB          READ TRACK AND SECTOR
          LDN    FNTP        GET SYSTEM EQUIPMENT
          CRD    CM
          LDD    CM          READ SYSTEM FST
          SHN    14
          ADD    CM+1
          ERRNZ  SYFO        CODE DEPENDS ON SYSTEM FILE FNT POSITION
          ADN    FSTG
          CRD    CM
          LDD    CM
          LPN    77
          STD    T5
          SETMS  READSYS
          LDD    AB+3        SET FILE POINTERS
          STD    T6          TRACK
          LDD    AB+4        SECTOR
          STD    T7
          LDN    0           INITIALIZE SECTOR COUNT
          STD    AB+1
 LBC7     LDC    BFMS        READ SECTOR
          RJM    RNS
          ZJN    LBC8        IF END OF FIRMWARE
          STD    AB          SAVE WORD COUNT
          AOD    AB+1        COUNT SECTOR
          LDD    RA          WRITE SECTOR TO CM
          SHN    6
          ADC    /MTX/UIBF
 LBCA     EQU    *-1
          CWM    BFMS+2,AB
          LDD    AB          ADVANCE BUFFER ADDRESS
          RAM    LBCA
          SHN    -14
          RAM    LBCA-1
          LDD    AB
          SHN    -6
          NJN    LBC7        IF NOT END OF FIRMWARE
 LBC8     ENDMS              RETURN CHANNEL
*         LDN    0           BUILD MESSAGE WITH PART NUMBER
          STD    T1
          LDD    AB          WORD COUNT OF LAST SECTOR
          STD    PL
          SHN    2
          RAD    PL          BYTE COUNT OF LAST SECTOR
 LBC9     LDM    BFMS-6,PL
          SCN    17
          SHN    11-7
          RAM    LBCH+17,T1
          LDM    BFMS-6,PL
          LPN    17
          RAM    LBCH+17,T1
          AOD    PL
          AOD    T1
          LMN    4
          NJN    LBC9        IF MORE MESSAGE TO BUILD
 
*         ENTER HERE IF FIRMWARE RECORD ALREADY IN CM BUFFER.
*
*         (AB) = WORD COUNT OF LAST SECTOR.
*         (AB+1) = NUMBER OF SECTORS.
 
 LBC10    LDI    SC          GET TAPE CHANNEL
          RJM    CMD
          NJP    LBC2        IF CHANNEL DOWN
          SFM    *+2,CH      ENSURE CHANNEL ERROR FLAG IS CLEAR
          LDI    SC          SET EQUIPMENT NUMBER
          LPC    7000
          STD    EQ
          ADC    F0414       ISSUE DEADSTART
          RJM    ICF
          NJN    LBC12       IF DEAD START FUNCTION ACCEPTED
 LBC11    LDC    LBCG
          LJM    ADC         ABORT FIRMWARE LOAD
 
 LBC12    ACN    CH
          LDC    /MTX/UIBF+20  SET CM BUFFER ADDRESS (SKIP 77 TABLE)
          STM    LBCB
          LDC    ADCI
          STM    LBCB-1
          LDN    0           INITIALIZE SECTOR COUNT
          STD    T1
          LDN    100-20      SET TO SKIP 77 TABLE
          STD    T3
 LBC13    LDD    RA          READ SECTOR FROM CM
          SHN    6
          ADC    *
 LBCB     EQU    *-1
          CRM    BFMS,T3
          LDD    T3          CONVERT WORDS TO BYTES
          SHN    2
          ADD    T3
          OAM    BFMS,CH     OUTPUT FIRMWARE
          FJM    *,CH
          NJN    LBC11       IF CONTROLLER ILL
          LDD    T3          RESET CM BUFFER ADDRESS
          RAM    LBCB
          SHN    -14
          RAM    LBCB-1
          LDD    HN          SET TO OUTPUT FULL SECTOR
          STD    T3
          AOD    T1          ADVANCE SECTOR COUNT
          SBD    AB+1
 LBCC     ZJN    LBC14       IF END OF MTS FIRMWARE
*         ZJN    LBC15       (FCS, ISMT,CMTS, CTS)
          ADN    1
          NJN    LBC13       IF NOT LAST SECTOR
          LDD    AB          SET WORD COUNT OF LAST SECTOR
          STD    T3
          UJN    LBC13       OUTPUT LAST SECTOR
 
 LBC14    DCN    CH+40       START BUFFER CONTROLLER
          RJM    LCM         LOAD CONVERSION MEMORIES
          LDD    CA          DROP CHANNEL
          DCHAN
          LJM    LBC2        LOOP FOR ALL CHANNELS
 
 LBC15    DCN    CH+40       START ADAPTOR
          LDD    EQ
          ADN    F0012       GET STATUS
          RJM    ICF         ISSUE FUNCTION
          ZJN    LBC16       IF LOAD ERROR
          ACN    CH+40
          LCN    0
 LBC15.1  FJM    LBC15.2,CH
          SBN    1
          NJN    LBC15.1     IF TIMEOUT NOT EXPIRED
          UJN    LBC16       ABORT FIRMWARE LOAD
 
 LBC15.2  IAN    CH+40
          SFM    LBC16,CH    IF ERROR
          DCN    CH+40
          SHN    21-13
          MJN    LBC16       IF ALERT SET
          LDD    CA          DROP CHANNEL
          DCHAN
          RJM    LCA         LOAD CONVERSION TABLES
 LBCE     EQU    *-2
*         UJN    *+2         CTS
          LJM    LBC18       LOOP FOR ALL CHANNELS
 LBCD     EQU    *-1
*         LJM    LBC22       LOOP FOR ALL CHANNELS (CMTS)
*         LJM    LBC26       LOOP FOR ALL CHANNELS (ISMT)
*         LJM    LBC30       LOOP FOR ALL CHANNELS (CTS)
 
 LBC16    LJM    LBC11       ABORT FIRMWARE LOAD
 
 
 LBCF     VFD    42/0LFIRM66X,18/0
 
 LBCG     DATA   C* C00 MTS FIRMWARE LOAD ERROR.*
 
 LBCH     DATA   C* MTS FIRMWARE LOAD, PART NO.- 00000000.*
*LBCH     DATA   C* CTS FIRMWARE LOAD, MB468-D0X.* (CTS)
 
 LBCI     VFD    42/0LTAPEFSC,18/0
 LBCJ     VFD    30/0LCW63X,30/0
 LBCK     VFD    30/0LMB467,30/0
 LCA      SPACE  4,15
**        LCA - LOAD CONVERSION MEMORY TO ATS CONTROLLER.
*
*         ENTRY  ((SC)) = E0CC WHERE E = EQUIPMENT AND CC = CHANNEL.
*
*         EXIT   CONVERSION TABLES LOADED.
*
*         ERROR  EXIT TO *ADC* IF LOAD ERRORS.
*
*         USES   T1, EQ.
*
*         CALLS  CCT, CMD, ICF.
*
*         MACROS DCHAN.
 
 
 LCA10    LDD    CA          RETURN TAPE CHANNEL
          DCHAN
 
 LCA      SUBR               ENTRY/EXIT
          LDI    SC          SET EQUIPMENT NUMBER
          LPC    7000
          STD    EQ
          LDI    SC          RESERVE CHANNEL
          RJM    CMD
          NJN    LCAX        IF CHANNEL DOWN
          LDN    0
          STD    T1
 LCA1     AOD    T1          INCREMENT TABLE NUMBER
          LMN    4
          ZJN    LCA10       IF ALL TABLES LOADED
          LDD    T1          SET TABLE NUMBER IN FORMAT PARAMETER
          SHN    10
          LMM    LCAD
          STM    LCAC
          LDD    T1
          LMN    3
          ZJN    LCA2        IF BCD LOAD
          LDN    40          SET A/D MODE 1 IN FORMAT PARAMETER
          RAM    LCAC
 LCA2     LDD    EQ          ISSUE FORMAT UNIT FUNCTION
          ADN    4
          RJM    ICF         ISSUE FUNCTION
          ZJN    LCA4        IF ERRORS
          ACN    CH          OUTPUT PARAMETERS
          LDN    2
          OAM    LCAC,CH
          FJM    *,CH
          DCN    CH+40
          NJN    LCA6        IF NOT ALL PARAMETERS TAKEN
          LDM    TMTC,T1     CONVERT MTS TABLE TO ATS READ TABLE
          RJM    CCT         CONVERT CONVERSION TABLE
          LDC    BFMS        SET BUFFER ADDRESS
          STM    LCAA
          LDN    57          LOAD READ CONVERSION TABLE
 LCA3     ADD    EQ
          RJM    ICF         ISSUE FUNCTION
 LCA4     ZJN    LCA7        IF LOAD ERRORS
          ACN    CH
          LDD    T1
          LMN    3
          ZJN    LCA5        IF BCD LOAD
          LDC    171D-128D
 LCA5     ADC    128D
          OAM    *,CH        OUTPUT CONVERSION TABLE
 LCAA     EQU    *-1
          FJM    *,CH
          DCN    CH+40
 LCA6     NJN    LCA9        IF NOT ALL DATA TAKEN
          LDD    EQ          GET STATUS
          ADN    12
          RJM    ICF         ISSUE FUNCTION
 LCA7     ZJN    LCA9        IF LOAD ERRORS
          ACN    CH
          IAN    CH+40
          DCN    CH+40
          SHN    21-13
          MJN    LCA9        IF ALERT SET
          LDM    LCAA
          LMC    BFMS
          NJN    LCA8        IF WRITE TABLE LOADED
          LDM    LCAE-1,T1   SET TO LOAD WRITE TABLE
          STM    LCAA
          LDC    257         ISSUE LOAD WRITE RAM FUNCTION
          LJM    LCA3        ISSUE FUNCTION
 
 LCA8     LJM    LCA1        INCREMENT TO NEXT TABLE
 
 LCA9     LDC    2R A        CHANGE MTS TO ATS IN MESSAGE
          STM    LCMC+4
          LDD    T1          SET TABLE IN ERROR
          RAM    LCMC+3
          LDC    LCMC        SET MESSAGE ADDRESS
          LJM    ADC         ABORT ATS CONVERSION TABLE LOAD
 
 
 LCAC     CON    0,0         UNIT FORMAT PARAMETERS
 LCAD     VFD    1/1,3/0,1/1,2/0,5/0  WORD 1 SKELETON
 
*         ATS WRITE TABLE ADDRESSES.
 
 LCAE     CON    ATANS       TABLE 1 - ANSII
          CON    ATEBC       TABLE 2 - EBCDIC
          CON    ATBCD       TABLE 3 - EXTERNAL BCD
 LCM      SPACE  4,15
**        LCM - LOAD MTS CONVERSION MEMORIES.
*
*         ENTRY  CHANNEL RESERVED.
*                (EQ) = EQUIPMENT NUMBER.
*
*         EXIT   CONVERSION TABLES LOADED.
*
*         ERROR  EXIT TO *ADC* IF LOAD ERRORS.
*
*         USES   T1.
*
*         CALLS  ICF.
 
 
 LCM      SUBR               ENTRY/EXIT
          LDN    0
          STD    T1
 LCM1     AOD    T1
          LMN    4
          ZJN    LCMX        IF END OF MTS CONVERSION TABLES
          LDM    TMTC,T1     GET TABLE ADDRESS
          STM    LCMA
          LDD    T1
          SHN    6
          ADN    31
          ADD    EQ          ADD EQUIPMENT NUMBER
          RJM    ICF
          ZJN    LCM3        IF LOAD ERRORS
          ACN    CH
          LDD    T1
          LMN    3
          ZJN    LCM2        IF BCD LOAD
          LDC    256D-64D
 LCM2     ADC    64D
          OAM    *,CH
 LCMA     EQU    *-1
          FJM    *,CH
          DCN    CH+40
          NJN    LCM3        IF DATA NOT TAKEN
          LDC    200000      DELAY FOR MTS TABLE SORT
*         LDC    400000      (2X PPU SPEED)
*         LCN    0           (4X PPU SPEED)
 LCMB     EQU    *-2
          SBN    1
          NJN    *-1
          LDN    12
          ADD    EQ          ADD EQUIPMENT NUMBER
          RJM    ICF
          ZJN    LCM3        IF LOAD ERRORS
          ACN    CH
          IAN    CH+40
          DCN    CH+40
          SHN    21-13
          MJN    LCM3        IF LOAD ERRORS
          LJM    LCM1        LOOP FOR ALL MTS CONVERSION TABLES
 
 LCM3     LDD    T1          SET TABLE IN ERROR
          RAM    LCMC+3
          LDC    LCMC
          LJM    ADC         ABORT MTS LOAD
 
 
 LCMC     DATA   C* C00, T0 MTS CONVERSION TABLE LOAD ERRORS.*
 
 
*         TMTC - ADDRESS TABLE FOR MTS CONVERSION TABLES.
 
 
 TMTC     BSS    1
          LOC    1
          CON    MTANS       TABLE 1 - ANSII
          CON    MTEBC       TABLE 2 - EBCDIC
          CON    MTBCD       TABLE 3 - EXTERNAL BCD
          LOC    *O
 BUF      SPACE  4,10
 CTAB     CHTB               CHANNEL TABLE
          SPACE  4,10
          USE    BUFFER
 
          ERRNG  BFMS-*      OVERFLOW TEST
          ERRNG  ERLA-*      CODE OVERFLOWS *0CT*
          ERRPL  ERLA+5+ZCTL-ERLB  *0CT* OVERFLOWS INTO BUFFER
 PRS      TITLE  PRESET OVERLAY.
 PRS      SPACE  4,10
**        PRS - INITIALIZE TAPE EXECUTIVE PRESET.
*
*         EXIT   TO *ITE* IF *MAGNET* INITIALIZATION.
*                TO *REC* IF LEVEL 3 RECOVERY.
*
*         CALLS  LFT, SCS.
 
 
 PRS      BSS    0
          RJM    LFT         LOAD FUNCTION TABLE
          LDD    IR+3
          SHN    6
          ADD    RA
          SHN    6
          ADD    IR+4        CHECK FOR LEVEL 3 RECOVERY
          CRD    CM
          LDD    CM+4
          LMN    1
          ZJN    PRS1        IF *MAGNET* INITIALIZATION
          LJM    REC         RECOVER
 
 PRS1     RJM    SCS         SET CHARACTER SET TABLES
          LJM    ITE         INITIALIZE TAPE EQUIPMENT
          TITLE  PRESET SUBROUTINES.
 CCH      SPACE  4,10
**        CCH - CHECK CHANNEL.
*
*         ENTRY  (A) = EST CHANNEL BYTE.
*                (CM - CM+4) = EST ENTRY *EQDE* WORD.
*
*         EXIT   CHANNEL ENTERED INTO TABLE IF NOT ALREADY THERE.
*
*         ERROR  EXIT TO *ABT* IF ERROR.
*
*         USES   T2, T3, T4.
 
 
 CCH6     LDD    CM          CHECK FOR MTS/ATS CHANNEL
          LPN    14
          NJN    CCH7        IF ISMT/CMTS CHANNEL
          LDD    CM
          SHN    -3
          LPN    70
 CCH7     SHN    -3
          SHN    5
          STD    T2
          LDM    CHLI,T3
          LPC    437
          LMD    T2
          STM    CHLI,T3
          LDD    CM+3
          SHN    21-10
          MJN    CCH8        IF NOT CTS
          LDC    340
          RAM    CHLI,T3     SET CTS CONTROLLER TYPE
 CCH8     LDD    CM+4        SET CONTROLLER NUMBER
          LPC    7000
          RAM    CHLI,T3
 
 CCH      SUBR               ENTRY/EXIT
          LPN    37          SET CHANNEL NUMBER
          STD    T4
          LCN    0           INITIALIZE CHANNEL COUNT
          STD    T3
 CCH1     AOD    T3          INCREMENT CHANNEL COUNT
          LMN    /MTX/MCHAN
          NJN    CCH2        IF NOT TOO MANY TAPE CHANNELS
          LDC    =C* MORE THAN 8 TAPE CHANNELS.*
          LJM    ABT         ABORT
 
 CCH2     LDD    T3
          LMM    CHCN
          ZJP    CCH4        IF END OF CHANNEL LIST
          LDM    CHLI,T3
          LMD    T4
          LPN    37
          NJN    CCH1        IF NO CHANNEL MATCH
 
*         COMPARE CONTROLLER TYPES.
 
          LDD    CM+3
          SHN    21-10
          MJN    CCH2.0      IF NOT CTS
          LDM    CHLI,T3
          SHN    -5
          LPN    7
          LMN    7
          UJN    CCH3.1      COMPARE CONTROLLER TYPES
 
*         THE FOLLOWING SIX LINES CLEAR THE ATS BIT IN 1MT-S COPY OF
*         THE EST ENTRY IF THE EST CONTROLLER TYPE IS CMTS.  THIS
*         ALLOWS THE COMPARISON OF THE *CHLI* CONTROLLER TYPE AND THE
*         EST CONTROLLER TYPE TO WORK CORRECTLY FOR CMTS.
 
 CCH2.0   LDD    CM
          SHN    21-2
          PJN    CCH2.1      IF NOT CMTS
          SCN    20          CLEAR ATS BIT
          SHN    3
          STD    CM
 CCH2.1   LDM    CHLI,T3
          SHN    21-7
          PJN    CCH3        IF MTS STATUS NOT SET IN TABLE
          LPC    577777      CLEAR BLOCK - ID DISABLE BIT
 CCH3     SHN    11
          LMD    CM
          LPC    700
 CCH3.1   NJN    CCH5        IF CONTROLLER TYPE MISMATCH
          LDM    CHLI,T3
          LMD    CM+4
          SHN    -11
          NJN    CCH5        IF EQUIPMENT MISMATCH
          LDM    CHLI,T3
          LJM    CCHX        EXIT
 
 CCH4     LDD    T4          SAVE CHANNEL IN TABLE
          STM    CHLI,T3
          AOM    CHCN        INCREMENT CHANNEL COUNT
          LJM    CCH6        SET CONTROLLER TYPE
 
 CCH5     LDC    =C* CONTROLLER TYPE/EQUIPMENT MISMATCH ON CHANNEL.*
          LJM    ABT         ABORT
 EST      SPACE  4,10
**        EST - EST PRE-PROCESSOR.
*
*         EXIT   *CHLI* TABLE BUILT.
*                TO *ABT* IF NO TAPE EQUIPMENT FOUND.
*
*         USES   SC, T5, CM - CM+4.
*
*         CALLS  CCH, CTE.
*
*         MACROS SFA.
 
 
 EST      SUBR               ENTRY/EXIT
          LDK    ESTP        READ EST POINTER
          CRD    CM
          LDD    CM+2        SET LAST EST ORDINAL + 1
          STD    SC
 
*         FIND MAXIMUM NUMBER OF TAPE CHANNELS.
 
          LDN    NOPE-1      INITIALIZE EST ORDINAL FOR SEARCH
          STD    T5
 EST1     AOD    T5          ADVANCE EST ORDINAL
          LMD    SC
          NJN    EST2        IF NOT END OF EST
          LDM    CHCN
          NJN    ESTX        IF TAPES FOUND
          LDC    =C* NO TAPE EQUIPMENT.*
          LJM    ABT         ABORT
 
 EST2     SFA    EST,T5      READ EST ENTRY
          ADK    EQDE
          CRD    CM
          LDD    CM+3
          RJM    CTE         CHECK FOR TAPE EQUIPMENT
          MJN    EST1        IF NOT TAPE EQUIPMENT
 
*         COUNT NUMBER OF CHANNELS.
 
          LDD    CM+1        CHECK FIRST CHANNEL
          RJM    CCH         CHECK CHANNEL
          LDD    CM+2
          ZJN    EST1        IF NO SECONDARY CHANNEL
          RJM    CCH         CHECK CHANNEL
          UJN    EST1        CHECK NEXT EQUIPMENT
 
 
          ERRNG  BFMS-*      OVERFLOW TEST
 LFT      SPACE  4,10
**        LFT - LOAD 1MT FUNCTION TABLE INTO MAGNET FL.
*
*         USES   T1.
 
 
 LFT      SUBR               ENTRY/EXIT
          LDN    TFUNC       SET FUNCTION TABLE LENGTH
          STD    T1
          LDD    RA
          SHN    6
          ADN    /MTX/TFUN   WRITE FUNCTION TABLE
          CWM    TFUN,T1
          UJN    LFTX        RETURN
 REC      SPACE  4,10
**        REC - RECOVER MAGNET.
*
*         EXIT   TO *ITE1* TO SET COMPLETION RESPONSE.
*
*         MACROS NFA.
 
 
 REC      LDD    CP          CHECK IDLEDOWN BIT IN CPA
          ADN    SNSW
          CRD    CM
          LDD    CM+3
          LPN    4
          ZJN    REC1        IF IDLEDOWN NOT SET
          LDD    RA          RESET IDLEDOWN IN RA+0
          SHN    6
          CRD    CM
          LDD    CM+3
          SCN    2
          LMN    2
          STD    CM+3
          LDD    RA          REWRITE RA+0
          SHN    6
          CWD    CM
 REC1     LDD    CP          RESET COMMANDS FOR RECOVERY
          ADN    CSPW
          CRD    CM
          LDC    CSBN        RESET TO BEGINNING OF BUFFER
          STD    CM+3
          SBN    TCML+1      SET LIMIT POINTER
          STD    CM+4
          LDN    TCML
          STD    T1
          NFA    CM+3,R
          CWM    TCCB,T1     WRITE RECOVERY COMMANDS
          LDD    CP          UPDATE COMMAND POINTER
          ADN    CSPW
          CWD    CM
          LJM    ITE1        SEND RESPONSE TO *MAGNET*
 
 
*         TABLE OF COMMANDS.
 
 TCCB     BSS    0
          VFD    60/8LMAGNET1.
          VFD    60/6L$EXIT.
          VFD    60/8LMAGNET1.
          VFD    60/8L$REVERT.
          VFD    60/6L$EXIT.
          VFD    60/10H$REVERT,AB
          VFD    60/4LORT.
 TCCBL    EQU    *-TCCB
 TCML     EQU    TCCBL/5     TABLE LENGTH IN CM WORDS
 SCS      SPACE  4,20
**        SCS - SET 63 CHARACTER SET OPTION IF SELECTED.
*
*         ENTRY  (IPRL, 24) = 0 IF 63 CHARACTER SET.
*                           = 1 IF 64 CHARACTER SET.
*
*         *CSET* TABLE FORMAT -
*         CON    LOC,CONT
*                LOC = LOCATION OF CHANGE.
*                CONT = CONTENTS OF CHANGE.
*         0 IN LOC FIELD = END OF TABLE.
*
*         *CSETP* TABLE FORMAT - (USED FOR ATS 9 TRACK TABLES
*                WHERE 3 FRAMES ARE PACKED INTO 2 PP BYTES)
*         CON    LOC,CONT1,CONT2
*                LOC = LOCATION OF CHANGE.
*                CONT1 = CONTENTS OF *LOC*
*                CONT2 = CONTENTS OF *LOC*+1
*         0 IN LOC FIELD = END OF TABLE.
*
*         EXIT   CHARACTER TABLES MODIFIED IF 63 CHARACTER SET.
 
 
 SCS      SUBR               ENTRY/EXIT
          LDN    IPRL        CHECK CONVERSION MODE
          CRD    CM
          LDD    CM+2
          LPN    1
          NJN    SCSX        IF 64 CHARACTER SET
          LDC    CSET        MODIFY TABLES
 SCS1     STD    T1
          LDI    T1
 SCS2     STD    T2
          LDM    1,T1
          STI    T2
 SCSA     UJN    SCS3        FOR C63 TABLE
*         AOD    T1          (C63P TABLE)
          AOD    T2
          LDM    1,T1
          STI    T2
 SCS3     LDN    2
          RAD    T1
          LDI    T1
          NJN    SCS2        IF MORE INSTRUCTIONS TO MODIFY
 SCSB     LDN    0
          NJN    SCSX        IF BOTH TABLES PROCESSED
          AOM    SCSB        SET EXIT
          LDC    AODI+T1     MODIFY INSTRUCTION
          STM    SCSA
          LDC    CSETP       PROCESS C63P TABLE
          UJN    SCS1        MODIFY INSTRUCTIONS FOR THIS TABLE
 
 
*         CONVERSION INFORMATION FOR 64 TO 63 CHARACTER SET.
 
 CSET     BSS    0
 C63      HERE
          CON    0           END OF TABLE
 
 CSETP    BSS    0
 C63P     HERE
          CON    0           END OF TABLE
 FUN      SPACE  4,15
**        FUN - DEFINE FUNCTION PROCESSOR.
*
*
*TNAM     FUN    TYPE,NAME,SNAME,RNB,UCP
*         ENTRY  *TNAM* = FWA OF TABLE IS SET TO TNAM.
*                *TYPE* = FUNCTION NUMBER.
*                *NAME* = NAME OF FUNCTION PROCESSOR.
*                *SNAME* = NAME OF ADDITIONAL OVERLAY TO BE LOADED.
*                *RNB* = FUNCTION REQUIRES READY AND NOT BUSY.
*                *UCP* = FUNCTION TO BE DONE AT USERS CONTROL POINT.
 
 
          MACRO  FUN,A,B,C,D,E,F
 .F1      IFC    NE,*A**
 A        BSS    0
 .2       SET    A
 .F1      ELSE
          ORG    .2+5*B-5
 .F2      IFC    NE,*C**
          LOC    B
 .1       SET    0
          IFC    NE,*E**,1
 .1       SET    .1+40
          IFC    NE,*F**,1
 .1       SET    .1+20
 .F3      IFC    NE,*D**
          CON    D/10000*100+.1+C/10000-D/10000,C-C/10000*10000
 .F3      ELSE
          CON    C/10000*100+.1,C-C/10000*10000
 .F3      ENDIF
 .F2      ENDIF
          BSS    0
 .F1      ENDIF
          ENDM
 TFUN     SPACE  4,15
**        TFUN - TABLE OF FUNCTION CODE PROCESSORS.
*         ENTRY = 2 WORDS.
*
*T,       6/ OV,1/B,1/U,4/ AO,12/ ADDR
*         OV     OVERLAY NAME THIRD CHARACTER.
*         B      FUNCTION REQUIRES NOT BUSY. (SEE NOTE)
*         U      FUNCTION TO BE DONE AT USER,S CONTROL POINT.
*         AO     ADDITIONAL OVERLAY REQUIRED IF NONZERO.  OV PLUS
*                AO IS THE SECOND OVERLAY NAME THIRD CHARACTER.
*         ADDR   ADDRESS OF FUNCTION PROCESSOR.  *CPP* JUMPS TO
*                THIS ADDRESS.
*
*         NOTE   THIS FLAG ALSO INDICATES THAT THE FUNCTION REQUIRES
*                A FORMAT UNIT FUNCTION TO BE ISSUED FOR MTS AND ATS
*                UNITS. SEE ROUTINE *CCD* IN CONTROL POINT PRESET
*                OVERLAY.
 
 
          BSS    0
 TFUN     FUN
          FUN    /MTX/SED,SED  SET EQUIPMENT DEFINITION
          FUN    /MTX/FNH,PFN   PROCESS FUNCTION
          FUN    /MTX/SKP,SKP,RDF,RNB    SKIP
          FUN    /MTX/OPF,OPF,,,UCP  OPEN
          FUN    /MTX/RDF,RDF,,RNB,UCP  READ
          FUN    /MTX/RLA,RLA,RDF,RNB  READ LABEL(S)
          FUN    /MTX/WTF,WTF,,RNB,UCP  WRITE
          FUN    /MTX/WLA,WLA,WTF,RNB  WRITE LABEL(S)
          FUN    /MTX/MDFN
 TFUNL    EQU    *-TFUN
 TFUNC    EQU    TFUNL/5     CM WORD LENGTH
          ERRNZ  TFUNC-/MTX/MDFN+1  *1MT*/*COMSMTX* OUT OF SYNC
 
          OVERFLOW  PPFW,EPFW
          OVERLAY (FUNCTION REJECT PROCESSOR.),(ERLA+5),P
 FRP      SPACE  4,10
**        FRP - FUNCTION REJECT PROCESSOR.
*
*         CALLS  CUI, DME, ERR, MCH, PCR, STC, STW.
*
*         MACROS CHTE.
*
*         THE FOLLOWING ARE THE POSSIBLE ACTIONS TAKEN FOR
*         A FUNCTION REJECT ON AN MTS TAPE CONTROLLER -
*
*         1)     IF CHANNEL ACTIVE EXIT WITH CHANNEL MALFUNCTION.
*
*         2)     ESTABLISH MTS BUFFER CONTROLLER IS RUNNING.
*
*         3)     IF NOT RUNNING TRY TO RESTART OPERATION BY AUTO-LOAD.
*                THIS IS ATTEMPED TWICE TO COVER THE CASE WHERE THE
*                COUPLER LOCKS UP WITH DATA IN ITS INTERNAL BUFFER
*                AND TWO AUTO-LOADS ARE REQUIRED TO FREE THE COUPLER.
*
*         4)     IF NOT SUCCESSFUL EXIT WITH CHANNEL MALFUNCTION.
*
*         5)     SEE PRECEDING STEP 2.
*
*         6)     IF RELEASE FUNCTION EXIT.
*
*         7)     IF STOP TAPE MOTION FUNCTION, RECONNECT UNIT AND EXIT.
*
*         8)     GET GENERAL AND DETAILED STATUS.
*
*         9)     IF ALERT NOT SET, EXIT WITH CHANNEL MALFUNCTION.
*
*         10)    IF ERROR CODE NOT SET IN DETAILED STATUS, EXIT
*                WITH CHANNEL MALFUNCTION.
*
*         11)    IF ERROR CODE 4 SET, EXIT WITH READY DROP.
*
*         12)    IF ERROR CODE 54B OR 55B SET, EXIT
*                WITH CHANNEL MALFUNCTION.
*
*         13)    IF ANY OTHER ERROR CODE, EXIT WITH FUNCTION REJECT.
*
*         THE FOLLOWING ARE THE POSSIBLE ACTIONS TAKEN FOR
*         A FUNCTION REJECT ON AN ATS CONTROLLER.
*
*         1)     IF CHANNEL ACTIVE, EXIT WITH CHANNEL MALFUNCTION.
*
*         2)     IF NOT FIRST ERROR, EXIT WITH CHANNEL MALFUNCTION.
*
*         3)     GET GENERAL AND DETAILED STATUS.
*
*         4)     IF ALERT NOT SET, EXIT WITH CHANNEL MALFUNCTION.
*
*         5)     IF CHANNEL OR TCU PARITY ERROR, EXIT WITH
*                CHANNEL MALFUNCTION.
*
*         6)     IF ERROR CODE 4 SET IN DETAILED STATUS, EXIT
*                WITH READY DROP.
*
*         7)     EXIT WITH FUNCTION REJECT.
 
 
 FRP      SUBR               ENTRY/EXIT
          LDC    FRPD        MODIFY CHANNELS
          RJM    MCH
          LDD    EC
          LMN    /MTX/CRJ
          ZJP    PCR         IF CONNECT REJECT
          LDM    //STCB      SAVE CHANNEL STATUS
          STM    //.OVLR+2
          LDC    LDNI+0      SET TO FORCE DROP OUT
          STM    //PNRC
          LDM    //FCND      SAVE FUNCTION REJECTED
          STM    //.OVLR
          LDM    //FCN       SAVE ADDRESS OF CALLER
          STM    //.OVLR+1
          LDC    //ERR       INSURE CORRECT EXIT SET IN *STW*
          STM    //STWC
          LDC    RJMI
          STM    //STWC-1
          IJM    FRP4,CH     IF CHANNEL OK
 FRP3     LJM    FRP12       GIVE FATAL ERROR
 
 FRP4     LDD    HP
          LPC    540
          NJN    FRP5        IF MTS/FSC/CMTS/ISMT ADAPTOR
          LDM    FRPB
          STM    FRPA
          LJM    FRP10       PROCESS ATS CONTROLLER
 
 FRP5     LDN    0           SET ERROR ENCOUNTERED FLAG
          STM    //FCNC
          FNC    0,CH        VERIFY B.C. RUNNING
          RJM    STC
          ZJN    FRP8        IF B.C. RUNNING
          LDN    2           NUMBER OF ATTEMPTS TO RESTART B.C.
          STD    T1
          LDN    0           CLEAR CONNECTED FLAG
          STM    //RELA
 FRP6     SOD    T1
 FRP7     MJN    FRP3        IF CANNOT RESTART B.C.
          FNC    414,CH      RESTART B.C.
          RJM    STC         STATUS CHANNEL
          NJN    FRP6        IF CHANNEL ILL
          ACN    CH
          OAN    CH+40
          DCN    CH+40
          STM    //.OVLR+3   INIDICATE B.C. RESTARTED
 FRP8     LDD    T6
          SHN    21-13
          MJN    FRP7        IF OVERLAY NOT CM RESIDENT
          LDM    //FCND      CHECK FUNCTION
          LMN    1
          ZJN    FRP9        IF RELEASE FUNCTION
          LMN    11&1
          NJN    FRP10       IF NOT STOP TAPE MOTION
          LDM    //RELA
          NJN    FRP9        IF UNIT CONNECTED
          RJM    CUI         REFORMAT UNIT
 FRP9     LDM    //.OVLR+1   RESET RETURN ADDRESS
          STM    //FCN
          LDN    0
          LJM    //FCNX      RETURN
 
 FRP10    LDM    FCNC
          ZJN    FRP12       IF ERROR ALREADY ENCOUNTERED
          LDN    0
          STM    //FCNC      SET ERROR ENCOUNTERED FLAG
          RJM    STW         GET STATUS
          SHN    21-13
          PJN    FRP12       IF NO ALERT
          LDM    MTDS
 FRPA     LPN    77
*         UJN    FRP14       (ATS CONTROLLER)
          ZJN    FRP12       IF NO ERROR CODE
          LMN    4
          ZJN    FRP11       IF READY DROP
          LMN    54-4
          ZJN    FRP12       IF OUTPUT PARITY ON PARAMETER ISSUE (54B)
          LMN    55-54
          ZJN    FRP12       IF OUTPUT PARITY ON FUNCTION ISSUE (55B)
          LDN    /MTX/FRJ&/MTX/RDR
 FRP11    LMN    /MTX/RDR
          UJN    FRP13       SET ERROR CODE
 
 FRP12    LDN    /MTX/CMF
 FRP13    STD    EC
          LDM    //.OVLR+2   RESTORE CHANNEL STATUS
          STM    STCB
          LDD    DS
          STM    //STER
          LDM    FRPC        PREVENT FURTHER FUNCTION REJECT
          STM    //MCCA
          LDD    EC
          RJM    ERR         GIVE FATAL ERROR
 
 FRP14    LPC    600
          NJN    FRP12       IF CHANNEL OR TCU PARITY ERROR
          LDM    MTDS
          LPC    177
          LMN    4
          ZJN    FRP11       IF NOT READY
          LDN    /MTX/FRJ    FUNCTION REJECT
          UJN    FRP13       EXIT
 
 
 FRPB     BSS    0
          LOC    FRPA
          UJN    FRP14       CHECK STATUS
          LOC    *O
 
 FRPC     BSS    0
          LOC    //MCCA
          UJN    //MCCX      RETURN
          LOC    *O
 PCR      SPACE  4,15
**        PCR - PROCESS CONNECT REJECT.
*
*         ENTRY  (EC) = ERROR CODE.
*
*         EXIT    TO ERROR MESSAGE OVERLAY IF NOT INITIAL CONNECT OR IF
*                    UNIT DOWNED.
*
*         USES   CM - CM+4, CN - CN+4.
*
*         CALLS  ERR, UAD.
*
*         MACROS MONITOR.
 
 
 PCR      BSS    0           ENTRY
          LDM    //STW       CHECK IF INITIAL CONNECT
          LMC    //.ECUI
          NJN    PCR1        IF NOT INITIAL CONNECT
          RJM    UAD
          ADK    /MTX/UXRQ
          CRD    CM
          ADK    /MTX/UVRI-/MTX/UXRQ
          CRD    CN
          LDD    CN
          NJN    PCR2        IF JOB ASSIGNED
 
*         DOWN UNIT.
 
          RJM    UAD
          ADK    /MTX/UST2   SET UP DIRECT CELLS FOR MESSAGE
          CRM    EI,TR
          LDD    EO          SET EST ORDINAL
          STD    CM+1
          LDN    /CPS/DWES   SET *DOWN* STATUS
          STD    CM+2
          MONITOR SEQM       SET EQUIPMENT PARAMETER
 PCR1     LDD    DS          SET STATUS FOR MESSAGE
          STM    //STER
          LDN    /MTX/CRJ    SET CONNECT REJECT
          RJM    ERR         EXIT TO ISSUE MESSAGE
 
 PCR2     LDD    CM
          NJN    PCR3        IF REQUEST IN PROGRESS
          LDD    CM+1
          LPN    77
          NJN    PCR4        IF REQUEST PENDING
 PCR3     LJM    //PNR       PROCESS NEXT UNIT
 
*         INTERLOCK REQUEST.
 
 PCR4     LDM    UADA        SET UDT ADDRESS
          STD    CM+1
          LDN    0           IGNORE BUSY STATUS
          STD    CM+2
          MONITOR  TDRM      SET REQUEST IN PROGRESS
          LDD    CM+4
          ZJN    PCR3        IF REQUEST NOT INTERLOCKED
          RJM    UAD         GET UDT INFORMATION
          ADK    /MTX/UXRQ
          CRD    RS
          ADK    /MTX/UST2-/MTX/UXRQ
          CRM    EI,TR
          ADK    /MTX/UST5-/MTX/UST4-1
          CRM    DNCV,ON
          ADK    /MTX/UDS4-/MTX/UST5-1
          CRM    MTSF,TR
          ADK    /MTX/UERC-/MTX/UDS6-1
          CRM    ECNT,ON
          LDN    /MTX/CRJ    SET CONNECT REJECT
          LJM    RET3        RETURN ERROR
 
 
 FRPD     CHTB               CHANNEL TABLE
          SPACE  4,10
**        COMMON DECKS.
 
 
*CALL     COMPC2D
 
 
          ERRNG  2*473+ERLA+5-*  FUNCTION REJECT PROCESSOR OVERFLOW
          OVERLAY (MTS/ATS ERRLOG MESSAGE PROCESSOR.),(ERLA+5),P,EMM
 EMM      SPACE  4,10
**        EMM - MTS ERRLOG MESSAGE PROCESSOR.
*         THIS OVERLAY MAY BE CALLED BY ANY PART OF THE PROGRAM
*         TO ISSUE A SUITABLE MESSAGE TO THE ERRLOG.  IN ADDITION IF
*         IT IS CALLED FROM THE MAIN PROGRAM IT ALSO PROCESSES THE
*         ERROR.
*
*         CALLS  BDM, IDM, *3MD*.
*
*         MACROS EXECUTE.
 
 
          ENTRY  EMM
 EMM      SUBR               ENTRY/EXIT
          RJM    BDM         BUILD MESSAGE
          LDM    EMMA
          ZJN    EMM3        IF NO MESSAGE OR SPECIAL PROCESSOR
          SBN    MAXM
          MJN    EMM4        IF SPECIAL PROCESSOR NEEDED
 
 EMM1     LCN    0           MOVE MESSAGE
          STD    T1
 EMM2     AOD    T1
          LDM    *,T1
 EMMA     EQU    *-1
          STM    MESE+13,T1
          NJN    EMM2        IF NOT END OF MESSAGE
 EMM3     LDD    HP
*         UJN    EMM5        (*3MD* ALREADY EXECUTED)
 EMMB     EQU    *-1
          LPC    500
          ZJN    EMM5        IF NOT FSC/CMTS/ISMT ADAPTOR
 EMM4     EXECUTE  3MD       LOAD SPECIAL PROCESSOR
 EMMC     UJN    EMM1        GO MOVE MESSAGE
*         PSN                (NO MESSAGE TO MOVE)
 
*         ISSUE MESSAGES.
 
 EMM5     LDN    ERLN/10000  ISSUE MESSAGE TO ERROR LOG
          RJM    IDM
          LDM    CECB
 EMMD     LPN    77
*         LPN    0           (MESSAGE ISSUE TO USER DISABLED)
          ZJN    EMM6        IF AT MAGNET CP
          LDN    CPON/10000  ISSUE MESSAGE TO USER
          RJM    IDM
 EMM6     LJM    EMMX        RETURN
 MES      SPACE  4,10
***       MESSAGE DATA.
*         MESSAGES ARE ISSUED IN THE FOLLOWING FORMAT-
*         MT,C13-0-02,ABCDEF,RD, 753,S0,GS00000000
*         MT,C13,D00000000000000000000000000000000
*         MT,C13,U000000000000000000000000,T0000.
*         MT,C13,A0000000000000000000000000000.
*         MT,C13,F04,I13,B000123,L5004,P00000000.
*         MT,C13,E00,H00000000, .(ADDITIONAL INFORMATION.)
*
*         THE FIRST MESSAGE WOULD TELL THE FOLLOWING-
*
*         1)     CHANNEL 13, EQUIPMENT 0, UNIT 2.
*         2)     VOLUME SERIAL NUMBER IS *ABCDEF*.
*         3)     OPERATION WAS A READ.  (ANY OPERATION NOT INVOLVING
*                AN ACTUAL READ OR WRITE WILL BE CALLED A READ.
*         4)     EST ORDINAL *753* IS THE UNIT THAT THE TAPE WAS LAST
*                LABELED ON.  THIS WILL ONLY BE AVAILABLE FOR LABELED
*                TAPE GENERATED UNDER KRONOS 2.1 OR NOS.  IT WILL
*                NORMALLY BE ZERO IN ALL OTHER CASES.  THIS FIELD DOES
*                NOT REPRESENT THE EST ORDINAL OF THE TAPE UNIT THAT
*                THE TAPE IS CURRENTLY MOUNTED ON.
*         5)     CHANNEL STATUS.
*         6)     GENERAL STATUS OF TAPE UNIT.
*         7)     BLOCK ID BYTE. ( LOWER 12 BITS OF GENERAL STATUS)
*
*         THE SECOND MESSAGE WOULD TELL THE FOLLOWING -
*
*         1)     CHANNEL 13 - THIS IS REPEATED SO THAT IF ERRORS
*                ARE OCCURING ON MORE THAN ONE TAPE CHANNEL AT THE
*                SAME TIME THE TWO MESSAGES CAN BE ASSOCIATED.
*         2)     DETAILED STATUS OF THE UNIT.
*                FOR FSC/CMTS/ISMT THIS IS WORD 3 OF ATS MAPPED STATUS
*                AND WORDS 1 - 7 OF SENSE BYTE STATUS.
*
*         THE THIRD MESSAGE (NOT MTS) WOULD TELL THE FOLLOWING -
*
*         1)     CHANNEL 13, SAME AS ABOVE.
*         2)     UNIT STATUS.
*                FOR FSC/CMTS/ISMT THIS IS WORDS 8 - 13 OF SENSE BYTE
*                STATUS.
*         3)     THIRD BYTE OF FORMAT PARAMETERS.
*
*         THE FOURTH MESSAGE (FSC/CMTS/ISMT ONLY) WOULD TELL THE
*         FOLLOWING -
*
*         1)     CHANNEL 13, SAME AS ABOVE.
*         2)     THE ADDITIONAL SENSE BYTE STATUS (WORDS 14 - 20) NOT
*                PLACED IN DETAILED STATUS OR UNIT STATUS FIELDS.
*
*         THE FIFTH MESSAGE WOULD TELL THE FOLLOWING -
*
*         1)     CHANNEL 13, SAME AS ABOVE.
*         2)     THE ERROR OCCURED ON A SOFTWARE FUNCTION 4.
*         3)     ERROR ITERATION.
*         4)     BLOCK NUMBER ERROR OCCURRED ON WAS 123.
*         5)     BLOCK LENGTH WAS 5004 BYTES.
*         6)     *1MT* INTERNAL ERROR PARAMETERS.
*
*         THE SIXTH MESSAGE WOULD TELL THE FOLLOWING -
*
*         1)     CHANNEL 13 - SAME AS ABOVE.
*         2)     OCTAL ERROR CODE VALUE.
*         3)     UNIT FORMAT PARAMETERS.  SEE 66X/67X MANUAL FOR FIELD
*                DEFINITIONS OF FORMAT SELECTION.
*         4)     ADDITIONAL DESCRIPTION.
 
****      MESSAGE DATA.
 
 MESA     DATA   H*MT,C00-0-00,      ,RD,    ,S0,GS00000000*
          CON    0
 MESB     DATA   H*MT,C00,D00000000000000000000000000000000*
          CON    0
 MESC     DATA   H*MT,C00,U000000000000000000000000,T0000. *
          CON    0
 MESD     DATA   H*MT,C00,F00,I00,B000000,L0000,P00000000. *
          CON    0
 MESE     DATA   C*MT,C00,E00,H00000000, .*
 MESL     EQU    MESE+MESB-MESA+1
 TERM     SPACE  4,10
 TERM     INDEX
          INDEX  0,(=C*REC.*)
          INDEX  /MTX/OPA,(=C*OPA.*)
          INDEX  /MTX/BTL,(=C*BTL.*)
          INDEX  /MTX/BNE,BNEM
          INDEX  /MTX/NBE,(=C*NBE.*)
          INDEX  /MTX/OTF,(=C*OTF.*)
          INDEX  /MTX/RDR,WEOM
          INDEX  /MTX/FRJ,FRJM
          INDEX  /MTX/WEO,WEOM
          INDEX  /MTX/CRJ,CRJM
          INDEX  /MTX/STE,(=C*STE.*)
          INDEX  /MTX/ERA,(=C*ERA.*)
          INDEX  /MTX/PLO,(=C*PLO.*)
          INDEX  /MTX/CMF,(=C*CMF.*)
          INDEX  /MTX/BCR,(=C*BCR.*)
          INDEX  /MTX/SMF,(=C*SMF.*)
          INDEX  /MTX/SMB,(=C*SMB.*)
          INDEX  /MTX/MDW,(=C*MDW.*)
          INDEX  /MTX/MOF,(=C*MOF.*)
          INDEX  /MTX/LCH,(=C*LCH.*)
          INDEX  /MTX/RCE,(=C*RCE.*)
          INDEX  /MTX/MWT,(=C*MWT.*)
          INDEX  /MTX/WVF,(=C*WVF.*)
          INDEX  /MTX/TME,(=C*TME.*)
          INDEX  /MTX/TCF,(=C*TCF.*)
          INDEX  /MTX/BFR,(=C*BFR.*)
          INDEX  /MTX/BFW,(=C*BFW.*)
          INDEX  /MTX/MERC
****
          SPACE  4,10
**        COMMON DECKS.
 
 
*CALL     COMPC2D
          SPACE  4,10
**        ERRORS REQUIRING ADDITIONAL OVERLAY TO BE LOADED.
 
 
 BEGM     BSS    0
          LOC    1
 FRJM     BSS    1           FUNCTION REJECT
 WEOM     BSS    1           NO END OF OPERATION
 CRJM     BSS    1           CONNECT REJECT
 BNEM     BSS    1           BLOCK SEQUENCE ERROR
 MAXM     BSS    1           MAXIMUM SPECIAL ERRORS
 
          ORG    BEGM
          TITLE  SUBROUTINES.
 CDA      SPACE  4,10
**        CDA - CONVERT DATA (4 DIGITS).
*
*         ENTRY  (A, 17 - 12) = ADDRESS WHERE DATA CONTAINED.
*                (A, 11 - 0) = ADDRESS WHERE TO STORE RESULT.
*
*         CALLS  C2D.
*
*         USES   T2, T3.
 
 
 CDA      SUBR               ENTRY/EXIT
          STD    T3          SAVE DESTINATION ADDRESS
          SHN    -14
          STD    T2          SAVE DATA ADDRESS
          LDI    T2          CONVERT FIRST 2 DIGITS
          SHN    -6
          RJM    C2D
          STI    T3
          LDI    T2          CONVERT SECOND 2 DIGITS
          RJM    C2D
          STM    1,T3
          UJN    CDAX        RETURN
 CDN      SPACE  4,10
**        CDN - CONVERT DATA (N DIGITS)
*
*         ENTRY  (A, 17 - 12) = LENGTH OF DATA.
*                (A, 11 - 0) = SOURCE OF DATA TO CONVERT.
*                (CN+3) = DESTINATION OF CONVERTED DATA.
*
*         CALLS  CDA.
*
*         USES   CN - CN+2
 
 
 CDN      SUBR               ENTRY/EXIT
          STD    CN+1        SAVE ADDRESS OF DATA TO CONVERT
          SHN    -14         SAVE LENGTH
          STD    CN+2
 CDN1     LDI    CN+1        CONVERT ONE BYTE OF DATA
          STD    CN
          LDC    CN*10000
          ADD    CN+3
          RJM    CDA
          LDN    2
          RAD    CN+3
          AOD    CN+1
          SOD    CN+2
          NJN    CDN1        IF NOT COMPLETE
          UJN    CDNX        RETURN
 IDM      SPACE  4,10
**        IDM - ISSUE DAYFILE MESSAGES.
*
*         ENTRY  (A) = MESSAGE DESTINATION CODE
*                (IDMA) = ADDRESS OF MESSAGE LINES TABLE.
*
*         EXIT   MESSAGE LINES DEFINED IN THE *IDMC* TABLE ARE ISSUED.
*
*         USES   T8.
*
*         CALLS  DFM.
 
 
 IDM      SUBR               ENTRY/EXIT
          LMC    LMCI        SET MESSAGE DESTINATION CODE
          STM    IDMB
          LDN    0           INITIALIZE MESSAGE INDEX
          STD    T8
 
*         LOOP UNTIL ALL MESSAGE LINES ARE ISSUED TO THE DAYFILE.
 
 IDM1     LDM    IDMC,T8     GET NEXT MESSAGE POINTER
*         LDM    IDMD,T8     (4 LINES OF MESSAGE)
*         LDM    /3M /FSCA,T8  (6 LINES OF MESSAGE)
 IDMA     EQU    *-1
          ZJN    IDMX        IF ALL MESSAGES ISSUED
          LMC    **          ADD MESSAGE DESTINATION
 IDMB     EQU    *-2         (MESSAGE DESTINATION CODE)
          RJM    DFM         ISSUE DAYFILE MESSAGE
          AOD    T8          ADVANCE MESSAGE INDEX
          UJN    IDM1        ISSUE NEXT MESSAGE LINE
 
 
*         TABLE OF MESSAGE LINE POINTERS FOR 5 LINES.
 
 IDMC     BSS    0
          LOC    0
          CON    MESA        LINE 1
          CON    MESB        LINE 2
          CON    MESC        LINE 3
          CON    MESD        LINE 4
          CON    MESE        LINE 5
          CON    0           TERMINATOR
          LOC    *O
 
 
*         TABLE OF MESSAGE LINE POINTERS FOR 4 LINES.
 
 IDMD     BSS    0
          LOC    0
          CON    MESA        LINE 1
          CON    MESB        LINE 2
          CON    MESD        LINE 3
          CON    MESE        LINE 4
          CON    0           TERMINATOR
          LOC    *O
 RUW      SPACE  4,10
**        RUW - READ UNIT DESCRIPTOR TABLE WORD.
*         USED TO READ UDT WHEN POSSIBLY NOT AT MAGNET CP.
*
*         ENTRY  (A) = UDT WORD.
*
*         EXIT   (CN - CN+4) = WORD READ.
*
*         USES   T1, CM - CM+4, CN - CN+4.
*
*         MACROS DELAY, MONITOR, PAUSE.
 
 
 RUW2     LDD    MA
          CRD    CN
 
 RUW      SUBR               ENTRY/EXIT
          STD    T1
 RUW1     LDM    UADA
          ADD    T1
          STD    CM+4
          LDD    HN          REQUEST 1 WORD
          STD    CM+3
          LDN    0           REQUEST READ FROM *MAGNET*
          STD    CM+1
          LCN    7777-/SSD/MTSI  SET *MAGNET* SUBSYSTEM IDENTIFICATION
          STD    CM+2
          MONITOR TDAM
          LDD    CM+1
          LMN    1
          NJN    RUW2        IF MOVE NOT IN PROGRESS
          PAUSE  NE
          DELAY
          UJN    RUW1        REISSUE REQUEST
          TITLE  OVERLAY AREA.
          ERRNG  ERLB-*      IF OVERFLOW INTO OVERLAY AREA
 
 
*         NOTE - THE FOLLOWING CODE MAY BE OVERLAID IF THE
*         SPECIAL ERROR MESSAGES OVERLAY IS REQUIRED.
 BDM      SPACE  4,15
**        BDM - BUILD MESSAGE.
*
*         EXIT   MESSAGE BUILT EXCEPT FOR DESCRIPTIVE MESSAGE IN LAST
*                  LINE OF MESSAGE.
*                (EMMD) MODIFIED IF MESSAGE ISSUE TO USER DISABLED.
*                *EMM* EXIT SET TO *RET4* IF CALLED FROM *ERR* AND
*                  REQUEST IN PROGRESS.
*                *EMM* EXIT SET TO *PNR* IF CALLED FROM *ERR* AND
*                  REQUEST NOT IN PROGRESS.
*
*         CALLS  CDA, CDN, C2D, HNG, MCH, RUW, SCS, UAD.
*
*         MACROS CHTE, SFA.
 
 
 BDM      SUBR               ENTRY/EXIT
 
*         CHECK CALL TYPE.
 
          LDC    CTAB        MODIFY CHANNELS
          RJM    MCH
          LDM    //LOV       CHECK CALL ORIGIN
          LMC    .EERR
          NJN    BDM2        IF NOT CALLED FROM *ERR*
          LDD    RS
          LMN    /MTX/RIP
          ZJN    BDM1        IF REQUEST IN PROGRESS
          LDC    //PNR&//RET4
 BDM1     LMC    //RET4
          STM    //LOV
          LDM    //ERR
          ADC    -OVL
          MJN    BDM4        IF *ERR* CALLED FROM RESIDENT
 BDM2     LDM    //STER      USE STATUS WHEN ERROR OCCURRED
          STD    DS
 
*         CHECK VALIDITY OF ERROR CODE.
 
 BDM4     LDD    EC
          SBN    /MTX/MERC
          MJN    BDM5        IF VALID ERROR CODE
          RJM    HNG         HANG PP
 BDM5     LDN    0           CLEAR ERROR TYPE INDICATOR
          STM    //ERR
          LDM    TERM,EC     SAVE TABLE ENTRY
          STM    EMMA
          LDD    EC
          LMN    /MTX/LCH
          NJN    BDM6        IF NOT LOAD CHECK ERROR
          AOM    //RELA      SET UNIT CONNECTED
          RJM    UAD         SET UP DIRECT CELLS FOR MESSAGE
          ADN    /MTX/UST2
          CRM    EI,TR
 
*         MESSAGE BUILD.
 
 BDM6     LDD    HP          SET DEVICE TYPE IN MESSAGE LINES
          LPN    1
          SHN    6
          ADC    2RMT
          RJM    SCS         SET CHARACTERS
          CHTE   *           SET CHANNEL NUMBER
          LDN    CH
          RJM    C2D
          ADC    2*10000
          RJM    SCS
          SFA    EST,EO      GET EQUIPMENT AND UNIT NUMBER
          ADK    EQDE
          CRD    CM
          LDD    CM+4        SET EQUIPMENT NUMBER
          SHN    -11
          RAM    MESA+3
          LDD    CM+4        SET UNIT NUMBER
          SHN    -3
          LPN    1
          RAM    MESA+4
          LDD    CM+4
          LPN    7
          SHN    6
          RAM    MESA+5
          LDN    /MTX/UVSN   READ UP VSN
          RJM    RUW
          LDD    CN
          ZJN    BDM7        IF VSN NOT SPECIFIED
          STM    MESA+6
          LDD    CN+1
          STM    MESA+7
          LDD    CN+2
          STM    MESA+10
 BDM7     LDM    ITMA
          LPN    77
          LMN    F0050
          NJN    BDM8        IF NOT WRITE OPERATION
          LDN    1RW-1RR     CHANGE *RD* TO *WD*
          RAM    MESA+11
 BDM8     LDN    /MTX/UGNU   GET EST ORDINAL WRITTEN ON
          RJM    RUW
          LDD    CN+1
          ZJN    BDM9        IF EST NOT AVAILABLE
          SHN    -6          CONVERT UPPER DIGIT OF EST ORDINAL
          ADC    2R 0
          STM    MESA+13
          LDD    CN+1        CONVERT LOWER TWO DIGITS OF EST ORDINAL
          RJM    C2D
          STM    MESA+14
 BDM9     LDM    STCB        SET CHANNEL STATUS
          SHN    6
          RAM    MESA+16
          LDC    MESA+20
          STD    CN+3
          LDC    1*10000+DS
          RJM    CDN
          LDC    1*10000+UBWB SET BID BYTE
          RJM    CDN
          LDD    EC          SET ERROR CODE
          RJM    C2D
          STM    MESE+4
          LDD    FN          CONVERT SOFTWARE FUNCTION NUMBER
          RJM    C2D
          STM    MESD+4
          LDD    EI          CONVERT ERROR ITERATION NUMBER
          RJM    C2D
          STM    MESD+6
          LDD    BL          CONVERT BLOCK NUMBER
          RJM    C2D
          STM    MESD+10
          LDC    BL*10000+10000+MESD+11  CONVERT BLOCK NUMBER
          RJM    CDA
          LDC    BY*10000+MESD+14  CONVERT BLOCK LENGTH
          RJM    CDA
          LDC    MESB+4      CONVERT DETAILED STATUS
          STD    CN+3
          LDC    10*10000+MTDS
          RJM    CDN
          LDN    MESD+17-MESB-24  CONVERT ERROR PARAMETERS
          RAD    CN+3
          LDC    2*10000+EP
          RJM    CDN
          LDN    MESE+6-MESD-23  CONVERT FORMAT
          RAD    CN+3
          LDC    2*10000+MTSF
          RJM    CDN
          LDD    CF
          SHN    21-7
          MJN    BDM10       IF MTS CONTROLLER
          LDC    MESC+4      SET UNIT STATUS FOR ATS
          STD    CN+3
          LDC    6*10000+ATUS
          RJM    CDN
          LDN    MESC+21-MESC-20 SET THIRD FORMAT PARAMETER
          RAD    CN+3
          LDC    1*10000+MTSF+2
          RJM    CDN
          UJN    BDM11       CHECK ERROR MESSAGE PROCESSING OPTION
 
 BDM10    LDC    IDMD        SET 4 LINE MESSAGE
          STM    IDMA
 BDM11    LDD    SP          CHECK ERROR MESSAGE PROCESSING OPTION
          SHN    21-7
          PJN    BDM11.1     IF USER DAYFILE MESSAGES ARE DISABLED
          LDD    EC
          ZJN    BDM12       IF RECOVERED MESSAGE
          LMN    /MTX/OTF
          ZJN    BDM12       IF ON THE FLY ERROR
          LDD    EI
          ZJN    BDM12       IF FIRST ITERATION
 BDM11.1  LDC    LPNI+0      DISABLE MESSAGE ISSUE
          STM    EMMD
 BDM12    LJM    BDMX        RETURN
 SCS      SPACE  4,10
**        SCS - STORE CHARACTERS IN MESSAGE LINES.
*
*         ENTRY  (A, 17 - 12) = MESSAGE FIELD INDEX.
*                (A, 11 -  0) = CHARACTERS.
*
*         USES   T0, T1.
 
 
 SCS      SUBR               ENTRY/EXIT
          STD    T0          SAVE CHARACTERS
          SHN    -14
          ADC    MESA
          STD    T1
 SCS1     LDD    T0
          STI    T1
          LDN    MESB-MESA
          RAD    T1
          ADC    -MESL
          MJN    SCS1        LOOP
          UJN    SCSX        RETURN
 BUF      SPACE  4,10
          USE    BUFFER
 CTAB     SPACE  4,10
*         CHANNEL TABLE.
 
 
 CTAB     CHTB               CHANNEL TABLE
 
          ERRNG  2*473+ERLA+5-*  ERROR PROCESSOR OVERFLOW
          OVERLAY (MTS/ATS SPECIAL MESSAGE PROCESSOR.),(ERLB+5),P
 
 
**        THIS OVERLAY IS CALLED FROM *EMM* FOR ERRORS WHICH
*         REQUIRE ADDITIONAL PROCESSING. SEE TABLE IN *EMM* FOR
*         LIST OF ERRORS WHICH REQUIRE THIS OVERLAY.
 EMN      SPACE  4,10
**        EMN - MTS ERRLOG MESSAGE SPECIAL PROCESSOR.
*
*         ENTRY  (/EMM/EMMA) = INDEX TO PROCESSOR.
*
*         EXIT   (/EMM/EMMA) = MESSAGE ADDRESS.
*
*         CALLS  BNP, CKR, ECN, FRE, FSC.
 
 
 EMN      SUBR               ENTRY/EXIT
          LDC    UJNI+/EMM/EMM5-/EMM/EMMB
          ERRPL  /EMM/EMM5-/EMM/EMMB-40  CHECK JUMP IN RANGE
          STM    /EMM/EMMB   SET *3MD* ALREADY EXECUTED
          LDM    /EMM/EMMA   GET PROCESSOR INDEX
          ZJN    EMN2        IF ONLY CALLED FOR FSC STATUS
          STD    T1
          SBN    /EMM/MAXM
          PJN    EMN2        IF FSC STATUS CALL BUT MESSAGE DEFINED
          LDM    SPRI,T1
          STM    EMNA
          RJM    *           PROCESS ERROR
 EMNA     EQU    *-1
          STM    /EMM/EMMA   SET MESSAGE ADDRESS
 EMN1     LDD    HP
          LPC    500
          ZJN    EMNX        IF NOT FSC/CMTS/ISMT ADAPTOR
          RJM    FSC         OBTAIN AND FORMAT FSC/CMTS/ISMT STATUS
          UJN    EMNX        RETURN
 
 EMN2     LDN    PSNI
          STM    /EMM/EMMC   SKIP MESSAGE MOVE
          UJN    EMN1        RETURN FSC STATUS
          TITLE  SPECIAL PROCESSORS.
 SPRI     SPACE  4,10
 SPRI     INDEX  0,//HNG
          INDEX  /EMM/FRJM,FRE
          INDEX  /EMM/WEOM,CKR
          INDEX  /EMM/CRJM,ECN
          INDEX  /EMM/BNEM,BNP
          INDEX  /EMM/MAXM
 BNP      SPACE  4,10
**        BNP - BLOCK NUMBER PROCESSOR.
*
*         ENTRY  (BNEI) = ACTUAL BYTE LENGTH.
*                (BNEI+1 - BNEI+2) = ACTUAL BLOCK NUMBER.
*
*         EXIT   (A) = MESSAGE ADDRESS.
*
*         CALLS  /EMM/CDA, /EMM/C2D.
*
*         USES   CM.
 
 
 BNP      SUBR               ENTRY/EXIT
          LDM    BNEI
          STD    CM
          LDC    CM*10000+BNPA+1  CONVERT EXPECTED LENGTH
          RJM    /EMM/CDA
          LDM    BNEI+1
          RJM    /EMM/C2D
          STM    BNPA+4
          LDM    BNEI+2
          STD    CM
          LDC    CM*10000+BNPA+5
          RJM    /EMM/CDA
          LDC    BNPA        SET MESSAGE ADDRESS
          UJN    BNPX        RETURN
 
 
 BNPA     DATA   C* L0000,B000000.*
 CKR      SPACE  4,10
**        CKR - CHECK IF READY OR WRITE ENABLE ERROR.
*         CLEARS LAST OPERATION WRITE FLAGS.
*
*         EXIT   (A) = MESSAGE ADDRESS.
 
 
 CKR2     LDN    /MTX/RDR    SET READY DROP ERROR
          STD    EC
 CKR3     LDC    CKRC        SET READY DROP MESSAGE
 
 CKR      SUBR               ENTRY/EXIT
          LDD    UP          CLEAR LAST OPERATION WRITE AND BLANK TAPE
          SCN    24
          STD    UP
          LDD    EC          CHECK FOR READY DROP ERROR
          SBN    /MTX/RDR
          ZJN    CKR3        IF READY DROP ERROR
          LDD    DS          CHECK FOR NOT READY STATUS
          SHN    21-0
          PJN    CKR2        IF NOT READY
          LDM    STWD
          LPN    2
          ZJN    CKR1        IF NOT WAIT BUSY
          LDD    DS
          LPN    2
          ZJN    CKR1        IF NOT BUSY
          LDC    CKRB        SET UNIT BUSY MESSAGE
          UJN    CKRX        RETURN
 
 CKR1     LDC    CKRA        SET NO EOP MESSAGE
          UJN    CKRX        RETURN
 
 
 CKRA     DATA   C*NO EOP.*
 CKRB     DATA   C*BUSY.*
 CKRC     DATA   C*NOT READY.*
 ECN      SPACE  4,10
**        ECN - ERROR ON CONNECT.
*
*         EXIT   (A) = MESSAGE ADDRESS.
*
*         USES   CM - CM+4.
*
*         MACROS SFA.
 
 
 ECN1     LDM    MTDS
          LPN    77
          NJN    ECN2        IF CONNECT ERROR
 
*         CHANGE MESSAGE TO *MDI* ERROR.
 
          LDC    2RMD
          STM    ECNA+5
          LDC    2RI.
          STM    ECNA+6
          LDN    0
          STM    ECNA+7
 ECN2     LDC    ECNA        EXIT WITH MESSAGE ADDRESS
 
 ECN      SUBR               ENTRY/EXIT
          SFA    EST,EO
          ADK    EQDE
          CRD    CM
          LDD    CM
          LPN    3
          LMN    /CPS/DWES
          ZJN    ECN1        IF UNIT DOWNED
          LDN    0           ALTER MESSAGE
          STM    ECNA+5
          UJN    ECN2        RETURN
 
 
 ECNA     DATA   C*CON. REJ. DOWN.*
 FRE      SPACE  4,10
**        FRE - FUNCTION REJECT ERROR.
*         DIAGNOSES ERROR BY GIVING FUNCTION AND THE ADDRESS OF
*         THE ROUTINE THAT INITIATED THE CALL.
*
*         EXIT   (A) = MESSAGE ADDRESS.
*
*         CALLS  /EMM/CDA.
*
*         USES   CM.
 
 
 FRE      SUBR               ENTRY/EXIT
          LDM    //.OVLR+1   GET ADDRESS OF CALLER
          STD    CM
          LDC    CM*10000+FREA+4
          RJM    /EMM/CDA
          LDM    //.OVLR     CONVERT FUNCTION
          STD    CM
          LDC    CM*10000+FREA+1
          RJM    /EMM/CDA
          LDC    FREA        SET MESSAGE ADDRESS
          UJN    FREX        RETURN
 
 
 FREA     DATA   C*FN0000,P0000.*
 FSC      SPACE  4,15
**        FSC - FSC/CMTS/ISMT ADAPTOR STATUS.
*         OBTAINS AND INSERTS THE FSC/CMTS/ISMT SENSE BYTE STATUS INTO
*         THE ERROR LOG MESSAGE.
*
*         USES   CM - CM+4, CN - CN+3.
*
*         CALLS  /EMM/CDN, DME, FCN, MCH.
*
*         NOTE - FSC ADAPTOR ALWAYS HAS A DEDICATED AND RESERVED
*                CHANNEL.  THE FSC STATUS (312) FUNCTION DOES NOT
*                REQUIRE A RESERVED UNIT.
 
 
 FSC2     LDM    /EMM/MESA   SET MT OR NT AND CHANNEL IN MESSAGE
          STM    FSCB
          LDM    /EMM/MESA+2
          STM    FSCB+2
          LDC    FSCA        INITIALIZE MESSAGE POINTER
          STM    /EMM/IDMA
 
 FSC      SUBR               ENTRY/EXIT
          LDM    MTDS        CHECK FOR ERROR CODE 70
          LPN    77
          LMN    70
          ZJP    FSC2        IF ERROR CODE 70 DO NOT GET ISMT STATUS
          LDC    FSCD        MODIFY CHANNELS
          RJM    MCH
          LDM    //MCCA      SKIP ACTUAL STATUS IF PREVIOUS REJECT
          LMC    LDNI+11
          NJN    FSC1        IF PREVIOUS FUNCTION REJECT
          LDC    312
          RJM    //FCN       ISSUE FSC/CMTS/ISMT STATUS FUNCTION
          ACN    CH+40
          LDN    20D
          IAM    FSCC,CH     INPUT STATUS
 FSC1     LDC    /EMM/MESB+6
          STD    CN+3
          LDC    7*10000+FSCC  USE SENSE BYTES FOR DETAILED STATUS
          RJM    /EMM/CDN
          LDC    /EMM/MESC+4
          STD    CN+3
          LDC    6*10000+FSCC+7  SUBSTITUTE SENSE BYTES FOR UNIT STATUS
          RJM    /EMM/CDN
          LDC    FSCB+4
          STD    CN+3
          LDC    7*10000+FSCC+15  SET SENSE BYTES IN ADDITIONAL STATUS
          RJM    /EMM/CDN
          LJM    FSC2        SET MT OR NT AND CHANNEL IN MESSAGE
 
 
*         TABLE OF MESSAGE LINE POINTERS FOR FSC, CMTS OR ISMT.
 
 FSCA     BSS    0
          LOC    0
          CON    /EMM/MESA   LINE 1
          CON    /EMM/MESB   LINE 2
          CON    /EMM/MESC   LINE 3
          CON    FSCB        LINE 4
          CON    /EMM/MESD   LINE 5
          CON    /EMM/MESE   LINE 6
          CON    0           TERMINATOR
          LOC    *O
 
 FSCB     DATA   H*MT,C00,A0000000000000000000000000000.   *
          CON    0
 
 FSCC     BSSZ   20D         SENSE BYTE STATUS
 
 FSCD     CHTB               CHANNEL TABLE
          SPACE  4,10
          USE    BUFFER
          ERRNG  1*473+ERLB+5-*  ERROR PROCESSOR OVERFLOW
          OVERLAY (CTS CHANNEL ERROR PROCESSOR.),(BUFB+5),P
 CCP      SPACE  4,25
**        CCP - CTS CHANNEL ERROR PROCESSOR.
*
*         THIS ROUTINE DOES ERROR RECOVERY AS FOLLOWS -
*
*         IF A JOB IS ASSIGNED, BUT NO FUNCTION IS PRESET, ERROR
*              LOGGING AND ERROR RECOVERY ARE NOT PERFORMED.
*         IF (EI) = 0 OR 1 LOG ERROR, LOAD CCC, POSITION TAPE IF
*                          NECESSARY, AND REQUEUE.
*         IF (EI) .GE. 2 LOG ERROR AND RETURN A FATAL ERROR.
*
*         ENTRY  (EC) = ERROR CODE.
*                (EI) = RETRY COUNT.
*                (PICA) = 0 IF POSITIONING OF TAPE NOT NECESSARY.
*
*         EXIT   TO *RET2* TO REQUEUE THE REQUEST.
*                TO *RET4* TO RETURN A FATAL ERROR.
*                TO *PNR* IF INITIAL CONNECT FAILED, BUT AUTOLOAD AND
*                   ENSUING CONNECT ARE SUCCESSFUL.
*                TO *PNR3 IF FUNCTION TIMEOUT FOR RELEASE.
*                (EI) = (EI) + 1.
*
*         USES   CN, CM - CM+4.
*
*         CALLS  CEC, *CEM*, MCH, PCM, PCR, POS, /PRESET/RCU, UAD,
*                *0CT*.
*
*         MACROS CALL, EXECUTE.
 
 
          ENTRY  CCP
 CCP      SUBR               ENTRY/EXIT
          LDC    CTAB
          RJM    MCH         MODIFY CHANNEL INSTRUCTIONS
          LDC    LDNI+F0002
          STM    /PRESET/GPSC  SEND CONTINUE IF COMMAND RETRY
          LDM    /PRESET/ICFA
          LMN    F0001
          NJN    CCP1        IF NOT RELEASE UNIT
          STM    RELA        INDICATE UNIT NOT CONNECTED
          LDN    PPAL        CHECK PPU AVAILABILITY
          CRD    CM
          LJM    PNR3        PROCESS NEXT REQUEST
 
 CCP1     LDN    0           DO NOT SET FET COMPLETE
          RJM    CEC         CHANGE TO MAGNET CONTROL POINT
          LDM    RELA
          NJN    CCP2        IF UNIT CONNECTED
          LDD    EC          SAVE ERROR CODE
          STD    T1
          RJM    UAD         GET UDT ADDRESS
          CRD    RS          SET UP DIRECT CELLS FOR MESSAGE
          ADN    /MTX/UST2
          CRM    EI,TR
          LDD    T1          RESTORE ERROR CODE
          STD    EC
 CCP2     LDD    EC
          LMN    /MTX/STE
          NJN    CCP3        IF NOT STATUS ERROR
          LDD    DS
          LPN    1
          NJN    CCP3        IF READY
          LDN    /MTX/RDR    NOT READY ERROR
          STD    EC
 CCP3     RJM    PCM         PROCESS CHANNEL MALFUNCTION
          RJM    PCR         PROCESS CONNECT REJECT
          CALL   CEM         LOG CTS ERROR MESSAGE
          LDC    LDNI
          STM    //PNRC      FORCE DROP OUT
          AOD    EI          INCREMENT RETRY COUNT
          STD    EP          SO RECOVERABLE ERROR WILL BE REPORTED
          SBN    3
          MJN    CCP4        IF RETRIES NOT COMPLETED
          LDN    0
          STD    EI          CLEAR RETRY COUNT
          LDD    FN
          ZJP    PNR         IF NO FUNCTION
          LJM    RET4        REPORT FATAL ERROR
 
 CCP4     RJM    UAD         GET UDT ADDRESS
          ADN    /MTX/UST2
          CWD    EI          SAVE RETRY COUNT AND BLOCK POSITION
          ADN    /MTX/UST3-/MTX/UST2
          CWD    LG          SAVE BLOCK POSITION (EP+1)
          CHTE   *
          LDN    CH          SET CHANNEL NUMBER
          STD    CN
          LDC    ERLB        SET BUFFER ADDRESS
          STD    CN+1
          EXECUTE  0CT,ERLA+5  LOAD CTS/CCC MICROCODE
          LDD    CN
          ZJN    CCP6        IF MICROCODE LOADED
          STD    EC
          SHN    0-13
          PJN    CCP5        IF ERROR CODE ALREADY SAVED
          LDN    /MTX/CMF
          STD    EC
 CCP5     LDM    CN+1        SAVE FUNCTION
          STM    /PRESET/ICFA
          UJP    CCP3        PERFORM NEXT STEP OF RECOVERY ALGORITHM
 
 CCP6     LDM    RELA
          ZJN    CCP9        IF UNIT NOT CONNECTED
          RJM    /PRESET/RCU RECONNECT UNIT
          LDM    /PRESET/PICA
          ZJN    CCP7        IF POSITIONING OF TAPE NOT NECESSARY
          RJM    POS         POSITION TAPE
          NJP    CCP3        IF ERROR
 CCP7     LDN    0
          STD    EC          CLEAR ERROR CODE
          LJM    RET2        REQUEUE THE REQUEST
 
 CCP9     RJM    /PRESET/CCU CONNECT UNIT
          LDN    0
          STD    EC          CLEAR ERROR CODE
          CALL   CEM         REPORT RECOVERED ERROR
          LDN    0
          STD    EI          CLEAR RETRY COUNT
          STD    EP
          LJM    PNR         PROCESS NEXT REQUEST
 CAU      SPACE  4,10
**        CAU - CHECK ALL UNITS.
*
*         EXIT   (A) = 0 IF NO JOB ASSIGNED AND NO FUNCTION PRESET.
*
*         USES   CM - CM+4, CN - CN+4, T1 - T5.
 
 
 CAU      SUBR               ENTRY/EXIT
          LDM    PNRD
          STM    CAUA        SET STARTING UDT ADDRESS
 CAU1     LDD    RA
          SHN    6
          ADC    0
 CAUA     EQU    *-1         (UDT ADDRESS)
          CRD    T1
          ADN    /MTX/UST1
          CRD    CM
          ADN    /MTX/UVRI-/MTX/UST1
          CRD    CN
          SFA    EST,CM+2    GET CHANNEL INFORMATION
          ADK    EQDE
          CRD    CM
          LDD    CM+1
          CHTE   *
          LMN    CH
          LPN    37
          ZJN    CAU1.1      IF UNIT ON THIS CHANNEL
          LDD    CM+2
          CHTE   *
          LMN    CH
          LPN    37
          NJN    CAU2        IF UNIT NOT ON THIS CHANNEL
 CAU1.1   LDD    CN          JOB ASSIGNED
          ADD    T2          FUNCTION
          NJN    CAUX        IF JOB ASSIGNED OR FUNCTION PRESENT
 CAU2     LDN    /MTX/UNITL
          RAM    CAUA        UPDATE TO NEXT UDT
          LMM    PNRA
          NJN    CAU1        IF NOT END OF UDT
          UJP    CAUX        RETURN
 CFT      SPACE  4,10
**        CFT - CHECK FOR TWO CHANNELS.
*
*         EXIT   (A) = 0 IF TWO CHANNELS ARE ON.
*
*         USES   T1, CM - CM+4.
 
 
 CFT      SUBR               ENTRY/EXIT
          SFA    EST,EO      READ EST ENTRY
          ADK    EQDE
          CRD    CM
          CHTE   *
          LDN    CH
          STD    T1          SAVE CHANNEL NUMBER
          LDD    CM+1
          SHN    -11
          LMN    4
          NJN    CFTX        IF 1ST CHANNEL NOT ON
          LDD    CM+1
          LMD    T1
          LPN    37
          NJN    CFT2        IF THIS IS A 2ND CHANNEL
          LDD    CM+2
          SHN    -11
 CFT1     LMN    4
          NJN    CFTX        IF NO 2ND CHANNEL
          LDD    CM+2
          LMD    T1
          LPN    37
          ZJN    CFT1        IF NO 2ND CHANNEL
 CFT2     LDN    0
          UJP    CFTX        RETURN
 DCI      SPACE  4,10
**        DCI - DOWN CHANNEL IN EST.
*         THIS ROUTINE DOWNS THE CHANNEL IN THE EST FOR ALL UNITS
*         ON THE CHANNEL.
*
*         USES   CM - CM+4, CN - CN+4.
*
*         MACROS MONITOR.
 
 
 DCI      SUBR               ENTRY/EXIT
          LDM    PNRD
          STM    DCIA        SET STARTING UDT ADDRESS
 DCI1     LDD    RA
          SHN    6
          ADC    0
 DCIA     EQU    *-1         (UDT ADDRESS)
          ADK    /MTX/UST1
          CRD    CM          GET EQUIPMENT DEFINITION
          SFA    EST,CM+2
          ADK    EQDE        GET CHANNEL INFORMATION
          CRD    CN
          LDD    CN+1
          CHTE   *
          LMN    CH
          LPN    37
          ZJN    DCI1.1      IF UNIT ON THIS CHANNEL
          LDD    CN+2
          CHTE   *
          LMN    CH
          LPN    37
          NJN    DCI2        IF UNIT NOT ON THIS CHANNEL
 DCI1.1   LDD    CM+2
          STD    CM+1        EST ORDINAL
          CHTE   *
          LDN    CH
          STD    CM+2        CHANNEL NUMBER
          LDN    /CPS/DWSS
          STD    CM+3        SUBFUNCTION
          MONITOR SCSM       DOWN CHANNEL IN EST
 DCI2     LDN    /MTX/UNITL
          RAM    DCIA        UPDATE TO NEXT UDT
          LMM    PNRA
          NJP    DCI1        IF NOT END OF UDT
          LJM    DCIX        RETURN
 PCM      SPACE  4,25
**        PCM - PROCESS CHANNEL MALFUNCTION.
*         THE CHANNEL IS DOWNED IF A CHANNEL MALFUNCTION ERROR
*         OCCURS, RECOVERY IS UNSUCCESSFUL, AND
*           1) THERE IS A 2ND CHANNEL, OR
*           2) THERE ARE NO JOBS ASSIGNED AND NO FUNCTION IS PRESENT.
*
*         ENTRY  (EC) = ERROR CODE.
*                (EI) = RETRY COUNT.
*
*         EXIT   TO *PNR* IF CHANNEL MALFUNCTION, JOB ASSIGNED, NO 2ND
*                   CHANNEL, AND NO FUNCTION IS PRESET.  THIS BYPASSES
*                   ERROR LOGGING AND ERROR RECOVERY.
*                TO *PNR5* IF CHANNEL DOWNED AND UNIT NOT CONNECTED.
*                TO *RET4* IF CHANNEL MALFUNCTION, ERROR RECOVERY IS
*                   UNSUCCESSFUL, AND A 2ND CHANNEL IS PRESENT.
*
*         USES   EC, EI, CM - CM+4, CN - CN+4.
*
*         CALLS  CAU, *CEM*, CFT, DCI, IMR, SRQ, UAD.
*
*         MACROS CALL, MONITOR.
 
 
 PCM      SUBR               ENTRY/EXIT
          LDD    EC
          SBN    /MTX/CMF
          ZJN    PCM1        IF CHANNEL MALFUNCTION
          SBN    /MTX/FRJ-/MTX/CMF
          NJN    PCMX        IF NOT FUNCTION REJECT
 PCM1     RJM    CFT         CHECK FOR TWO CHANNELS
          ZJN    PCM2        IF 2 CHANNELS
          RJM    CAU         CHECK ALL UNITS
          NJP    PCM4        IF JOB ASSIGNED OR FUNCTION PRESET
 PCM2     LDD    EI
          SBN    2
          MJN    PCMX        IF RECOVERY NOT COMPLETE
 
*         DOWN CHANNEL.
 
 PCM3     RJM    DCI         DOWN CHANNEL IN EST
          LDN    /CPS/EEVS
          STD    CM+1        ENTER EVENT
          LDN    0
          STD    CM+3
          LDN    /EVT/CDSE
          STD    CM+4        *CHANNEL DOWNED BY SYSTEM* EVENT
          MONITOR EATM
          LDN    /MTX/MDW    CHANNEL DOWNED ERROR
          STD    EC
          CALL   CEM         LOG THE ERROR
          LDN    0
          STD    EI          CLEAR RETRY COUNT
          LDC    LDNI
          STM    //PNRC      FORCE DROP OUT
 
*         ONLY GO TO *RET* IF CONNECTED, OTHERWISE 2 PPS COULD BE
*         CHANGING THE *UDT* AT THE SAME TIME.
 
          LDM    RELA
          ZJP    PNR5        IF UNIT NOT CONNECTED
          LJM    RET4        RETURN AN ERROR CODE
 
 PCM4     LDD    FN
          ZJP    //PNR       IF NO FUNCTION PENDING
 PCM5     LJM    PCMX        RETURN
 PCR      SPACE  4,20
**        PCR - PROCESS CONNECT REJECT.
*         IF ERROR RECOVERY IS UNSUCCESSFUL, NO FUNCTION IS PRESET,
*         AND NO JOB IS ASSIGNED, THE UNIT IS TURNED OFF.
*
*         ENTRY  (EC) = ERROR CODE.
*                (EI) = RETRY COUNT.
*
*         EXIT   TO *PNR* IF CONNECT REJECT, NO FUNCTION IS PRESENT,
*                   AND A JOB IS ASSIGNED.  THIS BYPASSES ERROR
*                   REPORTING AND ERROR RECOVERY.
*
*         USES   CM - CM+4, CN - CN+4.
*
*         CALLS  SRQ, UAD.
*
*         MACROS MONITOR.
 
 
 PCR      SUBR               ENTRY/EXIT
          LDD    EC
          LMN    /MTX/CRJ
          NJN    PCRX        IF NOT CONNECT REJECT
          RJM    UAD         CHECK IF JOB ASSIGNED
          ADK    /MTX/UXRQ
          CRD    RS
          ADK    /MTX/UVRI-/MTX/UXRQ
          CRD    CN
          LDD    CN
          NJN    PCR1        IF JOB ASSIGNED
          LDD    EI
          SBN    2
          MJN    PCRX        IF RECOVERY NOT COMPLETE
 
*         DOWN UNIT.
 
          LDD    EO          SET EST ORDINAL
          STD    CM+1
          LDN    /CPS/DWES   SET DOWN STATUS
          STD    CM+2
          MONITOR SEQM       SET EQUIPMENT PARAMETER
          UJP    PCRX        RETURN
 
 PCR1     LDD    FN
          ZJP    //PNR       IF NO FUNCTION PENDING
          LJM    PCRX        RETURN
 POS      SPACE  4,15
**        POS - POSITION TAPE.
*         THIS ROUTINE USES THE LOCATE BLOCK COMMAND TO POSITION
*         THE TAPE TO THE EXPECTED BLOCK POSITION.
*
*         ENTRY  (BL, BL+1) = NOS BLOCK POSITION.
*                (WP, EP+1) = PHYSICAL BLOCK ID WHEN (BL,BL+1) = 0.
*
*         EXIT   (A) = 0 IF NO ERROR.
*                (EC) = ERROR CODE IF (A) .NE. 0.
*
*         USES   T3.
*
*         CALLS  /PRESET/GPS, /PRESET/ICF, /PRESET/RBI.
 
 
 POS      SUBR               ENTRY/EXIT
          RJM    /PRESET/RBI READ BLOCK ID
          LDM    BIDW
          STM    POSA
          SBN    20
          ZJN    POS1        IF FIRST SEGMENT
          STM    POSA        SET PHYSICAL REFERENCE BLOCK ID
 POS1     LDD    BL+1
          SHN    4
          ADD    EP+1
          STM    POSA+2      MOVE BLOCK NUMBER TO PARAMETERS
          SHN    -14
          STM    POSA+1
          LDD    BL
          SHN    4
          ADD    WP
          RAM    POSA+1
          LDN    F0016       LOCATE BLOCK
          RJM    /PRESET/ICF ISSUE FUNCTION
          ACN    CH
          LDN    3
          OAM    POSA,CH     OUTPUT THE 3 PARAMETER WORDS
          STD    T3          WORDS NOT TRANSFERRED
          FJM    *,CH        WAIT FOR DATA TO BE TAKEN
 POS2     LDN    0           WAIT FOR END OF OPERATION
          RJM    /PRESET/GPS GET AND PROCESS GENERAL STATUS
          MJN    POS2        IF COMMAND RETRY
          SHN    21-13
          MJN    POS3        IF ERROR
          LDD    T3
          ZJN    POS5        IF ALL WORDS TRANSFERRED
          LDN    /MTX/CMF    CHANNEL MALFUNCTION
          UJN    POS4        SAVE ERROR CODE
 
 POS3     LDN    /MTX/STE    STATUS ERROR
 POS4     STD    EC
 POS5     LJM    POSX        RETURN
 
 
 POSA     DATA   0           LOCATE BLOCK PARAMETERS
          DATA   0           UPPER 12 BITS OF BLOCK NUMBER
          DATA   0           8/LOWER BITS OF BLOCK NUMBER / 4 UNUSED
          SPACE  4,10
          ERRNG  ERLA-*      CODE OVERFLOWS HELPER OVERLAY
          ERRPL  ERLA+5+ZCTL-ERLB  *0CT* OVERFLOWS INTO BUFFER
 CTAB     SPACE  4,10
*         CHANNEL TABLE.
 
 
 CTAB     CHTB               CHANNEL TABLE
          OVERLAY (CTS ERRLOG MESSAGE PROCESSOR.),(ERLA+5),P,CEM
 CEM      SPACE  4,10
**        CEM - CTS ERRLOG MESSAGE PROCESSOR.
*         THIS ROUTINE ISSUES A MESSAGE TO THE ERROR LOG.
*
*         USES   T1.
*
*         CALLS  BDM, *CSP*, IDM, MET.
*
*         MACROS CALL.
 
 
          ENTRY  CEM
 CEM      SUBR               ENTRY/EXIT
          RJM    BDM         BUILD MESSAGE
          LDM    CEMA
          ZJN    CEM3        IF NO MESSAGE OR SPECIAL PROCESSOR
          SBN    MAXM
          MJN    CEM5        IF SPECIAL PROCESSOR NEEDED
 CEM1     LCN    0           MOVE MESSAGE
          STD    T1
 CEM2     AOD    T1
          LDM    *,T1
 CEMA     EQU    *-1
          STM    MESF+12,T1
          NJN    CEM2        IF NOT END OF MESSAGE
 CEM3     RJM    MET         MOVE ERPA MESSAGE
          LDN    ERLN/10000  ISSUE MESSAGE TO ERROR LOG
          RJM    IDM
          LDM    CECB
 CEMB     LPN    77
*         LPN    0           (MESSAGE ISSUE TO USER DISABLED)
          ZJN    CEM4        IF AT MAGNET CP
          LDN    CPON/10000  ISSUE MESSAGE TO USER
          RJM    IDM
 CEM4     UJP    CEMX        RETURN
 
 CEM5     CALL   CSP         CALL SPECIAL PROCESSOR
          UJN    CEM1        GO MOVE MESSAGE
 MES      SPACE  4,10
***       MESSAGE DATA.
*         MESSAGES ARE ISSUED IN THE FOLLOWING FORMAT-
*         CT,C13-0-02,ABCDEF,RD, 753, GS00000000.
*         CT,C13,D0000000000000000000000000000000000000000.
*         CT,C13, 000000000000000000000000,A000000000000.
*         CT,C13,ERPA 00 - 000000000000000000000000000000.
*         CT,C13,F07,I02,B00000123.
*         CT,C13,E00, F=I ,U, TTTTTTTTTTTT.
*
*         THE FIRST MESSAGE WOULD TELL THE FOLLOWING-
*
*         1)     CHANNEL 13, EQUIPMENT 0, UNIT 2.
*         2)     VOLUME SERIAL NUMBER IS *ABCDEF*.
*         3)     OPERATION WAS A READ.  (ANY OPERATION NOT INVOLVING
*                AN ACTUAL READ OR WRITE WILL BE CALLED A READ.
*         4)     EST ORDINAL *753* IS THE UNIT THAT THE TAPE WAS LAST
*                LABELED ON.  THIS WILL ONLY BE AVAILABLE FOR A LABELED
*                TAPE GENERATED UNDER NOS.  IT WILL NORMALLY BE ZERO IN
*                ALL OTHER CASES.  THIS FIELD DOES NOT REPRESENT THE
*                EST ORDINAL OF THE TAPE UNIT THAT THE TAPE IS
*                CURRENTLY MOUNTED ON.
*         5)     GENERAL STATUS OF TAPE UNIT IN OCTAL.
*
*         THE SECOND MESSAGE WOULD TELL THE FOLLOWING -
*
*         1)     CHANNEL 13 - THIS IS REPEATED SO THAT IF ERRORS
*                ARE OCCURING ON MORE THAN ONE TAPE CHANNEL AT THE
*                SAME TIME THE TWO MESSAGES CAN BE ASSOCIATED.
*         2)     THIS IS THE FIRST 20 SENSE BYTES IN HEXADECIMAL.
*
*         THE THIRD MESSAGE WOULD TELL THE FOLLOWING -
*
*         1)     CHANNEL 13, SAME AS ABOVE.
*         2)     THIS IS THE LAST 12 SENSE BYTES IN HEXADECIMAL
*                FOLLOWED BY ADAPTER STATUS.  ADAPTER STATUS IS
*                DISPLAYED IN HEXADECIMAL AND IS THE LAST 48 BITS
*                OF DETAILED STATUS.
*
*         THE FOURTH MESSAGE WOULD TELL THE FOLLOWING -
*
*         1)     CHANNEL 13, SAME AS ABOVE.
*         2)     THE ERROR RECOVERY PROCEDURE ACTION CODE, FROM SENSE
*                BYTE 3, FOLLOWED BY THE TEXT MESSAGE FOR THE ERPA
*                CODE.
*
*         THE FIFTH MESSAGE WOULD TELL THE FOLLOWING -
*
*         1)     CHANNEL 13, SAME AS ABOVE.
*         2)     THE ERROR OCCURED ON A SOFTWARE FUNCTION OF 7.
*         3)     ERROR ITERATION.
*         4)     BLOCK NUMBER ERROR OCCURRED ON WAS 123.  THIS IS THE
*                NOS BLOCK NUMBER, NOT THE PHYSICAL BLOCK ID USED BY
*                THE CARTRIDGE TAPE SUBSYSTEM.  THE FIRST DATA BLOCK
*                AFTER A LABEL IS NOS BLOCK 0.
*
*         THE SIXTH MESSAGE WOULD TELL THE FOLLOWING -
*
*         1)     CHANNEL 13 - SAME AS ABOVE.
*         2)     NOS ERROR CODE.
*         3)     THE TAPE FORMAT IS I.
*         4)     THE ERROR IS UNRECOVERED.
*         5)     TTT CONTAINS ADDTIONAL STATUS.
 
****      MESSAGE DATA.  NOTE THAT MESSAGES LONGER THAN 40 CHARACTERS
*         WRAP TO THE NEXT LINE IF DISPLAYED WITH DSDI.  THE START
*         OF MESSAGES SHOULD BE AT EQUAL INTERVALS SO *SCS* CAN SAVE
*         REPETITIVE INFORMATION.
 
 MESA     DATA   H*CT,C00-0-00,      ,RD,    , GS00000000.*
          CON    0
          BSS    26D+MESA-*
 MESB     DATA   H*CT,C00,D                                        .*
          CON    0
 MESC     DATA   H*CT,C00,                         ,A            .  *
          CON    0
 MESD     DATA   H*CT,C00,ERPA   , *
          CON    0
          BSS    26D+MESD-*
 MESE     DATA   H*CT,C00,F00,I00,B00000000.*
          CON    0
          BSS    26D+MESE-*
 MESF     DATA   C*CT,C00,E00, F=I ,I, *
 MESL     EQU    MESF+MESB-MESA+1
 TERM     SPACE  4,10
 TERM     INDEX
          INDEX  0,(=C*REC.*)
          INDEX  /MTX/BTL,(=C*BTL.*)
          INDEX  /MTX/BNE,BNEM
          INDEX  /MTX/RDR,WEOM
          INDEX  /MTX/FRJ,FRJM
          INDEX  /MTX/WEO,WEOM
          INDEX  /MTX/CRJ,CRJM
          INDEX  /MTX/STE,(=C*STE.*)
          INDEX  /MTX/CMF,(=C*CMF.*)
          INDEX  /MTX/MDW,(=C*MDW.*)
          INDEX  /MTX/BFR,(=C*BFR.*)
          INDEX  /MTX/BFW,(=C*BFW.*)
          INDEX  /MTX/MERC
****
          SPACE  4,10
**        COMMON DECKS.
 
 
*CALL     COMPC2D
          SPACE  4,10
**        ERRORS REQUIRING ADDITIONAL OVERLAY TO BE LOADED.
 
 
 BEGM     BSS    0
          LOC    1
 FRJM     BSS    1           FUNCTION REJECT
 WEOM     BSS    1           NO END OF OPERATION
 CRJM     BSS    1           CONNECT REJECT
 BNEM     BSS    1           BLOCK SEQUENCE ERROR
 MAXM     BSS    1           MAXIMUM SPECIAL ERRORS
 
          ORG    BEGM
 IDM      SPACE  4,10
**        IDM - ISSUE DAYFILE MESSAGES.
*         THIS ROUTINE ISSUES THE MESSAGE LINES DEFINED IN TABLE
*         *IDMB* TO THE DAYFILE.
*
*         ENTRY  (A) = MESSAGE DESTINATION CODE
*
*         USES   T8.
*
*         CALLS  DFM.
 
 
 IDM      SUBR               ENTRY/EXIT
          LMC    LMCI        SET MESSAGE DESTINATION CODE
          STM    IDMA
          LDN    0           INITIALIZE MESSAGE INDEX
          STD    T8
 
*         LOOP UNTIL ALL MESSAGE LINES ARE ISSUED TO THE DAYFILE.
 
 IDM1     LDM    IDMB,T8     GET NEXT MESSAGE POINTER
          ZJN    IDMX        IF ALL MESSAGES ISSUED
          LMC    **          ADD MESSAGE DESTINATION
 IDMA     EQU    *-2         (MESSAGE DESTINATION CODE)
          RJM    DFM         ISSUE DAYFILE MESSAGE
          AOD    T8          ADVANCE MESSAGE INDEX
          UJN    IDM1        ISSUE NEXT MESSAGE LINE
 
 
*         TABLE OF MESSAGE LINE POINTERS FOR 6 LINES.
 
 IDMB     BSS    0
          LOC    0
          CON    MESA        LINE 1
          CON    MESB        LINE 2
          CON    MESC        LINE 3
          CON    MESD        LINE 4
          CON    MESE        LINE 5
          CON    MESF        LINE 6
          CON    0           TERMINATOR
          LOC    *O
 MET      SPACE  4,15
**        MET - MOVE ERPA TEXT MESSAGE.
*
*         USES   T1, T2.
*
*         CALLS  ERP.
*
*         MACROS CALL.
 
 
 MET2     LDC    2R.
          STM    MESD+7      SET END OF LINE WHEN NO MESSAGE
 
 MET      SUBR               ENTRY/EXIT
          CALL   ERP         LOAD ERPA TEXT MESSAGES
          LDM    MESD+6
          LMC    2R
          ZJN    MET2        IF NO ERPA CODE
          LDM    CTSD+2
          SHN    -4
          SBN    0#21
          MJN    MET2        IF NO ENGLISH TEXT
          STD    T1          INDEX INTO TABLE OF ADDRESSES
          LDM    /ERP/ERPA,T1
          ZJN    MET2        IF NO TEXT
          STD    T1          START OF ERPA TEXT
          LDC    MESD+10
          STD    T2          DESTINATION FOR ERPA TEXT
 MET1     LDI    T1
          STI    T2
          ZJN    METX        IF ALL TEXT MOVED
          AOD    T1
          AOD    T2
          UJN    MET1        CONTINUE MOVING TEXT
          TITLE  OVERLAY AREA.
 CDA      SPACE  4,10
**        CDA - CONVERT DATA (4 DIGITS).
*
*         ENTRY  (A, 17 - 12) = ADDRESS WHERE DATA CONTAINED.
*                (A, 11 - 0) = ADDRESS WHERE TO STORE RESULT.
*
*         USES   T2, T3.
*
*         CALLS  C2D.
 
 
 CDA      SUBR               ENTRY/EXIT
          STD    T3          SAVE DESTINATION ADDRESS
          SHN    -14
          STD    T2          SAVE DATA ADDRESS
          LDI    T2          CONVERT FIRST 2 DIGITS
          SHN    -6
          RJM    C2D
          STI    T3
          LDI    T2          CONVERT SECOND 2 DIGITS
          RJM    C2D
          STM    1,T3
          UJN    CDAX        RETURN
          ERRNG  ERLB-*      IF OVERFLOW INTO OVERLAY AREA
 
 
*         NOTE - THE FOLLOWING CODE MAY BE OVERLAID IF THE SPECIAL
*         ERROR MESSAGES OVERLAY IS REQUIRED OR IF AN ERPA CODE IS
*         PRESENT.
 CDN      SPACE  4,15
**        CDN - CONVERT DATA.
*         THIS ROUTINE CONVERTS 12-BIT HEX DATA TO DISPLAY CODE.
*
*         ENTRY  (A, 21 - 14 = 8-BIT BYTES TO CONVERT.
*                (A, 13 - 0) = SOURCE OF DATA TO CONVERT.
*                (T1) = STARTING NIBBLE POSITION (0, 1, OR 2).
*                (CN+3) = DESTINATION OF CONVERTED DATA.
*
*         EXIT   (CN+3) = UPDATED TO DESTINATION FOR NEXT CONVERTED
*                         BYTE.
*
*         USES   CN+1, CN+2.
*
*         CALLS  CNN.
 
 
 CDN      SUBR               ENTRY/EXIT
          STD    CN+1        STARTING ADDRESS OF DATA TO CONVERT
          SHN    -14
          STD    CN+2        8-BIT BYTES TO CONVERT
 CDN1     RJM    CNN         CONVERT NIBBLE
          SHN    6
          STI    CN+3
          RJM    CNN         CONVERT NIBBLE
          RAI    CN+3
          AOD    CN+3        UPDATE POINTER TO DESTINATION ADDRESS
          SOD    CN+2
          NJN    CDN1        IF MORE BYTES TO CONVERT
          UJN    CDNX        RETURN
CNN       SPACE  5,15
**        CNN - CONVERT NIBBLE.
*
*         ENTRY  (T1) = NIBBLE TO CONVERT (0, 1, OR 2).
*                (CN+1) = ADDRESS OF DATA TO CONVERT.
*
*         EXIT   (A) = DISPLAY CODE FOR NIBBLE.
*                (CN+1) = UPDATED TO ADDRESS OF NEXT BYTE TO CONVERT.
*                (T1) = UPDATED TO POSITION OF NEXT NIBBLE.
*
*         USES   T1, T2.
 
 
 CNN      SUBR               ENTRY/EXIT
          LDM    CNNB,T1
          STM    CNNA        SET SHIFT INSTRUCTION
          LDI    CN+1
          SHN    0
 CNNA     EQU    *-1         SHN -10, SHN -4, OR SHN 0
          LPN    17
          SBN    11
          ZJN    CNN1        IF 9
          PJN    CNN2        IF A - F
 CNN1     ADN    1R0+11      0 - 9
 CNN2     STD    T2
          AOD    T1          UPDATE NIBBLE POINTER
          SBN    3
          NJN    CNN3        IF NO WRAP
          STD    T1
          AOD    CN+1        ADDRESS OF DATA TO CONVERT
 CNN3     LDD    T2
          UJN    CNNX        RETURN
 
 
 CNNB     CON    1067        SHN  -10
          CON    1073        SHN   -4
          CON    1000        SHN    0
 RUW      SPACE  4,10
**        RUW - READ UNIT DESCRIPTOR TABLE WORD.
*         USED TO READ UDT WHEN POSSIBLY NOT AT MAGNET CP.
*
*         ENTRY  (A) = UDT WORD.
*
*         EXIT   (CN - CN+4) = WORD READ.
*
*         USES   T1, CM - CM+4, CN - CN+4.
*
*         MACROS DELAY, MONITOR, PAUSE.
 
 
 RUW2     LDD    MA
          CRD    CN
 
 RUW      SUBR               ENTRY/EXIT
          STD    T1
 RUW1     LDM    UADA
          ADD    T1
          STD    CM+4
          LDD    HN          REQUEST 1 WORD
          STD    CM+3
          LDN    0           REQUEST READ FROM *MAGNET*
          STD    CM+1
          LCN    7777-/SSD/MTSI  SET *MAGNET* SUBSYSTEM IDENTIFICATION
          STD    CM+2
          MONITOR TDAM
          LDD    CM+1
          LMN    1
          NJN    RUW2        IF MOVE NOT IN PROGRESS
          PAUSE  NE
          DELAY
          UJN    RUW1        REISSUE REQUEST
 BDM      SPACE  4,15
**        BDM - BUILD MESSAGE.
*         THIS ROUTINE BUILDS THE ERROR LOG MESSAGES.  (EXCEPT THE
*         DESCRIPTIVE MESSAGE IN THE 6TH LINE AND THE ERPA TEXT
*         MESSAGE.
*
*         ENTRY  (EC) = ERROR CODE.
*                (EI) = RETRY COUNT.
*
*         USES   T1, CM - CM+4.
*
*         CALLS  CDA, CDN, C2D, MCH, RUW, SCS.
*
*         MACROS CHTE, SFA.
 
 
 BDM      SUBR               ENTRY/EXIT
          LDC    CTAB        MODIFY CHANNELS
          RJM    MCH
          LDM    //LOV
          STM    CEM         SET RETURN ADDRESS
          LDM    TERM,EC
          STM    CEMA        SAVE TABLE ENTRY
 
*         MESSAGE BUILD.
 
          SFA    EST,EO      SET DEVICE TYPE IN MESSAGE LINES
          ADK    EQDE
          CRD    CM
          LDD    CM+3
          RJM    SCS         SET CHARACTERS
          CHTE   *           SET CHANNEL NUMBER IN MESSAGE LINES
          LDN    CH
          RJM    C2D
          ADC    2*10000
          RJM    SCS
          LDD    CM+4        SET UNIT NUMBER
          SHN    -3
          LPN    1
          RAM    MESA+4
          LDD    CM+4
          LPN    7
          SHN    6
          RAM    MESA+5
          LDN    /MTX/UVSN   READ UP VSN
          RJM    RUW
          LDD    CN
          ZJN    BDM1        IF VSN NOT SPECIFIED
          STM    MESA+6
          LDD    CN+1
          STM    MESA+7
          LDD    CN+2
          STM    MESA+10
 BDM1     LDD    FN
          SBN    /MTX/WTF
          MJN    BDM2        IF NOT WRITE OPERATION
          LDN    1RW-1RR     CHANGE *RD* TO *WD*
          RAM    MESA+11
 BDM2     LDN    /MTX/UGNU   GET EST ORDINAL WRITTEN ON
          RJM    RUW
          LDD    CN+1
          ZJN    BDM3        IF EST NOT AVAILABLE
          SHN    -6          CONVERT UPPER DIGIT OF EST ORDINAL
          ADC    2R 0
          STM    MESA+13
          LDD    CN+1        CONVERT LOWER TWO DIGITS OF EST ORDINAL
          RJM    C2D
          STM    MESA+14
 
*         MOVE GENERAL STATUS.
 
 BDM3     LDD    DS
          SHN    -6
          RJM    C2D
          STM    MESA+17
          LDD    DS
          RJM    C2D
          STM    MESA+20
          LDM    CTGS
          SHN    -6
          RJM    C2D
          STM    MESA+21
          LDM    CTGS
          RJM    C2D
          STM    MESA+22
          LDD    DS
          SHN    21-13
          PJP    BDM5        IF ALERT NOT SET
          LDM    CTGS
          SHN    21-12
          MJN    BDM4        IF UNIT CHECK
          LDC    MESC+21
          STD    CN+3        DESTINATION ADDRESS
          UJN    BDM4.1      SAVE CCC STATUS
 
*         MOVE DETAILED STATUS.
 
 BDM4     LDN    0
          STD    T1          FIRST NIBBLE
          LDC    MESB+4
          STD    CN+3        DESTINATION ADDRESS
          LDC    20D*10000+CTSD
          RJM    CDN         CONVERT FIRST 20 SENSE BYTES
          LDC    MESC+4
          STD    CN+3        DESTINATION ADDRESS
          LDC    12D*10000+CTSD+15
          RJM    CDN         CONVERT LAST 12 SENSE BYTES
          AOD    CN+3        DESTINATION ADDRESS
 BDM4.1   LDN    0
          STD    T1          FIRST NIBBLE
          LDC    6*10000+CTSD+26
          RJM    CDN         CONVERT ADAPTER STATUS
          LDM    MESB+7
          STM    MESD+6      SET ERPA CODE
          UJN    BDM6        DO CONVERSION FOR LINE 5
 
 BDM5     LDC    2R.         SHORTEN MESSAGE LINES WHEN NO STATUS
          STM    MESB+7
          STM    MESC+7
          LDN    0
          STM    MESB+10
          STM    MESC+10
 
*         CONVERSION FOR LINE 5.
 
 BDM6     LDD    FN          CONVERT SOFTWARE FUNCTION NUMBER
          RJM    C2D
          STM    MESE+4
          LDD    EI          CONVERT ERROR ITERATION NUMBER
          RJM    C2D
          STM    MESE+6
          LDC    BL*10000+MESE+10  CONVERT BLOCK NUMBER
          RJM    CDA
          LDC    BL*10000+10000+MESE+12  CONVERT BLOCK NUMBER
          RJM    CDA
 
*         CONVERSION FOR LINE 6.
 
          LDD    EC          SET ERROR CODE
          RJM    C2D
          STM    MESF+4
          LDD    FM          SET FORMAT
          SHN    -6
          STD    T1
          LDM    BDMA,T1     SAVE FORMAT
          STM    MESF+7
          LDD    EC
          NJN    BDM7        IF NOT RECOVERABLE ERROR
          LDN    1RR-1RI
          UJN    BDM8        INDICATE RECOVERABLE MESSAGE
 
 BDM7     LDD    EI
          SBN    2
          MJN    BDM9        IF NOT UNRECOVERABLE
          LDN    1RU-1RI     INDICATE UNRECOVERABLE MESSAGE
 BDM8     RAM    MESF+10
 BDM9     LDD    SP          CHECK ERROR MESSAGE PROCESSING OPTION
          SHN    21-7
          PJN    BDM10       IF USER DAYFILE MESSAGES ARE DISABLED
          LDD    EC
          ZJN    BDM11       IF RECOVERED MESSAGE
          LDD    EI
          ZJN    BDM11       IF FIRST ITERATION
 BDM10    LDC    LPNI+0      DISABLE MESSAGE ISSUE
          STM    CEMB
 BDM11    LJM    BDMX        RETURN
 
 
 BDMA     CON    2RI         I FORMAT
          CON    2RSI        SI FORMAT
          CON    2RF         F FORMAT
          CON    2RS         S FORMAT
          CON    2RL         L FORMAT
          CON    2RLI        LI FORMAT
 SCS      SPACE  4,10
**        SCS - STORE CHARACTERS IN MESSAGE LINES.
*
*         ENTRY  (A, 17 - 12) = MESSAGE FIELD INDEX.
*                (A, 11 -  0) = CHARACTERS.
*
*         USES   T1.
 
 
 SCS      SUBR               ENTRY/EXIT
          STD    T0          SAVE CHARACTERS
          SHN    -14
          ADC    MESA
          STD    T1
 SCS1     LDD    T0
          STI    T1
          LDN    MESB-MESA
          RAD    T1
          ADC    -MESL
          MJN    SCS1        LOOP
          UJN    SCSX        RETURN
 CTAB     SPACE  4,10
*         CHANNEL TABLE.
 
 
 CTAB     CHTB               CHANNEL TABLE
 
          ERRNG  2*473+ERLA+5-*  ERROR PROCESSOR OVERFLOW
          OVERLAY (CTS SPECIAL MESSAGE PROCESSOR.),(ERLB+5),P,CSP
 CSP      SPACE  4,10
**        CSP - CTS ERRLOG MESSAGE SPECIAL PROCESSOR.
*         THIS OVERLAY IS CALLED FROM *CEM* FOR ERRORS WHICH
*         REQUIRE ADDITIONAL PROCESSING. SEE TABLE IN *CEM* FOR
*         LIST OF ERRORS WHICH REQUIRE THIS OVERLAY.
*
*         ENTRY  (/CEM/CEMA) = INDEX TO PROCESSOR.
*
*         EXIT   (/CEM/CEMA) = MESSAGE ADDRESS.
*
*         CALLS  BNP, CKR, ECN, FRE, FSC.
 
 
          ENTRY  CSP
 CSP      SUBR               ENTRY/EXIT
          LDM    /CEM/CEMA   GET PROCESSOR INDEX
          STD    T1
          LDM    SPRI,T1
          STM    CSPA
          RJM    *           PROCESS ERROR
 CSPA     EQU    *-1
          STM    /CEM/CEMA   SET MESSAGE ADDRESS
          UJN    CSPX        RETURN
 
          TITLE  SPECIAL PROCESSORS.
 SPRI     SPACE  4,10
 SPRI     INDEX  0,//HNG
          INDEX  /CEM/FRJM,FRE
          INDEX  /CEM/WEOM,CKR
          INDEX  /CEM/CRJM,ECN
          INDEX  /CEM/BNEM,BNP
          INDEX  /CEM/MAXM
 BNP      SPACE  4,15
**        BNP - BLOCK NUMBER PROCESSOR.
*
*         ENTRY  (BNEU) = ACTUAL BYTE LENGTH UPPER (LI FORMAT).
*                (BNEI) = ACTUAL BYTE LENGTH LOWER.
*                (BNEI+1 - BNEI+2) = ACTUAL BLOCK NUMBER.
*
*         EXIT   (A) = MESSAGE ADDRESS.
*
*         USES   CM.
*
*         CALLS  /CEM/CDA, /CEM/C2D.
 
 
 BNP      SUBR               ENTRY/EXIT
          LDD    FM
          SHN    -6
          LMN    /MTX/TFLI
          NJN    BNP1        IF NOT LI FORMAT
          LDM    BNEU
          RJM    /CEM/C2D    CONVERT 2 DIGITS
          STM    BNPA+1      SAVE UPPER 2 OF 6 DIGITS OF BLOCK LENGTH
 BNP1     LDM    BNEI
          STD    CM
          LDC    CM*10000+BNPA+2  CONVERT EXPECTED LENGTH
          RJM    /CEM/CDA
          LDM    BNEI+1
          STD    CM
          LDC    CM*10000+BNPA+5
          RJM    /CEM/CDA    CONVERT BLOCK NUMBER
          LDM    BNEI+2
          STD    CM
          LDC    CM*10000+BNPA+7
          RJM    /CEM/CDA
          LDC    BNPA        SET MESSAGE ADDRESS
          UJP    BNPX        RETURN
 
 
 BNPA     DATA   C* L000000,B00000000.*
 CKR      SPACE  4,10
**        CKR - CHECK IF READY.
*         CLEARS LAST OPERATION WRITE FLAGS.
*
*         EXIT   (A) = MESSAGE ADDRESS.
 
 
 CKR3     LDC    CKRC        SET READY DROP MESSAGE
 
 CKR      SUBR               ENTRY/EXIT
          LDD    UP          CLEAR LAST OPERATION WRITE AND BLANK TAPE
          SCN    24
          STD    UP
          LDD    EC          CHECK FOR READY DROP ERROR
          SBN    /MTX/RDR
          ZJN    CKR3        IF READY DROP ERROR
          LDM    /PRESET/GPSB
          ZJN    CKR1        IF WAIT EOP
          LDD    DS
          LPN    2
          ZJN    CKR1        IF NOT BUSY
          LDC    CKRB        SET UNIT BUSY MESSAGE
          UJN    CKRX        RETURN
 
 CKR1     LDC    CKRA        SET NO EOP MESSAGE
          UJN    CKRX        RETURN
 
 
 CKRA     DATA   C*NO EOP.*
 CKRB     DATA   C*BUSY.*
 CKRC     DATA   C*NOT READY.*
 ECN      SPACE  4,10
**        ECN - ERROR ON CONNECT.
*         MESSAGE IS ALTERED IF UNIT NOT TURNED OFF.
*
*         EXIT   (A) = MESSAGE ADDRESS.
*
*         USES   CM - CM+4.
*
*         MACROS SFA.
 
 
 ECN2     LDC    ECNA        EXIT WITH MESSAGE ADDRESS
 
 ECN      SUBR               ENTRY/EXIT
          SFA    EST,EO
          ADK    EQDE
          CRD    CM
          LDD    CM
          LPN    3
          LMN    /CPS/DWES
          ZJN    ECN2        IF UNIT DOWNED
          LDN    0           ALTER MESSAGE
          STM    ECNA+5
          UJN    ECN2        RETURN
 
 
 ECNA     DATA   C*CON. REJ. DOWN.*
 FRE      SPACE  4,10
**        FRE - FUNCTION REJECT ERROR.
*         DIAGNOSES ERROR BY GIVING FUNCTION AND THE ADDRESS OF
*         THE ROUTINE THAT INITIATED THE CALL.
*
*         EXIT   (A) = MESSAGE ADDRESS.
*
*         USES   CM.
*
*         CALLS  /CEM/CDA.
 
 
 FRE      SUBR               ENTRY/EXIT
          LDM    /PRESET/ICF GET ADDRESS OF CALLER
          STD    CM
          LDC    CM*10000+FREA+4
          RJM    /CEM/CDA
          LDM    /PRESET/ICFA  CONVERT FUNCTION
          STD    CM
          LDC    CM*10000+FREA+1
          RJM    /CEM/CDA
          LDC    FREA        SET MESSAGE ADDRESS
          UJN    FREX        RETURN
 
 
 FREA     DATA   C*FN0000,P0000.*
          ERRNG  1*473+ERLB+5-*  ERROR PROCESSOR OVERFLOW
          OVERLAY (DROP PPU PROCESSOR.),,NOPRS,DPP
 DPP      SPACE  4,10
**        DPP - DROP CHANNEL AND PPU.
*         ALSO HANDLES ISSUE OF MESSAGE FOR ANY FUNCTION REJECTS
*         THAT COULD NOT BE DIAGNOSED WHEN THEY OCCURRED.  IT IS NOT
*         ALWAYS POSSIBLE TO LOAD AN OVERLAY AND DIAGNOSE A FUNCTION
*         REJECT AND STILL MAINTAIN THE CONTROLLER OPTIONS AETC.
*
*         CALLS  DME, *EMM*, MCH.
*
*         MACROS CALL, CHTE, DCHAN, MONITOR.
 
 
          ENTRY  DPP
 DPP      SUBR               ENTRY/EXIT
          LDM    HNG         CHECK FOR *HNG* CALL
          ZJN    DPP0        IF NORMAL DROP
          STM    CM+4        SET (OR+4) = *HNG* CALLER
          MONITOR HNGM       HANG PP
 DPP0     LDC    CTAB        MODIFY CHANNELS
          RJM    MCH
          LDC    DPP1        SET ADDRESS TO EXIT TO
          STM    //LOV
          UJN    DPPX        RETURN
 
 DPP1     LDD    HP
          SHN    21-7
          MJN    DPP2        IF CTS
          LDM    //FCNC
          NJN    DPP2        IF NO DELAYED REQUEST
          LDM    //.OVLR+3
          NJN    DPP2        IF NO B.C. RESTART
          LDD    DS          SET STATUS
          STM    //STER
          LDN    /MTX/BCR
          STD    EC
          CALL   EMM         CALL ERROR MESSAGE PROCESSOR
 DPP2     LDD    IA          RESET INPUT REGISTER
          CRD    IR
          LDD    RA
          SHN    6
          ADD    IR+4
          ADK    /MTX/CPST   GET PROCESSOR STATUS
          CRD    CM
          LDM    UADA        SET NEXT UDT TO PROCESS
          STD    CM+4
          LDD    CM
          LPC    3777        CLEAR *1MT* ACTIVE
          STD    CM
          LDD    RA
          SHN    6
          ADD    IR+4
          ADK    /MTX/CPST   UPDATE PROCESSOR STATUS
          CWD    CM
          CHTE   *
          LDN    CH          DROP CHANNEL
          DCHAN
          MONITOR DPPM       DROP PPU
          LJM    PPR         EXIT TO PP RESIDENT
 
 
 CTAB     CHTB               CHANNEL TABLE
          OVERLAY (CONTROL POINT/CODED PRESET.),(ERLA+5),P,CPP
 PRS      SPACE  4,10
**        PRS - CONTROL POINT/CODED PRESET.
*
*         USES   BT, FM, CM - CM+4, T1 - T5.
*
*         CALLS  CCD, UAD.
 
 
 PRS      SUBR               ENTRY/EXIT
          LDM    //LOV       SAVE ADDRESS TO EXIT AT
          STM    CPP
          LDC    PRS1        SET ADDRESS TO EXIT TO
          STM    //LOV
          UJN    PRSX        RETURN
 
 PRS1     RJM    CCD         CHECK IF CODED
          LDC    LDNI+1      SET ACTIVITY PROCESSED
          STM    PNRE
          IFEQ   TE,1        IF TRACE ENABLED
          RJM    TRB         SAVE TRACE INFORMATION IN CM
          ENDIF
          LDM    CPP
          LMC    PNRI
          NJN    CPPX        IF NOT CALLED FROM MAIN PROGRAM
          LDD    BT          SET ENTRY ADDRESS
          STM    CPP
          LDD    SC
          LPN    20
          NJN    CPP1        IF CP CHANGE
          STD    BT          PRESET BLOCKS TRANSFERRED
*         LJM    //LOVX      RETURN (TO CALLER OF *LOV*)
 CPP      SPACE  4,20
**        CPP - CONTROL POINT OPERATION PRESET.
*
*         ENTRY  (CN) = ADDRESS OF LIST OF INSTRUCTIONS TO MODIFY.
*                (CN+4) = RELATIVE ADDRESS OF WORD IN FET (IN OR OUT).
*                THIS WORD WILL BE READ UP AND VALIDATED.
*
*         EXIT   CHANGED TO CORRECT CP.
*                (EI) = 0, ERROR ITERATION PRESET.
*                (CN - CN+4) = SELECTED FET WORD VALIDATED.  (IF ERROR
*                            EXITS TO *BAE*.)
*                (LNUM) = LEVEL NUMBER FOR OPERATION.
*                (FETO) = FET OPTIONS.
*                (CIOE) = EXTERNAL CIO CODE.
*
*         USES   BT, T8, T1 - T7, CM -  CM+4, CN - CN+4.
*
*         CALLS  CAL, HNG, INM, SFP, UAD.
*
*         MACROS MONITOR.
 
 
          ENTRY  CPP
 
 CPP      SUBR               ENTRY/EXIT
 CPP1     LDD    CN          SAVE ADDRESS MODIFICATION POINTERS
          STM    CPPB
          LDD    CN+4
          STM    CPPC
          RJM    UAD         READ UDT FET INFORMATION
          ADN    /MTX/UCIA   FET ADDRESS
          CRD    T6-3
          ADN    /MTX/UCIC-/MTX/UCIA  FIRST, LIMIT, AND FL
          CRD    T1
          ADN    /MTX/UVRI-/MTX/UCIC  GET EJT ORDINAL
          CRD    CN
          LDN    0           PRESET BLOCKS TRANSFERRED COUNT
          STD    BT
          LDD    CN          SAVE EJT ORDINAL
          STD    T8
          SFA    EJT         SET EJT ADDRESS
          ADK    JSNE
          CRD    CM          GET JOB STATUS
          ADK    SCHE-JSNE
          CRD    CN          GET CP NUMBER
          LDD    CM+4
          LPC    176
          LMN    /EJT/EXJS*2
          NJN    CPP2        IF JOB ROLLED OR ROLLING OUT
          LDD    CN+3        SET CP NUMBER
          ADK    /CPS/RCMS+/CPS/ALCS  SET MOVE REJECT AND ALTERNATE CP
          STD    CM+1
          MONITOR CCAM       SET ACCESS TO USER CP
          LDD    CM+1
          NJN    CPP2        IF CHANGE NOT MADE
          AOM    //CECB      SET CP CHANGED FLAG
          LDD    CP
          ADN    TFSW        VERIFY JOB EJT ORDINAL
          CRD    CM
          LDD    CM
          LMD    T8
          ZJN    CPP3        IF CORRECT JOB
 CPP2     LDN    /MTX/RJB    REQUEUE ON JOB ROLLED OUT
          LJM    RET5        EXIT
 
 CPP3     LDD    FL
          SBD    T1
          PJN    CPP6        IF NO FL REDUCTION
 
*         RECHECK BUFFER PARAMTERS.
 
          LDD    .FE
          SHN    6
          ADD    RA
          SHN    6
          ADD    .FE+1
          ADN    1
          CRD    CM
          LDD    CM+3
          SHN    -6
          ADD    .FE+1
          ADN    4
          SHN    6
          ADD    .FE
          SHN    14
          SHN    -6
          SBD    FL
          PJN    CPP5        IF FET LWA .GT FL
          LDD    .LM
          SHN    14
          LMD    .LM+1
          SBN    1
          SHN    -6
          SBD    FL
          MJN    CPP6        IF LIMIT .LT FL
 CPP5     LDN    /MTX/BAE    BUFFER ARGUMENT ERROR
          LJM    RET3        RETURN ERROR CODE
 
 CPP6     RJM    CAL         CALCULATE PARAMETERS
          LDC    *           MODIFY INSTRUCTIONS
 CPPB     EQU    *-1
          RJM    INM
          LDC    *
 CPPC     EQU    *-1
          ZJN    CPP7        IF NO FET POINTER CHECK
          RJM    SFP         SET FET POINTER
          NJN    CPP5        IF BAD FET POINTER
 CPP7     LDD    WC
          ADC    -1001
          PJN    CPP8        IF INCORRECT WORD COUNT
          LJM    CPPX        RETURN
 
 CPP8     RJM    HNG         HANG PP
          TITLE  SUBROUTINES.
 CAL      SPACE  4,15
**        CAL - CALCULATE PARAMETERS.
*
*         ENTRY  (T1 - T5) = UCIC FROM UDT.
*                (.FT - .FT+1) = FIRST.
*                (.LM - .LM+1) = LIMIT.
*                (.FE - .FE+1) = FET ADDRESS.
*
*         EXIT   (.FT - .FT+1) = FIRST.
*                (.LM - .LM+1) = LIMIT.
*                (.FE - .FE+1) = FET ADDRESS.
*                (.LF - .LF+1) = LIMIT - FIRST.
*                (.BS - .BS+1) = BLOCK SIZE.
*                (BUFC - BUFC+4) = PRESET IF CONTROL WORD READ AND NOT
*                                 *LI* FORMAT.
*
*         USES   T1, .BS - .BS+1, .LF - .LF+1.
 
 
 CAL      SUBR               ENTRY/EXIT
          LDD    .LM         LIMIT - FIRST
          SBD    .FT
          SHN    14
          ADD    .LM+1
          SBD    .FT+1
          STD    .LF+1
          SHN    -14
          STD    .LF
          LDD    MD          SET MAXIMUM BLOCK SIZE
          SHN    -4
          LPN    3
          ADD    WC
          STD    .BS+1
          LDN    0
          STD    .BS
          LDD    OV          BLOCK SIZE = WC + OV*LBWD + CONTROL WORDS
          ZJN    CAL2        IF NOT LONG BLOCK OPERATION
          STD    T0
 CAL1     LDC    /MTX/LBWD
          RAD    .BS+1
          SHN    -14
          RAD    .BS
          SOD    T0
          NJN    CAL1        IF OVERFLOW COUNT NOT EXHAUSTED
 CAL2     LDD    MD
          SHN    -4
          LPN    3
          STD    T1
          ZJN    CAL4        IF NOT CONTROL WORD OPERATION
          LDD    FN
          LMN    /MTX/RDF
          NJN    CAL4        IF NOT READ NORMAL BLOCK
          LDD    FM
          SHN    -6
          LMN    /MTX/TFLI
          ZJN    CAL4        IF LI FORMAT
          LDN    ZERL
          CRM    BUFC,ON     PRESET CONTROL WORD
          LDD    T1
          LPN    2
          ZJN    CAL3        IF NOT 200 READ CODE
          LDD    MD          SET PARITY INDICATION
          LPC    100
          STM    BUFC
          LDD    .BS         SET BLOCK SIZE
          SHN    14
          LMD    .BS+1
          SBD    T1
 CAL3     STM    BUFC+1
          SHN    -14
          RAM    BUFC
 CAL4     LJM    CALX        RETURN
 INM      SPACE  4,10
**        INM - INSTRUCTION MODIFICATION.
*
*         ENTRY  (A) = FWA OF INSTRUCTION MODIFICATION LIST.
*
*         USES   SC, CM+4, CM+5.
 
 
          ENTRY  INM
 
 INM      SUBR               ENTRY/EXIT
          ZJN    INMX        IF NO MODIFICATIONS
          STD    SC
 INM1     LDI    SC
          ZJN    INMX        IF END OF LIST
          SHN    21-0
          STD    T1          SAVE INSTRUCTION ADDRESS
          SHN    -21
          SHN    1           COMPLEMENT FLAG * 2
          LMC    UJNI+3
          STM    INMA
          LDI    T1          PRESERVE INSTRUCTION OP CODE
          SCN    77
          STI    T1
          LDM    1,SC        EXTRACT DIRECT CELL TO REFERENCE
          SHN    14
          STD    CM+4
          SCN    77          CLEAR DIRECT CELL ADDRESS
          SHN    3           EXTRACT BIAS
          STD    CM+5
          SCN    7           CLEAR BIAS
          ADI    CM+4        ADD UPPER PORITON OF VALUE
          PJN    INM2        IF RELATIVE VALUE DESIRED
          SHN    6
          SCN    40          CLEAR ABSOLUTE FLAG
          ADD    RA
          SHN    14
 INM2     SHN    14
          ADM    1,CM+4      ADD LOWER PORTION OF VALUE
          ADD    CM+5        ADD BIAS
 
*         NOTE CODE SHOULD NOT BE ADDED IN NEXT THREE LINES.
 
 INMA     UJN    3           COMPLEMENT NOT NEEDED
*         UJN    1           COMPLEMENT NEEDED
          LMC    -0
          STM    1,T1        MODIFY INSTRUCTION
          SHN    -14
          RAI    T1
          LDN    2           INCREMENT TO NEXT ITEM IN LIST
          RAD    SC
          LJM    INM1        CONTINUE INSTRUCTION MODIFICATION
 SFP      SPACE  4,10
**        SFP - SET FET POINTER.
*
*         ENTRY  (A) = POINTER TO DESIRED FET WORD (IN OR OUT).
*
*         EXIT   (CN - CN+4) = FET POINTER.
*                (A) = 0, IF POINTER VALID.
 
 
 SFP1     LDN    1
 
 SFP      SUBR               ENTRY/EXIT
          STD    T0
          LDD    .FE         READ DESIRED FET POINTER
          SHN    6
          ADD    RA
          SHN    6
          ADD    .FE+1
          ADD    T0
          CRD    CN
          LDD    CN
          ADD    CN+1
          ADD    CN+2
          NJN    SFP1        IF BAD POINTER
          LDD    CN+3
          LPN    37
          STD    CN+3
          SBD    .FT         CHECK AGAINST FIRST
          SHN    14
          ADD    CN+4
          SBD    .FT+1
          MJN    SFP1        IF IN/OUT .GE. FIRST
          LDD    CN+3
          SBD    .LM
          SHN    14
          ADD    CN+4
          SBD    .LM+1
          PJN    SFP1        IF IN/OUT NOT .LT. LIMIT
          LDN    0
          UJN    SFPX        RETURN
 TRB      SPACE  4,25
          IFEQ   TE,1        IF SAVING TRACE INFORMATION
**        TRB - TRACE BUFFER.
*
*         THE TRACE BUFFER STARTS AT BYTE ADDRESS 2000000(16).  A
*         MODIFICATION TO *STL* AND SEVERAL OTHER DECKS MUST BE
*         EDITED ONTO THE DEADSTART TAPE TO DISABLE MEMORY BOUNDS
*         CHECKING.  THE TRACE IS UPDATED WITH EACH CALL TO
*         *CPP* AND CONSISTS OF 2 CP WORDS PER TRACE AS FOLLOWS.
*         LOCATION 10 IS THE POINTER TO THE TRACE BUFFER.  A MAXMIMUM
*         OF 16 MB WILL BE STORED IN THE TRACE BUFFER.  THE BUFFER
*         WILL NOT WRAP.  TO RESTART THE TRACE, JUST CLEAR LOCATION
*         10.
*
*         0 - 12/EO, 12/FN, 12/BL+1, 12/DS, 12,EC
*         1 - 12/PA, 12/PB, 12/HP, 12/MD, 12/FM
*
*         NOTE - THIS CODE IS ONLY FOR CHECKOUT.
*
*         USES   T1 - T7.
 
 
 TRB      SUBR               ENTRY/EXIT
          LDD    HP
          SHN    21-7
          PJN    TRBX        IF NOT CTS
          SRD    T1          SAVE R REGISTER
          LDN    10
          CRD    T3
          LDD    T3
          ZJN    TRB1        IF TRACE NOT STARTED
          LPN    10
          NJN    TRBX        IF TRACE BUFFER FULL
          UJN    TRB2        MOVE EST ORDINAL
 
 TRB1     LDN    20          INITIALIZE TRACE START ADDRESS
          STD    T3
          LDN    0
          STD    T4
          STD    T5
 TRB2     LRD    T3
          LDD    EO          EST ORDINAL
          STM    TRBB
          LDD    FN          FUNCTION NUMBER
          STM    TRBB+1
          LDD    BL+1        RIGHT-MOST 12 BITS OF BLOCK NUMBER
          STM    TRBB+2
          LDD    DS          GENERAL STATUS
          STM    TRBB+3
          LDD    EC          ERROR CODE
          STM    TRBB+4
          LDD    PA          PARAMETER
          STM    TRBB+5
          LDD    PB          PARAMETER
          STM    TRBB+6
          LDD    HP          HARDWARE OPTIONS
          STM    TRBB+7
          LDD    MD          MODES
          STM    TRBB+10
          LDD    FM          FORMAT
          STM    TRBB+11
          LDN    2
          STD    T6
          LDD    T5
          LMC    400000
          CWM    TRBB,T6
          LDN    2
          RAD    T5
          SHN    -6
          RAD    T4
          SHN    -14
          RAD    T3
          LDD    T5
          LPN    77
          STD    T5
          LDN    10
          CWD    T3          UPDATE POINTER TO TRACE BUFFER
          LRD    T1          RESTORE R REGISTER
          LJM    TRBX        RETURN
 
 
 TRBB     BSS    12
          ENDIF
 CCD      SPACE  4,15
**        CCD - CHECK CODED REQUEST AND BUILD FORMAT PARAMETERS.
*
*         ENTRY  (SC) = FUNCTION TABLE ENTRY WHEN CALLED FROM RESIDENT.
*
*         EXIT   UNIT FORMAT PARAMETERS BUILT.
*                CORRECT BID ACCUMULATION LOOP MOVED TO RESIDENT.
*                UNIT CONNECTED OR FORMATED IF NECESSARY.
*                BLOCKS TO TRANSFER BEFORE DROP OUT SET FOR CTS.
*
*         USES   T1, T2, T3.
*
*         CALLS  CUI, DDR, /PRESET/RCU.
 
 
 CCD      SUBR               ENTRY/EXIT
          LDD    MD
          SHN    21-6
          PJN    CCD1        IF NOT CODED OPERATION
          LDD    FM
          SHN    -6
          LMN    /MTX/TFSI
          NJN    CCD1        IF NOT SI FORMAT
          LDD    FN
          LMN    /MTX/RLA
          ZJN    CCD1        IF READ LABEL
          LMN    /MTX/WLA&/MTX/RLA
          NJN    CCD3        IF READ, WRITE OR SKIP
 CCD1     LDD    HP
          SHN    21-7
          PJP    CCD6        IF NOT CTS
          LDC    -BLKC
          STM    CDOC        BLOCKS TO TRANSFER BEFORE DROP OUT
 
*         THE BLANK COMMAND WRITES LABELS WITH AN S FORMAT CODED
*         OPERATION.  THE CTS SUBSYSTEM DOES NOT SUPPORT CODE
*         CONVERSION, SO THE DRIVER DOES SOFTWARE CONVERSION.
 
          LDD    MD
          SHN    21-6
          PJN    CCD4        IF NOT CODED
          LDD    FN
          SBN    /MTX/RDF
          ZJN    CCD2        IF READ
          SBN    /MTX/WTF-/MTX/RDF
          NJN    CCD4        IF NOT WRITE
 CCD2     LDD    FM
          SHN    -6
          LMN    /MTX/TFS
          ZJN    CCD4        IF S FORMAT
 CCD3     LDN    /MTX/SCI    CODED I/O NOT SUPPORTED
          LJM    RET3        RETURN ERROR CODE
 
 CCD4     LDM    CPP
          LMC    PNRI
          NJN    CCD4.1      IF NOT CALLED FROM MAIN PROGRAM
          LDD    FN
          LMN    /MTX/WTF
          NJN    CCD5        IF NOT DATA WRITE
          LDD    SP
          LPC    100
          ZJN    CCD5        IF COMPRESSED MODE WRITE NOT SELECTED
          SHN    7-6
          RAM    /PRESET/CCUA  SET COMPRESSED MODE
          ERRNZ  F0220-F0020-200
          UJN    CCD4.2      RECONNECT UNIT AND SET COMPRESSED MODE
 
 CCD4.1   LDM    RELA
          NJN    CCD5        IF CONNECTED
 CCD4.2   RJM    /PRESET/RCU RECONNECT UNIT
 CCD5     UJP    CCDX        RETURN
 
*         REBUILD FORMAT PARAMETERS.
 
 CCD6     LDM    CPP
          LMC    //PNRI
          ZJN    CCD8        IF CALLED FROM RESIDENT
 CCD7     LDM    RELA        CHECK IF CONNECTED
          NJN    CCD5        IF CONNECTED
          LJM    CCD14       RECONNECT UNIT
 
 CCD8     LDD    SC
          SHN    21-5
          PJN    CCD7        IF FUNCTION DOES NOT REQUIRE UNIT FORMATED
          LDD    HP
          SHN    21-10
          PJN    CCD9        IF NOT ISMT DEVICE
          LDC    -BLKX       BLOCKS TO TRANSFER BEFORE DROPOUT (ISMT)
          STM    CDOC
 CCD9     RJM    DDR         SET DIRECTION FOR BID ACCUMULATION
          LDC    LDNI+2      SET TO INPUT 2 WORDS OF DETAILED STATUS
          STM    //STWE
          LDM    MTSF        BUILD FORMAT PARAMETERS
          LPC    4237
          STM    MTSF
          LDM    MTSF+1
          LPC    6740
          STM    MTSF+1
          LDD    HP          PRESET A/D MODE FOR BINARY
          LPN    1
          SHN    5           SET PACKED MODE FOR 9 TRACK
          STD    T1
          LDD    MD          CHECK FOR CODED OPERATION
          SHN    21-6
          MJN    CCD10       IF CODED
          LDD    T1
          NJN    CCD12       IF NOT 7 TRACK
          LDC    3400        SET CONVERSION TABLE 7
          STD    T1
          UJN    CCD12       SET NOISE SIZE
 
 CCD10    LDD    T1          SET EVEN PARITY IF 7 TRACK
          LMN    40
          SHN    4
          RAM    MTSF+1
          LDM    DNCV        SET CONVERSION TABLE
          LPN    7
          ZJN    CCD12       IF NO CONVERSION REQUEST
          SBN    1
          ZJN    CCD11       IF BCD TYPE
          SBN    4-1
 CCD11    ADN    3
          SHN    10
          STD    T1
 CCD12    LDD    T1
          RAM    MTSF
          LDD    FM          SET NOISE SIZE
          LPN    37
          STD    T2
          SHN    1           NB*2
          STD    T3
          LDD    HP
          LPN    1
          ZJN    CCD13       IF 7 TRACK
          LDD    T2
          ADD    T3          NB*3
          SHN    -1          (NB*3)/2
          STD    T3
 CCD13    LDD    FM          ADJUST NOISE SIZE IF FILL STATUS
          LPN    40
          SHN    -5
          STD    T1
          LDD    T3
          SBD    T1
          RAM    MTSF+1
          LDD    HP
          LPN    40
          NJN    CCD14       IF MTS CONTROLLER
          LDC    4000
          STM    MTSF+2
          LDM    DNCV
          LPN    70
          LMN    /MTX/D62*10
          NJN    CCD14       IF NOT 6250 CPI
          LDD    FN          CHECK FUNCTION IN PROGRESS
          SBN    /MTX/WTF
          MJN    CCD14       IF NOT WRITE OPERATION
          LDD    SP          SET ERROR CORRECTION ENABLE/DISABLE (ATS)
          LPC    100
          SHN    4
          RAM    MTSF+2
 CCD14    LDN    0           CLEAR CONNECTED FLAG
          STM    //RELA
          RJM    CUI         FORMAT UNIT
          LJM    CCDX        RETURN
 DDR      SPACE  4,10
**        DDR - DETERMINE DIRECTION FOR BID ACCUMULATION.
*
*         ENTRY  (MD, 12 - 13) = 0 IF FORWARD DIRECTION.
*
*         EXIT   CORRECT BID ACCUMULATION ROUTINE MOVED TO RESIDENT.
*
*         USES   T1, T2.
 
 
 DDR      SUBR               ENTRY/EXIT
          LDD    MD
          SHN    -12
          ZJN    DDR1        IF FORWARD DIRECTION
          LDC    DDRB-DDRA   SET REVERSE DIRECTION TABLE
 DDR1     ADC    DDRA
          STD    T1
          LDI    T1
          LMM    //UBWA
          ZJN    DDRX        IF CORRECT ROUTINE LOADED
          LDN    0
          STD    T2
 DDR2     LDI    T1          MOVE CODE
          STM    UBWA,T2
          AOD    T1
          AOD    T2
          LMN    //UBWAL
          NJN    DDR2        IF MORE CODE TO MOVE
          UJN    DDRX        RETURN
 
 
 DDRA     BSS    0           CODE FOR FORWARD ACCUMULATION
          LOC    //UBWA
          AOD    WP
          LPN    7
          STD    WP
          LDM    UBWB
          STM    BIDW,WP
          LOC    *O
 DDRAL    EQU    *-DDRA      LENGTH OF OVERLAID CODE
 
          ERRNZ  //UBWAL-DDRAL  OVERLAID CODE NOT CORRECT LENGTH
 
 DDRB     BSS    0           CODE FOR REVERSE ACCUMULATION
          LOC    //UBWA
          LDN    4           SET UNAVAILABLE BID
          STM    BIDW,WP
          SOD    WP
          PJN    UBWX        IF NO UNDERFLOW
          LDN    7           RESET POINTER
          STD    WP
          LOC    *O
 DDRBL    EQU    *-DDRB
 
          ERRNZ  //UBWAL-DDRBL  OVERLAID CODE NOT CORRECT LENGTH
 
 
          USE    BUFFER
 
          ERRNG  2*473+ERLA+5-*  CPP OVERFLOW
          OVERLAY (USER JOB OPERATIONS.)
 PFN      SPACE  4,20
**        PFN - PROCESS FUNCTION REQUESTED.
*
*T,       12/ 1,12/ PFN,12/ 0,12/ PARAM,12/ FC
*
*         FC     FUNCTION CODE (SEE *COMSMTX*).
 
 
          ENTRY  PFN
 PFN      LDD    PB
          SBN    TFCNL
          MJN    PFN1        IF VALID FUNCTION
          RJM    HNG         HANG PP
 
 PFN1     LDM    TFCN,PB     SET PROCESSOR ADDRESS
          STM    PFNA
          LJM    *           PROCESS FUNCTION
 PFNA     EQU    *-1
          SPACE  4,10
**        TFCN - TABLE OF FUNCTION PROCESSORS.
 
 
 TFCN     INDEX
          INDEX  /MTX/FNRW,RUL    REWIND
          INDEX  /MTX/FNUL,RUL    UNLOAD
          INDEX  /MTX/FNSD,SDF    SET DENSITY IN UNIT FORMAT PARAMETERS
          INDEX  /MTX/FNMX        TERMINATE TABLE
 TFCNL    EQU    *-TFCN
 RUL      SPACE  4,10
**        RUL - REWIND OR UNLOAD UNIT.
*
*         CALLS  REU, RBL, WNB.
 
 
 RUL      BSS    0           ENTRY
          RJM    WNB         WAIT NOT BUSY
          LDD    HP
          SHN    21-7
          PJN    RUL1        IF NOT CTS UNIT
          RJM    RBL         READ BUFFERED LOG
 RUL1     LDD    PB
          LMK    /MTX/FNRW
          ZJN    RUL2        IF REWIND
          LDN    1           SET UNLOAD
 RUL2     RJM    REU         REWIND OR UNLOAD UNIT
          LJM    RET1        RETURN
 SDF      SPACE  4,10
**        SDF -  SET DENSITY IN UNIT FORMAT PARAMETERS.
 
 
 SDF      BSS    0           ENTRY
          LDD    HP
          SHN    21-7
          MJP    RET1        IF CTS UNIT
          LDM    MTSF+1
          LPC    7477
          STM    MTSF+1
          LDD    HP
          SHN    21-5
          MJN    SDF1        IF MTS CONTROLLER
          SHN    21-0-21+5
          MJN    SDF1        IF 9 TRACK
          LDM    DNCV        SET ATS 7 TRACK DENSITY
          SHN    -3
          LPN    7
          LMN    3
          UJN    SDF3        STORE DENSITY IN FORMAT PARAMETER
 
 SDF1     LDM    DNCV
          SHN    -3
          LPN    7
          SBN    /MTX/D02
          ZJN    SDF2        IF 200 BPI
          SBN    5-1
 SDF2     ADN    3
 SDF3     SHN    6
          RAM    MTSF+1
          LJM    RET1        RETURN
 SED      SPACE  4,10
**        SED - SET EQUIPMENT DEFINITIONS.
*
*         CALLS  DTS, LWR, REU, SDS, UAD.
*
*         MACROS MONITOR, SFA.
 
 
          ENTRY  SED
 SED      SFA    EST,EO      SET EST ADDRESS
          ADK    EQDE        GET EQUIPMENT PARAMETERS
          CRD    CN
          LDD    HP
          SHN    21-7
          MJN    SED1        IF CTS UNIT
          RJM    DTS         GET DETAILED STATUS
          LDM    MTSF
          NJN    SED1        IF NOT FIRST TIME PROCESSING
          LDD    CN+4
          LPN    37          UNIT NUMBER
          ADC    4220
          STM    MTSF        SET FORMAT FLAGS AND UNIT NUMBER
 SED1     LDD    DS
          SHN    21-0
          PJN    SED3        IF NOT READY
          SHN    21-1-21+22
          PJN    SED2        IF NOT BUSY
          LJM    RET2        RETRY
 
*         FORCE TAPE TO LOAD POINT.
 
 SED2     LPN    1
          NJN    SED3        IF AT LOAD POINT
*         LDN    0           SET REWIND
          RJM    REU         REWIND UNIT
          LDN    /MTX/RBS    REQUEUE ON UNIT BUSY
          LJM    RET5        EXIT
 
*         PRESET MTS/ATS UNIT.
 
 SED3     LDD    HP
          SHN    21-7
          MJP    SED7        IF CTS UNIT
          LDD    HP
          LPC    760         MASK CONTROLLER TYPE BITS
          STD    HP
          LPN    20
          ZJN    SED4        IF NOT ATS UNIT
          LDC    7440        MODIFY INSTRUCTIONS
          STM    SEDA
          LDM    ATUS        DETERMINE IF GCR UNIT
          SHN    1
          LPN    20
          STD    CM+4
          SHN    -3
          RAD    HP
          LDD    CN          ENSURE CORRECT *GCR* SETTING IN EST ENTRY
          LPN    20
          LMD    CM+4
          ZJN    SED4        IF NO CHANGE IN EST ENTRY
          LCN    20          SET MASK FOR GCR FLAG
          STD    CM+3
          LDD    EO          SET EQUIPMENT NUMBER
          STD    CM+1
          LDN    /CPS/SB0S   CHANGE BYTE 0 OF EST ENTRY
          STD    CM+2
          MONITOR  SEQM
 SED4     LDM    MTSF
          LPC    4237
          STM    MTSF
          LDC    7540
*         LDC    7440        (ATS CONTROLLER)
 SEDA     EQU    *-1
          STM    MTSF+1
          LDD    DS
          SHN    -6
          LPN    1           SET 7/9 TRACK OPTION
          RAD    HP
          LPN    1
          ZJN    SED5        IF 7 TRACK
          LDC    6640        SET 1600 BPI
          STM    MTSF+1
          LDC    400-1400    SELECT ANSI CONVERSION
 SED5     ADC    1400        SELECT BCD CONVERSION
          RAM    MTSF
          LDD    HP
          SHN    21-4
          PJN    SED6        IF NOT ATS UNIT
          RJM    LWR         CHECK LOOP WRITE TO READ
 SED6     RJM    SDS         SET DRIVE SPEED
          LDD    DS          SET EST DEVICE TYPE
          LPC    100
          ADC    2RMT
          STD    CM+3        SET CORRECT DEVICE MNEMONIC
          LMD    CN+3
          ZJN    SED7        IF NO MNEMONIC CHANGE
          LDD    EO          SET EQUIPMENT NUMBER
          STD    CM+1
          LDN    /CPS/SMNS   CHANGE EQUIPMENT MNEMONIC IN EST
          STD    CM+2
          MONITOR  SEQM
          LDD    LT          TOGGLE BIT 1 OF DEVICE TYPE
          LMC    400
          ERRNZ  /MTX/DVMT
          ERRNZ  /MTX/DVNT-2
          STD    LT
 
*         PRESET UDT.
 
 SED7     LDN    0
          STD    BL
          STD    BL+1
          STD    UP
          STD    LG
          STD    LG+1
          STD    EP
          STD    EP+1
          STD    SP
          STD    WC
          STD    OV
          LDD    HP
          SHN    21-7
          PJN    SED8        IF NOT CTS UNIT
          LDN    0
          STD    WP
 SED8     LDC    /MTX/TFF*100+4  SET FORMAT/NOISE FOR LABEL CHECK
          STD    FM
          LDD    LT
          LPC    700
          LMC    2000        SET LABELED FOR LABEL CHECK
          STD    LT
          SHN    -7
          LPN    3           TAPE DEVICE TYPE
          STD    T1
          LDM    TDCV,T1     SET INITIAL DENSITY AND CONVERSION MODE
          STM    DNCV
          RJM    UAD         UPDATE *UST4* PARAMETERS
          ADN    /MTX/UST4
          CWD    LT
          LDD    DS          CHECK READY STATUS
          LPN    1
          NJN    SED9        IF UNIT READY
          LDN    /MTX/FRJ    SET TO NOT ATTEMPT LABEL SCAN
          LJM    RET3        RETURN ERROR CODE
 
 SED9     LJM    RET1        RETURN
 TDCV     SPACE  4,10
**        TDCV - TABLE OF INITIAL DENSITY AND CONVERSION MODES.
*
*         INDEXED BY TAPE DEVICE TYPE.
*
*         ENTRY  FORMAT -
*
*         6/0,3/ DN,3/ CV
*
*                DN = INITIAL DENSITY.
*                CV = INITIAL CONVERSION MODE.
 
 
 TDCV     INDEX
          INDEX  /MTX/DVMT,/MTX/D08*10+/MTX/BCD
          INDEX  /MTX/DVCT,/MTX/D380*10+/MTX/ANS
          INDEX  /MTX/DVNT,/MTX/D16*10+/MTX/ANS
          INDEX  /MTX/DVAT,/MTX/D380*10+/MTX/ANS
          INDEX  /MTX/DVMX
          TITLE  SUBROUTINES.
 LWR      SPACE  4,15
**        LWR - TEST WRITE/READ PATH TO ATS UNIT.
*
*         ENTRY  (DS) = GENERAL STATUS.
*                (ATUS - ATUS+5) = UNIT STATUS.
*
*         EXIT   TAPE UNLOADED AND UNIT DOWNED IF LOOP WRITE/READ TEST
*                  FAILURE.
*
*         USES   CM+1, CM+2.
*
*         CALLS  CUI, DTS, *EMM*, ERR, FCR, REU, STW, UAD.
*
*         MACROS CALL, MONITOR.
 
 
 LWR7     LCN    /MTX/MOF-/MTX/CRJ  ALTER ERROR FOR CONNECT REJECT
          RAM    LWRA
          LJM    LWR5        *OFF* UNIT
 
 LWR      SUBR               ENTRY/EXIT
          LDD    DS          SAVE STATUS FOR POSSIBLE MESSAGE
          STM    //STER
          LPN    3
          LMN    1
          NJN    LWRX        IF UNIT NOT READY
 
*         RECHECK UNIT STATUS FOR MDI ERRORS. THESE ERRORS
*         MAY HAVE BEEN IGNORED AT INITIAL CONNECT TIME.
*         IF ANY ERRORS ARE PRESENT, PROCESS AS IF CONNECT REJECT.
 
          RJM    DTS         GET UNIT STATUS
          LDM    MTDS        CHECK STATUS
          SHN    21-12
          PJN    LWR2        IF NO UNIT CHECK
          LDM    ATUS+1
          LPC    216         LAMP,DSE,ERASE CURRENT,AIR PRESS. FAILURE
          NJN    LWR7        IF ERRORS OTHER THAN RESET OR LOAD CHECK
          LDM    ATUS+2
          LPN    30          AIR FLOW,THERMAL FAILURE
          NJN    LWR1        IF MDI ERRORS
          LDM    ATUS
          SHN    21-6
          PJN    LWR2        IF NO WRITE CURRENT FAILURE
 LWR1     LJM    LWR7        PROCESS CONNECT REJECT
 
*         ISSUE LOOP WRITE TO READ FUNCTION TO UNIT.
 
 LWR2     LDM    ATUS+2      GET DETAIL STATUS WORD 13
          LPN    34          AIR FLOW,THERMAL,CLEANER NOT PARKED
          ZJN    LWR2.1      IF NO PROBLEM
          LPN    30          AIR FLOW,THERMAL FAILURE
          NJN    LWR1        IF MDI PROBLEM
          LDN    /MTX/TCF-/MTX/MOF  ALTER ERROR FOR TAPE CLEANER FAULT
          RAM    LWRA
          LJM    LWR4        PROCESS CLEANER NOT PARKED
 
 LWR2.1   LDN    0
          STM    //RELA
          RJM    CUI         INSURE UNIT FORMATED
          LDM    MTDS+5
          SHN    21-7
          MJN    LWR4        IF WRITE CURRENT ON
          LDC    175         SET LOOP WRITE TO READ (LWR) MODE
          RJM    FCR
          NJN    LWR4        IF FUNCTION REJECT
          LDN    50          ISSUE WRITE FUNCTION
          RJM    FCR
          NJN    LWR4        IF FUNCTION REJECT
          ACN    CH          OUTPUT DATA
          LDD    HN
          OAM    BFMS,CH
          FJM    *,CH
          NJN    LWR3        IF ABNORMAL TERMINATION
          DCN    CH+40
 LWR3     LDN    0           GET STATUS
          RJM    STW
          STM    //STER      SAVE STATUS FOR POSSIBLE MESSAGE
          SHN    21-13
          MJN    LWR4        IF ALERT SET
          LJM    LWRX        RETURN
 
 LWR4     LDN    1           UNLOAD TAPE
          RJM    REU
 LWR5     LDD    EO
          STD    CM+1
          LDN    /CPS/DWES   SET DOWN STATUS
          STD    CM+2
          MONITOR SEQM       SET EQUIPMENT PARAMETER
 LWRA     LDN    /MTX/MOF    ISSUE MESSAGE AND ABORT
*         LDN    /MTX/CRJ    (CONNECT REJECT)
*         LDN    /MTX/TCF    (TAPE CLEANER FAULT)
          RJM    ERR
 RLB      SPACE  4,15
**        RBL - READ BUFFERED LOG.
*
*         EXIT   RECOVERED ERROR COUNTS UPDATED.
*
*         USES   T1, T3.
*
*         CALLS  ERR, /PRESET/GPS, /PRESET/ICF.
 
 
 RBL      SUBR               ENTRY/EXIT
          LDK    F0312
          RJM    /PRESET/ICF ISSUE READ BUFFERED LOG FUNCTION
 RBL1     ACN    CH
          LDN    32D
          IAM    RBLA,CH
          STD    T3          WORDS NOT TRANSFERRED
          SFM    RBL3,CH     IF CHANNEL PARITY ERROR
 RBL2     LDN    0
          RJM    /PRESET/GPS GET AND PROCESS GENERAL STATUS
          MJN    RBL1        IF COMMAND RETRY
          LDD    T3
          ZJN    RBL4        IF ALL BUFFERED LOG DATA RECEIVED
 RBL3     LDN    /MTX/CMF
          RJM    ERR         PROCESS ERROR (NO RETURN)
 
*         INCREMENT WRITE ERROR COUNTER.
 
 RBL4     LDM    RBLA+2
          LPN    17
          SHN    14
          ADM    RBLA+3      TEMPORARY WRITE DATA CHECKS
          RAM    ECNT+2
          SHN    -14
          RAM    ECNT+1
          LDM    RBLA+6
          SHN    -4
          STD    T1
          LDM    RBLA+5
          LPC    377
          SHN    10
          ADD    T1          WRITE BLOCKS CORRECTED WITHOUT ERPA
          RAM    ECNT+2
          SHN    -14
          RAM    ECNT+1
 
*         INCREMENT READ ERROR COUNTER.
 
          LDM    RBLA+1
          SHN    -10
          SHN    16
          ADM    RBLA
          SHN    4           TEMPORARY READ DATA CHECKS
          RAM    ECNT+4
          SHN    -14
          RAM    ECNT+3
          LDM    RBLA+5
          SHN    -10
          SHN    16
          ADM    RBLA+4
          SHN    4           READ BLOCKS CORRECTED WITHOUT ERPA
          RAM    ECNT+4
          SHN    -14
          RAM    ECNT+3
          LJM    RBLX        RETURN
 
 
 RBLA     BSS    32D         BUFFERED LOG DATA
 WNB      SPACE  4,10
**        WNB - WAIT NOT BUSY AND CHECK READY.
*         IF UNIT IS BUSY, THE REQUEST IS REQUEUED.
*         IF UNIT NOT READY AFTER TIMEOUT, EXIT WITH READY DROP.
*
*         ENTRY  (DS) = GENERAL STATUS.
*
*         CALLS  /PRESET/GPS, STW.
 
 
 WNB1     LDD    HN          SET DELAY
          STM    WNBA
 WNB2     LDD    DS
          LPN    1
          NJN    WNBX        IF UNIT READY
          LDD    HP
          SHN    21-7
          PJN    WNB4        IF NOT CTS
 WNB3     LDN    0           WAIT FOR END OF OPERATION
          RJM    /PRESET/GPS GET AND PROCESS CTS GENERAL STATUS
          MJN    WNB3        IF RETRY OCCURRED
          UJN    WNB5        CHECK TIMEOUT
 
 WNB4     LDN    0
          RJM    STW         GET DEVICE STATUS
 WNB5     SOM    WNBA
          NJN    WNB2        IF NOT TIMEOUT
          LDN    /MTX/RDR    READY DROP
          LJM    RET3        RETURN ERROR CODE
 
 WNB      SUBR               ENTRY/EXIT
          LDD    DS
          LPN    2
          ZJN    WNB1        IF NOT BUSY
          LDN    /MTX/RBS    REQUEUE ON UNIT BUSY
          LJM    RET5        EXIT
 
 
 WNBA     BSS    1
          TITLE  HARDWARE SUBROUTINES.
 FCR      SPACE  4,10
**        FCR - PROCESS FUNCTION.
*
*         ENTRY  (A) = FUNCTION.
*
*         EXIT   (A) = 0, IF NO EXTERNAL REJECT.
*
*         CALLS  STC.
 
 
 FCR      SUBR               ENTRY/EXIT
          ADM    FCNA        ADD EQUIPMENT NUMBER FOR ATS/MTS
          FAN    CH          FUNCTION EQUIPMENT
          STM    FCRA        SAVE FUNCTION
          RJM    STC         STATUS CHANNEL
          UJN    FCRX        RETURN
 
 
 FCRA     CON    0
 REU      SPACE  4,10
**        REU - REWIND/UNLOAD.
*
*         ENTRY  (A) = 0, REWIND.
*                (A) = 1, UNLOAD.
*
*         EXIT   BID WINDOW SET TO UNAVAILABLE.
*
*         CALLS  FCN, /PRESET/GPS, STW.
 
 
 REU      SUBR               ENTRY/EXIT
          SHN    6
          ADN    F0010       ISSUE REWIND/UNLOAD
          ERRNZ  F0110-F0010-100
          RJM    FCN
          LDD    HP
          SHN    21-7
          MJN    REU2        IF CTS
          LDN    0           GET DEVICE STATUS
          RJM    STW
          LDN    10          RESET BID WINDOW
          STD    WP
 REU1     LDN    4
          STM    BIDW-1,WP
          SOD    WP
          NJN    REU1        IF MORE BYTES TO SET
          UJN    REU3        CLEAR BLOCK AND PRU COUNTER
 
 REU2     LDN    0           WAIT FOR END OF OPERATION
          RJM    /PRESET/GPS GET AND PROCESS CTS GENERAL STATUS
          MJN    REU2        IF RETRY
 REU3     LDN    0           CLEAR BLOCK AND PRU COUNTER
          STD    BL
          STD    BL+1
          STD    EP          CLEAR ERROR PARAMETERS
          STD    EP+1
          STD    EI
          LDD    HP
          SHN    21-7
          PJN    REU4        IF NOT CTS UNIT
          LDN    0
          STD    WP
 REU4     LDD    UP          SET LAST BLOCK EOR/EOF
          SCN    10
          LMN    10
          STD    UP
          UJP    REUX        RETURN
 SDS      SPACE  4,25
**        SDS - SET DRIVE SPEED FOR MTS/ATS UNITS.
*
*         EXIT   (HP, 2-3) = DRIVE SPEED.
*                FOR ATS AND MTS.
*                0 = 100 IPS DRIVE.
*                1 = 150 IPS DRIVE.
*                2 = 200 IPS DRIVE.
*
*                FOR FSC.
*                0 =  75 IPS DRIVE.
*                1 = 125 IPS DRIVE.
*                2 = 200 IPS DRIVE.
*
*                FOR CMTS.
*                2 = 200 IPS DRIVE.
*
*                FOR ISMT.
*                3 = 25 IPS DRIVE.
*
*                FOR CTS.
*                0 = 79 IPS DRIVE.
*
*         USES   T1.
 
 
 SDS1     LPN    12
          ZJN    SDS2        IF NOT FSC/CMTS/ISMT
          LPN    10
          ZJN    SDS1.1      IF NOT ISMT
          LDN    3
          UJN    SDS3        SAVE INDEX FOR ISMT
 
 SDS1.1   LDM    ATUS        SET FSC/CMTS DRIVE SPEED
          LPN    7
          SBN    3
          PJN    SDS3        IF *STC* HAS VALID UNIT SPEED STATUS
          UJN    SDSX        SET DEFAULT DRIVE SPEED TO 75 IPS
 
 SDS2     LDM    ATUS        SET ATS DRIVE SPEED
          SHN    -1
          LPN    3
          SBN    1
          ZJN    SDS3        IF 100 IPS UNIT
          LMN    3
 SDS3     STD    T1          SAVE INDEX
          LDM    SDSA,T1     SET SPEED
          RAD    HP
 
 SDS      SUBR               ENTRY/EXIT
          LDD    HP
          SHN    21-4
          MJN    SDS1        IF ATS-TYPE UNIT
          LDM    MTDS+4      SET MTS DRIVE SPEED
          SHN    -11
          LPN    3
          UJN    SDS3        SET SPEED
 
 
 SDSA     BSS    0
          CON    0           100 IPS DRIVE
          CON    4           150 IPS DRIVE
          CON    10          200 IPS DRIVE
          CON    14          25 IPS DRIVE (ISMT)
 
 
          USE    BUFFER
 
 TADD     TSAD               ADDRESS TABLE
 
 
          ERROVL
 PRS      SPACE  4,10
**        PRS - PRESET.
*
*         CALLS  MCH.
 
 
 PRS      LDC    CTAB        MODIFY CHANNELS
          RJM    MCH
          LDD    HP
          SHN    21-7
          MJN    PRS1        IF CTS UNIT
          LDN    F0040       SET READ FUNCTION FOR MESSAGE
          STM    ITMA
 PRS1     LDC    TADD
          STD    CN
          LJM    PRSX        EXIT
 CTAB     CHTB               CHANNEL TABLE
          OVERLAY (READ FUNCTION PROCESSOR.),,,READ
 
 .IM      SET    2           GENERATE ADDRESSES FOR OVERLAYS
 STAP     EQU    PRSX        STATUS PRIOR TO READ
 SKEI     EQU    PRSX+1      IF .NE. 0, SKIPEI OR POSMF IN PROGRESS
 WOCN     EQU    PRSX+2      WORD COUNT AT START OF OPERATION
 ISKR     EQU    PRSX+3      IF .NE. 0, SKIP REVERSE INSTEAD OF READ
                              REVERSE
 RDF      SPACE  4,10
**        RDF - PROCESS READ OPERATION.
*
*         CALLS  FCN, ITM, MRD, TDA.
 
 
          ENTRY  RDF
 RDF      LDC    6           SELECT CLIP LEVEL
 RDFA     EQU    *-1
 RDFB     RJM    FCN
*         UJN    *+2         (NORMAL CLIP LEVEL)
*         UJN    *+2         (CTS)
          RJM    ITM         INITIATE TAPE MOTION
 RDF1     LDD    DS          SAVE DEVICE STATUS
          STM    STAP
          RJM    MRD         READ TAPE
 RDFC     RJM    TDA         TRANSFER DATA
*         LJM    SKP2        (SKIP FORWARD)
*         LJM    SKR4        (SKIP REVERSE)
*         LJM    RLA6        (READ CTS LABELS)
*         LJM    RLA6.1      (READ NON CTS LABELS)
*         LJM    CLA4        (LABEL ERROR PROCESSING)
 RDFD     UJN    RDF1        LOOP
*         UJN    RDF         (200 IPS/9 TRACK OR 6250 BPI AT 1X PPU
*                            SPEED OR 6250 BPI 200 IPS 2X PPU SPEED)
          TITLE  READ - SUBROUTINES.
 MRD      SPACE  4,10
**        MRD - READ TAPE.
*         NO MODIFICATIONS SHOULD BE MADE WITHOUT CHECKING IMPACT ON
*         LONG BLOCK PROCESSING.  IF CTS, THE FOLLOWING CODE IS
*         OVERLAYED WITH *RCT*.
*
*         EXIT   (TB) = TERMINATION STATUS.
*
*         CALLS  BCW, CDO, DTS, FCN, MCC, PDA, STW, UBW, VDA, WEO.
*
*         MACROS SADT.
 
 
 MRD      SUBR               ENTRY/EXIT
          LDN    0           CLEAR ERROR CODE
          STD    EC
          STD    TB          CLEAR TYPE OF BLOCK
 
*         INPUT DATA BLOCK.
 
          STM    MRDP        CLEAR NOISE FLAG
 MRD1     LDC    5005        SET BYTE COUNT FOR I FORMAT READ OR SKIP
 MRDA     EQU    *-1
*         LDC    LBBY        (READ LONG BLOCK FULL CHUNK)
*         LDC    WC*5+1      (ALL OTHER READ DATA OPERATIONS)
*         LDC    LABL+1      (READ LABELS)
*         LDC    5001        (SKIP - NOT LONG BLOCKS)
*         LDC    LBBY        (SKIP L FORMAT OR LONG BLOCK F FORMAT)
*         LDC    SLBY        (SKIP LI FORMAT)
 MRD3     IAM    BUF,CH      INPUT DATA
 MRDB     EQU    *-1
*         IAM    BUFB,CH     (READ LONG BLOCK)
*         IAM    /RLA/BUF    (READ LABEL)
 MRD4     STD    T1
          NJN    MRD6        IF NOT EXCESS BLOCK LENGTH
          LJM    *+2
*         LJM    /RLB/RLB5   (READ LONG BLOCKS)
*         LJM    /RLB/RLB4   (READ LONG BLOCKS - CYBER 180)
*         LJM    /SKP/SLB    (SKIP LONG BLOCKS)
 MRDC     EQU    *-1
 MRD4.1   LDN    /MTX/BTL    SET BLOCK TOO LONG
 MRD5     RJM    MCC         MASTER CLEAR CHANNEL
*         LDN    0
          RJM    STW         GET GENERAL STATUS
          LDN    1           SET TO COMPUTE MAXIMUM BYTE COUNT
          STD    T1
 MRD6     LDM    MRDA        CALCULATE REMAINDER OF CM WORD COUNT
          SBD    T1
          STD    BY          BYTE COUNT READ
          STD    SC          SAVE ORIGINAL BYTE COUNT
          ZJN    MRD7        IF NO DATA READ
 MRDD     SBN    2           I FORMAT
*         PSN                (SI FORMAT)
*         ADN    4           (ALL OTHER FORMATS)
          STD    T2
 
*         CALCULATE WORD COUNT.
 
          SHN    1           13*BYTES
          ADD    T2
          SHN    2
          ADD    T2
          SHN    14  (-6)    (13*BYTES)/64
          STD    T0
          SHN    6+2         4*13*BYTES  (52*BYTES)
          SBD    T2          51*BYTES
          ADD    T0          (51*BYTES)+((13*BYTES)/64)
          SHN    -8D         WORDS = ((51*BYTES)+((13*BYTES)/64))/256
 MRD7     STD    WC
 MRDE     LPN    3
*         LPN    1           (ATS UNIT)
 MRDF     UJN    MRD9        7 TRACK AND 9 TRACK CODED
*         ZJN    MRD9        (9 TRACK I FORMAT)
          LMN    1
          NJN    MRD8        IF NOT MODULO 4, 1
 MRDG     SOD    BY
*         PSN                (ATS UNIT)
 MRD8     SOD    BY
 
*         CHECK AND CONVERT DATA.
 
 MRD9     LDD    EC
          LMN    /MTX/BTL
          ZJN    MRD10       IF BLOCK TOO LARGE ERROR
          RJM    VDA         VALIDATE DATA (I FORMAT)
 MRDH     EQU    *-2
*         UJN    *+2         (ALL OTHERS)
          RJM    CDO         CHECK DROP OUT FLAG
 
*         PROCESS STATUS.
 
 MRD9.1   RJM    WEO         WAIT END OF OPERATION
          SHN    21-10
 MRDI     PJN    MRD10       IF NOT NOISE BLOCK
*         UJN    MRD10       (ATS UNIT)
          AOM    MRDP        SET NOISE BYPASSED FLAG
          LDN    42          ISSUE REPEAT READ
          RJM    FCN
          ACN    CH
          LJM    MRD1        REINITIATE READ
 
 MRD10    ZJN    MRD11.2     IF NO ERRORS
          SHN    21-4-21+10
          PJN    MRD11       IF NOT TAPE MARK
          LDN    3           SET STOP TO EOI
          STD    TB
          LDN    17          SET LEVEL NUMBER
          STM    LNUM
          LDN    0           CLEAR WORD AND BYTE COUNTS
          STD    ES
          STD    WC
          STD    BY
          LDN    /MTX/BEI    SET EOI
          STD    EC
          LJM    MRD16       PROCESS DATA
 
 MRD11    LDD    EC
          ZJN    MRD11.1     IF ERROR NOT ALREADY ENCOUNTERED
          LDM    MTDS
          LPC    7077
 MRDQ     EQU    *-1
*         LPC    7777        (ATS UNIT)
          ZJN    MRD12       IF NOT FATAL ERROR
 MRD11.1  LDN    /MTX/STE    STATUS ERROR
          STD    EC
          UJN    MRD12       NO TAPE ERROR REPORTED FROM HARDWARE
 
 MRD11.2  LDM    MTDS+1
*         UJN    MRD12       (NON-GCR UNIT)
 MRDR     EQU    *-2
          SHN    21-11
          PJN    MRD12       IF NO GCR SINGLE TRACK CORRECTION
          AOM    ECNT+4      INCREMENT COUNTER
          SHN    -14
          RAM    ECNT+3      INCREMENT COUNTER FOR OVERFLOW
 
*         TRANSLATE ODD COUNT TO FILL STATUS.
 
 MRD12    LDD    DS          PROCESS ODD COUNT STATUS
          LPN    40
 MRDJ     UJN    MRD13       7 TRACK, 9 TRACK CODED OR ATS UNIT
*         SHN    0-5         (9 TRACK BINARY)
          ADD    SC
          LPN    3
          ZJN    MRD13       IF NO FILL STATUS
          LMN    3
          ZJN    MRD13       IF (N*3)+1 FRAMES - NO FILL STATUS
          LDN    40          SET FILL STATUS
 MRD13    STD    ES          CLEAR FILL STATUS
 MRDK     UJN    MRD14       7 TRACK, 9 TRACK CODED, 9 TRACK I AND ATS
 
*         CORRECT BYTE COUNT AND CM WORD COUNT.
 
*         LDD    DS          (ALL OTHERS)
          LPN    40
          ZJN    MRD14       IF NO ODD COUNT
          LDD    BY
          LPN    2
          ZJN    MRD14       IF NOT MODULO 4, 2 OR 3
          SOD    BY          CORRECT BYTE COUNT
          SOD    WC          CORRECT CM WORD COUNT
 MRDL     UJN    MRD14       SI FORMAT
*         SHN    2           (ALL OTHER FORMATS)
          ADD    WC
          SBD    BY
          ZJN    MRD14       IF NEW CM WORD COUNT CORRECT
          AOD    WC
 MRD14    UJN    MRD15       NOT I OR 7 TRACK SI FORMAT
*         LDD    ES          (I OR 7 TRACK SI FORMAT)
 MRDM     EQU    *-1
          LPN    40
          ZJN    MRD15       IF NO FILL STATUS
          LDD    EC
          NJN    MRD16       IF ERROR ALREADY ENCOUNTERED
          LDN    /MTX/STE
          STD    EC
 MRD15    LDD    EC
          NJN    MRD16       IF ERROR
          RJM    UBW         UPDATE BID WINDOW
 MRD16    LDD    EC
          ZJN    MRD17       IF NO ERRORS
          RJM    DTS         DETAIL STATUS
 
*         THIS MUST BE THE FIRST ADDRESS IN THE TSAD TABLE.  PRESET
*         FOR CTS IS HARDCODED TO CHANGE THE FIRST ADDRESS IN THE
*         TABLE.
 
          SADT   .FE,,6,A
 MRD17    LDC    *           SET FET+6 ADDRESS (FOR BCW)
          RJM    PDA         PROCESS DATA (I AND SI FORMAT)
 MRDO     EQU    *-2
*         RJM    BCW         BUILD CONTROL WORD ( S AND SOME F)
*         RJM    /3M /BCW    (L FORMAT AND LONG BLOCKS IN F FORMAT)
*         UJN    MRD18       (NOT READ DATA)
 MRD18    LDD    DS          SAVE STATUS FOR ERROR PROCESSOR
          STM    //STER
          LJM    MRDX        RETURN
 
 
 MRDP     BSS    1           NOISE BYPASSED FLAG
 
 
          USE    BUFFER
 OVLS     BSS    0           OVERLAY ORIGIN FOR SKIP
 CIB      SPACE  4,10
**        CIB - CHECK INPUT BUFFER.
*
*         ENTRY  (CN - CN+4) = IN POINTER.
*
*         EXIT   (A) = WORD COUNT OF FREE BUFFER SPACE.
*
*         MACROS SADT.
 
 
 CIB1     LDD    CM+3        LENGTH = OUT - IN - 1
          SBD    CN+3
          SHN    14
          ADD    CM+4
          SBD    CN+4
          SBN    1
          PJN    CIBX        IF (IN + 1) .LT OUT
          SADT   .LF
          ADC    *           (LIMIT - FIRST)
 
 CIB      SUBR               ENTRY/EXIT
          SADT   .FE,,3,A
          LDC    *           READ OUT
          CRD    CM
          LDD    CM+3
          LPN    37
          STD    CM+3
          SHN    14
          LMD    CM+4
          SADT   .LM,C
          ADC    -*          (-LIMIT)
          MJN    CIB1        IF OUT .LT. LIMIT
          LDN    /MTX/BAE    BUFFER ARGUMENT ERROR
          LJM    RET3        RETURN ERROR CODE
 TDA      SPACE  4,15
**        TDA - TRANSFER DATA.
*         CALCULATES PARAMETERS FOR TRANSFER TO CENTRAL.  IT ALSO
*         CHECKS IF TERMINATION CONDITION HAS NOT BEEN MET, THERE
*         IS NO ERROR, AND THE BUFFER WILL STILL HAVE ROOM FOR A
*         BLOCK AFTER THE CURRENT ONE IS TRANSFERRED, THEN MOTION IS
*         STARTED FOR THE NEXT BLOCK.
*
*         ENTRY  (TB) = STATUS OF BLOCK READ.
*                (CN - CN+4) = IN POINTER.
*                (WC) = WORD COUNT TO BE TRANSFERRED TO BUFFER.
*
*         CALLS  CIB, ITM, WCB.
*
*         MACROS SADT.
 
 
 TDA      SUBR               ENTRY/EXIT
          LDD    WC
 TDAA     ADN    0           ALLOW FOR CONTROL WORDS
*         ADN    1           (260 READ NOT LONG BLOCKS)
*         ADN    2           (200 READ NOT LONG BLOCKS)
*         PSN                (LONG BLOCKS - FLAG FOR OTHER OVERLAYS)
          STD    T6
 
*         LABEL BUFFER - WILL OVERLAY REMAINDER OF *TDA*.
 
 LBUF     EQU    *           BEGINNING OF LABEL BUFFER
 
 TDAB     UJN    TDA1        UPDATE FET POINTERS
*         PSN                (READ SKIP)
          RJM    CIB         CHECK INPUT BUFFER
          SBD    T6
          PJN    TDA1        IF ROOM IN BUFFER FOR BLOCK
          RAD    T6          ADJUST WORDS TO BE TRANSFERRED
 TDA1     LDD    CN+3        SAVE IN
          STD    T4
          LDD    CN+4
          STD    T5
          LDN    0           PRESET SECOND PART WORD COUNT
          STD    T7
          LDD    T6          UPDATE IN
          RAD    CN+4
          SHN    -14
          RAD    CN+3
          SHN    14
          LMD    CN+4
          SADT   .LM,C
          ADC    -*          (-LIMIT)
          MJN    TDA2        IF NO WRAP AROUND
          STD    T7          SET SECOND PART WORD COUNT
          SADT   .FT
          ADC    *           (FIRST)
          STD    CN+4        RESET IN
          SHN    -14
          STD    CN+3
          LDD    T6          RESET FIRST PART WORD COUNT
          SBD    T7
          STD    T6
 TDA2     LDD    TB
 TDAC     SBN    0           READ STOP CONDITION
          PJN    TDA5        IF TERMINATION MET
          RJM    CIB         CHECK INPUT BUFFER
          SADT   .BS,C
 TDAD     ADC    -*          (- MAXIMUM BLOCK SIZE)
 TDAE     MJN    TDA4        IF NOT ROOM FOR NEXT BLOCK
*         PSN                (READ-SKIP)
          SADT   .BS,C
          ADC    -*          (-MAXIMUM BLOCK SIZE)
          SHN    -21
          RAM    WCBC
          LDD    EP          CHECK IF ERROR OR RECOVERY IN PROGRESS
          LPN    77
          ADD    EC
          ADD    DF          CHECK DROP OUT FLAG
          NJN    TDA3        IF DROP OUT OR ERROR CONDITION
 TDAF     RJM    ITM         INITIATE TAPE MOTION
*         UJN    *+2         (LONG BLOCKS / 200 IPS / GCR NOT 2X PPU)
          RJM    WCB         WRITE CENTRAL BUFFER
          LJM    TDAX        RETURN
 
 TDA3     RJM    WCB         WRITE CENTRAL BUFFER
          LJM    RET2        REQUEUE
 
 TDA4     LDN    0           INDICATE NO COMPLETION
          STD    TB
          UJN    TDA6        TRANSFER DATA TO CM BUFFER
 
 TDA5     LDD    WC
          NJN    TDA6        IF DATA
          STD    T6          DO NOT TRANSFER CONTROL WORDS
          LDD    T4          BACK UP FET POINTER
          STD    CN+3
          LDD    T5
          STD    CN+4
 TDA6     RJM    WCB         WRITE CENTRAL BUFFER
 TDAG     UJN    TDA7        COMPLETE FET
*         LDM    LNUM        (READSKP)
          CON    LNUM
 TDAH     SBN    0           LEVEL NUMBER DESIRED
          PJN    TDA7        IF TERMINATION MET
 TDAI     LDN    4           SET TO SKIP RECORD
*         LDN    10          (IF FILE SKIP REQUIRED)
          STD    PB          INDICATE TO MAGNET TO SKIP
          LDN    /MTX/BEI
          LJM    RET3        RETURN ERROR CODE
 
 TDA7     LDD    TB
          ZJN    TDA8        IF PRU READ COMPLETE OR BUFFER FULL
          LDD    UP          SET EOR/EOF FLAG
          SCN    10
          LMN    10
          STD    UP
          LDD    TB
          ADN    1           RETURN EOR/EOF
          SHN    3+4
          LMM    LNUM        MERGE LEVEL NUMBER
          SHN    16
 TDA8     ADN    1
          LJM    RET         SET FET COMPLETE
 
 
 ORLA     EQU    LBUF+CLBL+12  ORIGIN ADDRESS FOR READ LABEL OVERLAY
 WCB      SPACE  4,15
**        WCB - WRITE CENTRAL BUFFER.
*         WRITES DATA TO CENTRAL, THEN CHECKS IF ERROR MUST BE
*         PROCESSED.  ERRORS INCLUDE TAPE MARKS AND EOT.
*         IF ERROR, THEN READ ERROR RECOVERY IS CALLED.
*
*         ENTRY  (T4 - T5) = IN POINTER.
*                (T6) = FIRST PART WORD COUNT.
*                (T7) = SECOND PART WORD COUNT.
*
*         CALLS  *CRE*, *REM*.
*
*         MACROS CALL, SADT.
 
 
 WCB      SUBR               ENTRY/EXIT
          LDD    T6
          ZJN    WCB1        IF NO FIRST PART
          LDD    T4          WRITE FIRST PART
          SHN    6
          ADD    RA
          SHN    6
          ADD    T5
          CWM    BUF,T6
 WCBA     EQU    *-1
*         CWM    BUFC,T6     (CONTROL WORD MODE)
          LDD    T7
          ZJN    WCB1        IF NO SECOND PART
          LDD    T6          SET BUFFER ADDRESS
          SHN    2
          ADD    T6
          ADM    WCBA
          STM    WCBB
          SADT   .FT,,,A
          LDC    *           (FIRST+RA)
          CWM    *,T7
 WCBB     EQU    *-1
 WCB1     LDD    EP
          LPN    77
          ADD    EC
          ZJN    WCB2        IF NO ERROR ENCOUNTERED
 WCBF     CALL   REM         LOAD READ ERROR PROCESSOR
*         CALL   CRE         LOAD ERROR PROCESSOR (CTS)
          SADT   .FE,,2,A
 WCB2     LDC    *           UPDATE IN POINTER IN FET
          CWD    CN
 WCBC     LDN    0           RECALL CPU FLAG
          ZJN    WCB3        IF NO RECALL CPU
          LDD    OA          RECALL CPU
          CWM    WCBE,ON
          SOM    WCBC
 WCB3     AOD    BL+1        INCREMENT BLOCK COUNT
          SHN    -14
          RAD    BL
          AOD    BT          INCREMENT BLOCKS TRANSFERRED
          LJM    WCBX
 WCBD     EQU    *-1
*         LJM    RET4        (FATAL READ ERROR)
 
 WCBE     CON    DRCM        DRIVER RECALL CPU MONITOR FUNCTION
          SPACE  4,10
 OVLB     BSS    0           FWA OF OVERLAID CODE
 
*         WARNING ..........
*
*         THE FOLLOWING ROUTINES CANNOT USE ADDRESS MODIFICATION.
 
 VDA      SPACE  4,10
**        VDA - VALIDATE DATA.
*         CHECKS I FORMAT TRAILER INFORMATION.
 
 
 VDA      SUBR               ENTRY/EXIT
          LDD    BY
          ZJN    VDAX        IF NO DATA READ
          LDD    EP
          SHN    21-12
          MJN    VDAX        IF OPPOSITE PARITY BEING TRIED
          LDM    BUF-4,BY    SAVE BLOCK LENGTH
          STM    //BNEI
          LDM    BUF-3,BY
          STM    //BNEI+1
          LMD    BL
          SHN    14
          LMM    BUF-2,BY
          STM    //BNEI+2
          LMD    BL+1
          NJN    VDA1        IF BLOCK NUMBER ERROR
          LDM    //BNEI
          LMD    BY
          ZJN    VDAX        IF CORRECT BLOCK LENGTH
 VDA1     LDN    /MTX/BNE
          STD    EC
          UJN    VDAX        RETURN
 PDA      SPACE  4,10
**        PDA - PROCESS DATA.
*         PROCESSES INTERNAL FORMAT LEVEL NUMBERS.
*
*         (TB) = TERMINATION STATUS.
 
 
 PDA      SUBR
 PDAA     UJN    PDA1        I FORMAT
*         LDD    ES          (SI FORMAT)
          LPN    40
          ZJN    PDA1        IF NO FILL STATUS
          LDD    WC
          ZJN    PDA1        IF NOISE RECORD
          SOD    WC          DECREMENT WORD COUNT
          SOD    BY          DECREMENT BYTE COUNT
 PDA1     LDD    BY
          ZJN    PDA4        IF NO BYTES READ
          LMM    MRDA
 PDAC     EQU    *-1
*         LMM    RCTA        (CTS)
          LMN    1
          STM    BUFL        SET 0 LEVEL NUMBER
          ZJN    PDA3        IF FULL PRU
          LDM    BUF-1,BY    SET LEVEL NUMBER FOR CONTROL WORD
          LPN    17
          STM    BUF-4,BY
          STM    LNUM
          LMN    17
          ZJN    PDA2        IF EOF
          LCN    1
 PDA2     ADN    2
 PDA3     STD    TB          SET BLOCK STATUS
 PDA4     LDD    WC
          SHN    2
 PDAB     ADD    WC          (200 READ)
*         LDD    WC          (260 READ)
          STM    BUFC+4
          LJM    PDAX
 
 .BCWA    BSS    0
 BUF      SPACE  4,10
          BUFFER
 BCW      SPACE  4,10
**        BCW - BUILD CONTROL WORD.
*         OVERLAYS *VDA* AND *PDA* FOR ALL FORMATS EXCEPT I AND SI.
*
*         ENTRY  (A) = ABSOLUTE ADDRESS OF FET+6.
*
*         EXIT   (FET+6) UPDATED IF NON-CONTROL WORD READ.
*
*         USES   CM - CM+4.
 
 
 .BCWB    BSS    0
          LOC    OVLB
 
 BCW6     LDD    T1          SET UBC IN FET
          STD    CM+2
          LDC    *
 BCWG     EQU    *-2
          CWD    CM
 
 BCW      SUBR               ENTRY/EXIT
          CRD    CM          READ FET+6
          STM    BCWG+1      SAVE ADDRESS
          SHN    -14
          LMC    LDCI
          STM    BCWG
          LDD    WC          CALCULATE UNUSED BIT COUNT
          SHN    2
          ADD    WC
          STD    T1
          ZJN    BCW1        IF NO WORDS
 BCWA     LDN    0           SET BLOCK STATUS
*         LDN    1           (S/L FORMAT NOT 200/260 CODE)
          STD    TB
          LDN    0           SET LEVEL NUMBER
          STM    BUF,T1
          STM    LNUM
 BCW1     STD    T1
          LDD    WC
 BCWB     EQU    *-1
*         LDD    BY          (200 READ CODE)
          STM    BUFC+4
 BCWC     UJN    BCW2        CALCULATE UNUSED BIT COUNT
*         SHN    2
          ADD    WC
          SBD    BY
          SHN    2           4 * UNUSED BYTE COUNT
          STD    T1
          SHN    1           8 * UNUSED BYTE COUNT
          RAD    T1          12 * UNUSED BYTE COUNT
 BCW2     LDD    ES
          LPN    40
 BCWD     ZJN    BCW3        IF NO FILL STATUS
*         ZJN    BCW5        (9 TRACK BINARY OR CTS)
          LDD    WC
          ZJN    BCW4        IF ZERO WORDS
 BCWE     LDN    6           (7 TRACK OR 9 TRACK CODED)
*         LDN    8D          (9 TRACK BINARY OR CTS)
 BCW3     RAD    T1
 BCW4     STM    BUFC+2
          LJM    BCWX        RETURN
*         LJM    BCW6        (S/L FORMAT NON-CONTROL WORD READ)
 BCWF     EQU    *-1
 
 BCW5     LDD    BY
          LPN    1
          SHN    2
          UJN    BCW3        SET UNUSED BIT COUNT
 
.BCWC     BSS    0
          LOC    *O
 .BCWL    EQU    *-.BCWB
          ERRNG  .BCWA-.BCWC OVERLAID CODE OVERFLOW
          TITLE  READ - PRESET.
 PRS      SPACE  4,20
**        PRS - PRESET.
*
*         ENTRY  FOR A READ FUNCTION THAT IS NOT LONG BLOCKS THIS
*                PRESET CODE RETURNS TO THE CALLER, LOADS AND
*                EXECUTES OVERLAY *CPP*, THEN ENTERS AT *PRS39.
*
*         EXIT   (WP, EP+1) PLUS THE BLOCK NUMBER IN (BL,BL+1) IS THE
*                          PHYSICAL BLOCK NUMBER FOR CTS.
*                (SC) = 1 IF *RLB* MUST BE LOADED.
*                (SC) = 2 IF *RLI* MUST BE LOADED.
*                TO *RDF* IF READ FUNCTION AND NOT LONG BLOCKS.
*
*         USES   BT, CN, CN+4, SC, T1, T2, T8.
*
*         CALLS  CIB, MCH, /PRESET/RBI.
*
*         MACROS ISTORE.
*
*         NOTE   OVERLAY *RLB* MUST IMMEDIATELY FOLLOW *READ* AND
*                OVERLAY *RLI* MUST IMMEDIATELY FOLLOW *RLB*.
 
 
 PRS      LDD    HP
          SHN    21-7
          PJN    PRS0        IF NOT CTS
          LDD    BL
          ADD    BL+1
          NJN    PRS0        IF STARTING BLOCK ID ALREADY SAVED
          RJM    /PRESET/RBI READ BLOCK ID
          AOM    /PRESET/PICA  LOCATE BLOCK NECESSARY IN ERROR RECOVERY
          LDM    BIDW+1
          STD    WP          SAVE CURRENT BLOCK ID
          LDM    BIDW+2
          STD    EP+1
 PRS0     LDD    FM
          SHN    -6
          STD    T8          SET FORMAT
          LMN    /MTX/TFLI
          NJN    PRS0.1      IF NOT LI FORMAT
          LDD    FN
          LMN    /MTX/RDF
          NJN    PRS0.1      IF NOT READ FUNCTION
          LDN    2
          RAD    SC          SET TO LOAD READ LI FORMAT OVERLAY
          LJM    PRSX        RETURN
 
 PRS0.1   LDD    HP
          SHN    21-7
          PJN    PRS0.2      IF NOT CTS
          LDC    UJNI+2
          STM    RDFB        SKIP CLIP LEVEL FUNCTION
          LDC    RCTA
          STM    PDAC
          LDC    LDNI+CRE/10000  CALL CTS ERROR PROCESSOR
          STM    WCBF
          LJM    PRS6        CONTINUE PRESET
 
 PRS0.2   LDC    PRSD        MODIFY CHANNELS
          RJM    //MCH
          LDD    HP
          LPN    20
          ZJN    PRS1        IF MTS UNIT
          LDN    0           MODIFY INSTRUCTIONS FOR ATS CONTROLLER
          STM    MRDG
          LCN    0
          STM    MRDQ
          LCN    2
          RAM    MRDE
          LDM    PRSG
          STM    PRSA
          LDC    UJNI-PJNI
          RAM    MRDI
          LDD    HP
          SHN    21-1
          PJN    PRS0.3      IF NOT GCR UNIT
          ISTORE MRDR,(UJN MRD12)  DISABLE CORRECTED ERROR CHECK
 PRS0.3   LDM    ATUS        SET FOR DENSITY CHECK
 PRS1     STD    T1
          LDD    HP
          LPN    1
          NJN    PRS2        IF 9 TRACK DRIVE
          LJM    PRS9        CONTINUE PRESET
 
*         PRESET FOR MTS/ATS 9 TRACK OPERATION.
 
 PRS2     LDD    T1          DETERMINE IF 6250 BPI
          LPN    30
          LMN    30
          NJN    PRS3        IF NOT 6250 BPI
          LDM    DLYA
          LPN    14
          ZJN    PRS5        IF 1X PPU SPEED
          LPN    4
          ZJN    PRS4        IF 2X PPU
          UJN    PRS6        4X PPU, FULL MOTION AHEAD
 
 PRS3     LDM    DLYA
          LPN    14
          NJN    PRS6        IF 2X OR 4X PPU SPEED
 PRS4     LDD    HP
          LPN    10
          LMN    10
          NJN    PRS6        IF NOT 200 IPS UNIT
 PRS5     LDC    UJNI+2      DISABLE MOTION AHEAD
          STM    TDAF
          LDM    PRSF
          STM    RDFD
 PRS6     LDD    MD
          SHN    21-6
          MJN    PRS9        IF CODED
 
*         9 TRACK BINARY.
 
          LDD    HP
          LPN    20
          NJN    PRS7        IF ATS CONTROLLER
          LDC    SHNI+72
          STM    MRDJ
 PRS7     LDD    T8
          LMN    /MTX/TFI
          ZJN    PRS8        IF I FORMAT
 PRSA     LDC    LDDI+DS
*         UJN    PRS9        (ATS CONTROLLER)
          STM    MRDK
          LDD    T8
          LMN    /MTX/TFSI
          ZJN    PRS9        IF SI FORMAT
          LDC    SHNI+2
          STM    MRDL
          UJN    PRS9        SAVE WORD COUNT
 
 PRS8     LDC    ZJNI-UJNI
          RAM    MRDF
          LDC    ZJNI-UJNI
          RAM    RCTF+.RCT-RCTX  (CTS)
 PRS9     LDD    WC          SAVE BEGINNING WORD COUNT
          STM    WOCN
          LDD    UP
          SCN    10          CLEAR EOR/EOF FLAG
          STD    UP
          LDD    FN
          LMN    /MTX/RDF
          ZJN    PRS11       IF READ
          LMN    /MTX/SKP&/MTX/RDF
          ZJN    PRS10       IF SKIP
          LDN    /MTX/TFF    PROCESS AS IF F FORMAT
          STD    T8
 PRS10    LDC    UJNI+MRD18-MRDO
          ERRNG  MRDO-MRD18+37
          STM    MRDO
          STM    RCTL+.RCT-RCTX  (CTS)
 PRS11    LDD    MD
          LPN    60
          NJN    PRS12       IF CONTROL WORD REQUEST
          LDD    T8
          LMN    /MTX/TFS
          ZJN    PRS15       IF S FORMAT
          LMN    /MTX/TFL&/MTX/TFS
          ZJN    PRS15       IF L FORMAT
          UJN    PRS13       CONTINUE PRESET
 
 PRS12    SHN    -4          ALLOW SPACE FOR CONTROL WORDS
          RAM    TDAA
          LCN    BUF-BUFC    RESET BUFFER WRITE ADDRESS
          RAM    WCBA
 PRS13    LDD    T8
          SBN    /MTX/TFSI+1
          PJN    PRS16       IF NOT I OR SI
          LDD    MD
          LPN    40
          NJN    PRS14       IF 200 READ
          LDC    LDDI+WC
          STM    PDAB
 PRS14    LJM    PRS20       CONTINUE PRESET
 
 PRS15    AOM    BCWA+.BCWB-OVLB  SET TO RETURN EOR ALWAYS
          LDC    BCW6        ENABLE RETURN OF MLRS
          STM    BCWF+.BCWB-OVLB
 PRS16    LDN    .BCWL-1     MOVE *BCW*
          STD    T1
 PRS17    LDM    .BCWB,T1
          STM    OVLB,T1
          SOD    T1
          PJN    PRS17       IF STILL MORE CODE TO MOVE
          LDC    BCW         ENABLE CODE
          STM    MRDO+1
          STM    RCTL+1+.RCT-RCTX  (CTS)
          LDD    MD
          SHN    21-6
          MJN    PRS18       IF CODED
          LDD    HP
          SHN    21-7
          MJN    PRS17.1     IF CTS
          SHN    21-0-21+7
          PJN    PRS18       IF 7 TRACK
 PRS17.1  LDN    BCW5-BCW3   MODIFY UBC CODE FOR 9 TRACK AND CTS
          RAM    BCWD
          LDN    2
          RAM    BCWE
 PRS18    LDD    MD
          LPN    40
          NJN    PRS19       IF 200
          LDC    SHNI+2
          STM    BCWC
          UJN    PRS20       CONTINUE PRESET
 
 PRS19    LDC    LDDI+BY
          STM    BCWB
 PRS20    LDC    TRSO
          STD    T1
          LDN    0
          UJN    PRS22       SET READ STOP CONDITION
 
 PRS21    LDN    2           ADVANCE TABLE
          RAD    T1
          LDI    T1
          ZJN    PRS25       IF END OF TABLE
 PRS22    LMM    CIOE
          LPC    774
          NJN    PRS21       IF NOT MATCH
          AOD    T1
          LDD    T8
          LMN    /MTX/TFS
          ZJN    PRS23       IF S FORMAT
          LMN    /MTX/TFL&/MTX/TFS
          NJN    PRS24       IF NOT L FORMAT
 PRS23    LDI    T1          SELECT S/L PORTION OF TABLE
          SHN    -6
          STI    T1
 PRS24    LDM    LNUM
          SHN    -10
          STD    T2
          LMN    17
          NJN    PRS25       IF NOT LEVEL 17
          LDI    T1
          SHN    -3
          STI    T1
          LDN    10-4        SET FILE SKIP FOR *READSKP*
          RAM    TDAI
 PRS25    LDI    T1          SET STOP CONDITION
          LPN    3
          RAM    TDAC
          LDM    CIOE
          LPC    774
          LMN    20
          NJN    PRS27       IF NOT READ SKIP
          STM    TDAB
          STM    TDAE
          LDC    UJNI-PJNI
          RAM    PRSC
          LDC    LDMI
          STM    TDAG
          LDD    T2
          ZJN    PRS27       IF LEVEL 0
          LMN    17
          ZJN    PRS26       IF LEVEL 17
          LDD    T8
          SBN    /MTX/TFSI+1
          PJN    PRS27       IF NOT I/SI FORMAT
 PRS26    LDD    T2          SET LEVEL NUMBER
          RAM    TDAH
 PRS27    LDD    T8
          LMN    /MTX/TFI
          ZJN    PRS28       IF I FORMAT
          LDD    WC          SET BYTES TO READ
          SHN    2
          ADD    WC
          ADN    1
          STM    MRDA
          STM    RCTA+.RCT-RCTX  (CTS)
          LDC    UJNI+2      DISABLE VALIDATE DATA
          STM    MRDH
          STM    RCTG+.RCT-RCTX  (CTS)
 PRS28    LDD    T8
          SBN    /MTX/TFSI+1
          PJN    PRS31       IF NOT I OR SI
          LDD    HP
          SHN    21-7
          MJN    PRS28.1     IF CTS
          SHN    21-0-21+7
          PJN    PRS29       IF 7 TRACK
 PRS28.1  LDD    T8
          LMN    /MTX/TFSI
          ZJN    PRS30       IF SI FORMAT
 PRS29    LDC    LDDI+ES     FORCE FILL STATUS TO ALWAYS BE ERROR
          STM    MRDM
          LDC    ZJNI-UJNI
          RAM    RCTJ+.RCT-RCTX  (CTS)
          UJN    PRS31       CONTINUE PRESET
 
 PRS30    LDC    LDDI+ES
          STM    PDAA
 PRS31    LDD    T8
          LMN    /MTX/TFI
          ZJN    PRS33       IF I FORMAT
          LMN    /MTX/TFSI&/MTX/TFI
          ZJN    PRS32       IF SI FORMAT
          LDC    ADNI+4
 PRS32    STM    MRDD
          STM    RCTE+.RCT-RCTX  (CTS)
 PRS33    LDN    40          SELECT READ FUNCTION
          STM    //ITMA
          LDD    HP
          SHN    21-7
          MJN    PRS34       IF CTS
          LDC    4435
          STM    //WEOA
          LDN    1
          STM    //WEOB
          LDD    EP          SET CLIPPING LEVEL
          LPC    700
          ZJP    PRS34.2     IF NORMAL CLIP LEVEL
          RAM    RDFA
          UJP    PRS35       CONTINUE PRESET
 
*         REPLACE *MRD* WITH READ ROUTINE *RTC* FOR CTS.
 
 PRS34    LDC    .RCTL-1
          STD    T1          LENGTH OF CODE TO MOVE
 PRS34.1  LDM    .RCT,T1
          STM    MRDX,T1
          SOD    T1
          PJN    PRS34.1     IF MORE CODE TO MOVE
          LDC    .RCTA
          RJM    MCH         MODIFY CHANNEL INSTRUCTIONS
 
*         THE SADT MACRO FOR *MRD17* MUST BE THE FIRST ONE IN
*         THE OVERLAY.
 
          LDC    RCTK*2
          STM    PRSE
          LDC    6125        BITS TO TEST IN GENERAL STATUS
          STM    /PRESET/WFEA
          LDN    1           BITS IN GENERAL STATUS THAT SHOULD BE SET
          STM    /PRESET/WFEB
          LDD    FN
          LMN    /MTX/RDF
          NJN    PRS35       IF NOT READ DATA
          LDD    T8
          LMN    /MTX/TFS
          NJN    PRS35       IF NOT S FORMAT
          LDD    MD
          SHN    21-6
          PJN    PRS35       IF NOT CODED
          LDN    CLBL+1
          STM    RCTA        LABEL LENGTH + 1
          UJN    PRS35       SET TO MODIFY INSTRUCTIONS
 
 PRS34.2  LDC    UJNI+2      DISABLE CLIP LEVEL SELECTION
          STM    RDFB
 PRS35    LDC    PRSE        SET TO MODIFY INSTRUCTIONS
          STD    CN
          LDN    2           SET TO FETCH IN POINTER
          STD    CN+4
          LDC    /SRU/ITRW*100  SET SRU INCREMENT
          STM    //CECA
          LDD    FN
          LMN    /MTX/RDF
          NJN    PRS38       IF NOT READ
          LDD    OV
          ZJN    PRS37       IF NOT POSSIBLE LONG BLOCKS
          LDD    T8
          LMN    /MTX/TFL
          ZJN    PRS36       IF L FORMAT
          LMN    /MTX/TFF&/MTX/TFL
          NJN    PRS37       IF NOT F FORMAT
 PRS36    AOD    SC          SET TO LOAD LONG BLOCK OVERLAY
 PRS37    LDC    PRS39       SET TO RETURN HERE IF READ DATA
          STD    BT
 PRS38    LJM    PRSX        RETURN
 
*         RETURN HERE IF READ DATA, NOT LONG BLOCKS.
 
 PRS39    LDM    TDAD        SET BLOCK SIZE
          STM    PRSB
          LDM    TDAD+1
          STM    PRSB+1
          RJM    CIB         CHECK INPUT BUFFER
 PRSB     ADC    -*          (- MAXIMUM BLOCK SIZE)
 PRSC     PJN    PRS40       IF ENOUGH ROOM IN BUFFER
*         UJN    PRS40       (READSKP)
          LDN    1
          LJM    RET         SET FET COMPLETE
 
 PRS40    LDN    0           PRESET EXIT CONDITION
          STD    PB
          LJM    RDF         ENTER READ CODE
 
 
 PRSD     CHTB
 
*         THE FIRST ENTRY IN THIS TABLE MUST BE FROM *MRD17*.  CTS
*         PRESET CHANGES THE FIRST ENTRY.
 
 PRSE     TSAD
 
 PRSF     BSS    0
          LOC    RDFD
          UJN    RDF         LOOP FOR NEXT BLOCK
          LOC    *O
 
 PRSG     BSS    0
          LOC    PRSA
          UJN    PRS9        CONTINUE PRESET
          LOC    *O
 TRSO     SPACE  4,10
**        TRSO - TABLE OF READ STOP CODES.
 
 
 TRSO     BSS    0
          CON    0,0000
          CON    10,0011
          CON    20,0011
          CON    200,2323
          CON    250,2222
          CON    260,2222
          CON    600,0033
          CON    0
 RCT      SPACE  4,20
**        RCT - READ CARTRIDGE TAPE.
*
*         ENTRY  AT *RCT2* FROM /RLB/CLB TO INPUT LAST CHUNK.
*                AT *RCT3* FROM /RLB/CLB IF *1LT* INPUT LAST CHUNK.
*                AT *RCT4* FROM */SKP/SLB* IF BLOCK TOO LONG.
*                AT *RCT5* FROM */SKP/SLB* IF BLOCK NOT TOO LONG.
*                AT *RCT5* FROM /RLB/CLB IF *1LT* COMPLETED TRANSFER.
*                AT *RCT6* FROM /RLB/CLB IF *1MT* COMPLETED TRANSFER.
*                AT *RCT13* FROM /RLA/RLA IF BACKSPACE.
*
*         EXIT   (EC) = ERROR CODE, 0 IF NO ERROR.
*                (TB) = TYPE OF BLOCK.
*                (WC) = WORD COUNT FOR TRANSFER TO CENTRAL.
*                (BY) = BYTES READ.
*                (ES) = 0 IF NO FILL STATUS.
*                TO */SKP/SLB* IF SKIP LONG BLOCK, NOT LAST CHUNK.
*                TO */RLB/CLB1* IF COMMAND RETRY FOR READ LONG BLOCK.
*
*         USES   T1, T2.
*
*         CALLS  BCW, *CCL*, CDO, /RLB/CRA, PDA, VDA, /PRESET/WFE.
*
*         MACROS CALL, SADT.
*
*         NOTE   OVERLAY *RLI* READS CARTRIDGE TAPE FOR LI FORMAT.
 
 
 .RCT     BSS    0
          LOC    MRDX
 RCT      SUBR               ENTRY/EXIT
 RCT1     LDN    0           CLEAR ERROR CODE
          STD    EC
          STD    TB          CLEAR TYPE OF BLOCK
          LDC    5005        SET BYTE COUNT FOR I FORMAT READ OR SKIP
 RCTA     EQU    *-1
*         LDC    LBBY        (READ LONG BLOCK FULL CHUNK)
*         LDC    WC*5+1      (ALL OTHER READ DATA OPERATIONS)
*         LDC    CLBL+1      (READ LABELS)
*         LDC    5001        (SKIP - NOT LONG BLOCKS)
*         LDC    LBBY        (SKIP L FORMAT OR LONG BLOCK F FORMAT)
*         LDC    SLBY        (SKIP LI FORMAT)
 RCT2     IAM    BUF,CH      INPUT DATA
 RCTB     EQU    *-1
*         IAM    BUFB,CH     (READ LONG BLOCK)
*         IAM    /RLA/BUF,CH (READ LABEL)
 RCT3     STD    T1
          NJN    RCT6        IF NOT EXCESS BLOCK LENGTH
          LJM    *+2
 RCTC     EQU    *-1
*         LJM    /SKP/SLB    (SKIP LONG BLOCKS AND SKIP LI FORMAT)
 
*         THROW AWAY DATA WHEN THE BLOCK IS TOO LONG.  IF THE DATA
*         IS NOT TAKEN, OVERRUN ERRORS COULD OCCUR.  ALSO, WITH A
*         CROSS-COUPLED CONTROLLER, THE CONTROLLER HUNG WITH CHLA
*         030F FLASHING ON ITS ERROR DISPLAY.
 
 RCT4     LDC    500
          IAM    ERLB,CH
          ZJN    RCT4        IF THERE MAY BE MORE DATA
          LDN    /MTX/BTL    SET BLOCK TOO LONG
          STD    EC
          LDN    1           SET TO COMPUTE MAXIMUM BYTE COUNT
 RCT5     STD    T1
 RCT6     LDM    RCTA        CALCULATE REMAINDER OF CM WORD COUNT
          SBD    T1
          STD    BY          BYTE COUNT READ
 
*         PROCESS STATUS.
 
          RJM    /PRESET/WFE WAIT FOR END OF OPERATION
          PJN    RCT8        IF NOT COMMAND RETRY
          LDN    0
 RCTD     EQU    *-1
*         UJN    RCT7        (LONG BLOCK)
          UJN    RCT6.1      SKIP CLEAR OF CHUNK COUNT
 RCTM     EQU    *-1
*         STM    /SKP/IDFE   (SKIP LI FORMAT)
          CON    /SKP/IDFE
 RCT6.1   ACN    CH
          LJM    RCT1        READ THE DATA AGAIN
 
 RCT7     RJM    /RLB/CRA    READ *1LT* INTERFACE WORD
          NJN    RCT7        IF *1LT* TRANSFER TO CM NOT COMPLETE
          ACN    CH
          LDM    /RLB/BCWC   BACK UP POINTERS
          STD    CN+3
          LDM    /RLB/BCWD
          STD    CN+4
          LJM    /RLB/CLB1   RESEND THE DATA
 
 RCT8     STM    RCTH
          LDD    FN
          LMN    /MTX/RDF
          NJN    RCT10       IF NOT READ
          LDD    MD
          SHN    21-6
          PJN    RCT10       IF NOT CODED
          LDD    BY
          ZJN    RCT10       IF NO DATA READ
          LMN    CLBL
          NJN    RCT9        IF BLOCK TOO SHORT
          LDC    LPNI
          STM    RCTI        TO INDICATE NO FILL STATUS
          CALL   CCL         CODE CONVERT LABEL
          LDN    LABL        LABEL LENGTH AFTER CONVERSION
          STD    BY
          LDD    DS
          LPN    40
          NJN    RCT10       IF FILL STATUS
 RCT9     LDN    /MTX/BTL    BLOCK LENGTH ERROR
          STD    EC
 RCT10    LDD    BY
          ZJN    RCT11       IF NO DATA READ
          SBN    2           I FORMAT
 RCTE     EQU    *-1
*         PSN                (SI FORMAT)
*         ADN    4           (ALL OTHER FORMATS)
          STD    T2
 
*         CALCULATE WORD COUNT.
 
          SHN    1           13*BYTES
          ADD    T2
          SHN    2
          ADD    T2
          SHN    14  (-6)    (13*BYTES)/64
          STD    T0
          SHN    6+2         4*13*BYTES  (52*BYTES)
          SBD    T2          51*BYTES
          ADD    T0          (51*BYTES)+((13*BYTES)/64)
          SHN    -8D         WORDS = ((51*BYTES)+((13*BYTES)/64))/256
 RCT11    STD    WC
          LPN    1
          UJN    RCT12       CHECK AND CONVERT DATA (CODED)
 RCTF     EQU    *-1
*         ZJN    RCT12       (I FORMAT)
          SOD    BY
 
*         CHECK AND CONVERT DATA.
 
 RCT12    RJM    VDA         VALIDATE DATA (I FORMAT)
 RCTG     EQU    *-2
*         UJN    *+2         ALL OTHER FORMATS
          RJM    CDO         CHECK DROP OUT FLAG
          LDC    *           ERROR STATUS FROM *WFE*
 RCTH     EQU    *-1
 RCT13    ZJN    RCT15       IF NO ERROR
          SHN    21-4
          PJN    RCT14       IF NOT TAPE MARK
          LDN    3           SET STOP TO EOI
          STD    TB
          LDN    17          SET LEVEL NUMBER
          STM    LNUM
          LDN    0           CLEAR WORD AND BYTE COUNTS
          STD    ES
          STD    WC
          STD    BY
          LDN    /MTX/BEI    SET EOI
          STD    EC
          UJN    RCT16       PROCESS DATA
 
 RCT14    LDN    /MTX/STE
          STD    EC          STATUS ERROR
 RCT15    LDD    DS
          LPN    40
 RCTI     EQU    *-1
*         LPN    0           S FORMAT READ
          STD    ES
          UJN    RCT16       SET FET+6 ADDRESS
 RCTJ     EQU    *-1
*         ZJN    RCT16       IF NO FILL STATUS (I FORMAT)
          LDN    /MTX/STE
          STD    EC          STATUS ERROR
*         SADT   .FE,,6,A
 RCT16    LDC    *           SET FET+6 ADDRESS (FOR BCW)
 RCTK     EQU    *-2
          RJM    PDA         PROCESS DATA (I AND SI FORMAT)
 RCTL     EQU    *-2
*         RJM    BCW         BUILD CONTROL WORD (S AND SOME F)
*         RJM    /3M /BCW    (L FORMAT AND LONG BLOCKS IN F FORMAT)
*         UJN    RCT17       (NOT READ DATA)
          ERRNZ  MRD18-MRDO-RCT17+RCTL  IF MODIFYING WRONG ADDRESS
 RCT17    LJM    RCTX        RETURN
          ERRMI  OVLS-*
          LOC    *O
 .RCTL    EQU    *-.RCT      LENGTH OF *RCT*
 
.RCTA     CHTB               CHANNEL TABLE
          OVERLAY (READ LONG BLOCK PROCESSOR.),(BUFC+5),,RLB
 .IM      SET    1           SET FOR ADDRESS MODIFICATION ON ERRORS
 RLB      SPACE  4,10
**        RLB - READ LONG BLOCK.
*
*         CALLS  ADP, /READ/CIB, CRA, FCN, ITM, /READ/MRD, SRQ,
*                /READ/TDA, WDA.
*
*         MACROS SADT.
 
 
          ENTRY  RLB
 RLB      RJM    /READ/CIB   CHECK INPUT BUFFER
          SADT   .BS,C
          ADC    -*          (-MAXIMUM BLOCK SIZE)
 RLBA     PJN    RLB1        IF ENOUGH ROOM IN BUFFER
*         UJN    RLB1        READ SKIP
          LDN    1
          LJM    RET         SET FET COMPLETE
 
 RLB1     LDD    CN+3        SAVE STARTING IN POINTER
          STM    BCWC
          LDD    CN+4
          STM    BCWD
 
*         THE FOLLOWING CODE IS OVERLAYED WITH *CLB* FOR CTS.
 
 RLBB     LDN    0           ALLOW FOR CONTROL WORDS
*         LDN    1           (200/260 READ CODE)
          RJM    ADP
          LDN    0
          STM    RLBH        CLEAR SHUTDOWN ENABLED FLAG
          STM    BCWA
          STM    .BYC
          STD    EC          CLEAR ERROR CODE AND TERMINATION STATUS
          STD    TB
          UJN    RLB2        SET PCL
*         PSN                (ATS NON-CYBER 180)
 RLBJ     EQU    *-1
          LDC    NJNI+.RLB12-.RLBB  RESET END-OF-BLOCK CHECK
          STM    .RLBB
 RLB2     LDM    /READ/RDFA  SET PCL
 RLBC     RJM    FCN
*         UJN    *+2         (NORMAL CLIP LEVEL)
          RJM    ITM         INITIATE TAPE MOTION
          LDN    0           SET UP POINTERS FOR *1LT*
          RJM    ADP
          LDN    1           SEND REQUEST TO *1LT*
          RJM    SRQ
          LDD    DS          SAVE DEVICE STATUS
          STM    /READ/STAP
          LDC    RLB5        SET EXIT ON END OF INPUT
*         LDC    RLB4        (CYBER 180 IOU)
 RLBD     EQU    *-1
          STM    /READ/MRDC
          LDC    LBBY        SET BYTE COUNT
          STM    /READ/MRDA
          LJM    RLB2.1      READ TAPE
*         LJM    /READ/MRD3  (CYBER 180 - INITIATE INPUT)
*         LJM    .RLB11      (ATS NON-CYBER 180 - INITIATE INPUT)
 RLBI     EQU    *-1
 
 RLB2.1   RJM    /READ/MRD   READ TAPE
 
*         RETURN FROM */READ/MRD*.
 
 RLB3     LDN    77          DELAY
          SBN    1
          NJN    *-1
          RJM    CRA         SEE IF *1LT* PASSED CHUNK LENGTH
          NJN    RLB3        IF *1LT* NOT DONE
          LJM    RLB15       ACKNOWLEDGE *1LT*
 
*         CYBER 180 - ENTER HERE AT END OF INPUT OF A CHUNK OF DATA.
 
 RLB4     IJM    RLB18,CH    IF *1MT* FINISHED INPUT
          EJM    RLB4,CH     IF *1LT* NOT TAKING DATA YET
          CCF    *,CH        CLEAR CHANNEL FLAG
          UJN    RLB6        COUNT DATA TRANSFERRED
 
*         ATS NON-CYBER 180 - ENTER HERE AT END OF INPUT OF A CHUNK.
 
 RLB5     IJM    RLB18,CH    IF *1MT* FINISHED INPUT
          EJM    RLB5,CH     IF *1LT* NOT TAKING DATA YET
 RLB6     AOM    .BYC        COUNT CHUNK
          LMN    1
          ZJN    RLB7        IF FIRST CHUNK
          LDC    /MTX/LBWD   ADVANCE FOR *1LT* DATA
          RJM    ADP
          AOM    .BYC        COUNT CHUNK
 RLB7     LDC    /MTX/LBWD   ADVANCE FET POINTER
          RJM    ADP
          RJM    WDA         WRITE DATA
          LDM    .BYC
          ADN    1
          SBD    OV
          MJN    RLB9        IF MORE FULL CHUNKS TO INPUT
          STM    RLBH        SET SHUTDOWN ENABLED IF ODD CHUNK COUNT
          NJN    RLB8        IF ODD CHUNK COUNT
          LDD    WC
          SHN    2
          ADD    WC
 RLB8     ADN    1           SET AMOUNT TO INPUT
          STM    /READ/MRDA
 RLBE     LDC    /READ/MRDC+1  REENABLE SHUT DOWN
*         LDC    UJNI+.RLB14-.RLBB  (ATS NON-CYBER 180)
 RLBF     STM    /READ/MRDC
*         STM    .RLBB       (ATS NON-CYBER 180)
 RLBG     LDM    RLBH
*         UJN    .RLB9       (ATS NON-CYBER 180)
          NJN    RLB12       IF *1LT* WILL FINISH INPUT
          LDM    /READ/MRDA
          UJN    RLB10       INPUT DATA
 
*         THE FOLLOWING CODE IS OVERLAID BY THE ATS INPUT LOOP IF ATS
*         ON A NON-CYBER 180, OR BY THE IOU INPUT LOOP ON A CYBER 180.
 
 .RLBA    EQU    *           BEGINNING OF OVERLAID CODE
 
 RLB9     LDC    LBBY        SET TO INPUT FULL CHUNK
 RLB10    IJM    RLB12,CH    IF *1LT* FINISHED INPUT
 RLB11    EJM    RLB10,CH    IF *1LT* TAKING DATA
          EJM    RLB10,CH    IF *1LT* TAKING DATA
          EJM    RLB10,CH    IF *1LT* TAKING DATA
          EJM    RLB10,CH    IF *1LT* TAKING DATA
          FJM    /READ/MRD3,CH  IF TIME FOR *1MT* TO TAKE DATA
          UJN    RLB11       WAIT FOR *1LT* TO COMPLETE
          BSS    7           PAD TO MAKE SAME LENGTH AS ATS INPUT LOOP
 
 .RLBAL   EQU    *-.RLBA     LENGTH OF OVERLAID AREA
 
 RLB12    LDN    77          DELAY
          SBN    1
          NJN    *-1
          RJM    CRA         SEE IF *1LT* PASSED CHUNK LENGTH
          NJN    RLB12       IF *1LT* NOT DONE
          AOM    BCWA        SKIP UPDATE IN BCW
          LDC    LBBY        CALCULATE BYTES IN LAST CHUNK
          STM    /READ/MRDA
          SBD    CM+1
          STD    T1
          LMC    LBBY
          ZJN    RLB13       IF *1LT* ENDED ON CHUNK BOUNDARY
          LDC    0
 RLBH     EQU    *-1
          ZJN    RLB14       IF SHUTDOWN NOT ENABLED
          LDD    WC          SET BYTE COUNT ATTEMPTED TO READ
          SHN    2
          ADD    WC
          ADN    1
          STM    /READ/MRDA
          SBD    CM+1
          LJM    /READ/MRD4  DETERMINE IF BLOCK TOO LARGE
 
 RLB13    STD    T1
 RLB14    LJM    /READ/MRD6  EXIT
 
*         PROCESSING CONTINUES HERE AFTER EXIT FROM MRD.
 
 RLB15    LDD    MD
          LPN    40
          ZJN    RLB16       IF NOT 200 READ CODE
          LDN    0           SET TRAILER CONTROL WORD
          STM    BUFB
          LDN    1
          RJM    ADP
          RJM    WDA         WRITE TRAILER CONTROL WORD
 RLB16    LDN    0           SET WORD COUNT
          STD    WC
          STD    CM          ACKNOWLEDGE *1LT*
          LDM    CPDA
          ADN    2
          CWD    CM
          LDD    TB
          LMN    3
          NJN    RLB17       IF NOT TAPE MARK
          LDM    BCWC        BACK UP POINTERS
          STD    CN+3
          LDM    BCWD
          STD    CN+4
 RLB17    RJM    /READ/TDA
          LDM    SRQB        RESTORE STARTING WORD COUNT
          STD    WC
          LJM    RLB         LOOP
 
 RLB18    LDN    20          DELAY
          SBN    1
          NJN    *-1         IF MORE DELAY
          RJM    CRA         CHECK *1LT* COMPLETE
          NJN    RLB18       IF *1LT* NOT COMPLETE
          LJM    /READ/MRD6  PROCESS READ COMPLETION
 
 
 .BYC     CON    0           CHUNKS INPUT OF *LBBY* BYTES
          TITLE  SUBROUTINES.
 ADP      SPACE  4,15
**        ADP - ADVANCE POINTER.
*
*         ENTRY  (CN+3 - CN+4) = IN POINTER.
*                (A) = WORDS TO INCREMENT IN BY.
*
*         EXIT   (T4 - T5) = STARTING IN POINTER.
*                (CN+3 - CN+4) = UPDATED IN POINTER.
*                (T6) = FIRST PART WORD COUNT.
*                (T7) = SECOND PART WORD COUNT.
*
*         CALLS  /READ/CIB.
*
*         MACROS SADT.
 
 
 ADP      SUBR               ENTRY/EXIT
          STD    T6
          RJM    /READ/CIB   CHECK INPUT BUFFER
          SBD    T6
          PJN    ADP1        IF ROOM IN BUFFER FOR BLOCK
          RAD    T6          ADJUST WORD COUNT
 ADP1     LDD    CN+3        SAVE IN
          STD    T4
          LDD    CN+4
          STD    T5
          LDN    0           PRESET SECOND PART WORD COUNT
          STD    T7
          LDD    T6          UPDATE IN
          RAD    CN+4
          SHN    -14
          RAD    CN+3
          SHN    14
          LMD    CN+4
          SADT   .LM,C
          ADC    -*          (-LIMIT)
          MJN    ADPX        IF NO WRAP AROUND
          STD    T7          SET SECOND PART WORD COUNT
          SADT   .FT
          ADC    *           (FIRST)
          STD    CN+4
          SHN    -14
          STD    CN+3
          LDD    T6          RESET FIRST PART WORD COUNT
          SBD    T7
          STD    T6
          LJM    ADPX        RETURN
 BCW      SPACE  4,10
**        BCW - BUILD CONTROL WORD.
*
*         ENTRY  (BCWA) = 0 IF *1MT* FINISHED INPUT.
*
*         USES   TB, T1, CM - CM+4.
*
*         CALLS  ADP, WDA.
*
*         MACROS SADT.
 
 
 BCW      SUBR               ENTRY/EXIT
          LDC    *
 BCWA     EQU    *-1
          NJN    BCW2        IF *1LT* FINISHED INPUT
          LDM    .BYC
          ZJN    BCW1        IF FIRST PASS
          AOM    .BYC        COUNT *1LT* BLOCK
          LDC    /MTX/LBWD
          RJM    ADP
 BCW1     LDD    WC          TRANSFER LAST PART OF DATA
          RJM    ADP
          RJM    WDA         WRITE DATA
          UJN    BCW3        CHECK FOR TAPE MARK
 
 BCW2     LDD    WC          ADVANCE POINTER FOR *1LT*
          RJM    ADP
 BCW3     LDD    EC
          LMN    /MTX/BEI
          ZJN    BCW4        IF TAPE MARK
          LDM    /READ/BCWA
          LPN    77
          STD    TB
          LDN    0
          STM    LNUM
 BCW4     STD    T1
          LDD    MD
          LPN    40
          NJN    BCW5        IF 200 READ
          LDD    WC          12 * UNUSED BYTES
          SHN    2
          ADD    WC
          SBD    BY
          SHN    2
          STD    T1
          SHN    1
          RAD    T1
 BCW5     LDD    ES
          LPN    40
 BCWB     ZJN    BCW7        IF NO FILL STATUS
*         ZJN    BCW6        (9 TRACK BINARY - IF NO FILL STATUS)
          LDD    WC
          ADM    .BYC
          ZJN    BCW7        IF NO DATA READ
          LDM    /READ/BCWE
          LPN    77
          UJN    BCW7        ADJUST UNUSED BIT COUNT
 
 BCW6     LDD    BY          ADJUST UBC FOR ODD BYTE COUNT
          LPN    1
          SHN    2
 BCW7     RAD    T1
          STM    BUFC+2
          LDC    LBBY
          STD    T1
          LDD    BY
          STM    BUFC+4
          LDD    MD
          LPN    60
          NJN    BCW9        IF CONTROL WORD READ
          LDM    BUFC+2
          STD    T1
          LDD    FM
          SHN    -6
          LMN    /MTX/TFL
          NJN    BCW8        IF NOT L FORMAT
          SADT   .FE,,6,A
          LDC    *           RETURN UBC TO FET
          CRD    CM
          LDD    T1          SET UBC
          STD    CM+2
          SADT   .FE,,6,A
          LDC    *
          CWD    CM
 BCW8     LJM    BCWX        RETURN
 
 BCW9     LPN    40
          NJN    BCW10       IF 200 READ
          LDC    /MTX/LBWD
          STD    T1
          LDD    WC
          STM    BUFC+4
 BCW10    LDN    0
          STM    BUFC+3
          LDM    .BYC
          STD    T0
          ZJN    BCW12       IF NO PARTIAL BLOCKS
 BCW11    LDD    T1          COUNT BYTES OR WORDS FOR EACH BUFFER FULL
          RAM    BUFC+4
          SHN    -14
          RAM    BUFC+3
          SOD    T0
          NJN    BCW11       IF MORE BLOCKS TO COUNT
 BCW12    LDC    *           PUT CONTROL WORD IN BUFFER
 BCWC     EQU    *-1
          SHN    6
          ADD    RA
          SHN    6
          ADC    *
 BCWD     EQU    *-1
          CWM    BUFC,ON
          LJM    BCWX        RETURN
 CPD      SPACE  4,10
**        CPD - CHECK PP (1LT) DROP OUT.
*
*         ENTRY  (CPDA) = PP INPUT REGISTER ADDRESS.
*
*         EXIT   (A) = 0, IF *1LT* STILL AROUND.
*
*         MACROS CHTE.
 
 
 CPD      SUBR               ENTRY/EXIT
          LDC    *
 CPDA     EQU    *-1
          CRD    CM
          LDD    CM+1
          SCN    77
          SHN    6
          LMD    CM
          LMC    3RT1L
          ZJN    CPD1        IF *1LT*
          SHN    14
          LMN    1R1
          NJN    CPDX        IF NOT *1LT* LOADING
 CPD1     LDD    CM+3
          CHTE   *
          LMN    CH
          LPN    77
          UJN    CPDX        RETURN
 CRA      SPACE  4,10
**        CRA - CHECK REQUEST ACCEPTANCE FROM *1LT*.
*
*         EXIT   (A) = 0 IF *1LT* COMPLETE.
*                (CM - CM+4) = REQUEST/RETURN WORD.
 
 
 CRA      SUBR               ENTRY/EXIT
          LDM    CPDA
          ADN    2
          CRD    CM
          LDD    CM
          LMN    2
          UJN    CRAX        RETURN
 ITS      SPACE  4,10
**        ITS - INDICATE *1MT* TRANSFER STARTED.
*
*         ENTRY  (A) = BYTE COUNT.
*
*         EXIT   (A) = BYTE COUNT.
 
 
 ITS      SUBR               ENTRY/EXIT
          STD    T0          SAVE BYTE COUNT
          LDM    CPDA        INDICATE *1MT* TRANSFER STARTED
          ADN    3
          CWD    ON
          LDD    T0          RESTORE (A)
          UJN    ITSX        RETURN
 SRQ      SPACE  4,10
**        SRQ - SEND REQUEST TO *1LT* TO START BLOCK.
*
*         ENTRY  (A) = REQUEST CODE.
*                (T4 - T5) = POINTER.
*                (SRQB) = STARTING WORD COUNT.
*                (SRQC) = STARTING OV CONTENTS.
*
*         USES   T1, T2, T3, CM - CM+4.
*
*         CALLS  CPD, HNG.
 
 
 SRQ      SUBR               ENTRY/EXIT
          STD    T1
 SRQA     UJN    SRQ1        NO CHANNEL FLAG PRESENT
*         PSN                (CYBER 180)
          SCF    *+2,CH      SET CHANNEL FLAG
          LDM    CPDA        INDICATE *1MT* TRANSFER STARTED
          ADN    3
          CWD    ON
 SRQ1     LDM    CPDA        CHECK *1LT* FUNCTION
          ADN    1
          CRD    CM
          LDD    CM
          LMN    PRLM
          ZJN    SRQ3        IF *1LT* PAUSING
          LDC    *           WORD COUNT
 SRQB     EQU    *-1
          STD    T2
          LDC    *           CHUNK COUNT
 SRQC     EQU    *-1
          STD    T3
          LDM    CPDA        ENTER REQUEST
          ADN    2
          CWD    T1
          RJM    CPD         CHECK IF PP *L1T* DROPPED OUT
          ZJP    SRQX        IF *1LT* STILL AROUND
          RJM    HNG         HANG PP
 
 SRQ3     LJM    RET2        REQUEUE REQUEST
 WDA      SPACE  4,10
**        WDA - WRITE DATA TO CENTRAL.
*
*         ENTRY  (T4 - T5) = IN POINTER.
*                (T6) = FIRST PART WORD COUNT.
*                (T7) = SECOND PART WORD COUNT.
*
*         MACROS SADT.
 
 
 WDA      SUBR               ENTRY/EXIT
          LDD    T6
          ZJN    WDAX        IF NO FIRST PART
          SHN    2
          ADD    T6
          ADC    BUFB
          STM    WDAA
          LDD    T4          TRANSFER FIRST PART
          SHN    6
          ADD    RA
          SHN    6
          ADD    T5
          CWM    BUFB,T6
          LDD    T7
          ZJN    WDAX        IF NO SECOND PART
          SADT   .FT,,,A
          LDC    *           TRANSFER SECOND PART
          CWM    *,T7
 WDAA     EQU    *-1
          UJN    WDAX        RETURN
 WTS      SPACE  4,10
**        WTS - WAIT FOR *1LT* TRANSFER TO START.
*
*         ENTRY  (A) = BYTE COUNT.
*
*         EXIT   (A) = BYTE COUNT.
*
*         USES   CM - CM+4.
 
 
 WTS3     LDD    T0          RESTORE (A)
 
 WTS      SUBR               ENTRY/EXIT
          STD    T0          SAVE BYTE COUNT
 WTS1     LDM    CPDA        CHECK *1MT*/*1LT* INTERLOCK
          ADN    3
          CRD    CM
          LDD    CM
          ZJN    WTS3        IF *1LT* TRANSFER STARTED
          LDN    24          DELAY 10 MICROSECONDS
 WTS2     SBN    1
          NJN    WTS2        IF NOT DONE
          UJN    WTS1        CHECK INTERLOCK
 BUFFER   SPACE  4,10
          BUFFER BUFB
 CALL     SPACE  4,10
 .IM      SET    0           DISABLE ADDRESS MODIFICATION ON ERRORS
 
**        *1LT* CALL BLOCK.
*
*T        18/  1LT,6/ CP,12/  0,12/ CHANNEL,12/  PPIA
*T,       12/  -0,24/  FIRST,24/  LIMIT
 
 
 CALL     VFD    18/3R1LT,6/0
          CON    0           READ
          CHTE   *
          CON    CH          CHANNEL
          CON    0           *1MT* INPUT REGISTER ADDRESS
          CON    -0
          SADT   .FT,,,,SE
          CON    0,0
          SADT   .LM,,,,SE
          CON    0,0
          TITLE  PRESET.
 PRS      SPACE  4,10
**        PRS - PRESET.
*
*         ENTRY  AT *PRS10* AFTER OVERLAY *CPP* HAS BEEN LOADED AND
*                   EXECUTED.
*
*         EXIT   TO *RLB* WHEN PRESET COMPLETE.
*
*         USES   T1, T4, T5.
*
*         CALLS  CEC, CPD, CRA, MCH, SRQ.
*
*         MACROS MONITOR, PAUSE.
 
 
 PRS      LDC    UJNI+2      DISABLE READ AHEAD
          STM    /READ/TDAF
          LDN    0           DISABLE ALLOWANCE FOR CONTROL WORDS
          STM    /READ/TDAA
          LDC    PRSC        MODIFY CHANNELS
          RJM    MCH
          LDD    MD
          LPN    60
          ZJN    PRS1        IF NO CONTROL WORDS
          AOM    RLBB        ALLOW FOR CONTROL WORD
          AOM    .CLB+CLBA-CLB  ALLOW FOR CONTROL WORD
 PRS1     LDD    HP
          SHN    21-7
          PJN    PRS3        IF NOT CTS
          ISTORE /READ/RCTD,(UJN /READ/RCT7)  SET FOR COMMAND RETRY
          LDC    BUFB
          STM    /READ/RCTB
          LDC    CLB14
          STM    /READ/RCT   RETURN ADDRESS FROM *RCT*
          LDC    BCW
          STM    /READ/RCTL+1
          LDC    .CLBL-1     LENGTH OF CODE TO MOVE
          STD    T1
 PRS2     LDM    .CLB,T1
          STM    CLB,T1
          SOD    T1
          PJN    PRS2        IF MORE CODE TO MOVE
          LDC    .CLBA       MODIFY CHANNELS
          UJP    PRS5        CONTINUE PRESET
 
 PRS3     LDC    BUFB
          STM    /READ/MRDB
          LDC    BCW
          STM    /READ/MRDO+1
          LDM    /READ/RDFB  DISABLE PCL IF NORMAL CLIP LEVEL
          STM    RLBC
          LDD    HP
          LPN    60
          SHN    6
          RAM    CALL+3      SET MTS/ATS FLAGS FOR *1LT*
          LDK    MABL        CHECK MAINFRAME TYPE
          CRD    CM
          LDD    CM+1
          SHN    -6
          LPN    41
          LMN    1
          NJN    PRS7        IF NOT CYBER 180 IOU
 
*         PRESET FOR CYBER 180 IOU.
 
          LDC    RLB3        SET EXIT FROM /READ/MRD
          STM    /READ/MRD
          LDC    RLB4        SET EXIT FROM READ
          STM    RLBD
          LDC    /READ/MRD3  SET ENTRY ON INITIAL READ
          STM    RLBI
          LDN    RLBRL.-1    MOVE IOU LOOP
          STD    T1
 PRS4     LDM    RLBR.,T1
          STM    .RLBA,T1
          SOD    T1
          PJN    PRS4        IF MORE CODE TO MOVE
          LDC    RLBC.       MODIFY CHANNELS
 PRS5     RJM    MCH
          LDN    PSNI
          STM    SRQA
 PRS6     LJM    PRS9        CONTINUE PRESET
 
 PRS7     LDD    HP
          SHN    21-4
          PJN    PRS6        IF MTS CONTROLLER
 
*         INITIALIZE DRIVER FOR ATS (NON-CYBER 180).
 
          LDC    RLB3        SET EXIT FROM /READ/MRD
          STM    /READ/MRD
          LDC    .RLB11      MODIFY INSTRUCTIONS
          STM    RLBI
          LDM    PRSA
          STM    RLBG
          LDC    UJNI+.RLB14-.RLBB
          STM    RLBE+1
          LDC    .RLBB
          STM    RLBF+1
          LDN    PSNI
          STM    RLBJ
          LDN    .RLBRL-1    MOVE ATS INPUT LOOP
          STD    T1
 PRS8     LDM    .RLBR,T1
          STM    .RLBA,T1
          SOD    T1
          PJN    PRS8        IF NOT END OF MOVE
          LDC    .RLBC       MODIFY CHANNELS
          RJM    MCH
 PRS9     LDC    PRSB        SET FOR INSTRUCTION MODIFICATION
          STD    CN
          LDC    PRS10       SET TO RETURN CONTROL HERE AFTER LOAD
          STD    BT
          LJM    PRSX        RETURN
 
*         RETURN HERE AFTER ALL ROUTINES LOADED.
*         BUILD CALL TO *1LT*.
 
 PRS10    LDD    CP          MERGE CP NUMBER
          SHN    -7
          RAM    CALL+1
          LDD    IA          SET INPUT REGISTER ADDRESS IN CALL
          STM    CALL+4
          LDN    CMCL        CHECK MOVE FLAG
          CRD    CM
          LDD    CM
          SHN    7
          LMD    CP
          ZJN    PRS11       IF MOVE FLAG
          LDD    MA          WRITE REQUEST BLOCK
          CWM    CALL,TR
          LDN    1           SET TO NOT QUEUE REQUEST
          STD    CM+1
          MONITOR RPPM       REQUEST PP
          LDD    CM+1
          NJN    PRS12       IF PP ASSIGNED
 PRS11    LJM    RET2        REQUEUE
 
 PRS12    STM    CPDA        SAVE PP INPUT REGISTER ADDRESS
 PRS13    LDN    77          DELAY
          SBN    1
          NJN    *-1
          LDD    MA          CHECK FOR *1LT* ACKNOWLEDGE
          ADN    1
          CRD    CM
          LDD    CM
          ZJN    PRS15       IF *1LT* READY
          RJM    CPD         CHECK FOR *1LT* DROP
          NJN    PRS11       IF *1LT* GONE
          LDN    CMCL        CHECK MOVE FLAG
          CRD    CM
          LDD    CM
          SHN    7
          LMD    CP
          NJN    PRS13       IF NO MOVE FLAG FOR THIS CP
          RJM    CEC         CHANGE BACK TO MAGNET CP
 PRS14    RJM    CPD         CHECK PP DROP
          NJN    PRS11       IF *1LT* GONE
          PAUSE  NE
          UJN    PRS14       LOOP
 
 PRS15    LDD    HP
          LPC    201
          ZJN    PRS16       IF 7 TRACK
          LDD    MD
          SHN    21-6
          MJN    PRS16       IF CODED
          LCN    BCW7-BCW6   SET TO ADJUST UBC IF ODD BYTE COUNT
          RAM    BCWB
 PRS16    LDD    WC          SET WORD AND CHUNK COUNT FOR *1LT*
          STM    SRQB
          LDD    OV
          STM    SRQC
          LDM    CIOE
          LPC    774
          LMN    20
          NJN    PRS17       IF NOT READ SKIP
          LDC    UJNI-PJNI
          RAM    RLBA
          RJM    /READ/CIB
          MJN    PRS18       IF BUFFER ARGUMENT ERROR
          STD    T5
          SHN    -14
          STD    T4
          LDN    3           SET REQUEST TO *1LT*
          RJM    SRQ
 PRS17    LDN    77          DELAY
          SBN    1
          NJN    *-1
          RJM    CRA         SEE IF *1LT* ACCEPTED READ SKIP
          LMN    2
          NJN    PRS17       IF *1LT* NOT DONE
 PRS18    LDC    /SRU/ITRL*100  SET SRU INCREMENT
          STM    //CECA
          LJM    RLB         ENTER READ TAPE
 
*         SEE *1LT* FOR FORMAT OF CALL BLOCK.
 
 PRSA     BSS    0
          LOC    RLBG
          UJN    .RLB9       WAIT FOR *1LT* TO COMPLETE
          LOC    *O
 
 PRSB     TSAD   SLBP
 PRSC     CHTB
          TITLE  PRESET SUBROUTINES.
 RLB      SPACE  4,10
**        ATS INPUT LOOP (NON-CYBER 180).
 
 
 .RLBR    BSS    0
          LOC    .RLBA
 
 .RLB9    AJM    *,CH        IF WAITING FOR *1LT* TO DCN CHANNEL
          LDM    /READ/MRDA  SET NUMBER OF BYTES TO INPUT
 .RLB10   IJM    RLB12,CH    IF *1LT* FINISHED INPUT
          EJM    .RLB10,CH   IF DATA NOT AVAILABLE
 .RLB11   IAM    BUFB,CH     INPUT DATA
          DCN    CH+40       INDICATE TO *1LT* TO CONTINUE READ
 .RLBB    NJN    .RLB12      IF END OF BLOCK
*         UJN    .RLB14      (SHUTDOWN ENABLED)
          ACN    CH
 .RLB12   STD    T1          SAVE BYTES REMAINING
 .RLB13   IJM    RLB18,CH    IF *1MT* FINISHED INPUT
          EJM    .RLB13,CH   IF *1LT* NOT TAKING DATA YET
          LJM    RLB6        SETUP FOR NEXT CHUNK
 
 .RLB14   LJM    /READ/MRD4  CHECK FOR BLOCK TOO LARGE
 
          LOC    *O
 .RLBRL   EQU    *-.RLBR     LENGTH OF ATS INPUT LOOP
 
          ERRNG  .RLBAL-.RLBRL  OVERLAID CODE OVERFLOWED
 
 .RLBC    CHTB               CHANNEL TABLE FOR ATS INPUT LOOP
 
 
*         READ LOOP FOR CYBER 180 IOU.
 
 RLBR.    BSS    0
          LOC    .RLBA
 
 RLB9.    LDC    LBBY        BYTES TO INPUT
          ERRNZ  RLB9.-RLB9  CODE DEPENDS ON VALUE
 RLB10.   RJM    WTS         WAIT FOR *1LT* TRANSFER TO START
          ERRNZ  RLB10.-RLB10  CODE DEPENDS ON VALUE
 RLB11.   IJM    RLB12,CH    IF 1LT COMPLETED READ
          SCF    RLB11.,CH   WAIT UNTIL FLAG IS CLEARED BY 1LT
          RJM    ITS         INDICATE *1MT* TRANSFER STARTED
          LJM    /READ/MRD3  PROCESS DATA
 
          LOC    *O
 RLBRL.   EQU    *-RLBR.     LENGTH OF IOU INPUT CODE
 
          ERRNG  .RLBAL-RLBRL.  IOU INPUT CODE TOO LONG
 
 RLBC.    CHTB               TABLE OF CHANNELS FOR IOU CODE
 CLB      SPACE  4,15
**        CLB - CTS LONG BLOCK READ.
*
*         THIS ROUTINE OVERLAYS *RLB* STARTING AT *RLBB*.
 
 
 .CLB     BSS    0
          LOC    RLBB
 CLB      LDD    DS
          STM    /READ/STAP  SAVE GENERAL STATUS
          RJM    ITM         INITIATE TAPE MOTION
 CLB1     LDN    0           ALLOW FOR CONTROL WORD
 CLBA     EQU    *-1
*         LDN    1           200/260 READ CODE
          RJM    ADP         ADVANCE IN POINTER
          LDN    0
          STM    BCWA
          STM    .BYC        CLEAR CHUNK COUNT
          STD    EC          CLEAR ERROR CODE
          STD    TB          CLEAR TERMINATION STATUS
*         LDN    0
          RJM    ADP         SET UP POINTERS FOR *1LT*
          LDN    1
          RJM    SRQ         SEND START BLOCK REQUEST TO *1LT*
          LDC    LBBY
          STM    /READ/RCTA
          IAM    BUFB,CH
          UJN    CLB4        CHECK IF ALL WORDS TRANSFERRED
 
 CLB2     LDC    LBBY
          STM    /READ/RCTA
          RJM    WTS         WAIT FOR *1LT* TRANSFER TO START
 CLB3     IJM    CLB8,CH     IF TRANSFER COMPLETE
          SCF    CLB3,CH     IF *1LT* NOT FINISHED
          RJM    ITS         INDICATE *1MT* TRANSFER STARTED
          IAM    BUFB,CH
 CLB4     NJN    CLB6        IF TRANSFER COMPLETE
 CLB5     FJM    CLB9,CH     IF A WORD IS PRESENT FOR *1LT* TO TRANSFER
          AJM    CLB5,CH     IF TRANSFER NOT COMPLETE
 
*         *1MT* FINISHED THE CHANNEL TRANSFER.
 
 CLB6     STD    T1          SAVE WORDS NOT TRANSFERRED
 CLB7     RJM    CRA         READ *1LT* INTERFACE WORD
          NJN    CLB7        IF *1LT* NOT COMPLETE
          LJM    /READ/RCT6  CALCULATE REMAINDER OF CM WORD COUNT
 
*         *1LT* FINISHED THE CHANNEL TRANSFER.
 
 CLB8     RJM    CRA         READ *1LT* INTERFACE WORD
          NJN    CLB8        IF *1LT* TRANSFER TO CM NOT COMPLETE
          AOM    BCWA        SKIP UPDATE IN *BCW*
          LDC    LBBY
          SBD    CM+1
          LJM    /READ/RCT5  CALCULATE REMAINDER OF CM WORD COUNT
 
 CLB9     CCF    *,CH        CLEAR CHANNEL FLAG (TELL *1LT* TO START)
          AOM    .BYC        COUNT CHUNK
          LMN    1
          ZJN    CLB10       IF FIRST CHUNK
          LDC    /MTX/LBWD
          RJM    ADP         ADVANCE POINTER FOR *1LT* DATA
          AOM    .BYC        COUNT CHUNK
 CLB10    LDC    /MTX/LBWD
          RJM    ADP         ADVANCE POINTER
          RJM    WDA         WRITE DATA TO CM
          LDM    .BYC
          ADN    1
          SBD    OV
          MJP    CLB2        IF MORE CHUNKS TO INPUT
          NJN    CLB12       IF *1LT* IS READING LAST CHUNK
          LDD    WC
          SHN    2
          ADD    WC
          ADN    1
          STM    /READ/RCTA  LENGTH TO READ + 1
 CLB11    IJM    CLB8,CH     IF *1LT* FINISHED TRANSFER
          SCF    CLB11,CH    IF *1LT* STILL READING
          LJM    /READ/RCT2  INPUT LAST CHUNK
 
 CLB12    RJM    CRA         READ *1LT* INTERFACE WORD
          NJN    CLB12       IF *1LT* NOT DONE
          AOM    BCWA        SKIP UPDATE IN *BCW*
          LDD    WC
          SHN    2
          ADD    WC
          ADN    1
          STM    /READ/RCTA
          SBD    CM+1
          LJM    /READ/RCT3  SAVE BYTES NOT TRANSFERRED
 
*         *RCT* RETURNS HERE AFTER LAST CHUNK IS TRANSFERRED.
 
 CLB14    LDD    MD
          LPN    40
          ZJN    CLB15       IF NOT 200 READ CODE
          LDN    0           SET TRAILER CONTROL WORD
          STM    BUFB
          LDN    1
          RJM    ADP
          RJM    WDA         WRITE TRAILER CONTROL WORD
 CLB15    LDN    0           SET WORD COUNT
          STD    WC
          STD    CM          ACKNOWLEDGE *1LT*
          LDM    CPDA
          ADN    2
          CWD    CM
          LDD    TB
          LMN    3
          NJN    CLB16       IF NOT TAPE MARK
          LDM    BCWC        BACK UP POINTERS
          STD    CN+3
          LDM    BCWD
          STD    CN+4
 CLB16    RJM    /READ/TDA
          LDM    SRQB        RESTORE STARTING WORD COUNT
          STD    WC
          LJM    RLB         LOOP
 
          ERRMI  .BYC-*      IF CODE OVERFLOWS
 
          LOC    *O
 .CLBL    EQU    *-.CLB      LENGTH OF *CLB*
 
 .CLBA    CHTB               CHANNEL TABLE
          OVERLAY (READ LI FORMAT.),,,RLI
 .IM      SET    0           GENERATE ADDRESSES FOR OVERLAY
 RLI      SPACE  4,20
**        RLI - READ LI FORMAT.
*         THIS ROUTINE READS CONSECUTIVE BLOCKS AS LONG AS THERE IS
*         ROOM IN THE BUFFER.  ROUTINE *EBP* WILL STOP THE READ OF
*         CONSECUTIVE BLOCKS IF THE TERMINATION CONDITION HAS BEEN
*         MET, AN UNRECOVERABLE ERROR HAS OCCURRED, OR THE DROP OUT
*         BLOCK COUNT HAS BEEN MET.  *WDA* TRANSFERS ALL DATA READ
*         IN THE 1ST, 3RD, ... CHUNKS.  *UIP* UPDATES THE IN POINTER
*         IN THE FET.  FOR A 200 READ *VDA* WRITES THE INITIAL CONTROL
*         WORD AND THE TRAILER CONTROL WORD IS WRITTEN IN *RLI*.  IF
*         THE TAPE IS ATS, MOST OF THIS ROUTINE IS OVERLAYED BY *ALI*.
*
*         ENTRY  (CN+3,CN+4) = STARTING IN POINTER.
*
*         EXIT   TO *RET* IF NOT ENOUGH ROOM IN BUFFER.
*
*         USES   CM, CN+3, CN+4, EC, T1.
*
*         CALLS  ADP, CDO, CIB, CRA, EBP, ITM, ITS, SRQ, UCP, VDA,
*                WDA, WTS, /PRESET/WFE.
*
*         MACROS SADT.
 
 
 RLI      RJM    CIB         CHECK INPUT BUFFER
          SADT   .BS,C
          ADC    -*          (-MAXIMUM BLOCK SIZE)
 RLIB     PJN    RLI1        IF ENOUGH ROOM IN BUFFER
*         UJN    RLI1        (READSKP)
          LDN    1
          LJM    RET         SET FET COMPLETE
 
 RLI1     LDD    CN+3        SAVE STARTING IN POINTER
          STM    VDAB
          LDD    CN+4
          STM    VDAC
 
*         THE FOLLOWING CODE IS OVERLAYED WITH *ALI* FOR ATS.
 
 .RLIA    BSS    0           START OF OVERLAYED CODE
          RJM    ITM         INITIATE TAPE MOTION
 RLI2     LDN    1
          RJM    SRQ         SEND READ BLOCK REQUEST TO *1LT*
          LDC    LBBY+5      BYTE COUNT FOR FIRST CHUNK
          STM    RLIA
          IAM    BUFB-5,CH
          UJN    RLI5        CHECK IF ALL WORDS TRANSFERRED
 
 RLI3     RJM    WTS         WAIT FOR *1LT* TRANSFER TO START
          LDC    LBBY
          STM    RLIA
 RLI4     IJM    RLI17,CH    IF *1LT* FINISHED THE TRANSFER
          SCF    RLI4,CH     IF *1LT* NOT FINISHED
          RJM    ITS         INDICATE *1MT* TRANSFER STARTED
          IAM    BUFB,CH
 RLI5     IJM    RLI9,CH     IF *1MT* FINISHED THE CHANNEL TRANSFER
          EJM    RLI5,CH     IF *1LT* NOT TAKING DATA YET
          CCF    *,CH        TELL *1LT* TO START
          RJM    UCP         UPDATE COUNTERS AND POINTER
          LMN    1
          ZJN    RLI6        IF FIRST CHUNK
          RJM    UCP         UPDATE COUNTERS AND POINTER
 RLI6     RJM    WDA         WRITE DATA TO CENTRAL MEMORY
          LDM    .BYC
          SBN    LICH-1      FULL CHUNKS PER BLOCK - 1
          MJP    RLI3        IF MORE FULL CHUNKS TO INPUT
          RJM    WTS         WAIT FOR *1LT* TRANSFER TO START
 RLI7     IJM    RLI17,CH    IF *1LT* FINISHED THE CHANNEL TRANSFER
          SCF    RLI7,CH     IF *1LT* STILL READING
          RJM    ITS         INDICATE *1MT* TRANSFER STARTED
          LDC    LIRW*5+1+1  BYTES IN REMAINDER + PAD + 1
          STM    RLIA        LENGTH TO READ + 1
          IAM    BUFB,CH
          NJN    RLI9        IF NOT EXCESS BLOCK LENGTH
 
*         THROW AWAY DATA WHEN THE BLOCK IS TOO LONG.  IF THE DATA
*         IS NOT TAKEN, OVERRUN ERRORS COULD OCCUR.  ALSO, WITH A
*         CROSS-COUPLED CONTROLLER, THE CONTROLLER HUNG WITH CHLA
*         030F FLASHING ON ITS ERROR DISPLAY.
 
 RLI8     LDC    500
          IAM    ERLB,CH
          ZJN    RLI8        IF THERE MAY BE MORE DATA
          LDN    /MTX/BTL    SET BLOCK TOO LONG
          STD    EC
          LDN    1           SET TO COMPUTE WORD COUNT
 RLI9     STD    T1
          LDC    LBBY+5      BYTE COUNT FOR FIRST CHUNK
 RLIA     EQU    *-1
*         LDC    LBBY        (MIDDLE CHUNK)
*         LDC    LIRW*5+1+1  (LAST CHUNK)
          RJM    VDA         PROCESS DATA
          RJM    CDO         CHECK DROP OUT FLAG
 RLI10    RJM    CRA         READ *1LT* INTERFACE WORD
          NJN    RLI10       IF *1LT* TRANSFER TO CM NOT COMPLETE
 
*         PROCESS STATUS.
 
          RJM    /PRESET/WFE WAIT FOR END OF OPERATION
          PJN    RLI11       IF NOT COMMAND RETRY
          ACN    CH
          LDM    VDAB        BACK UP POINTERS
          STD    CN+3
          LDM    VDAC
          STD    CN+4
          LJM    RLI2        RESEND THE DATA
 
 RLI11    ZJN    RLI12       IF NO ERROR
          SHN    21-4
          PJN    RLI13       IF NOT TAPE MARK
          LDN    3           SET STOP TO EOI
          STD    TB
          LDN    17          SET LEVEL NUMBER
          STM    LNUM
          LDM    VDAB        BACK UP POINTERS
          STD    CN+3
          LDM    VDAC
          STD    CN+4
          LDN    /MTX/BEI    SET EOI
          UJN    RLI14       SAVE ERROR CODE
 
 RLI12    LDD    DS
          LPN    40
          ZJN    RLI15       IF NO FILL STATUS
 RLI13    LDN    /MTX/STE    STATUS ERROR
 RLI14    STD    EC
 RLI15    LDD    MD
          LPN    40
          ZJN    RLI16       IF NOT 200 READ CODE
          LDN    1
          RJM    ADP
          RJM    WDA         WRITE TRAILER CONTROL WORD
 RLI16    LDN    0
          STD    CM          ACKNOWLEDGE *1LT*
          LDM    CPDA
          ADN    2
          CWD    CM
          RJM    EBP         END OF BLOCK PROCESSING
          LJM    RLI         READ NEXT BLOCK
 
*         *1LT* FINISHED THE CHANNEL TRANSFER.
 
 RLI17    RJM    CRA         READ *1LT* INTERFACE WORD
          NJN    RLI17       IF *1LT* TRANSFER TO CM NOT COMPLETE
          AOM    VDAA        INDICATE *1LT* FINISHED THE TRANSFER
          LDC    LBBY
          SBD    CM+1
          LJM    RLI9        SAVE BYTES TRANSFERRED
 
          BSS    70          MAKE ROOM FOR *ALI*
 .RLIAL   EQU    *-.RLIA     LENGTH OF *RLI*
 .BYC     CON    0           CHUNKS INPUT OF *LBBY* BYTES
 ADP      SPACE  4,15
**        ADP - ADVANCE POINTER.
*         THIS ROUTINE ADVANCES THE IN POINTER FOR WRITES INTO THE
*         BUFFER.  ROUTINE *UIP* UPDATES THE IN POINTER FOR THE FET.
*
*         ENTRY  (CN+3 - CN+4) = IN POINTER.
*                (A) = WORDS TO INCREMENT IN BY.
*
*         EXIT   (T4 - T5) = STARTING IN POINTER.
*                (CN+3 - CN+4) = UPDATED IN POINTER.
*                (T6) = FIRST PART WORD COUNT.
*                (T7) = SECOND PART WORD COUNT.
*
*         CALLS  CIB.
*
*         MACROS SADT.
 
 
 ADP      SUBR               ENTRY/EXIT
          STD    T6
          RJM    CIB         CHECK INPUT BUFFER
          SBD    T6
          PJN    ADP1        IF ROOM IN BUFFER FOR BLOCK
          RAD    T6          ADJUST WORD COUNT
 ADP1     LDD    CN+3        SAVE IN
          STD    T4
          LDD    CN+4
          STD    T5
          LDN    0           PRESET SECOND PART WORD COUNT
          STD    T7
          LDD    T6          UPDATE IN
          RAD    CN+4
          SHN    -14
          RAD    CN+3
          SHN    14
          LMD    CN+4
          SADT   .LM,C
          ADC    -*          (-LIMIT)
          MJN    ADPX        IF NO WRAP AROUND
          STD    T7          SET SECOND PART WORD COUNT
          SADT   .FT
          ADC    *           (FIRST)
          STD    CN+4
          SHN    -14
          STD    CN+3
          LDD    T6          RESET FIRST PART WORD COUNT
          SBD    T7
          STD    T6
          LJM    ADPX        RETURN
 CIB      SPACE  4,10
**        CIB - CHECK INPUT BUFFER.
*
*         ENTRY  (CN+3 - CN+4) = IN POINTER.
*
*         EXIT   (A) = WORD COUNT OF AVAILABLE BUFFER SPACE.
*                TO *RET3* IF ERROR.
*
*         USES   CM - CM+4.
*
*         MACROS SADT.
 
 
 CIB1     LDD    CM+3        LENGTH = OUT - IN - 1
          SBD    CN+3
          SHN    14
          ADD    CM+4
          SBD    CN+4
          SBN    1
          PJN    CIBX        IF (IN + 1) .LT OUT
          SADT   .LF
          ADC    *           (LIMIT - FIRST)
 
 CIB      SUBR               ENTRY/EXIT
          SADT   .FE,,3,A
          LDC    *           READ OUT
          CRD    CM
          LDD    CM+3
          LPN    37
          STD    CM+3
          SHN    14
          LMD    CM+4
          SADT   .LM,C
          ADC    -*          (-LIMIT)
          MJN    CIB1        IF OUT .LT. LIMIT
          LDN    /MTX/BAE    BUFFER ARGUMENT ERROR
          LJM    RET3        RETURN ERROR CODE
 CPD      SPACE  4,10
**        CPD - CHECK PP (1LT) DROP OUT.
*
*         ENTRY  (CPDA) = PP INPUT REGISTER ADDRESS.
*
*         EXIT   (A) = 0, IF *1LT* STILL AROUND.
*
*         USES   CM - CM+4.
*
*         MACROS CHTE.
 
 
 CPD      SUBR               ENTRY/EXIT
          LDC    *
 CPDA     EQU    *-1
          CRD    CM
          LDD    CM+1
          SCN    77
          SHN    6
          LMD    CM
          LMC    3RT1L
          ZJN    CPD1        IF *1LT*
          SHN    14
          LMN    1R1
          NJN    CPDX        IF NOT *1LT* LOADING
 CPD1     LDD    CM+3
          CHTE   *
          LMN    CH
          LPN    77
          UJN    CPDX        RETURN
 CRA      SPACE  4,10
**        CRA - CHECK REQUEST ACCEPTANCE FROM *1LT*.
*
*         EXIT   (A) = 0 IF *1LT* COMPLETE.
*                (CM - CM+4) = REQUEST/RETURN WORD.
 
 
 CRA      SUBR               ENTRY/EXIT
          LDM    CPDA
          ADN    2
          CRD    CM
          LDD    CM
          LMN    2
          UJN    CRAX        RETURN
 EBP      SPACE  4,15
**        EBP - END OF BLOCK PROCESSING.
*
*         ENTRY  (TB) = STATUS OF BLOCK READ.
*                (CN+3 - CN+4) = IN POINTER.
*
*         EXIT   TO *RET* IF TERMINATION CONDITION MET.
*                TO *RET2* IF DROP OUT CONDITION OR RECOVERED ERROR.
*
*         USES   CN+3, CN+4, HP.
*
*         CALLS  CIB, UIP.
*
*         MACROS SADT.
 
 
 EBP      SUBR               ENTRY/EXIT
          LDD    TB
 EBPA     SBN    0           READ STOP CONDITION
 EBPB     PJN    EBP3.1      IF TERMINATION MET (NOT LEVEL 17 READCW)
*         PJN    EBP3        IF TERMINATION MET (LEVEL 17 READCW)
          RJM    CIB         CHECK INPUT BUFFER
          SADT   .BS,C
          ADC    -*          (- MAXIMUM BLOCK SIZE)
 EBPC     MJN    EBP1        IF NOT ROOM FOR NEXT BLOCK
*         PSN                (READSKP)
          SADT   .BS,C
          ADC    -*          (-MAXIMUM BLOCK SIZE)
          SHN    -21
          RAM    UIPB        SET DRIVER RECALL FLAG
          LDD    EP          CHECK IF ERROR OR RECOVERY IN PROGRESS
          LPN    77
          ADD    EC
          ADD    DF          CHECK DROP OUT FLAG
          NJN    EBP2        IF DROP OUT OR ERROR CONDITION
 EBP1     RJM    UIP         UPDATE IN POINTER
          UJN    EBPX        RETURN
 
 EBP2     RJM    UIP         UPDATE IN POINTER
          LJM    RET2        REQUEUE
 
 EBP3     LDM    VDAB        BACK UP IN POINTER
          STD    CN+3
          LDM    VDAC
          STD    CN+4
 EBP3.1   RJM    UIP         UPDATE IN POINTER IN FET
 EBPD     UJN    EBP3.2      COMPLETE FET
*         LDM    LNUM        (READSKP)
          CON    LNUM
 EBPE     SBN    0           LEVEL NUMBER DESIRED
          PJN    EBP3.2      IF TERMINATION MET
 EBPF     LDN    4           SET TO SKIP RECORD
*         LDN    10          (IF FILE SKIP REQUIRED)
          STD    PB          INDICATE TO MAGNET TO SKIP
          LDN    /MTX/BEI
          LJM    RET3        RETURN ERROR CODE
 
 EBP3.2   LDD    TB
          ZJN    EBP4        IF PRU READ COMPLETE
          LDD    UP          SET EOR/EOF FLAG
          SCN    10
          LMN    10
          STD    UP
          LDD    TB
          ADN    1           RETURN EOR/EOF
          SHN    3+4
          LMM    LNUM        MERGE LEVEL NUMBER
          SHN    16
 EBP4     ADN    1
          LJM    RET         SET FET COMPLETE
 ITS      SPACE  4,10
**        ITS - INDICATE *1MT* TRANSFER STARTED.
*
*         ENTRY  (A) = BYTE COUNT.
*
*         EXIT   (A) = BYTE COUNT.
 
 
 ITS      SUBR               ENTRY/EXIT
          STD    T0          SAVE BYTE COUNT
          LDM    CPDA        INDICATE *1MT* TRANSFER STARTED
          ADN    3
          CWD    ON
          LDD    T0          RESTORE (A)
          UJN    ITSX        RETURN
 SRQ      SPACE  4,10
**        SRQ - SEND REQUEST TO *1LT* TO START BLOCK.
*
*         ENTRY  (A) = REQUEST CODE.
*                (CN+3 - CN+4) = IN POINTER.
*
*         EXIT   TO *RET2* IF *1LT* PAUSING.
*
*         USES   EC, TB, CM - CM+4.
*
*         CALLS  ADP, CPD, HNG.
 
 
 SRQ      SUBR               ENTRY/EXIT
          STM    SRQC        SAVE REQUEST CODE
          LDN    0           ALLOW FOR CONTROL WORD
 SRQA     EQU    *-1
*         LDN    1           (200 READ CODE)
          RJM    ADP
          LDN    0
          STM    VDAD+3      CLEAR BLOCK LENGTH FOR CONTROL WORD
          STM    VDAD+4
          STM    VDAA        INDICATE *1MT* FINISHED INPUT
          STM    .BYC        FULL CHUNK COUNT READ
          STD    EC          ERROR CODE
          STD    TB          TERMINATION STATUS
          LDD    CN+3
          STM    SRQC+3
          LDD    CN+4
          STM    SRQC+4      SET UP IN POINTER FOR *1LT*
          PSN
*         UJN    SRQ1        (NOT CYBER 180)
 SRQB     EQU    *-1
          SCF    *+2,CH      SET CHANNEL FLAG
          LDM    CPDA        INDICATE *1MT* TRANSFER STARTED
          ADN    3
          CWD    ON
 SRQ1     LDM    CPDA        CHECK *1LT* FUNCTION
          ADN    1
          CRD    CM
          LDD    CM
          LMN    PRLM
          ZJN    SRQ2        IF *1LT* PAUSING
          LDM    CPDA        ENTER REQUEST
          ADN    2
          CWM    SRQC,ON
          RJM    CPD         CHECK PP DROP OUT
          ZJP    SRQX        IF *1LT* STILL AROUND
          RJM    HNG         HANG PP
 
 SRQ2     LJM    RET2        REQUEUE REQUEST
 
 
 SRQC     BSS    0           *1LT* REQUEST
          CON    1           READ BLOCK REQUEST
          CON    LIRW        REMAINDER
          CON    LICH        CHUNK COUNT
          CON    0,0         IN POINTER
 UCP      SPACE  4,10
**        UCP - UPDATE COUNTERS AND POINTERS.
*
*         ENTRY  (CN+3 - CN+4) = IN POINTER.
*
*         EXIT   (A) = (.BYC) = FULL CHUNKS READ.
*
*         CALLS  ADP.
 
 
 UCP      SUBR               ENTRY/EXIT
          LDC    LBBY
          RAM    VDAD+4      COUNT BYTES READ
          SHN    -14
          RAM    VDAD+3
          LDC    /MTX/LBWD   ADVANCE POINTER TO WRITE CM
          RJM    ADP
          AOM    .BYC        INCREMENT FULL CHUNK COUNT
          UJN    UCPX        RETURN
 UIP      SPACE  4,15
**        UIP - UPDATE IN POINTER IN FET.
*         IF AN ERROR OCCURRED, THE ERROR PROCESSING OVERLAY IS
*         CALLED.  ERRORS INCLUDE TAPE MARKS AND EOT.  IF NO ERROR
*         OCCURRED OR THE ERROR IS RECOVEABLE, THE IN POINTER IN THE
*         FET IS UPDATED.
*
*         CALLS  *CRE*, *REM*.
*
*         MACROS CALL, SADT.
 
 
 UIP      SUBR               ENTRY/EXIT
          LDD    EP
          LPN    77
          ADD    EC
          ZJN    UIP1        IF NO ERROR ENCOUNTERED
 UIPA     CALL   REM         LOAD READ ERROR PROCESSOR
*         CALL   CRE         LOAD ERROR PROCESSOR (CTS)
          SADT   .FE,,2,A
 UIP1     LDC    *           UPDATE IN POINTER IN FET
          CWD    CN
          LDN    0           RECALL CPU FLAG
 UIPB     EQU    *-1
*         LDN    1           (ROOM FOR 1 BLOCK, NO ROOM FOR 2 BLOCKS)
          ZJN    UIP2        IF NO RECALL CPU
          LDD    OA          RECALL CPU
          CWM    UIPD,ON
          SOM    UIPB
 UIP2     AOD    BL+1        INCREMENT BLOCK COUNT
          SHN    -14
          RAD    BL
          AOD    BT          INCREMENT BLOCKS TRANSFERRED
          LJM    UIPX
 UIPC     EQU    *-1
*         LJM    RET4        (FATAL READ ERROR)
 
 
 UIPD     CON    DRCM        DRIVER RECALL CPU MONITOR FUNCTION
 VDA      SPACE  4,20
**        VDA - VALIDATE DATA.
*         THIS ROUTINE UPDATES THE BYTE COUNTER AND IN POINTER FOR THE
*         LAST CHUNK READ.  IF *1MT* READ THE LAST CHUNK, *WDA* PUTS
*         THE DATA IN CENTRAL.  THIS ROUTINE ALSO VALIDATES THE DATA
*         IN THE BLOCK PREFIX, AND WRITES THE BEGINNING CONTROL WORD
*         FOR A 200 READ.
*
*         ENTRY  (A) = BYTE COUNT USED FOR LAST INPUT.
*                (T1) = BYTES NOT TRANSFERRED.
*                (VDAA) = 0 IF *1MT* FINISHED THE TRANSFER.
*                (BUFB-5 - BUFB-1) = BLOCK PREFIX.
*                (.BYC) = FULL CHUNKS TRANSFERRED.
*
*         EXIT   (TB) = TERMINATION STATUS.
*                (LNUM) = LEVEL NUMBER.
*                (EC) = /MTX/BNE IF VALIDATION ERROR.
*                (BUFB) = LEVEL NUMBER FOR 200 READ.
*                (VDAE) .NE. 0 IF BLOCK LENGTH ERROR.
*
*         USES   BY, T1, T2, WC.
*
*         CALLS  ADP, UCP, WDA.
 
 
 VDA      SUBR
          SBD    T1
          STD    BY          BYTE COUNT READ
 
*         ADJUST THE BYTE COUNT TO ALLOW FOR THE PREFIX, THEN
*         CALCULATE THE WORD COUNT TO TRANSFER TO CENTRAL.
 
          LDM    .BYC
          NJN    VDA1        IF NOT FIRST CHUNK
          LDD    BY
          SBN    2
          PJN    VDA2        IF AT LEAST 2 BYTES RECEIVED
 VDA1     LDD    BY
          ADN    3
 VDA2     STD    T2
          SHN    1           13*BYTES
          ADD    T2
          SHN    2
          ADD    T2
          SHN    14  (-6)    (13*BYTES)/64
          STD    T0
          SHN    6+2         4*13*BYTES  (52*BYTES)
          SBD    T2          51*BYTES
          ADD    T0          (51*BYTES)+((13*BYTES)/64)
          SHN    -8D         WORDS = ((51*BYTES)+((13*BYTES)/64))/256
          STD    WC
          LPN    1
          NJN    VDA3        IF NO PAD BYTE ADDED ON WRITE
          LDD    BY
          ZJN    VDA3        IF NO DATA READ THIS CHUNK
          SOD    BY
 VDA3     LDC    *
 VDAA     EQU    *-1
          NJN    VDA5        IF *1LT* FINISHED INPUT
          LDM    .BYC
          ZJN    VDA4        IF FIRST CHUNK
          RJM    UCP         UPDATE COUNTERS AND POINTER FOR *1LT*
 VDA4     LDD    WC
          RJM    ADP         ADVANCE IN POINTER
          RJM    WDA         WRITE DATA TO CENTRAL MEMORY
          UJN    VDA6        CHECK BYTES READ
 
 VDA5     LDD    WC          ADVANCE IN POINTER FOR *1LT*
          RJM    ADP
 VDA6     LDM    VDAD+3
          STD    T1          BYTES READ (UPPER)
          LDM    VDAD+4
          STD    T2          BYTES READ (LOWER)
          LDD    WC
          SHN    2
          ADD    WC
          RAM    VDAD+4      UPDATE BYTE COUNT FOR CONTROL WORD
          SHN    -14
          RAM    VDAD+3
          LDM    BUFB-4      SAVE BLOCK LENGTH LOWER BITS
          STM    //BNEI
          LDM    BUFB-5      SAVE BLOCK LENGTH UPPER BITS
          STM    //BNEU
          LDM    BUFB-2      SAVE BLOCK NUMBER
          STM    //BNEI+2
          LDM    BUFB-3
          STM    //BNEI+1
          LDN    1
          STM    VDAE
          LDD    BY
          ADM    .BYC
          ZJN    VDA9        IF NO BYTES READ
          LDM    .BYC
          ZJN    VDA8        IF FIRST CHUNK
          LDD    T2          BYTES (LOWER) READ BEFORE LAST CHUNK
          ADN    5           ALLOW FOR PREFIX
 VDA8     ADD    BY          BYTES READ THIS CHUNK
          STD    T0
          SHN    -14
          ADD    T1          BYTES (UPPER) READ BEFORE LAST CHUNK
          LMM    BUFB-5
          NJN    VDA9        IF BLOCK LENGTH UPPER ERROR
          LDD    T0
          LMM    BUFB-4
          NJN    VDA9        IF BLOCK LENGTH LOWER ERROR
          STM    VDAE
          LDM    BUFB-3
          LMD    BL
          NJN    VDA9        IF BLOCK NUMBER UPPER ERROR
          LDM    BUFB-2
          LMD    BL+1
          ZJN    VDA10       IF BLOCK NUMBER CORRECT
 VDA9     LDN    /MTX/BNE
          STD    EC
 VDA10    LDM    .BYC
          LMN    LICH
          NJN    VDA11       IF NOT FULL PRU
          LDD    BY
          LMC    LIRW*5
          STM    BUFB        SET 0 LEVEL NUMBER
          ZJN    VDA13       IF FULL PRU
 VDA11    LDM    BUFB-1      SET LEVEL NUMBER FOR CONTROL WORD
          STM    BUFB
          STM    LNUM
          LMN    17
          ZJN    VDA12       IF EOF
          LCN    1
 VDA12    ADN    2
 VDA13    STD    TB          SET BLOCK STATUS
          LDD    MD
          LPN    40
          ZJN    VDA14       IF NOT CONTROL WORD READ
          LDC    *           PUT CONTROL WORD IN BUFFER
 VDAB     EQU    *-1
          SHN    6
          ADD    RA
          SHN    6
          ADC    *
 VDAC     EQU    *-1
          CWM    VDAD,ON
 VDA14    LJM    VDAX
 
*         BEGINNING CONTROL WORD FOR 200 READ.
 
 VDAD     DATA   1,0         PRU SIZE
          DATA   0
          DATA   0,0         BLOCK LENGTH IN BYTES
 VDAE     DATA   0           0 IF CORRECT BLOCK LENGTH (FOR ERR. REC.)
 WDA      SPACE  4,10
**        WDA - WRITE DATA TO CENTRAL MEMORY.
*
*         ENTRY  (T4 - T5) = IN POINTER.
*                (T6) = FIRST PART WORD COUNT.
*                (T7) = SECOND PART WORD COUNT.
*
*         MACROS SADT.
 
 
 WDA      SUBR               ENTRY/EXIT
          LDD    T6
          ZJN    WDAX        IF NO FIRST PART
          SHN    2
          ADD    T6
          ADC    BUFB
          STM    WDAA
          LDD    T4          TRANSFER FIRST PART
          SHN    6
          ADD    RA
          SHN    6
          ADD    T5
          CWM    BUFB,T6
          LDD    T7
          ZJN    WDAX        IF NO SECOND PART
          SADT   .FT,,,A
          LDC    *           TRANSFER SECOND PART
          CWM    *,T7
 WDAA     EQU    *-1
          UJN    WDAX        RETURN
 WTS      SPACE  4,10
**        WTS - WAIT FOR *1LT* TRANSFER TO START.
*
*         ENTRY  (A) = BYTE COUNT.
*
*         EXIT   (A) = BYTE COUNT.
*
*         USES   CM - CM+4.
 
 
 WTS3     LDD    T0          RESTORE (A)
 
 WTS      SUBR               ENTRY/EXIT
          STD    T0          SAVE BYTE COUNT
 WTS1     LDM    CPDA        CHECK *1MT*/*1LT* INTERLOCK
          ADN    3
          CRD    CM
          LDD    CM
          ZJN    WTS3        IF *1LT* TRANSFER STARTED
          LDN    24          DELAY 10 MICROSECONDS
 WTS2     SBN    1
          NJN    WTS2        IF NOT DONE
          UJN    WTS1        CHECK INTERLOCK
          SPACE  4,10
          ERRNG  BUFB-5-*    CODE OVERFLOWS INTO DATA BUFFER
          TITLE  PRESET.
 PRS      SPACE  4,10
**        PRS - PRESET.
*         THIS OVERLAY IS ONLY LOADED IF THE FUNCTION IS A READ AND
*         THE FORMAT IS LI.  THIS ROUTINE LOADS *1LT* WHICH TRANSFERS
*         THE 2ND, 4TH, ... CHUNKS OF THE BLOCK.
*
*         EXIT   TO *RET2* IF MOVE FLAG OR NO PP ASSIGNED FOR *1LT*.
*                TO *RLI* TO READ THE FIRST BLOCK.
*
*         USES   T1, CM - CM+4.
*
*         CALLS  CEC, CPD, *CPP*, MCH.
*
*         MACROS MONITOR, PAUSE.
 
 
 PRS      LDC    PRSA        MODIFY CHANNELS
          RJM    MCH
          LDD    WC
          STM    /READ/WOCN  SO /CPP/CAL SETS CORRECT BLOCK SIZE
          LDD    HP
          LPN    20
          SHN    6
          RAM    CALL+3      SET ATS FLAG FOR *1LT*
          LDC    TRSO
          STD    T1
 PRS1     LDI    T1
          ZJN    PRS5        IF END OF TABLE
          LMM    CIOE
          LPC    774
          ZJN    PRS2        IF FUNCTION FOUND IN TABLE
          LDN    2
          RAD    T1
          UJN    PRS1        CHECK NEXT ENTRY IN TABLE
 
 PRS2     AOD    T1
          LDM    LNUM
          SHN    -10
          RAM    EBPE        SET *READSKP* LEVEL NUMBER
          LPN    17
          LMN    17
          NJN    PRS3        IF NOT LEVEL 17
          LDN    10-4        SET *READSKP* FOR FILE SKIP
          RAM    EBPF
          LDD    MD
          LPN    40
          ZJN    PRS3        IF NOT 200 READCW
          LCN    EBP3.1-EBP3 SUPPRESS LEVEL 17 EOF CONTROL WORDS
          RAM    EBPB
          SOI    T1          ADJUST TERMINATION CONDITION
 PRS3     LDI    T1
 PRS4     RAM    EBPA
 PRS5     LDN    F0040       SELECT READ FUNCTION
          STM    //ITMA
          LDD    MD
          LPN    40
          ZJN    PRS6        IF NO CONTROL WORDS
          AOM    SRQA        ALLOW FOR CONTROL WORD
 PRS6     LDD    HP
          SHN    21-7
          PJN    PRS7        IF NOT CTS
          LDC    LDNI+CRE/10000  CALL CTS ERROR PROCESSOR
          STM    UIPA
          LDC    6125        BITS TO TEST IN GENERAL STATUS
          STM    /PRESET/WFEA
          LDN    1           BITS IN GENERAL STATUS THAT SHOULD BE SET
          STM    /PRESET/WFEB
          LJM    PRS13       SET TO MODIFY SADT INSTRUCTIONS
 
*         REPLACE *RLI* WITH READ ROUTINE *ALI* FOR ATS.
 
 PRS7     LDC    .ALIL-1     LENGTH OF CODE TO MOVE
          STD    T1
 PRS8     LDM    .ALI,T1
          STM    ALI,T1
          SOD    T1
          PJN    PRS8        IF MORE CODE TO MOVE
          LDC    .ALIB       MODIFY CHANNELS
          RJM    MCH
          LDC    4435        BITS TO TEST IN GENERAL STATUS
          STM    //WEOA
          LDN    1           BITS IN GENERAL STATUS THAT SHOULD BE SET
          STM    //WEOB
          LDK    MABL        CHECK MAINFRAME TYPE
          CRD    CM
          LDD    CM+1
          SHN    -6
          LPN    41
          LMN    1
          NJP    PRS10       IF NOT CYBER 180
 
*         PRESET FOR CYBER 180 IOU.  THE CHANNEL FLAG IS USED FOR
*         COMMUNICATION BETWEEN *1MT* AND *1LT* IF CYBER 180.
 
          LDC    UJNI+2      JUMP TO INPUT FIRST CHUNK
          STM    ALIE
          LDC    ALI1
          STM    ALIA        JUMP ADDRESS IF NOT LAST CHUNK
          LDC    AILA
          STM    ALIG
          STM    ALIB
          LDC    ALI8
          STM    ALIF        JUMP ADDRESS IF LAST CHUNK
          LDN    .AILL-1     MOVE IOU LOOP
          STD    T1
 PRS9     LDM    .AIL,T1
          STM    AIL,T1
          SOD    T1
          PJN    PRS9        IF MORE CODE TO MOVE
          LDC    .AILB       MODIFY CHANNELS
          RJM    MCH
          UJN    PRS11       CONTINUE PRESET
 
 PRS10    ISTORE SRQB,(UJN SRQ1)  SKIP SETTING CHANNEL FLAG
 PRS11    LDD    EP          SET CLIPPING LEVEL
          LPC    700
          ZJP    PRS12       IF NORMAL CLIP LEVEL
          RAM    ALIC
          UJN    PRS13       CONTINUE PRESET
 
 PRS12    LDC    UJNI+2      DISABLE CLIP LEVEL SELECTION
          STM    ALID
 PRS13    LDC    PRSB        SET TO MODIFY SADT INSTRUCTIONS
          STD    CN
          LDN    2           SET TO FETCH IN POINTER
          STD    CN+4
          LDC    /SRU/ITRL*100  SET SRU INCREMENT
          STM    //CECA
          LDC    PRS14       SET TO RETURN HERE AFTER *CPP* LOADED
          STD    BT
          LJM    PRSX        RETURN
 
*         RETURN HERE AFTER *CPP* LOADED.
*         BUILD CALL TO *1LT*.
 
 PRS14    LDD    CP          MERGE CP NUMBER
          SHN    -7
          RAM    CALL+1
          LDD    IA          SET INPUT REGISTER ADDRESS IN CALL
          STM    CALL+4
          LDN    CMCL        CHECK MOVE FLAG
          CRD    CM
          LDD    CM
          SHN    7
          LMD    CP
          ZJN    PRS15       IF MOVE FLAG
          LDD    MA          WRITE REQUEST BLOCK
          CWM    CALL,TR
          LDN    1           SET TO NOT QUEUE REQUEST
          STD    CM+1
          MONITOR RPPM       REQUEST PP
          LDD    CM+1
          NJN    PRS16       IF PP ASSIGNED
 PRS15    LJM    RET2        REQUEUE
 
 PRS16    STM    CPDA        SAVE PP INPUT REGISTER ADDRESS
 PRS17    LDN    77          DELAY
          SBN    1
          NJN    *-1
          LDD    MA          CHECK FOR *1LT* ACKNOWLEDGE
          ADN    1
          CRD    CM
          LDD    CM
          ZJN    PRS19       IF *1LT* READY
          RJM    CPD         CHECK PP DROP OUT
          NJN    PRS15       IF *1LT* GONE
          LDN    CMCL        CHECK MOVE FLAG
          CRD    CM
          LDD    CM
          SHN    7
          LMD    CP
          NJN    PRS17       IF NO MOVE FLAG FOR THIS CP
          RJM    CEC         CHANGE BACK TO MAGNET CP
 PRS18    RJM    CPD         CHECK PP DROP OUT
          NJN    PRS15       IF *1LT* GONE
          PAUSE  NE
          UJN    PRS18       LOOP
 
 PRS19    LDM    CIOE
          LPC    774
          LMN    20
          NJN    PRS20       IF NOT READ SKIP
          STM    EBPC
          LDC    UJNI-PJNI
          RAM    RLIB
          LDC    LDMI
          STM    EBPD
          RJM    CIB
          MJN    PRS21       IF BUFFER ARGUMENT ERROR
          STD    T5
          SHN    -14
          STD    T4
          LDN    3           SET REQUEST TO *1LT*
          RJM    SRQ
 PRS20    LDN    77          DELAY
          SBN    1
          NJN    *-1         IF DELAY NOT COMPLETE
          RJM    CRA         SEE IF *1LT* ACCEPTED READ SKIP
          LMN    2
          NJN    PRS20       IF *1LT* NOT DONE
 PRS21    LJM    RLI         ENTER READ ROUTINE
 CALL     SPACE  4,10
**        *1LT* CALL BLOCK.
*
*T        18/  1LT,6/ CP,12/  0,12/ CHANNEL,12/  PPIA
*T,       12/  -0,24/  FIRST,24/  LIMIT
 
 
 CALL     VFD    18/3R1LT,6/0
          CON    0           READ
          CHTE   *
          CON    CH          CHANNEL
          CON    0           *1MT* INPUT REGISTER ADDRESS
          CON    -0
          SADT   .FT,,,,SE
          CON    0,0
          SADT   .LM,,,,SE
          CON    0,0
 
          ERRMI  ERLA-*      IF CODE OVERFLOWS
 TRSO     SPACE  4,10
**        TRSO - TABLE OF READ STOP CODES.
 
 
 TRSO     BSS    0
          CON    10,1        READ
          CON    20,1        READSKP
          CON    200,3       READCW
          CON    250,2       READNS
          CON    600,3       READEI
          CON    0           RPHR
 
 PRSA     CHTB               CHANNEL TABLE
 PRSB     TSAD
          TITLE  PRESET SUBROUTINES.
 ALI      SPACE  4,15
**        ALI - ATS LI FORMAT READ.
*         THIS ROUTINE OVERLAYS *RLI*.
*
*         USES   T1.
*
*         CALLS  ADP, CDO, CRA, DTS, EBP, FCN, ITM, MCC, SRQ, STW,
*                UBW, UCP, VDA, WDA, WEO.
 
 
 .ALI     BSS    0
          LOC    .RLIA
 ALI      LDC    NJNI+ALI6-ALIH
*         LDC    ALI1        (CYBER 180)
 ALIA     EQU    *-1
          STM    ALIH        NOT LAST CHUNK
*         STM    AILA        (CYBER 180)
 ALIB     EQU    *-1
          LDC    6
*         LDC    X06         (SELECT CLIP LEVEL)
 ALIC     EQU    *-1
          RJM    FCN
*         UJN    *+2         (NORMAL CLIP LEVEL)
 ALID     EQU    *-2
          RJM    ITM         INITIATE TAPE MOTION
          LDN    1
          RJM    SRQ         SEND START BLOCK REQUEST TO *1LT*
          LDD    DS          SAVE DEVICE STATUS
          STM    /READ/STAP
          LDC    LBBY+5      BYTE COUNT FOR FIRST CHUNK
          STM    ALII
          LJM    ALI7        INPUT THE FIRST CHUNK
*         UJN    *+2         (CYBER 180 - INPUT THE FIRST CHUNK)
 ALIE     EQU    *-2
          IAM    BUFB-5,CH   INPUT FIRST CHUNK
 ALI1     IJM    ALI9,CH     IF *1MT* FINISHED THE CHANNEL TRANSFER
          EJM    ALI1,CH     IF *1LT* NOT TAKING DATA YET
          CCF    *,CH        TELL *1LT* TO START
 ALI2     RJM    UCP         UPDATE COUNTERS AND POINTER
          LMN    1
          ZJN    ALI3        IF FIRST CHUNK
          RJM    UCP         UPDATE COUNTERS AND POINTER
 ALI3     RJM    WDA         WRITE DATA TO CENTRAL MEMORY
          LDC    LBBY
          STM    ALII        BYTE COUNT FOR MIDDLE CHUNK
          LDM    .BYC
          SBN    LICH-1      FULL CHUNKS PER BLOCK - 1
          MJN    ALI4        IF MORE FULL CHUNKS TO INPUT
          LDC    LIRW*5+1+1  BYTES IN REMAINDER + PAD + 1
          STM    ALII
          LDC    UJNI+ALI8-ALIH
*         LDC    ALI8        (CYBER 180)
 ALIF     EQU    *-1
          STM    ALIH        LAST CHUNK HANDLING
*         STM    AILA        (CYBER 180)
 ALIG     EQU    *-1
 
*         THE FOLLOWING CODE IS OVERLAID BY CODE AT *AIL* IF USING
*         THE CHANNEL FLAG INSTRUCTION.
 
 .ALIA    BSS    0           BEGINNING OF OVERLAID CODE
 ALI4     AJM    *,CH        IF WAITING FOR *1LT* TO DCN CHANNEL
          LDM    ALII        SET NUMBER OF BYTES TO INPUT
 ALI5     IJM    ALI19,CH    IF *1LT* FINISHED THE CHANNEL TRANSFER
          EJM    ALI5,CH     IF *1LT* STILL READING
          IAM    BUFB,CH     INPUT DATA
          DCN    CH+40       INDICATE TO *1LT* TO CONTINUE READ
          NJN    ALI9        IF *1MT* FINISHED THE CHANNEL TRANSFER
 ALIH     EQU    *-1
*         UJN    ALI8        (LAST CHUNK)
          ACN    CH
 ALI6     IJM    ALI9,CH     IF *1MT* FINISHED THE CHANNEL TRANSFER
          EJM    ALI6,CH     IF *1LT* NOT TAKING DATA YET
          LJM    ALI2        SETUP FOR NEXT CHUNK
 
 ALI7     IAM    BUFB-5,CH
          DCN    CH+40       INDICATE TO *1LT* TO CONTINUE READ
          NJN    ALI9        IF *1MT* FINISHED THE CHANNEL TRANSFER
          ACN    CH
          UJN    ALI6        SAVE BYTES NOT TRANSFERRED
 
 .ALIAL   EQU    *-.ALIA     LENGTH OF OVERLAID AREA
 
 ALI8     NJN    ALI9        IF NOT EXCESS BLOCK LENGTH
          LDN    /MTX/BTL    SET BLOCK TOO LONG
          RJM    MCC         MASTER CLEAR CHANNEL
*         LDN    0
          RJM    STW         GET GENERAL STATUS
          LDN    1           SET TO COMPUTE WORD COUNT
 ALI9     STD    T1
          LDC    LBBY+5      BYTE COUNT FOR FIRST CHUNK
*         LDC    LBBY        (MIDDLE CHUNK)
*         LDC    LIRW*5+1+1  (LAST CHUNK)
 ALII     EQU    *-1
          RJM    VDA         PROCESS DATA
          RJM    CDO         CHECK DROP OUT FLAG
 
*         PROCESS STATUS.
 
          RJM    WEO         WAIT FOR END OF OPERATION
          ZJN    ALI12       IF NO ERRORS
          SHN    21-4
          PJN    ALI10       IF NOT TAPE MARK
          LDN    3           SET STOP TO EOI
          STD    TB
          LDN    17          SET LEVEL NUMBER
          STM    LNUM
          LDM    VDAB        BACK UP POINTERS
          STD    CN+3
          LDM    VDAC
          STD    CN+4
          LDN    /MTX/BEI    SET EOI
          STD    EC
          UJN    ALI15       GET DETAILED STATUS
 
 ALI10    LDD    EC
          ZJN    ALI11       IF ERROR NOT ALREADY ENCOUNTERED
          LDM    MTDS
          ZJN    ALI13       IF NOT FATAL ERROR
 ALI11    LDN    /MTX/STE    STATUS ERROR
          STD    EC
          UJN    ALI13       NO TAPE ERROR REPORTED FROM HARDWARE
 
 ALI12    LDM    MTDS+1
          SHN    21-11
          PJN    ALI13       IF NO GCR SINGLE TRACK CORRECTION
          AOM    ECNT+4      INCREMENT COUNTER
          SHN    -14
          RAM    ECNT+3      INCREMENT COUNTER FOR OVERFLOW
 ALI13    LDD    DS
          LPN    40
          ZJN    ALI14       IF NO FILL STATUS
          LDD    EC
          NJN    ALI15       IF ERROR ALREADY ENCOUNTERED
          LDN    /MTX/STE
          STD    EC
 ALI14    LDD    EC
          NJN    ALI15       IF ERROR
          RJM    UBW         UPDATE BID WINDOW
          UJN    ALI16       SAVE STATUS FOR ERROR PROCESSOR
 
 ALI15    RJM    DTS         DETAILED STATUS
 ALI16    LDD    DS          SAVE STATUS FOR ERROR PROCESSOR
          STM    //STER
 ALI17    RJM    CRA         READ *1LT* INTERFACE WORD
          NJN    ALI17       IF *1LT* TRANSFER TO CM NOT COMPLETE
          LDD    MD
          LPN    40
          ZJN    ALI18       IF NOT 200 READ CODE
          LDN    1
          RJM    ADP
          RJM    WDA         WRITE TRAILER CONTROL WORD
 ALI18    LDN    0
          STD    CM          ACKNOWLEDGE *1LT*
          LDM    CPDA
          ADN    2
          CWD    CM
          RJM    EBP         END OF BLOCK PROCESSING
          LJM    RLI         READ NEXT BLOCK
 
*         *1LT* FINISHED THE CHANNEL TRANSFER.
 
 ALI19    RJM    CRA         READ *1LT* INTERFACE WORD
          NJN    ALI19       IF *1LT* TRANSFER TO CM NOT COMPLETE
          AOM    VDAA        INDICATE *1LT* FINISHED THE TRANSFER
          LDC    LBBY
          STM    ALII        BYTE COUNT FOR INPUT
          SBD    CM+1
          LJM    ALI9        SAVE BYTES NOT TRANSFERRED
 
          LOC    *O
 .ALIL    EQU    *-.ALI      LENGTH OF *ALI*
          ERRMI  .RLIAL-.ALIL  IF CODE OVERFLOWS
 .ALIB    CHTB               CHANNEL TABLE
 AIL      SPACE  4,10
**        ATS INPUT LOOP IF USING THE CHANNEL FLAG INSTRUCTION.
 
 
 .AIL     BSS    0
          LOC    .ALIA
 AIL      LDM    ALII        BYTES TO INPUT
          RJM    WTS         WAIT FOR *1LT* TRANSFER TO START
 AIL1     IJM    ALI19,CH    IF *1LT* FINISHED THE CHANNEL TRANSFER
          SCF    AIL1,CH     IF *1LT* STILL READING
          RJM    ITS         INDICATE *1MT* TRANSFER STARTED
          IAM    BUFB,CH
          LJM    ALI1        SAVE WORDS NOT TRANSFERRED
 AILA     EQU    *-1
*         LJM    ALI8        LAST CHUNK
 
          LOC    *O
 .AILL    EQU    *-.AIL      LENGTH OF ATS INPUT LOOP
 
          ERRMI  .ALIAL-.AILL  IF IOU INPUT CODE TOO LONG
 
 .AILB    CHTB               TABLE OF CHANNELS FOR IOU CODE
          OVERLAY (READ LABEL PROCESSOR.),(/READ/ORLA),,RLA
 RLA      SPACE  4,15
**        RLA - READ LABELS PROCESSOR.
*
*T        12/ 0,12/ RLA,12/ 0100,12/ PAR,6/ OP,6/ SEC
*
*         OP     OPERATION TYPE (SEE LISTS BY LABEL TYPE)
*         SEC    SECTION IN PROCESS.
*         PAR    PARAMETER.
*
*         RETURN TO *RLAX* WILL ADVANCE TO NEXT SECTION WITHOUT A
*         NEW READ BEING PERFORMED.
*
*         CALLS  CHC, CCL, FCN, HNG, *MFP*, /READ/MRD9.1, /READ/RCT13,
*                /READ/RDF, RUD, UBW, WEL, /PRESET/WFE.
*
*         MACROS CALL.
 
 
          ENTRY  RLA
 RLA      LDD    PB
          SHN    -6
          SBN    /MTX/RLCM/100
          MJN    RLA1        IF NOT MULTI-FILE OPERATION
          CALL   MFP
 RLA1     UJN    RLA1.1      DISABLE IF NOT INITIAL LABEL CHECK
*         LDN    0           (CLEAR LABEL RETRY COUNTER)
 RLAF     EQU    *-1
          STM    LERA
 RLA1.1   LDD    PB          CHECK SEQUENCE
          SHN    -6
          LMC    0           (CURRENT SEQUENCE)
 RLAA     EQU    *-1
          NJN    RLA2        IF INCORRECT SEQUENCE
          LDD    PB          SET SECTION
          LPN    77
          STD    T1
          ADC    -*          (MAXIMUM NUMBER OF SECTIONS)
 RLAB     EQU    *-1
          MJN    RLA3        IF LEGAL SECTION
 RLA2     RJM    HNG         HANG PP
 RLA3     LDM    TABC,T1
          STM    RLAE
          RJM    RUD         READ UDT LABEL DATA
          LDC    BUF         SET DEFAULT BUFFER ADDRESS
          STM    IBUF
          LDC    UDTB
          STM    DBUF
          LDC    0
 RLAC     EQU    *-1
          SHN    21-13
          MJP    RLA7        IF RECOVERED LABEL BLOCK
          NJN    RLA4        IF SKIP READ
          LDC    *           (READ BEFORE FIRST OPERATION FLAG)
 RLAD     EQU    *-1
          ZJN    RLA5        IF READ BEFORE FIRST OPERATION
          LDN    0
          STM    RLAD
 RLA4     UJP    RLA9        PROCESS ROUTINE
 
 RLA5     LDD    MD          CHECK DIRECTION
          SHN    21-12
          PJN    RLA5.1      IF FORWARD READ
          LDC    F0113       ISSUE BACKSPACE FUNCTION
          RJM    FCN
          STD    EC          CLEAR ERROR CODE
          LDN    LABL        SET LABEL LENGTH
 RLAI     EQU    *-1
*         LDN    CLBL        CTS LABEL LENGTH
          STD    BY
          LDD    HP
          SHN    21-7
          PJP    /READ/MRD9.1  IF NOT CTS (RETURN AT *RLA6.1)
 RLA5.0   RJM    /PRESET/WFE WAIT FOR END OF OPERATION
          MJN    RLA5.0      IF COMMAND RETRY
          NJP    /READ/RCT13 IF ERROR
          LDN    40
          STD    ES          CHARACTER FILL STATUS
          UJN    RLA6.1      SAVE STATUS FOR ERROR PROCESSING
 
 RLA5.1   LJM    /READ/RDF   READ TAPE
 
*         ENTER HERE AFTER LABEL READ OR BACKSPACE FUNCTION.
 
 RLA6     CALL   CCL         CODE CONVERT LABEL
 RLA6.1   AOD    BT          INCREMENT BLOCKS READ
          LDD    EC
          NJN    RLA8        IF READ ERROR
 RLA7     RJM    WEL         WRITE EXTENDED LABELS
          UJN    RLA9        PROCESS LABEL
 
 RLA8     LMN    /MTX/BEI
          NJN    RLA9        IF NOT TAPE MARK
          LDN    1           SET TAPE MARK INDICATION
 RLAH     EQU    *-1
*         UJN    RLA9        CTS
          STM    UBWB
          RJM    UBW         UPDATE BLOCK ID WINDOW
 RLA9     LDN    0           CLEAR SKIP READ FLAG
          STM    RLAC
          RJM    *           PROCESS LABEL
 RLAE     EQU    *-1
          NJN    RLA10       IF MORE LABELS TO PROCESS
          LJM    RET1        EXIT
 
 RLAX     AOD    PB          ADVANCE SECTION
          STM    RLAC        SET SKIP READ FLAG
 RLA10    LJM    RLA1        LOOP
 
 RLA11    RJM    CHC         CHANGE CONTROL POINT AND RELOCATE ADDR.
          UJN    RLA10       LOOP
          SPACE  4,10
**        CURRENT OPERATION TABLE.
*
*         CORRECT TABLE WILL BE MOVED INTO THIS
*         AREA BY PRESET ROUTINE.
 
 
 TABC     BSS    14
 TABCL    EQU    *-TABC
 FAD      SPACE  4,10
**        FAD - SET FET ADDRESS.
*         THIS ROUTINE IS HERE AS ADDRESS MODIFICATION DOES NOT WORK
*         ABOVE 3777B.
*
*         EXIT   (A) = FET ADDRESS.
*
*         MACROS SADT.
 
 
 FAD      SUBR               ENTRY/EXIT
          SADT   .FE,,,A
          LDC    *
          UJN    FADX        RETURN
 CHC      SPACE  4,10
**        CHC - CHANGE CONTROL POINTS AND RELOCATE ADDRESSES.
*
*         CALLS  /CPP/CPP.
*
*         MACROS CALL.
 
 
 CHC      SUBR               ENTRY/EXIT
          CALL   CPP
          LDN    ZERL        SET ADDRESS RELOCATION
          CRD    CN
          LDC    TADD
          STD    CN
          RJM    /CPP/CPP
          AOD    PB          INCREMENT SECTION
          UJN    CHCX        RETURN
 CLA      SPACE  4,15
**        CLA - CHECK LABEL FOR VALIDITY.
*         CHECKS FOR SIZE AND ERRORS.
*
*         EXIT   (A) = 0, IF GOOD LABEL.
*                (A) = 1, IF TAPE MARK.
*                (A) = -1, IF ((PB, 11 - 6) = 0) AND BAD LABEL.
*
*                GIVES LABEL MISSING ON ALL OTHER BAD LABELS.
*
*         USES   BT.
*
*         CALLS  CCM, CLL, *CRE*, LER, *REM*.
*
*         MACROS CALL.
 
 
 CLA8     RJM    CLL         CHECK LABEL LENGTH
          NJN    CLA2        IF INCORRECT LENGTH
 
 CLA      SUBR               ENTRY/EXIT
          LDD    EC
          ZJN    CLA8        IF NO ERROR
          LMN    /MTX/BEI
          NJN    CLA1        IF NOT TAPE MARK
          LDN    1           INDICATE TAPE MARK
          UJN    CLAX        RETURN
 
 CLA1     LMN    /MTX/OTF&/MTX/BEI
          ZJN    CLA8        IF ON THE FLY ERROR CORRECTION
          LMN    /MTX/STE&/MTX/OTF
 CLA2     NJN    CLA5        IF NOT STATUS ERROR
          LDD    PB
          SHN    -6
          LMN    /MTX/RLCR/100
          ZJN    CLA6        IF REEL RECHECK
 CLA3     LDD    SP
          SHN    21-2
          MJN    CLA7        IF ERROR PROCESSING INHIBITED
          SOD    BT          DECREMENT BLOCKS READ
 
*         ENTER HERE ON LABEL READ RECOVERY TO RELOAD ERROR PROCESSOR.
 
 CLA4     RJM    LER         CHECK FOR LABEL ERROR AT LOAD POINT/INIT
*         UJN    *+2         (NOT INITIAL LABEL CHECK)
 CLAA     EQU    *-2
 CLAD     CALL   REM         LOAD READ ERROR PROCESSOR
*         CALL   CRE         LOAD ERROR PROCESSOR (CTS)
 
 CLA5     LDD    EC
          LMN    /MTX/NBE
          ZJN    CLA3        IF NOISE BLOCK
          LDD    PB
          SHN    -6
          ZJN    CLA7        IF INITIAL LABEL CHECK
          ERRNZ  /MTX/RLCL
          LMN    /MTX/RLCR/100
          ZJN    CLA7        IF REEL RECHECK
          LDN    /MTX/LAM    LABEL MISSING
          LJM    RET3        RETURN ERROR CODE
 
 CLA6     LDM    MTDS        CHECK FOR ON-THE-FLY CORRECTED ERROR
          LPC    7077
*         LPC    7777        (ATS UNIT)
 CLAB     EQU    *-1
          NJN    CLA7        IF FATAL ERROR
 CLAC     EQU    *-1
*         UJN    CLA7        CTS
          LJM    CLA8        CHECK LENGTH
 
 CLA7     LCN    1           INDICATE BAD LABEL
          LJM    CLAX        RETURN
 
          ERRNG  BUFB-*      *CLA* DESTROYED BY READ ERROR PROCESSOR
 CLL      SPACE  4,15
**        CLL - CHECK LABEL LENGTH.
*
*         THIS ROUTINE VERIFIES THAT THE DATA READ FOR THE LABEL WAS
*         THE CORRECT LENGTH.
*
*         ENTRY  (BY) = BYTES READ.
*                (ES) = FILL STATUS.
*                (HP) = HARDWARE OPTIONS.
*
*         EXIT   (A) = 0 IF CORRECT LENGTH.
 
 
 CLL      SUBR               ENTRY/EXIT
          LDD    HP
          SHN    21-7
          MJN    CLL1        IF CTS
          LDD    BY          BYTES READ
          LMN    LABL
          NJN    CLLX        IF WRONG LENGTH
          LDD    ES          EXPECT NO FILL STATUS
          UJN    CLL2        CHECK FILL STATUS
 
 CLL1     LDD    BY          BYTES READ
          LMN    CLBL
          NJN    CLLX        IF WRONG LENGTH
          LDD    ES
          LMN    40          EXPECT FILL STATUS
 CLL2     LPN    40
          UJN    CLLX        RETURN
 DBT      SPACE  4,10
**        DBT - DETERMINE BLOCK TYPE.
*
*         EXIT   (A) = 0 IF TAPE MARK OR BLOCK WRONG LENGTH.
 
 
 DBT2     LDN    0           SET INCORRECT NUMBER OF BYTES
 
 DBT      SUBR               ENTRY/EXIT
          LDD    EC
          LMN    /MTX/BEI
          ZJN    DBTX        IF TAPE MARK
          LDD    EC
          LMN    /MTX/BTL
          ZJN    DBTX        IF BLOCK TOO LARGE
          LDD    BY
          ZJN    DBT1        IF POSSIBLE RECOVERABLE ERROR
          RJM    CLL         CHECK LABEL LENGTH
          NJN    DBT2        IF INCORRECT LENGTH
 DBT1     LDN    1           SET TO VALIDATE LABEL
          UJN    DBTX        RETURN
 ELA      SPACE  4,10
**        ELA - EXTENDED LABELS ADDRESS PROCESSING.
*
*         ENTRY  (T6 - T7) = POSITION TO START AT IN BUFFER.
*
*         EXIT   (A) = ABSOLUTE ADDRESS.
*                (A) = 0, END OF LABEL BUFFER.
*
*         CALLS  FAD.
 
 
 ELA2     LDN    0           INDICATE END OF BUFFER
 
 ELA      SUBR               ENTRY/EXIT
          RJM    FAD         GET FET ADDRESS
          ADN    11
          CRD    CM
          LDD    CM+3
          SHN    14
          STD    CM+1
          SHN    -14
          STD    CM+3
          SHN    14
          LMD    CM+4
          SBN    2
          MJN    ELA2        IF NO LABEL BUFFER
          LDD    CM+2
          SHN    6
          LMD    CM+1
          STD    CM+2
          SHN    -14
          STD    CM+1
          LDD    T6
          SBD    CM+1
          SHN    14
          ADD    T7
          SBD    CM+2
          ADN    11          ALLOW FOR LABEL
          PJN    ELA2        IF END OF LABEL BUFFER
          LDD    CM+1        CHECK IF BUFFER WITHIN FL
          ADD    CM+3
          SHN    14
          ADD    CM+2
          ADD    CM+4
          SHN    -6
          SBD    FL
          MJN    ELA1        IF BUFFER WITHIN FL
          LDN    /MTX/BAE    BUFFER ARGUMENT ERROR
          LJM    RET3        RETURN ERROR CODE
 
 ELA1     LDD    CM+3
          ADD    T6
          SHN    6
          ADD    RA
          SHN    6
          ADD    CM+4
          ADD    T7
          LJM    ELAX        RETURN
 EOF      SPACE  4,10
**        LOAD POINT RECOVERY CODE OVERLAYS INTO HERE ON INITIAL LABEL
*         CHECK.  THE CHECKING OF END OF FILE LABELS AND VOLUME ONE
*         LABELS WILL NEVER OCCUR AT THE SAME TIME.
 
 .LERA    BSS    0           FWA OF OVERLAY CODE FROM *PRSD*
 EOF      SPACE  4,15
**        EOF - PROCESS *EOF1*.
*         RETURNS 1271/1273 IF EOI ON S/L FORMAT TAPE AND 260/262
*         READ CODE WAS USED.  THIS IS FOR SCOPE PRODUCT SET
*         COMPATIBILITY.
*
*         ALSO COUNTS TAPE MARK AS A BLOCK IF TAPE IS LABELED, BUT
*         LABEL DATA DOES NOT FOLLOW TAPE MARK.  AGAIN THIS FOR SAME
*         REASON AS ABOVE.
*
*         CALLS  CBC, CIF, CLA, DBT, SKR, /MFP/SSN, UAD.
 
 
 EOF      SUBR               ENTRY/EXIT
          RJM    CIF         CHECK INTERNAL TAPE FORMAT
          ZJN    EOF2        IF INTERNAL TAPE FORMAT
          RJM    DBT         DETERMINE BLOCK TYPE
          NJN    EOF2        IF NOT TAPE MARK OR BLOCK TOO LARGE
 
*         ENTRY FROM *EOV*.
 
 EOF0     LDD    PB
          SHN    -6
          LMN    /MTX/RLCF/100
          NJN    EOF1        IF NOT CLOSE
          RJM    SKR         SKIP BLOCK REVERSE
          LJM    RBE         RETURN *BEI* ERROR TO NOT SKIP REVERSE
 
 EOF1     RJM    SKR         SKIP BLOCK REVERSE
          LJM    EOF11       PROCESS TAPE MARK
 
 EOF2     RJM    CLA
          NJN    EOF3        IF BAD LABEL
          LDM    BUF
          LMC    2REO
          NJN    EOF3        IF NOT *EO*
          LDM    BUF+1
          LMC    2RF1
          ZJN    EOF7        IF *EOF1*
 EOF3     LDD    PB          CHECK IF MULTI FILE
          SHN    -6
          SBN    /MTX/RLCM/100
          ZJN    EOF4        IF END OF REEL CHECK
          MJN    EOF5        IF NOT MULTI FILE
          LDN    /MTX/LAM    LABEL MISSING
          LJM    RET3        RETURN ERROR CODE
 
 EOF4     LDN    10
          RAD    PB
          UJN    EOF6        ADVANCE TO NEXT LABEL TYPE
 
 EOF5     ADN    7-6
          NJN    EOF6        IF NOT CLOSE
          LDN    2
          RAD    PB
 EOF6     LJM    RLAX        ADVANCE TO NEXT LABEL TYPE
 
 EOF7     LDD    PB          CHECK IF MULTI FILE
          SHN    -6
          SBN    /MTX/RLCM/100
          MJN    EOF9        IF NOT MULTI FILE
          NJN    EOF8        IF NOT MF LABEL CHECK
          RJM    /MFP/SSN    SET SEQUENCE NUMBER
 EOF8     AOD    PB          ADVANCE SECTION
          LJM    EOFX        RETURN
 
 EOF9     ADN    7-6
          ZJN    EOF8        IF CLOSE
          RJM    CBC         CHECK BLOCK COUNT
 
*         ENTER HERE ON NON - STANDARD LABEL.
 
 EOF10    LDC    1031        RETURN EOI STATUS
          STD    PB
          STM    EOFA        SET EOI FOR SKIP OPERATION
          UJN    EOF12       RETURN EOI
 
*         HANDLE TAPE MARKS NOT FOLLOWED BY LABELS.
 
 EOF11    AOD    BL+1        COUNT BLOCK
          SHN    -14
          RAD    BL
          LDN    31          RETURN EOF STATUS
          STD    PB
 EOF12    RJM    UAD         READ CIO CODE
          ADN    /MTX/UCIA
          CRD    CM
          LDD    CM
          SHN    -6
          LPN    57
          ZJN    EOF14       IF READ OPERATION
          SHN    -4
          ZJN    EOF13       IF NOT SKIP REVERSE
          LDN    1           DO NOT SET EOF BIT
          STM    EOFA
 EOF13    LDM    CIOE        RETURN CIO CODE
          LPC    774
          ADC    31          SET EOR AND EOF BITS
*         ADC    1031        (EOI ENCOUNTERED)
*         ADC    1           (POSITION BACKWARD)
 EOFA     EQU    *-1
          STD    PB
 EOF14    LDN    74          SET LEVEL 17
          STD    PA
          LDD    FM
          SHN    -6
          LMN    /MTX/TFS
          ZJN    EOF15       IF S FORMAT
          LMN    /MTX/TFL&/MTX/TFS
          NJN    EOF16       IF NOT L FORMAT
 EOF15    LDM    CIOE
          LPC    774
          LMC    260
          NJN    EOF16       IF NOT 260 READ CODE
          LDD    PB
          LPC    1000
          LMC    271
          STD    PB
 EOF16    LJM    RBE         RETURN *BEI* ERROR
 EFO      SPACE  4,10
**        EFO - PROCESS EOF2 - EOF9.
*
*         CALLS  CLA.
 
 
 EFO      SUBR               ENTRY/EXIT
          RJM    CLA         CHECK LABEL
          NJN    EFO1        IF BAD LABEL
          LDM    BUF
          LMC    2REO
          NJN    EFO1        IF NOT *EO*
          LDC    2RF2
          ADD    PA
          LMM    BUF+1
          NJN    EFO1        IF NOT *FN*
          AOD    PA          INCREMENT TO NEXT LABEL
          LMN    9D
          NJN    EFOX        IF NOT ALL POSSIBLE LABELS SKIPPED
 EFO1     LDN    0
          STD    PA
          LJM    RLAX        ADVANCE TO NEXT LABEL TYPE
 EOV      SPACE  4,10
**        EOV - PROCESS *EOV1*.
*
*         CALLS  CBC, CIF, CLA, UAD.
 
 
 EOV      SUBR               ENTRY/EXIT
          RJM    CLA         CHECK LABEL
          NJN    EOV1        IF BAD LABEL
          LDM    BUF
          LMC    2REO
          NJN    EOV1        IF NOT *EO*
          LDM    BUF+1
          LMC    2RV1
          ZJN    EOV2        IF *EOV1*
 EOV1     RJM    CIF         CHECK INTERNAL TAPE FORMAT
          NJP    EOF0        IF NOT INTERNAL FORMAT
          LDN    /MTX/LCE    LABEL CONTENT ERROR
          LJM    RET3        RETURN ERROR CODE
 
 EOV2     LDD    PB
          SHN    -6
          SBN    /MTX/RLCF/100
          NJN    EOV3        IF NOT CLOSE
          LJM    EOV7        INCREMENT TO NEXT SECTION
 
 EOV3     PJN    EOV4        IF MULTI-FILE OPERATION
          RJM    CBC         CHECK BLOCK COUNT
 
*         ENTER HERE FOR UNLABELED END OF REEL.
 
 EOV4     LDM    FETO
          SHN    21-11
          PJN    EOV5        IF USER NOT PROCESSING END OF REEL
          LDM    CIOE        SET TO RETURN END OF REEL STATUS
          LPC    774
          LMC    2001
          STD    PB
          LDN    0
          STD    PA
          LJM    RBE         RETURN *BEI* ERROR
 
 EOV5     LDD    PB
          SHN    -6
          SBN    /MTX/RLCM/100
          MJN    EOV6        IF NOT *POSMF*
          LDC    4000        SET *EOV1* ENCOUNTERED DURING *POSMF*
          RAD    PA
 EOV6     RJM    UAD         CHECK IF VSNS DECLARED
          ADN    /MTX/UUFN
          CRD    CM
          LDD    FM
          SHN    -6
          SBN    /MTX/TFI
          ZJN    EOV7        IF I FORMAT
          SBN    /MTX/TFLI-/MTX/TFI
          ZJN    EOV7        IF LI FORMAT
          LDD    CM+4
          ZJN    EOV8        IF NOT INTERNALLY WRITTEN TAPE
          LDD    LT
          SHN    -11
          LPN    3
          LMN    2
          NJN    EOV8        IF NOT ANSI LABEL
 EOV7     AOD    PB          INCREMENT TO NEXT SECTION
          LJM    EOVX        RETURN
 
 EOV8     LJM    EVO2        CLEAR VSN FIELD
 ETC      SPACE  4,10
**        ETC - END OF TAPE CHECK.
*
*         CALLS  CIF.
 
 
 ETC3     AOD    PB          INCREMENT TO NEXT SECTION
 
 ETC      SUBR               ENTRY/EXIT
          LDD    LT
          SHN    21-11
          MJN    ETC2        IF NON-STANDARD LABEL
          LDD    SP
          SHN    -12
          NJN    ETC1        IF NOT READ TO TRAILER LABEL
 ETCA     EQU    *-1
*         PSN    0           ALWAYS PO = S FOR CTS
          LDD    LT
          SHN    21-12
          MJN    ETC3        IF LABELED
          RJM    CIF         CHECK INTERNAL TAPE FORMAT
          ZJN    ETC3        IF INTERNAL FORMAT
 ETC1     LDM    ETC         SET EXIT ADDRESS
          STM    EOV
          LJM    EOV4        RETURN END OF REEL STATUS
 
 ETC2     LDD    DS          CHECK FOR END OF TAPE
          LPN    10
          NJN    ETC1        IF END OF TAPE
          LJM    EOF10       RETURN EOI
 EVO      SPACE  4,10
**        EVO - PROCESS *EOV2*.
*
*         IF AN *EOV2* LABEL IS PRESENT, THE NEXT VSN WILL BE RETURNED
*         TO THE UDT.
*
*         CALLS  CLA, UAD, WUD.
 
 
 EVO5     AOD    PB          INCREMENT SECTION
 
 EVO      SUBR               ENTRY/EXIT
          RJM    CLA         CHECK LABEL
          LDM    BUF
          LMC    2REO
          NJN    EVO2        IF NOT *EO*
          LDM    BUF+1
          LMC    2RV2
          NJN    EVO2        IF NOT *EOV2*
          LDD    PB
          SHN    -6
          LMN    /MTX/RLCF/100
          ZJN    EVO5        IF CLOSE
          UJN    EVO3        UPDATE UDT INFORMATION
 
*         ENTER HERE IF NOT TO RETURN NEXT VSN.
 
 EVO2     LDD    PB
          SHN    -6
          LMN    /MTX/RLCF/100
          NJN    EVO4        IF NOT CLOSE
          LJM    RLAX        ADVANCE TO NEXT LABEL TYPE
 
 EVO3     RJM    WUD         UPDATE UDT INFORMATION
          ZJN    EVO4        IF NOT AT MAGNET CP
          SBK    /MTX/UUDTL+/MTX/UUFN-/MTX/UVRI
          CRD    CM
          ADK    /MTX/UISN-/MTX/UVRI
          CRD    CN
          LDM    BUF+2       SET NEXT INTERNAL VSN
          STD    CN
          LDM    BUF+3
          STD    CN+1
          LDM    BUF+4
          STD    CN+2
          LDD    CM+4        SET VSN FROM *EOV2* LABEL FLAG
          SCN    10
          LMN    10
          STD    CM+4
          RJM    UAD         UPDATE UDT
          ADK    /MTX/UVRI
          CWD    CM
          ADK    /MTX/UISN-/MTX/UVRI
          CWD    CN
 EVO4     LJM    RET1        EXIT
 HDR      SPACE  4,10
**        HDR - PROCESS *HDR1*.
*
*         CALLS  CLA, CSC, GCD, GCH, /MFP/PHD, THL, VOL, WUD.
 
 
 HDR10    LDN    /MTX/LAM    LABEL MISSING
          LJM    RET3        RETURN ERROR CODE
 
 HDR      SUBR               ENTRY/EXIT
          RJM    CLA         CHECK LABEL
          ZJN    HDR2        IF GOOD LABEL
 HDR1     LDD    PB
          SHN    -6
          NJN    HDR10       IF NOT INITIAL LABEL CHECK
          ERRNZ  /MTX/RLCL
          STD    PB          SET TO RESTART SEQUENCE
          STM    BUF
          RJM    VOL
          UJN    HDRX        RETURN
 
 HDR2     LDM    BUF         CHECK FOR *HDR1*
          LMC    2RHD
          NJN    HDR1        IF NOT *HD*
          LDM    BUF+1
          LMC    2RR1
          NJN    HDR1        IF NOT *HDR1*
          LDM    UDTB+10     CLEAR LABEL EXPIRED
          SCN    2
          STM    UDTB+10
          RJM    WUD
          LDD    PB          CHECK IF MULTI FILE
          SHN    -6
          SBN    /MTX/RLCM/100
          MJN    HDR3        IF NOT MULTI FILE
          RJM    /MFP/PHD
          UJN    HDR4        CHECK SYSTEM CODE
 
 HDR3     ADN    7           DETERMINE WHETHER TO TRANSFER HEADER
          NJN    HDR4        IF NOT INITIAL LABEL CHECK
          RJM    THL         TRANSFER HEADER LABEL
 HDR4     RJM    CSC         CHECK SYSTEM CODE
          ZJN    HDR5        IF INTERNALLY WRITTEN TAPE
          LDN    0           CLEAR EST FIELD
          STD    T3
          UJN    HDR6        CLEAR EST WRITTEN ON FIELD IN UDT
 
 HDR5     LDC    71D         CONVERT EST WRITTEN ON
          STD    T6
          RJM    GCH
          SBN    1R0
          SHN    3
          STD    T3
          RJM    GCH
          SBN    1R0
          RAD    T3
          RJM    GCH         GET POSSIBLE THIRD CHARACTER
          SBN    1R0
          STD    T6
          LMN    1R -1R0
          ZJN    HDR6        IF TWO DIGIT EST ORDINAL
          LDD    T3
          SHN    3
          LMD    T6
          STD    T3
 HDR6     LDD    T3          SAVE EST WRITTEN ON
          STM    UDTB+5*5+1
          LDN    JDAL        READ TODAYS DATE
          CRD    CN
          LDN    49D         SET POSITION IN SOURCE BUFFER
          STD    T6
          LDN    CN          SET DESTINATION BUFFER ADDRESS
          STM    DBUF
          LDN    6
          STD    T7
          LDN    5
          STD    T2
          LDN    1R7         SET CENTURY CROSSOVER
          STD    T0
 HDR7     RJM    GCH         GET EXPIRATION DATE CHARACTER
          SBD    T0          CHECK CENTURY
          PJN    HDR7.1      IF NOT 21ST CENTURY
          ADN    10D         ADJUST DECADE FOR 21ST CENTURY
 HDR7.1   STD    T4
          RJM    GCD         GET TODAYS DATE CHARACTER
          SBD    T0          CHECK CENTURY
          PJN    HDR7.2      IF NOT 21ST CENTURY
          ADN    10D         ADJUST DECADE FOR 21ST CENTURY
 HDR7.2   SBD    T4
          NJN    HDR8        IF NO MORE COMPARES REQUIRED
          STD    T0          CLEAR CENTURY CROSSOVER
          SOD    T2
          NJN    HDR7        IF MORE CHARACTERS TO COMPARE
 HDR8     MJN    HDR9        IF NOT EXPIRED
          LDN    2           SET LABEL EXPIRED
          RAM    UDTB+10
 HDR9     RJM    WUD         WRITE UDT INFORMATION
          LDN    0           INCREMENT TO NEXT SECTION
          STD    PA
          AOD    PB
          LJM    HDRX        RETURN
 OHD      SPACE  4,10
**        OHD - PROCESS *HDR2 - HDR9* OPTIONAL VOLUME LABELS.
*
*         CALLS  CLA.
 
 
 OHD      SUBR               ENTRY/EXIT
          RJM    CLA         CHECK LABEL
          NJN    OHD1        IF BAD LABEL
          LDM    BUF
          LMC    2RHD
          NJN    OHD1        IF NOT *HD*
          LDC    2RR2
          SBM    BUF+1
          ADD    PA
          NJN    OHD1        IF NOT *RN*
          AOD    PA          INCREMENT TO NEXT USER VOLUME NUMBER
          LMN    9D
          NJN    OHDX        IF NOT ALL POSSIBLE USER LABELS SKIPPED
 OHD1     LDN    0
          STD    PA
          LJM    RLAX        ADVANCE TO NEXT LABEL TYPE
 PTM      SPACE  4,10
**        PTM - PROCESS TAPE MARK.
*
*         CALLS  CLA.
 
 
 PTM3     LDD    PA          INCREMENT BACKSPACE COUNT
          ADC    100
          STD    PA
          ADC    -MXBS*100
          PJN    PTM2        IF MAXIMUM NUMBER OF BACKSPACES ATTEMPTED
 
 PTM      SUBR               ENTRY/EXIT
          LDD    PA
          ZJN    PTMX        IF ONLY BACK UP 1 BLOCK
          LDD    DS          CHECK LOAD POINT STATUS
          SHN    21-2
          MJN    PTM2        IF POSITIONED AT LOAD POINT
          RJM    CLA         CHECK LABEL
          SBN    1
          NJN    PTM1        IF NOT A TAPE MARK
          LDD    PA
          LPN    77
          SBN    1           DECREMENT TAPE MARK COUNT
          ZJN    PTMX        IF ALL TAPE MARKS READ
          STM    PTMA
          LDD    PA          UPDATE TAPE MARK COUNT
          LPC    7700
          ADM    PTMA
          STD    PA
 PTM1     LDD    MD
          SHN    21-12
          MJP    PTM3        IF BACKSPACING
          LDD    PA
          UJN    PTMX        RETURN
 
 PTM2     LDN    /MTX/LAM    LABEL MISSING
          LJM    RET3        RETURN ERROR CODE
 
 PTMA     CON    0           TEMPORARY STORAGE
 RBE      SPACE  4,10
**        RBE - RETURN *BEI* ERROR TO MAGNET.
*
*         EXIT   TO *RET3* WITH *BEI* ERROR.
 
 
 RBE      BSS    0           ENTRY
          LDN    /MTX/BEI    SET *BEI* ERROR
          LJM    RET3        RETURN ERROR TO MAGNET
 SBL      SPACE  4,10
**        SBL - SKIP BLOCK.
 
 
 SBL      SUBR               ENTRY/EXIT
          LDD    EC
          LMN    /MTX/BEI
          ZJN    SBL1        IF TAPE MARK
          AOD    PA          INCREMENT BLOCK COUNT
          LMN    77          SKIP UP TO 64 BLOCKS
          NJN    SBLX        IF NOT MAXIMUM BLOCKS SKIPPED
 SBL1     STD    PA
          LJM    RLAX        ADVANCE TO NEXT LABEL TYPE
 SDE      SPACE  4,10
**        SDE - SET ACTUAL DENSITY FOR 9 TRACK.
*
*         EXIT   DENSITY SET FROM UNIT STATUS.
*
*         CALLS  DTS.
 
 
 SDE      SUBR               ENTRY/EXIT
          LDD    HP
          SHN    21-7
          MJN    SDEX        IF CTS
          SHN    21-0-21+7
          PJN    SDEX        IF 7 TRACK
          LDM    DNCV        CLEAR DENSITY
          SCN    70
          STM    DNCV
          RJM    DTS         GET DETAILED STATUS
          LDM    MTDS+4
 SDEA     EQU    *-1
*         LDM    ATUS        (ATS UNIT)
 SDEB     SHN    -6
*         SHN    -3          (ATS UNIT)
          LPN    3
          STD    T1
          LDM    SDED,T1     GET EQUIVALENT DENSITY
 SDEC     SHN    0
*         SHN    3           (ATS UNIT)
          LPN    70
          RAM    DNCV        SET DENSITY
          UJN    SDEX        RETURN
 
 
**        DENSITY TABLE.
*         TABLE IS INDEXED BY VALUES IN DETAILED STATUS.
*
*         6/0,3/ MTS DENSITY, 3/ ATS DENSITY
 
 
 SDED     VFD    6/0,3//MTX/D05,3//MTX/D16
          VFD    6/0,3//MTX/D08,3//MTX/D16
          VFD    6/0,3//MTX/D16,3//MTX/D08
          VFD    6/0,3//MTX/D16,3//MTX/D62
 SKR      SPACE  4,10
**        SKR - SKIP BLOCK REVERSE.
*
*         EXIT   (WP) DECREMENTED IF TAPE MARK OR BLOCK WITHOUT
*                ERROR WAS READ.
 
 
 SKR      SUBR               ENTRY/EXIT
          LDD    EC
          ZJN    SKR1        IF NO ERROR
 SKRA     EQU    *-1
*         UJN    SKR2        CTS
          LMN    /MTX/BEI
          NJN    SKR2        IF NOT TAPE MARK
 SKR1     LDN    4           SET UNUSABLE BID
          STM    BIDW,WP
          SOD    WP          BACK UP BID WINDOW
          PJN    SKR2        IF NO UNDERFLOW
          LDN    7           RESET POINTER
          STD    WP
 SKR2     RJM    BKS         BACKSPACE TAPE
          UJN    SKRX        RETURN
 
 BKS      SPACE  4,10
**        BKS - BACKSPACE TAPE.
*         WAIT BACKSPACE FUNCTION COMPLETE.
*         TIMES OUT AFTER APPROXIMATECY 25 FEET OF TAPE.
*
*         EXIT   (DS) = GENERAL STATUS.
*
*         CALLS  FCN, STW, WNB.
 
 
 BKS2     CON    0           ENTERED VIA *RJM FROM //STW
          SOD    T2
          NJN    BKS1        IF NOT TIMEOUT
          LDC    ERR         RESET ERROR EXIT
          STM    STWC
          UJN    BKS1        ATTEMPT 1 MORE TIME
 
 BKS      SUBR               ENTRY/EXIT
          LDD    HP
          SHN    21-7
          MJN    BKS1.2      IF CTS
          LDN    2           WAIT NOT BUSY
          RJM    STW
          LDC    F0113       BACKSPACE
          RJM    FCN
          LDN    27
          STD    T2
          LDC    BKS2        SET RETURNED TIMEOUT FROM //STW
          STM    STWC
 BKS1     LDN    2           WAIT NOT BUSY
          RJM    STW
          LDC    ERR         RESET ERROR EXIT
          STM    STWC
 BKS1.1   UJN    BKSX        RETURN
 
 BKS1.2   RJM    WNB         WAIT NOT BUSY
          LDC    F0113       BACKSPACE BLOCK
          RJM    FCN         ISSUE FUNCTION
          RJM    WNB         WAIT NOT BUSY
          UJN    BKS1.1      RETURN
 STM      SPACE  4,10
**        STM - SKIP TAPE MARK.
*
*         CALLS  CLA, SKR.
 
 
 STM3     AOD    PB          ADVANCE SECTION
 
 STM      SUBR               ENTRY/EXIT
          LDD    PB
          SHN    -6
          LMN    /MTX/RLCF/100
          ZJN    STM2        IF CLOSE
          RJM    CLA         CHECK LABELS
          SBN    1
          ZJN    STM3        IF TAPE MARK
          LDN    /MTX/LAM    LABEL MISSING
 STM1     LJM    RET3        RETURN ERROR CODE
 
 STM2     LDD    EC
          LMN    /MTX/BEI
          ZJN    STM3        IF TAPE MARK
          RJM    SKR         SKIP BLOCK REVERSE
          LDN    /MTX/BEI    SET NOT TO SKIP TAPE MARKS REVERSE
          UJN    STM1        RETURN ERROR CODE
 THL      SPACE  4,10
**        THL - TRANSFER HEADER LABEL.
*
*         CALLS  CCH, DCV, GCH.
 
 
 THL      SUBR               ENTRY/EXIT
          LDN    5           FILE IDENTIIFER
          STD    T6
          LDN    21D
          STD    T7
          LDN    17D
          RJM    CCH
          LDN    41D         SET IDENTIFIER
          STD    T7
          LDN    6
          RJM    CCH
          LDN    38D         FILE SECTION NUMBER
          STD    T7
          LDC    30004
          RJM    DCV
          LDN    48D         FILE SEQUENCE NUMBER
          STD    T7
          LDC    30004
          RJM    DCV
          LDN    58D         GENERATION NUMBER
          STD    T7
          LDC    30004
          RJM    DCV
          LDN    56D         GENERATION VERSION NUMBER
          STD    T7
          LDC    20002
          RJM    DCV
          RJM    GCH         SKIP CHARACTER
          LDN    61D         CREATION DATE
          STD    T7
          LDN    5
          RJM    CCH
          RJM    GCH         SKIP CHARACTER
          LDN    5           EXPIRATION DATE
          RJM    CCH
          LDN    47D         ACCESSIBILITY
          STD    T7
          LDN    1
          RJM    CCH
          LJM    THLX        RETURN
 TMS      SPACE  4,10
**        TMS - TAPE MARK SENSE.
*
*         USES   PB, T7.
*
*         CALLS  CLA, SCH, VOL, WUD.
 
 
 TMS      SUBR               ENTRY/EXIT
          RJM    CLA
          SBN    1
          MJN    TMS2        IF NOT TAPE MARK
          LDD    PB
          SHN    -6
          NJN    TMS1        IF NOT INITIAL LABEL CHECK
          ERRNZ  /MTX/RLCL
          LDN    17D         CLEAR LABEL CHECK IN PROGRESS
          STD    T7
          LDN    0
          RJM    SCH
          RJM    WUD         REWRITE UDT
 TMS1     LJM    RET1        EXIT
 
 TMS2     LDD    PB
          SHN    -6
          ZJN    TMS4        IF INITIAL LABEL CHECK SEQUENCE
          ERRNZ  /MTX/RLCL
 TMS3     LDN    /MTX/LCE    LABEL CONTENT ERROR
          LJM    RET3        RETURN ERROR CODE
 
 TMS4     LDN    0           SET TO RESTART SEQUENCE
          STD    PB
          STM    BUF
          RJM    VOL
          UJN    TMS3        RETURN LABEL CONTENT ERROR
 UHL      SPACE  4,10
**        UHL - PROCESS *UHLA* USER FILE HEADER LABELS.
*
*         CALLS  CLA.
 
 
 UHL      SUBR               ENTRY/EXIT
          RJM    CLA         CHECK LABEL
          NJN    UHL1        IF BAD LABEL
          LDM    BUF
          LMC    2RUH
          NJN    UHL1        IF NOT *UH*
          LDM    BUF+1
          SHN    -6
          LMN    1RL
          NJN    UHL1        IF NOT *UHLN*
          AOD    PA          INCREMENT TO NEXT USER VOLUME NUMBER
          LMC    64D+1
          NJN    UHLX        IF NOT ALL POSSIBLE USER LABELS SKIPPED
          LDN    /MTX/LCE    LABEL CONTENT ERROR
          LJM    RET3        RETURN ERROR CODE
 
 UHL1     LDC    0
*         LDC    4000        (*VOL1* READ AND VALIDATE HEADER LABEL)
 UHLA     EQU    *-1
          STD    PA
          LJM    RLAX        ADVANCE TO NEXT LABEL TYPE
 UTL      SPACE  4,10
**        UTL - PROCESS USER TRAILER LABELS.
*
*         CALLS  CLA.
 
 
 UTL      SUBR               ENTRY/EXIT
          RJM    CLA         CHECK LABEL
          NJN    UTL1        IF BAD LABEL
          LDM    BUF
          LMC    2RUT
          NJN    UTL1        IF NOT *UT*
          LDM    BUF+1
          SHN    -6
          LMN    1RL
          NJN    UTL1        IF NOT *UTLN*
          AOD    PA
          LMC    64D+1
          NJN    UTLX        IF NOT ALL TRAILER LABELS SKIPPED
          LDN    /MTX/LCE    LABEL CONTENT ERROR
          LJM    RET3        RETURN ERROR CODE
 
 UTL1     LDD    PB
          SHN    -6
          LMN    /MTX/RLCF/100
          NJN    UTL2        IF NOT CLOSE
          LJM    RET1        EXIT
 
 UTL2     LDN    0
          STD    PA
          LJM    RLAX        ADVANCE TO NEXT LABEL TYPE
 UVL      SPACE  4,10
**        UVL - PROCESS *UVLN* USER VOLUME LABELS.
*
*         CALLS  CLA, VOL.
 
 
 UVL      SUBR               ENTRY/EXIT
          RJM    CLA         CHECK LABEL
          NJN    UVL1        IF BAD LABEL
          LDM    BUF
          LMC    2RUV
          NJN    UVL3        IF NOT *UV*
          LDM    BUF+1
          ADC    -2RL1
          SBD    PA
          NJN    UVL3        IF NOT *LN*
          AOD    PA          INCREMENT TO NEXT USER VOLUME NUMBER
          LMN    9D+1
          NJN    UVLX        IF NOT ALL POSSIBLE USER LABELS SKIPPED
 UVL1     LDD    PB
          SHN    -6
          NJN    UVL2        IF NOT INITIAL LABEL CHECK SEQUENCE
          ERRNZ  /MTX/RLCL
          STD    PB          RESTART LABEL CHECK SEQUENCE
          STM    BUF
          RJM    VOL
 UVL2     LMN    5
          ZJN    UVL4        IF REEL CHECK
          LDN    /MTX/LCE    LABEL CONTENT ERROR
          LJM    RET3        RETURN ERROR CODE
 
 UVL3     LDD    PB          CHECK IF HEADER VALIDATION
          SHN    -6
          LMN    /MTX/RLVH/100
          NJN    UVL4        IF NOT HEADER VALIDATION
          LDC    4000        SET *VOL1* LABEL READ
          STM    UHLA
          LDN    4           ADVANCE TO HDR1 CHECK
          RAD    PB
 UVL4     LJM    RLAX        ADVANCE TO NEXT LABEL TYPE
 VOL      SPACE  4,10
**        VOL - PROCESS *VOL1* LABEL.
*
*         CALLS  CCH, CLA, C2D, DBT, FCH, SCH, SDE, UAD, UDA, WUD.
 
 
 VOL      SUBR               ENTRY/EXIT
          LDC    BUF         SET UP BUFFER ADDRESSES
          STM    IBUF
          LDC    UDTB
          STM    DBUF
          LDD    PB
          SHN    -6
          ZJN    VOL1        IF INITIAL LABEL CHECK
          ERRNZ  /MTX/RLCL
          LMN    /MTX/RLVH/100
          NJN    VOL3        IF NOT HEADER VALIDATION
          RJM    DBT         DETERMINE BLOCK TYPE
          NJN    VOL3        IF GOOD BLOCK
          LJM    VOL6        PROCESS TAPE MARK OR BAD BLOCK
 
 VOL1     RJM    CLA         CHECK LABEL
          ZJN    VOL4        IF GOOD LABEL
          LDD    EC
          LMN    /MTX/BTA
          ZJN    VOL2        IF BLANK TAPE
          LMN    /MTX/BTL&/MTX/BTA
          NJN    VOL6        IF NOT *BLOCK TOO LARGE* ERROR
          LDD    HP
          SHN    21-7
          MJN    VOL2        IF CTS
          SHN    21-0-21+7
          PJN    VOL6        IF 7 TRACK
 VOL2     LJM    VOL12       PRESET *UDT* FOR UNLABELED TAPE
 
 VOL3     RJM    CLA         CHECK LABEL
          NJN    VOL6        IF BAD LABEL
 VOL4     LDM    BUF         CHECK FOR *VOL1*
          LMC    2RVO
          NJN    VOL6        IF NOT *VO*
          LDM    BUF+1
          LMC    2RL1
          NJN    VOL6        IF NOT *L1*
          LDD    PB
          SHN    -6
          ZJN    VOL5        IF INITIAL LABEL CHECK
          ERRNZ  /MTX/RLCL
          LJM    VOL22       INCREMENT TO NEXT SECTION
 
 VOL5     LJM    VOL15       SET GOOD *VOL1* LABEL
 
 VOL6     LDD    PB
          SHN    -6
          ZJN    VOL9        IF INITIAL LABEL SEQUENCE
          ERRNZ  /MTX/RLCL
          LMN    /MTX/RLVH/100
          NJN    VOL7        IF NOT HEADER VALIDATION
          AOD    PB          ADVANCE SECTION
          LJM    RLAX        ADVANCE TO NEXT LABEL TYPE
 
 VOL7     LMN    4&10
          NJN    VOL8        IF NOT OPEN
          LDM    CIOE
          LPC    1774
          LMC    110
          NJN    VOL8        IF NOT *POSMF*
          LDN    1           ADVANCE TO *HDR1* CHECK
          RAD    PB
          LJM    RLAX        ADVANCE TO NEXT LABEL TYPE
 
 VOL8     LDN    /MTX/LAM    LABEL MISSING
          LJM    RET3        RETURN ERROR CODE
 
 VOL9     LDD    HP
          SHN    21-7
          MJN    VOL10       IF CTS
          SHN    21-0-21+7
          MJN    VOL10       IF 9 TRACK
          LCN    10          TRY NEXT LOWER DENSITY
          RAM    DNCV
          LPN    70
          NJN    VOL11       IF MORE DENSITIES TO TRY
          UJN    VOL12       PRESET UDT FOR UNLABELED TAPE
 
 VOL10    LDM    DNCV
          LPN    7
          SBN    /MTX/MCCO-1
          PJN    VOL12       IF ALL CONVERSION MODES TRIED
          LDN    0           TRY ANOTHER CONVERSION MODE
          STD    PA
          AOM    DNCV        INCREMENT TO NEXT CONVERSION MODE
 VOL11    LJM    RET1        EXIT
 
 VOL12    LDD    PB
          SHN    -6
          LMK    /MTX/RLCL
          ZJN    VOL13       IF INITIAL LABEL SEQUENCE
          LJM    VOL6        ADVANCE SECTION COUNT
 
*         SET UDT LABEL PARAMETERS FOR UNLABELED TAPE.
 
 VOL13    LDD    LT
          LPC    777         CLEAR LABELED FLAGS
          STD    LT
          RJM    UAD
          ADK    /MTX/UST4
          CWD    LT
          LDM    DNCV        CLEAR CONVERSION MODE
          SCN    7
          STM    DNCV        UPDATE CONVERSION MODE
          RJM    SDE         SET DENSITY FOR 9 TRACK
          LDD    EO          SET EST ORDINAL IN DEFAULT VSN
          SHN    -6
          RAM    TDLP+6
          LDD    EO
          RJM    C2D
          STM    TDLP+7
          LDD    HP
          LPN    20
          ZJN    VOL14       IF NOT ATS UNIT
          LDM    MTDS
          LPC    177
          LMN    7
          NJN    VOL14       IF UNIT CAPABLE OF TAPE DENSITY
          LDC    400         SET DENSITY MISMATCH
          RAM    TDLP+1*5+3
          LDN    2
          STD    T6
          LDD    MA
          CWM    VOLB,T6     *WRONG DENSITY*
          SBN    2
          CRM    TDLP+2*5,T6
 VOL14    LDN    JDAL        READ JULIAN DATE
          CRM    BUF,ON
          LDC    OVLM        RESET DESTINATION BUFFER
          STM    DBUF
          LDN    6           SET UP CREATION DATE
          STD    T6
          LDN    1           SET EXPIRATION DATE
          STD    T7
          LDN    5
          RJM    CCH
          LDN    6
          STD    T6
          LDN    5
          RJM    CCH
          RJM    UDA
          CWM    TDLP,T1
          LJM    VOL11       UPDATE CONVERSION MODE AND LABELED FLAGS
 
*         PROCESS GOOD *VOL1* LABEL.
 
 VOL15    RJM    SDE         SET DENSITY FOR 9 TRACK
          LDN    5           MOVE VSN TO UDT
          STD    T6
          LDN    11D
          STD    T7
          LDN    6
          RJM    CCH
          LDN    40          SET LABEL CHECK IN PROGRESS FLAG
          RJM    SCH         STORE CHARACTER
          LDN    3           FILL THREE CHARACTERS WITH ZERO
          RJM    FCH
          LDN    11D         COPY VOLUME ACCESSIBILITY TO *UGNU*
          STD    T6
          LDN    55D
          STD    T7
          LDN    1
          RJM    CCH
          RJM    WUD         WRITE UDT LABEL AREA
 
*         SET TO PROCESS NEXT LABEL OPERATION.
 
 VOL22    LDN    0
          STD    PA
          AOD    PB          INCREMENT TO NEXT LABEL OPERATION
          LJM    VOLX        RETURN
 
 
 VOLB     VFD    60/10LWRONG DENS
          VFD    42/7LITY    ,18/1
 WEL      SPACE  4,10
**        WEL - WRITE EXTENDED LABELS TO USER BUFFER.
*
*         CALLS  ELA.
 
 
 WEL2     LDN    ZERL        SET UP CONTROL WORD
          CRM    BUFC,ON
          LDC    80D
          STM    BUFC+4
          LDN    ZERL        SET TERMINATOR WORD
          CRM    BUF+40D,ON
          LDN    12          RETURN LABEL TO USER BUFFER
          STD    T5
          RJM    ELA
          CWM    BUFC,T5
 
 WEL      SUBR               ENTRY/EXIT
 WELA     UJN    WELX        RETURN
*         PSN                (EXTENDED LABELS)
          LDD    BY
          ZJN    WELX        IF EOF READING LABEL
          LDN    0
          STD    T6
          STD    T7
 WEL1     RJM    ELA         GET LABEL BUFFER ADDRESS
          ZJN    WELX        IF END OF BUFFER
          CRD    CM
          LDD    CM+4
          ZJN    WEL2        IF END OF LABELS IN BUFFER
          LDN    11          UPDATE POSITION IN BUFFER
          RAD    T7
          SHN    -14
          RAD    T6
          UJN    WEL1        LOOP
 WNB      SPACE  4,10
**        WNB - WAIT NOT BUSY.
*
*         CALLS  /PRESET/GPS.
 
 
 WNB      SUBR               ENTRY/EXIT
 WNB1     LDN    2           WAIT NOT BUSY
          RJM    /PRESET/GPS GET AND PROCESS GENERAL STATUS
          MJN    WNB1        IF COMMAND RETRY
          UJN    WNBX        RETURN
 ZRO      SPACE  4,10
**        ZRO - ZERO FIRST WORD OF XL BUFFER.
*
*         CALLS  ELA.
 
 
 ZRO      SUBR               ENTRY
          LDN    0
          STD    T6
          STD    T7
          LDN    ZERL
          CRD    CN
          RJM    ELA         GET XL BUFFER ADDRESS
          ZJN    ZRO1        IF END OF BUFFER
          CWD    CN          PRESET BUFFER
 ZRO1     LJM    RLAX        ADVANCE TO NEXT LABEL TYPE
          TITLE  CHARACTER PROCESSING SUBROUTINES.
          SPACE  4,10
**        DIRECT CELL USAGE IN FOLLOWING ROUTINES.
*
*         ENTRY  (T5) = NUMBER OF CHARACTERS.
*                (T6) = CHARACTER POSITION IN INPUT BUFFER.
*                (T7) = CHARACTER POSITION IN DESTINATION BUFFER.
*
*         ALL CHARACTER POSITIONS ARE REFERENCED STARTING WITH *1*.
*         THUS, THE CHARACTER POSITION VALUES BEING USED TO ACCESS
*         *BUF* MAY BE REFERENCED DIRECTLY TO THE LABEL STANDARD.
 
 IBUF     CON    0           FWA OF FETCH BUFFER
 DBUF     CON    0           FWA OF DESTINATION BUFFER
 CAN      SPACE  4,15
**        CAN - COMPARE ALPHANUMERIC FIELDS.
*         COMPARE WILL BE GOOD IF ALL OF INPUT CHARACTER STRING IS
*         BINARY ZERO.
*
*         ENTRY  (A) = NUMBER OF CHARACTERS TO COMPARE.
*                (T6) = CHARACTER POSITION IN INPUT BUFFER.
*                (T7) = CHARACTER POSITION IN DESTINATION BUFFER.
*
*         EXIT   (A) = 0, GOOD COMPARE.
*                (A) .NE. 0, (A) = CHARACTER POSITION AT START.
*                (T6), (T7) = UPDATED.
*
*         USES   T3, T4.
*
*         CALLS  GCD, GCH.
 
 
 CAN4     SOD    T5          UPDATE TO SKIP REMAINDER OF FIELD
          RAD    T6
          LDD    T5
          RAD    T7
          LDD    T3
 
 CAN      SUBR               ENTRY/EXIT
          STD    T5
          STD    T4
          LDD    T6          SAVE STARTING POSITION
          STD    T3
 CAN1     RJM    GCH         GET CHARACTER
          NJN    CAN2        IF SPECIFIED
          SOD    T4
          NJN    CAN1        IF MORE CHARACTERS TO CHECK
          LDD    T5
          RAD    T7
          LDN    0           GOOD COMPARE
          UJN    CANX        RETURN
 
 CAN2     LDD    T3          RESET CHARACTER POSITION
          STD    T6
 CAN3     RJM    GCH         GET CHARACTER
          STD    T4
          RJM    GCD         GET CHARACTER FROM DESTINATION BUFFER
          LMD    T4
          NJN    CAN4        IF NO COMPARE
          SOD    T5
          NJN    CAN3        IF MORE CHARACTERS TO COMPARE
          UJN    CANX        RETURN
 CBC      SPACE  4,10
**        CBC - CHECK BLOCK COUNT.
*
*         CALLS  DCV.
 
 
 CBC      SUBR               ENTRY/EXIT
          LDD    SP
          SHN    21-1
          MJN    CBCX        IF IGNORE ERRORS
          LDN    CN          SET DESTINATION BUFFER
          STM    DBUF
          LDN    0
          STD    CN
          LDN    55D
          STD    T6
          LDN    2
          STD    T7
          LDC    30006
          RJM    DCV
          LDC    UDTB        RESET DESTINATION BUFFER
          STM    DBUF
          LDD    CN
          LMD    BL
          NJN    CBC1        IF ERROR IN BLOCK NUMBER
          LDD    CN+1
          LMD    BL+1
          ZJN    CBCX        IF GOOD BLOCK COUNT
 CBC1     LDN    /MTX/LBE    LABEL BLOCK COUNT ERROR
          LJM    RET3        RETURN ERROR CODE
 CCH      SPACE  4,15
**        CCH - COPY INPUT BUFFER TO DESTINATION BUFFER.
*
*         ENTRY  (A) = NUMBER OF CHARACTERS TO MOVE.
*                (T6) = CHARACTER POSITION IN INPUT BUFFER.
*                (T7) = CHARACTER POSITION IN DESTINATION BUFFER.
*
*         EXIT   (T6), (T7) = INCREMENTED.
*
*         USES   T5.
*
*         CALLS  GCH, SCH.
 
 
 CCH      SUBR               ENTRY/EXIT
          STD    T5
 CCH1     RJM    GCH         GET LABEL CHARACTER
          RJM    SCH         STORE CHARACTER IN USER BUFFER
          SOD    T5
          NJN    CCH1        IF MORE CHARACTERS TO MOVE
          UJN    CCHX        RETURN
 CIF      SPACE  4,10
**        CIF - CHECK INTERNAL TAPE FORMAT.
*
*         EXIT   (A) = 0 IF I, SI, OR LI TAPE FORMAT.
 
 
 CIF      SUBR               ENTRY/EXIT
          LDD    FM
          SHN    -6
          LMN    /MTX/TFI
          ZJN    CIFX        IF I FORMAT
          LMN    /MTX/TFSI&/MTX/TFI
          ZJN    CIFX        IF SI FORMAT
          LMN    /MTX/TFLI&/MTX/TFSI
          UJN    CIFX        RETURN WITH STATUS
 CSC      SPACE  4,10
**        CSC - CHECK SYSTEM CODE.
*
*         EXIT   (A) = 0, IF INTERNALLY WRITTEN TAPE (SYSTEM CODE
*                IN HDR1 LABEL = KRONOS 2.1 OR NOS).
*
*         CALLS  CAN, GCH.
 
 
 CSC1     LDN    1
 
 CSC      SUBR               ENTRY/EXIT
          LDN    61D
          STD    T6
          LDC    CSCA        CHECK IF KRONOS 2.1
          STM    DBUF
          LDN    1
          STD    T7
          RJM    GCH
          ZJN    CSC1        IF FIELD NOT SPECIFIED
          SOD    T6
          LDN    10D         COMPARE FIELDS
          RJM    CAN
          ZJN    CSCX        IF COMPARE
          LDN    61D         CHECK FOR NOS SYSTEM CODE
          STD    T6
          LDN    6
          RJM    CAN         COMPARE FIELDS
          UJN    CSCX        RETURN
 
 
 CSCA     DATA   H*KRONOS2.1-*
          DATA   H*NOS   *
 DCV      SPACE  4,15
**        DCV - CONVERT DECIMAL FIELD TO BINARY.
*
*         ENTRY  (A, 13 - 12) = NUMBER OF CHARACTER POSITIONS IN RESULT.
*                (A, 11 - 0) = NUMBER OF CHARACTERS IN LABEL FIELD.
*                (T6) = CHARACTER POSITION IN INPUT BUFFER.
*                (T7) = CHARACTER POSITION IN DESTINATION BUFFER.
*
*         EXIT   (T6), (T7) = INCREMENTED.
*
*         USES   T2, T3, T4, T5.
*
*         CALLS  GCH, SCH.
 
 
 DCV      SUBR               ENTRY/EXIT
          STD    T5          NUMBER OF CHARACTERS IN LABEL
          SHN    -14
          STD    T4          NUMBER OF CHARACTER POSITIONS IN UDT
          LDN    0           PRESET RESULT
          STD    T2
          STD    T3
 DCV1     RJM    GCH         GET CHARACTER
          SBN    1R0
          RAD    T3
          SHN    -14
          RAD    T2
          SOD    T5
          ZJN    DCV2        IF ALL DIGITS PROCESSED
          LDD    T2          10D * ACCUMULATED RESULT
          SHN    14
          ADD    T3
          SHN    2+6         * 4
          ADD    T2          * 5
          SHN    14
          ADD    T3
          SHN    1           * 10D
          STD    T3
          SHN    -14
          STD    T2
          UJN    DCV1        LOOP
 
 DCV2     LDD    T4
          LMN    3
          NJN    DCV3        IF NOT 3 CHARACTER POSITIONS
          LDD    T2          STORE VALUE
          RJM    SCH         STORE CHARACTER
          UJN    DCV4
 DCV3     LMN    2&3
          NJN    DCV5        IF NOT 2 CHARACTER POSIITONS
 DCV4     LDD    T3          STORE VALUE
          SHN    -6
          RJM    SCH         STORE CHARACTER
 DCV5     LDD    T3
          LPN    77
          RJM    SCH         STORE CHARACTER
          LJM    DCVX        RETURN
 FCH      SPACE  4,15
**        FCH - FILL DESTINATION BUFFER WITH CHARACTER(S).
*
*         ENTRY  (A, 17- 12) = CHARACTER TO FILL WITH.
*                (A, 11 - 0) = NUMBER OF CHARACTERS TO FILL.
*                (T7) = CHARACTER POINTER IN DESTINATION BUFFER.
*
*         EXIT   (T7) = INCREMENTED.
*
*         USES   T4.
*
*         CALLS  SCH.
 
 
 FCH      SUBR               ENTRY/EXIT
          STD    T5          SAVE COUNT
          SHN    -14
          STD    T4          SAVE FILL VALUE
 FCH1     LDD    T4          STORE CHARACTER
          RJM    SCH
          SOD    T5
          NJN    FCH1        IF MORE TO FILL
          UJN    FCHX        RETURN
 GCD      SPACE  4,10
**        GCD - GET CHARACTER FROM DESTINATION BUFFER.
*
*         ENTRY  (T7) = CHARACTER POSITION IN DESTINATION BUFFER.
*
*         EXIT   (A) = CHARACTER.
*                (T7) = INCREMENTED.
*
*         USES   T1.
 
 
 GCD1     LDM    -1,T1
          LPN    77
 
 GCD      SUBR               ENTRY/EXIT
          AOD    T7
          SBN    1
          SHN    21
          ADM    DBUF
          STD    T1
          SBM    DBUF
          SHN    -21
          ZJN    GCD1        IF LOWER 6 BITS
          LDI    T1
          SHN    -6
          UJN    GCDX        RETURN
 GCH      SPACE  4,10
**        GCH - GET CHARACTER FROM INPUT BUFFER.
*
*         ENTRY  (T6) = CHARACTER POSITION IN INPUT BUFFER.
*
*         EXIT   (A) = CHARACTER.
*                (T6) = INCREMENTED.
*
*         USES   T1.
 
 
 GCH1     LDM    -1,T1
          LPN    77
 
 GCH      SUBR               ENTRY/EXIT
          AOD    T6
          SBN    1
          SHN    21
          ADM    IBUF
          STD    T1
          SBM    IBUF
          SHN    -21
          ZJN    GCH1        IF LOWER 6 BITS
          LDI    T1
          SHN    -6
          UJN    GCHX        RETURN
 RUD      SPACE  4,10
**        RUD - READ UNIT DESCRIPTOR TABLE LABEL INFORMATION.
*         OPERATION ONLY PERFORMED AT *MAGNET* CP.
*
*         CALLS  UDA.
 
 
 RUD      SUBR               ENTRY/EXIT
          RJM    UDA         GET UDT LABEL ADDRESS ADDRESS
          ZJN    RUDX        IF NOT AT MAGNET CP
          CRM    UDTB,T1
          UJN    RUDX        RETURN
 SCH      SPACE  4,10
**        SCH - STORE CHARACTER IN DESTINATION BUFFER.
*
*         ENTRY  (A) = CHARACTER.
*                (T7) = CHARACTER POSITION IN DESTINATION BUFFER.
*
*         EXIT   (T7) = INCREMENTED.
*
*         USES   T1.
 
 
 SCH1     LDM    -1,T1
          SCN    77
          LMD    T0
 SCH2     STM    -1,T1
 
 SCH      SUBR               ENTRY/EXIT
          LPN    77
          STD    T0          SAVE CHARACTER
          AOD    T7          INCREMENT POSITION
          SHN    21          SET BYTE ADDRESS
          ADM    DBUF
          STD    T1
          SBM    DBUF
          SHN    -21
          NJN    SCH1        IF EVEN CHARACTER
          LDM    -1,T1
          LPN    77
          SHN    14
          LMD    T0
          SHN    6
          UJN    SCH2        STORE CHARACTER
 UDA      SPACE  4,10
**        UDA - SET ADDRESS OF UDT LABEL PARAMETERS.
*
*         EXIT   (A) = ADDRESS OF UDT LABEL PARAMETERS (*UUFN*) IF AT
*                      MAGNET CP.
*                (A) = 0 IF NOT AT MAGNET CP.
*                (T1) = LENGTH OF UDT LABEL PARAMETERS (*UUDTL*) IF AT
*                       MAGNET CP.
*
*         USES   T1.
*
*         CALLS  UAD.
 
 
 UDA1     LDN    0           SET NOT AT MAGNET CP
 
 UDA      SUBR               ENTRY/EXIT
          LDM    //CECB
          LPN    77
          NJN    UDA1        IF NOT AT MAGNET CP
          LDN    /MTX/UUDTL
          STD    T1
          RJM    UAD
          ADK    /MTX/UUFN   SET LABEL PARAMETERS ADDRESS
          UJN    UDAX        RETURN
 WUD      SPACE  4,10
**        WUD - WRITE UNIT DESCRIPTOR TABLE.
*
*         EXIT   (A) = LWA+1 OF LABEL PARAMETERS IF AT MAGNET CP.
*                (A) = 0 IF NOT AT MAGNET CP.
*                LABEL PARAMETERS WRITTEN TO UDT IF AT MAGNET CP.
*
*         CALLS  UDA.
 
 
 WUD      SUBR               ENTRY/EXIT
          RJM    UDA         GET UDT LABEL ADDRESS ADDRESS
          ZJN    WUDX        IF NOT AT MAGNET CP
          CWM    UDTB,T1
          UJN    WUDX        RETURN
          SPACE  4,10
**        COMMON DECKS.
 
 
*CALL     COMPC2D
 BUFFER   SPACE  4,10
          USE    BUFFER
 
 TADD     TSAD               ADDRESS TABLE
          SPACE  4,10
**        DEFAULT LABEL PARAMETERS FOR UNLABELED TAPES.
 
 
 TDLP     BSS    0
          VFD    42/7L       ,6/0,12/0  *UUFN*
          VFD    36/6L***000,12/6,12/0  *UVSN*
          VFD    60/10LUNLABELED.       *UFID*
          VFD    42/7L       ,18/1      *UFSN*
          VFD    36/6L      ,6/1L ,18/1 *USID*
          VFD    24/,6/1L ,12/0,18/1    *UGNU*
          SPACE  4,10
**        UDT LABEL INFORMATION BUFFER (*UUFN* - *UDAT*).
 
 
 UDTB     BSS    /MTX/UUDTL*5  LABEL INFORMATION BUFFER
          SPACE  4,10
**        THE FOLLOWING ROUTINES WILL BE OVERLAID IF THE OPERATION
*         IS CHECK MULTI-FILE LABELS (*RLCM*) OR VALIDATE HEADER LABEL
*         (*RLVH*).
 
 
 OVLM     BSS    0           MULTI-FILE OVERLAY ORIGIN
 BTA      SPACE  4,10
**        BTA - BLANK TAPE CHECK.
*
*         EXIT   (EC) = /MTX/BTA IF BLANK TAPE.
*
*         CALLS  DTS.
 
 
 BTA      SUBR               ENTRY/EXIT
          LDD    HP
          SHN    21-7
          MJN    BTA3        IF CTS
          LDC    RJMI        RESET *STW* EXIT
          STM    STWC-1
          LDC    //ERR
          STM    STWC
          LDD    DS
          SHN    21-13
          MJN    BTA1        IF ALERT
          RJM    DTS         GET DETAILED STATUS
 BTA1     LDM    MTDS        CHECK FOR BLANK TAPE
          LPC    77
*         LPC    177         (ATS UNIT)
 BTAA     EQU    *-1
          LMN    16
 BTAB     PSN
*         ZJN    BTA2        (ATS UNIT - IF AGC FAILURE)
          LMN    16&10
          NJN    BTA3        IF NOT BLANK TAPE
          LDN    /MTX/BTA
 BTA2     STD    EC
 BTA3     LJM    RLAX        ADVANCE SECTION
 CFU      SPACE  4,15
**        CFU - COMPARE FAMILY AND USER NAMES.
*
*         ENTRY  (IBUF) = *BUF*.
*
*         EXIT   (A) = 0 IF FAMILY/USER NAME IN *VOL1* LABEL MATCHES
*                      FAMILY/USER FROM UDT.
*                (IBUF) = *BUF*.
*                (DBUF) = *UDTB*.
*
*         USES   T1, T2, T6, T7, CM - CM+4, CN - CN+4.
*
*         CALLS  CAN, CCH.
 
 
 CFU      SUBR               ENTRY/EXIT
 
*         SET *VOL1* LABEL OR *ZFAM* FAMILY NAME.
 
          LDN    38D         SET LOCATION OF FAMILY NAME IN LABEL
          STD    T6
          LDN    CM          SET DESTINATION BUFFER
          STM    DBUF
          LDN    1
          STD    T7
          LDN    7           SET CHARACTER COUNT
          RJM    CCH         MOVE LABEL FAMILY NAME
          LDD    CM+3
          SCN    77
          LMN    1R
          STD    CM+3
          LDN    CM+4
          STD    T2
 CFU1     SOD    T2
          LMN    CM-1
          ZJN    CFU3        IF ALL BYTES PROCESSED
          LDI    T2
          LMC    2R
          NJN    CFU2        IF NOT BLANK BYTE
          STI    T2          SET ZERO FILL
          UJN    CFU1        CHECK NEXT BYTE
 
 CFU2     LPN    77
          NJN    CFU3        IF NO MORE TRAILING BLANKS
          LDI    T2
          SCN    77          SET ZERO FILL
          STI    T2
 CFU3     LDD    CM          CHECK FOR NULL FAMILY NAME
          ADD    CM+1
          ADD    CM+2
          ADD    CM+3
          NJN    CFU4        IF NOT NULL FAMILY NAME
          LDD    MA
          CWM    CFUA,ON
          SBN    1
          CRD    CM          SET *ZFAM* FAMILY NAME FOR COMPARE
 
*         SET CURRENT FAMILY NAME.
 
 CFU4     LDK    FOTP        GET FOT POINTER
          CRD    CN
          LDM    UDTB+3      SET FOT ORDINAL
          LPN    77
          STD    T1
          LDD    CN          SET FOT ADDRESS
          SHN    14
          ADD    CN+1
          ADD    T1
          CRD    CN          READ FAMILY NAME
 
*         COMPARE FAMILY NAMES.
 
          LDD    CM
          LMD    CN
          NJN    CFU5        IF NO MATCH
          LDD    CM+1
          LMD    CN+1
          NJN    CFU5        IF NO MATCH
          LDD    CM+2
          LMD    CN+2
          NJN    CFU5        IF NO MATCH
          LDD    CM+3
          LMD    CN+3
          SCN    77
          NJN    CFU5        IF NO MATCH
 
*         COMPARE USER NAMES.
 
          LDN    45D         SET LABEL USER NAME POINTER
          STD    T6
          LDC    UDTB        RESTORE DESTINATION BUFFER
          STM    DBUF
          LDN    1           SET UDT USER NAME POINTER
          STD    T7
          LDN    7
          RJM    CAN         COMPARE USER NAMES
 CFU5     LJM    CFUX        RETURN WITH STATUS
 
 
 CFUA     VFD    48/0L"ZFAM"
 CLR      SPACE  4,10
**        CLR - CHECK LABELED REEL REQUIRED.
*
*         EXIT   TO CALLER IF TO ACCEPT UNLABELED REEL.
*                TO *SEC* IF LABELED REEL REQUIRED.
 
 
 CLR      SUBR               ENTRY/EXIT
          LDD    LT
          SHN    -11
          LPN    3
          LMN    2
          NJN    CLRX        IF NOT ANSI LABELED TAPE REQUESTED
          LDD    UP
          SHN    21-12
          MJN    CLR1        IF NOT INITIAL REEL CHECK
          LDD    LT
          SHN    21-13
          MJN    CLRX        IF *OPEN WRITE* TO BE PERFORMED BY *RESEX*
 CLR1     LDN    /MTX/NLB    *NEEDS LABEL.*
          LJM    SEC         SET ERROR CODE
 HLC      SPACE  4,10
**        HLC - HEADER LABEL CHECK.
*
*         ENTRY  (MD, 0) = 1, IF REQUESTER IS NOT OWNER.
*
*         CALLS  CLA, CLR, CSC, GCH, HDR.
 
 
 HLC      SUBR               ENTRY/EXIT
 
*         CHECK FOR *HDR1* LABEL.
 
          RJM    CLA         CHECK LABEL
          NJN    HLC1        IF NOT GOOD LABEL
          LDM    BUF
          LMC    2RHD
          NJN    HLC1        IF NOT *HDR1* LABEL
          LDM    BUF+1
          LMC    2RR1
          ZJN    HLC3        IF *HDR1* LABEL
 HLC1     RJM    CLR         CHECK LABELED REEL REQUIRED
          LJM    HLC8        RETURN
 
*         CHECK FILE ACCESS PERMISSIONS.
 
 HLC3     RJM    CSC         CHECK SYSTEM CODE
          STD    T4
          LDC    UDTB        RESET BUFFER
          STM    DBUF
          LDD    SP
          SHN    21-10
          PJN    HLC7        IF NOT ENFORCING ACCESS RESTRICTIONS
          LDD    T4
          NJN    HLC7        IF NOT INTERNALLY WRITTEN TAPE
          LDN    54D         SET ACCESSIBILITY
          STD    T6
          RJM    GCH         GET CHARACTER
          STD    T4
          LMN    1R
          ZJN    HLC7        IF UNLIMITED ACCESS
          LMN    1RA&1R
          NJN    HLC4        IF NOT RESTRICTED TO THIS USER
          LDD    MD
          LPN    1
          ZJN    HLC7        IF REQUESTER IS OWNER OF THIS REEL
          UJN    HLC5        DISPLAY ERROR MESSAGE
 
 HLC4     LDM    UDTB+4      GET SPECIFIED FILE ACCESS
          SHN    -6
          LMD    T4
          ZJN    HLC7        IF MATCHING FILE ACCESS
 HLC5     LDN    /MTX/CAD    *CAN-T ACCESS DATA.*
 HLC6     LJM    SEC         SET ERROR CODE
 
*         RETURN *HDR1* LABEL INFORMATION TO UDT.
 
 HLC7     RJM    HDR         PROCESS HEADER LABEL
 HLC8     LJM    RET1        EXIT
 SEC      SPACE  4,10
**        SEC - SET *RRJ* ERROR AND SUB-CODE.
*
*         ENTRY  (A) = *RRJ* ERROR SUB-CODE.
 
 
 SEC      BSS    0           ENTRY
          STM    ERSC        SET ERROR SUB-CODE
          LDK    /MTX/RRJ
          LJM    RET3        RETURN *RRJ* ERROR
 VLC      SPACE  4,10
**        VLC - VOLUME LABEL CHECK.
*
*         EXIT   (MD, 0) = 1, IF NOT MATCHING USER NAME AND EXIT
*                TO NEXT SECTION.
*
*         CALLS  CAN, CCH, CFU, CLL, GCH, UAD, WUD.
 
 
 VLC      SUBR               ENTRY/EXIT
 
*         CHECK WRITE ENABLE ENFORCEMENT.
 
          LDD    SP
          SHN    21-4
          PJN    VLC2        IF WRITE ACCESS NOT REQUIRED
          LDD    DS
          SHN    21-7
          MJN    VLC2        IF TAPE WRITE ENABLED
          LDN    /MTX/WRD    *WRITE DISABLED*
 VLC1     LJM    SEC         SET ERROR CODE
 
*         CHECK FOR *VOL1* LABEL.
 
 VLC2     RJM    CLL         CHECK LABEL LENGTH
          NJN    VLC3        IF NOT CORRECT SIZE FOR ANSI LABEL
          LDM    BUF
          LMC    2RVO
          NJN    VLC3        IF NOT *VOL1* LABEL
          LDM    BUF+1
          LMC    2RL1
          ZJN    VLC8        IF *VOL1* LABEL
 
*         PROCESS *VOL1* LABEL NOT FOUND.
 
 VLC3     RJM    CLR         CHECK LABELED REEL REQUIRED
          LDD    EC
          LMN    /MTX/BTA
          NJN    VLC5        IF NOT BLANK TAPE
          LDD    UP          SET BLANK TAPE FLAG
          SCN    4
          LMN    4
          STD    UP
 VLC5     RJM    WUD         REWRITE UDT
          LJM    RET1        ACCEPT THIS REEL
 
*         CHECK VSN.
 
 VLC8     LDN    5           COMPARE VSNS
          STD    T6
          LDN    11D
          STD    T7
          LDN    6
          RJM    CAN         COMPARE FIELDS
          ZJN    VLC10       IF VSN,S MATCH
          RJM    UAD
          ADK    /MTX/UESN
          CRD    CM
          LDD    CM+4
          SHN    21-5
          MJN    VLC9        IF SCRATCH TAPE REQUESTED
          LDN    /MTX/WVS    *WRONG VSN.*
          LJM    SEC         SET ERROR CODE
 
 VLC9     LDN    5           COPY VSN TO UDT
          STD    T6
          LDN    11D
          STD    T7
          LDN    6
          RJM    CCH         COPY CHARACTERS
          RJM    WUD         REWRITE UDT
 
*         CHECK UNLABELED ACCESS TO LABELED TAPE.
 
 VLC10    LDD    LT
          SHN    -11
          LPN    3
          LMN    2
          ZJN    VLC11       IF ANSI LABELED REQUEST
          LDN    11D         CHECK VOLUME ACCESSIBILITY
          STD    T6
          RJM    GCH         GET CHARACTER
          LMN    1R
          ZJN    VLC11       IF UNLIMITED ACCESS
          LDD    SP
          LPN    10
          NJN    VLC11       IF WRITE ACCESS DISABLED
          LDD    SP
          SHN    21-10
          PJN    VLC13       IF NOT ENFORCING ACCESS RESTRICTIONS
          LDN    /MTX/CAD    *CAN-T ACCESS DATA.*
          LJM    SEC         SET ERROR CODE
 
*         CHECK FAMILY AND USER NAME FOR FILE OWNERSHIP CHECK.
 
 VLC11    RJM    CFU         CHECK FAMILY AND USER NANE
          ZJN    VLC12       IF MATCHING FAMILY/USER NAME
          AOD    MD          SET NO USER NAME MATCH
 VLC12    AOD    PB          INCREMENT TO NEXT SECTION
 VLC13    LJM    VLCX        RETURN
 
 
 OVLML    EQU    *           END OF OVERLAY AREA
 
 BUFC     EQU    /READ/LBUF
 BUF      EQU    BUFC+5
          ERROVL OVLML
 PRS      SPACE  4,10
 PRSD     BSS    0           FWA OF RELOCATED INITIAL LABEL ERROR CODE
          LOC    .LERA       INITIAL LABEL HANDLER
 LER      SPACE  4,10
**        LER - HANDLE LABEL ERRORS AT LOAD POINT AND ON INITIAL
*               LABEL CHECKING DONE BY SCANNER.
*
*         ENTRY  (/READ/STAP) = PREVIOUS GENERAL STATUS.
*                DS = CURRENT GENERAL STATUS.
*
*         EXIT   TO *CLA7* = FATAL LABEL ERROR.
*                TO *RLA5* = REREAD LABEL PRU.
*
*         CALLS  BKS, FCN, WFC.
 
 
 LER      SUBR               ENTRY/EXIT
          LDM    /READ/STAP  LOAD PREVIOUS GENERAL STATUS
          LPN    4
          ZJN    LER1        IF NOT AT LOAD POINT BEFORE READ
          RJM    CLL         CHECK LABEL LENGTH
          NJN    LER2        IF NOT LABEL PRU
          AOM    LERA        INCREMENT LABEL RETRY COUNTER
          SBN    4
          PJN    LER2        IF THREE TRIES ON THIS PRU HAVE BEEN TRIED
          LDN    F0010       REWIND TO LOAD POINT
          RJM    FCN
          LDD    HP
          SHN    21-7
          PJN    LER0        IF NOT CTS
          RJM    WNB         WAIT NOT BUSY
          UJN    LER0.1      REREAD LABEL PRU
 
 LER0     RJM    WFC
 LER0.1   LJM    RLA5        REREAD LABEL PRU FROM LOAD POINT
 
 LER1     AOM    LERA        INCREMENT LABEL PRU REREAD COUNT
          SBN    4
          PJN    LER2        IF THREE TRIES ON THIS PRU HAVE BEEN DONE
          RJM    BKS         BACKSPACE ONE PRU
          LJM    RLA5        REREAD LABEL PRU
 
 LER2     LJM    CLA7        FATAL INITIAL LABEL READ ERROR
 
 
 LERA     CON    0           LABEL RETRY COUNTER
 WFC      SPACE  4,10
**        WFC - WAIT BACKSPACE FUNCTION COMPLETE.
*         TIMES OUT APPROXIMATELY 25 FEET OF TAPE.
*
*         EXIT   (DS) = UNIT STATUS.
*
*         USES   T2.
*
*         CALLS  //STW.
 
 WFC2     CON    0           ENTERED VIA *RJM* FROM //STW
          SOD    T2
          NJN    WFC1        IF NOT TIMEOUT
          LDC    //ERR       RESET ERROR EXIT
          STM    //STWC
          UJN    WFC1        ATTEMPT 1 MORE WAIT
 
 WFC      SUBR               ENTRY/EXIT
          LDC    2000        SET TIME OUT
          STD    T2
          LDC    WFC2        SET RETURN ON TIMEOUT IN //STW
          STM    //STWC
 WFC1     LDN    2           WAIT NOT BUSY
          RJM    //STW
          LDC    //ERR       RESET ERROR EXIT
          STM    //STWC
          UJN    WFCX        RETURN
          SPACE  4,10
 .LERB    BSS    0           END OF INITIAL LABEL ERROR CODE
          LOC    *O
 PRS      SPACE  4,10
**        PRS - PRESET.
*
*         CALLS  CTM, HNG, MCH.
 
 
 PRS      LDC    PRSC        MODIFY CHANNELS
          RJM    MCH
          LDC    /SRU/ITCL*100  SET SRU INCREMENT
          STM    //CECA
          LDD    HP
          SHN    21-7
          PJP    PRS0        IF NOT CTS
          LDC    RLA6
          STM    /READ/RDFC+1
          LDC    LDNI+CRE/10000
          STM    CLAD        LOAD CTS ERROR PROCESSOR
          LDC    UJNI-NJNI   MODIFY INSTRUCTIONS FOR CTS
          RAM    CLAC
          LDN    0
          STM    ETCA        ALLOW PO=S ONLY
          LDC    BUF
          STM    /READ/RCTB
          ISTORE RLAH,(UJN RLA9)
          LDC    LDNI+CLBL
          STM    RLAI        12-BIT WORD LENGTH OF LABEL
          LDN    CLBL+1
          STM    /READ/RCTA  SET LENGTH TO READ + 1
          ISTORE SKRA,(UJN SKR2)  SKIP SAVING BLOCK ID
          LDC    /READ/RCT
          STM    PRSE
          LJM    PRS3.0      CONTINUE CODE MODIFICATION
 
 PRS0     SHN    21-4-21+7
          PJN    PRS1        IF NOT ATS
          LDC    ZJNI+BTA2-BTAB  MODIFY INSTRUCTIONS FOR ATS
          STM    BTAB
          LCN    0
          STM    CLAB
          LDC    177
          STM    BTAA
          LDC    ATUS
          STM    SDEA
          LDC    SHNI+74
          STM    SDEB
          LDC    SHNI+3
          STM    SDEC
 PRS1     LDC    4425
          STM    //WEOA
          LDC    RLA6.1
          STM    /READ/RDFC+1
          LDN    LABL+1
          STM    /READ/MRDA  LABEL LENGTH TO READ + 1
          LDD    PB
          SHN    -6
          ZJN    PRS2        IF INITIAL LABEL CHECK
          ERRNZ  /MTX/RLCL
          LMN    /MTX/RLCR/100
          NJN    PRS3        IF NOT CHECK NEXT REEL
 PRS2     LDC    LJMI        SET RETURN ON *NO EOP*
          STM    STWC-1
          LDC    /READ/MRD5
          STM    STWC
 PRS3     LDC    BUF
          STM    /READ/MRDB
 PRS3.0   LDC    LJMI
          STM    /READ/RDFC
          LDC    /READ/RDFC
          STM    /READ/MRD
 PRSE     EQU    *-1
*         STM    /READ/RCT   (CTS)
          LDD    PB
          SHN    -6
          NJN    PRS3.2      IF NOT INITIAL LABEL CHECK
          ERRNZ  /MTX/RLCL
          STD    T2
          LDC    .LERB-.LERA
          STD    T1
 PRS3.1   LDM    PRSD,T2     MOVE CODE FOR INITIAL LABEL CHECK ERROR
          STM    EOFX,T2
          AOD    T2
          SBD    T1
          MJN    PRS3.1      IF NOT ALL CODE MOVED
          LDC    LDNI        ENABLE INITIAL LABEL
          STM    RLAF
          UJN    PRS4        CONTINUE NORMAL PROCESSING
 
 PRS3.2   LDC    UJNI+2      DISABLE INITIAL LABEL ERROR RECOVERY
          STM    CLAA
          LDD    EP
          LPN    77
          ZJN    PRS4        IF NOT RELOAD ERROR PROCESSOR
          LDC    CLA4        SET TO RELOAD ERROR PROCESSOR
          STM    /READ/RDFC+1
 PRS4     LDM    FETO
          SHN    21-5
          PJN    PRS7        IF NO EXTENDED LABELS
          LDD    PB
          SHN    -6
          LMN    /MTX/RLOF/100
          ZJN    PRS6        IF OPEN
          LMN    /MTX/RLOF/100&/MTX/RLCF/100
          NJN    PRS7        IF NOT CLOSE
          LDD    DS
          LPN    4
          ZJN    PRS6        IF NOT POSITIONED AT LOAD POINT
          LDC    PRS5        SET TO RETURN HERE
          STM    //LOV
          LJM    PRSX        COMPLETE OVERLAY LOAD
 
 PRS5     LDN    /MTX/BEI    SET TO NOT SKIP TAPE MARKS
          LJM    RET3        RETURN ERROR CODE
 
 PRS6     STM    WELA        ENABLE EXTENDED LABELS
 PRS7     LDD    LT          SET LABEL TYPE INDEX
          LPC    1000
          ZJN    PRS7.1      IF NOT NON-STANDARD LABELS
          LDN    3
 PRS7.1   STD    T1          SET TABLE INDEX
          SBN    LTYPL
          MJN    PRS11       IF LEGAL LABEL TYPE
 PRS8     LDC    PRS10       SET TO RETURN AFTER COMPLETION OF LOAD
 PRS9     STM    LOV
          LJM    PRSX        RETURN
 
 PRS10    LDN    /MTX/LIT    INCORRECT LABEL TYPE
          LJM    RET3        RETURN ERROR CODE
 
 PRS11    LDM    LTYP,T1     SET ADDRESS OF LABEL OPERATION TABLE
          ZJN    PRS8        IF INCORRECT LABEL TYPE
          STD    T3
          LDD    PB          CHECK IF LEGAL OPERATION
          SHN    -6
          STM    RLAA
          SHN    1
          SBM    LTYP+2,T1
          MJN    PRS13       IF DEFINED OPERATION
          LDC    PRS12       SET TO RETURN AFTER COMPLETION OF LOAD
          UJN    PRS9        RETURN
 
 PRS12    RJM    HNG         HANG PP
 
 PRS13    LDD    PB
          SHN    1-6
          RAD    T3
          LDI    T3          SET CURRENT OPERATION TABLE
          STM    PRSA
          AOD    T3
          LDI    T3          SET LENGTH OF TABLE
          LPN    77
          STD    T2
          LMC    -0
          STM    RLAB
          LDI    T3
          LPC    4000        DO NOT READ BEFORE FIRST OPERATION FLAG
          STM    RLAD
          LDN    0           MOVE TABLE
          STD    T3
 PRS14    LDM    *,T3
 PRSA     EQU    *-1
          STM    TABC,T3
          AOD    T3
          SBD    T2
          MJN    PRS14       IF NOT COMPLETE
          LDD    PB
          LPN    77
          ZJN    PRS15       IF FIRST TIME
          LDN    0           CLEAR *FIRST OPERATION DO NOT READ* FLAG
          STM    RLAD
 PRS15    LDM    LOV         CHECK WHERE CALLED FROM
          ADC    -//OVL
          MJN    PRS16       IF NOT CALLED FROM READ ERROR RETURN
          LDC    4000        SET *SKIP READ* FLAG AND FORCE EXECUTION
          STM    RLAC        OF *WEL*
          LDC    RLA         SET TO ENTER READ LABELS
          STM    //LOV
          LDC    //LOV
          STM    PRSB
 PRS16    LDD    PB
          SHN    -6
          LMN    /MTX/RLOF/100
          ZJN    PRS16.3     IF OPEN
          LMN    6&4
          NJN    PRS17       IF NOT CLOSE
 PRS16.3  LDD    PB
          LPN    77
          ZJN    PRS17       IF PROCESSING FIRST SECTION
          SOD    PB          DECREMENT SECTION NUMBER - WILL BE
*                            INCREMENTED BY ROUTINE *CHC*
          LDC    RLA11       INSURE CONTROL POINT CHANGE TAKES PLACE
          STM    BT
*         STM    //LOV       (READ ERROR RETURN)
 PRSB     EQU    *-1
 PRS17    LJM    PRSX        RETURN
 
 
 PRSC     CHTB               CHANNEL TABLE
          TITLE  PROCESSING TABLES.
          SPACE  4,10
**        TABLE OF LABEL TYPES AND SIZES.
*T,       12/ TYPE,12/ SIZE,12/ LENGTH
*         TYPE   ADDRESS OF LABEL OPERATION TABLE.
*         SIZE   SIZE OF LABEL BLOCK IN BYTES.
*         LENGTH LENGTH OF LABEL OPERATION TABLE.
 
 LTYP     BSS    0
          LOC    0
          CON    ANS,LABL,ANSL  ANSI LABELS
          CON    NST,LABL,NSTL  (NON - STANDARD LABELS)
          LOC    *O
 LTYPL    EQU    *-LTYP
          TITLE  ANSI LABEL PROCESSORS.
          SPACE  4,10
**        TABLES OF LABEL OPERATIONS.
*T,       12/ ADDRESS,1/R,5/,6/SEC
*         R      DON,T READ PRIOR TO FIRST OPERATION.
*         SEC    NUMBER OF SECTIONS.
 
 
 ANS      INDEX              ANSI LABELS OPERATION TABLE
          INDEX  /MTX/RLCL/40,(CIL,CILL)       CHECK IF LABELED
          INDEX  /MTX/RLCE/40,(CET,CETL+4000)  CHECK END OF TAPE
          INDEX  /MTX/RLSL/40,(SKL,SKLL)       SKIP OVER LABELS
          INDEX  /MTX/RLSM/40,(SKT,SKTL)       SKIP TAPE MARKS
          INDEX  /MTX/RLOF/40,(OPL,OPLL+4000)  OPEN FILE
          INDEX  /MTX/RLCR/40,(RCE,RCEL)       CHECK NEXT REEL
          INDEX  /MTX/RLCF/40,(CLF,CLFL+4000)  CLOSE FILE
          INDEX  /MTX/RLCM/40,(CFL,CFLL+4000)  CHECK MULTI FILE LABELS
          INDEX  /MTX/RLVH/40,(CVH,CVHL)       VALIDATE HEADER LABEL
          INDEX  /MTX/RLMX/40                  TERMINATE TABLE
 ANSL     EQU    *-ANS       LENGTH OF TABLE
 
 NST      INDEX              NON-STANDARD LABELS OPERATION TABLE
          INDEX  /MTX/RLCE/40,(CET,CETL+4000)  CHECK END OF TAPE
          INDEX  /MTX/RLSL/40,(PNL,PNLL)       SKIP OVER LABELS
          INDEX  /MTX/RLSM/40,(SKT,SKTL)       SKIP TAPE MARKS
          INDEX  /MTX/RLOF/40,(OPL,OPLL+4000)  OPEN FILE
          INDEX  /MTX/RLCR/40,(RCE,RCEL)       CHECK NEXT REEL
          INDEX  /MTX/RLCF/40,(CLF,CLFL+4000)  CLOSE FILE
          INDEX  /MTX/RLCF/40+2                TERMINATE TABLE
 NSTL     EQU    *-NST       LENGTH OF TABLE
          SPACE  4,10
**        TABLE OF ANSI LABEL SEQUENCES.
 
 CIL      BSS    0
          LOC    0
          CON    BTA         BLANK TAPE CHECK
          CON    VOL         VOL1
          CON    UVL         UVLA
          CON    HDR         HDR1
          CON    OHD         HDR2 - HDR9
          CON    UHL         UHLA
          CON    TMS         TAPE MARK SENSE
          LOC    *O
 CILL     EQU    *-CIL
 
 CET      BSS    0
          LOC    0
          CON    ETC
          CON    EOF         EOF1
          CON    EOV         EOV1
          CON    EVO         EOV2
          LOC    *O
 CETL     EQU    *-CET
 
 CFL      BSS    0
          LOC    0
          CON    ETC         END OF TAPE CHECK
          CON    EOF         CHECK *EOF1*
          CON    EFO         CHECK EOF2 -EOF9
          CON    UTL         UTLA
          CON    /MFP/TMC    CHECK TAPE MARK
          CON    /MFP/TMC    CHECK TAPE MARK
          CON    HDR         CHECK *HDR1*
          CON    OHD         HDR2 - HDR9
          CON    UHL         UHLA
          CON    TMS         TAPE MARK SENSE
          CON    EOV         CHECK *EOV1*
          CON    EVO         CHECK *EOV2*
          LOC    *O
 CFLL     EQU    *-CFL
 
 CVH      BSS    0
          LOC    0
          CON    VOL         CHECK *VOL1*
          CON    UVL         USER VOLUME LABELS
          CON    EOF         CHECK *EOF1*
          CON    EFO         CHECK EOF2 - EOF9
          CON    UTL         UTLA
          CON    STM         SKIP TAPE MARK
          CON    HDR         CHECK *HDR1*
          CON    OHD         HDR2 - HDR9
          CON    UHL         UHLA
          CON    TMS         TAPE MARK SENSE
          LOC    *O
 CVHL     EQU    *-CVH
 
 CLF      BSS    0
          LOC    0
          CON    CHC         CHANGE CONTROL POINTS
          CON    ZRO         ZERO FIRST WORD OF XL BUFFER
          CON    STM         SKIP TAPE MARK
          CON    EOF         EOF1
          CON    EFO         EOF2 - EOF9
          CON    UTL         UTLA
          CON    EOV         EOV1
          CON    EVO         EOV2
          CON    UTL         UTLA
          LOC    *O
 CLFL     EQU    *-CLF
 
 OPL      BSS    0
          LOC    0
          CON    CHC         CHANGE CONTROL POINTS
          CON    VOL         VOL1
          CON    UVL         UVLA
          CON    HDR         HDR1
          CON    OHD         HDR2 - HDR9
          CON    UHL         UHLA
          CON    TMS         TAPE MARK SENSE
          LOC    *O
 OPLL     EQU    *-OPL
 
 RCE      BSS    0
          LOC    0
          CON    BTA         BLANK TAPE CHECK
          CON    VLC         VOL1 CHECK
          CON    UVL         SKIP OPTIONAL LABELS
          CON    HLC         HDR1 CHECK
          LOC    *O
 RCEL     EQU    *-RCE
 
 SKL      BSS    0
          LOC    0
          CON    VOL         VOL1
          CON    UVL         UVLA
          CON    HDR         HDR1
          CON    OHD         HDR2 - HDR9
          CON    UHL         UHLA
          CON    TMS         TAPE MARK SENSE
          LOC    *O
 SKLL     EQU    *-SKL
 
 SKT      BSS    0
          LOC    0
          CON    PTM         READ TO TAPE MARK
          LOC    *O
 SKTL     EQU    *-SKT
          SPACE  4,10
**        TABLE OF NON-STANDARD LABEL SEQUENCES.
 
 PNL      BSS    0
          LOC    0
          CON    SBL
          CON    TMS
          LOC    *O
 PNLL     EQU    *-PNL
 
 MTL      MAX    CILL,CETL,CFLL,CVHL,CLFL,OPLL,RCEL,SKLL,SKTL,PNLL
 
          ERRNZ  MTL-TABCL   BUFFER NOT LONG ENOUGH FOR LARGEST TABLE
          OVERLAY (CODE CONVERT LABEL READ.),(ERLB+5),P
 CCL      SPACE  4,15
**        CCL - CODE CONVERT LABEL READ FOR CTS.
*
*         THIS ROUTINE CONVERTS 8-BIT CHARACTERS READ FROM A
*         CTS LABEL TO 6-BIT DISPLAY CODE CHARACTERS.
*
*         ENTRY  /READ/RCTB = STARTING ADDRESS OF DATA TO CONVERT.
*                (CF) = 63/64 CHARACTER SET FLAG.
*                (MD) = DRIVER MODE.
*                (DNCV) = CONVERSION MODE.
*
*         USES   T1, T2, T3, T6.
*
*         CALLS  EXC.
 
 
          ENTRY  CCL
 CCL      SUBR               ENTRY/EXIT
          LDD    CF
          LPN    1
          NJN    CCL1        IF 64 CHARACTER SET
          LCN    63-1R       MODIFY TABLES FOR 63 CHARACTER SET
          RAM    ANSI+ANSIA
          STM    ANSI+ANSIC
          LDC    63*100
          RAM    ANSI+ANSIB
          STM    ANSI+ANSID
          LCN    63-1R
          RAM    EBCI+EBCIA
          LDN    63-55
          RAM    EBCI+EBCIB
          LDC    1R *100-63*100
          RAM    EBCI+EBCIC
          LDC    63*100-0
          RAM    EBCI+EBCID
 CCL1     LDD    MD
          SHN    21-6
          PJN    CCL2        IF NOT CODED
          LDM    DNCV
          LPN    7
          LMN    /MTX/ANS
          ZJN    CCL2        IF ASCII CONVERSION MODE
          LDC    UJNI-PJNI
          RAM    EXCA        CODE MODIFICATION FOR EBCDIC
          LDC    EBCI
          STM    EXCB
          STM    EXCC
 CCL2     LDM    /READ/RCTB
          STD    T1          POINTER TO CHARACTER TO CONVERT
          LDN    0
          STD    T2          POINTER TO STORE CONVERTED CHARACTER
          STD    T3          1 OF 3 POSITIONS OF 8-BIT BYTE
 CCL3     RJM    EXC         EXTRACT CHARACTER
 
*         STORE CONVERTED CHARACTER.
 
          LDD    T2
          SHN    21-0
          ADM    /READ/RCTB
          STD    T6          ADDRESS TO STORE CONVERTED CHARACTER
          PJN    CCL4        IF UPPER CHARACTER
          LDD    T7
          RAI    T6
          UJN    CCL5        CHECK IF MORE CHARACTERS TO CONVERT
 
 CCL4     LDD    T7
          SHN    6
          STI    T6
 CCL5     AOD    T2
          LMC    80D
          NJN    CCL3        IF MORE CHARACTERS TO CONVERT
          UJP    CCLX        RETURN
 EXC      SPACE  4,15
**        EXC - EXTRACT CHARACTER.
*
*         THIS ROUTINE TAKES ONE OF THE 80 CHARACTERS OF THE LABEL
*         THAT WAS READ AND CONVERTS IT TO DISPLAY CODE.
*
*         ENTRY  (T1) = POINTER TO CHARACTER TO CONVERT.
*                (T3) = 0  UPPER 8 OF 24.
*                       1  MIDDLE 8 OF 24.
*                       2  LOWER 8 OF 24.
*
*         EXIT   (T5) = (BUF,T1) IF (T3) = 0.
*                (T7) = CONVERTED CHARACTER.
*
*         USES   T4, T5
 
 
 EXC      SUBR               ENTRY/EXIT
          LDD    T3
          NJN    EXC1        IF NOT UPPER 8 OF 24
          LDI    T1
          STD    T5
          SHN    -4
          UJN    EXC3        MASK 8-BIT CHARACTER
 
 EXC1     SBN    1
          NJN    EXC2        IF NOT BYTE 2 OF 3
          LDD    T5
          LPN    17
          SHN    4
          STD    T5
          LDM    1,T1
          SHN    -10
          ADD    T5
          UJN    EXC3        MASK 8-BIT CHARACTER
 
 EXC2     LDM    1,T1
 EXC3     SHN    21-7
          PJN    EXC4        IF LEGAL CHARACTER (ANSI)
 EXCA     EQU    *-1
*         UJN    EXC4        (EBCDIC)
          LDN     0
 EXC4     SHN    7-21        MASK 8 BITS
          SHN    21-0
          STD    T4
          PJN    EXC5        IF LEFT HALF OF CONVERSION TABLE WORD
          LDM    ANSI,T4
 EXCB     EQU    *-1
*         LDM    EBCI,T4     (EBCDIC)
          LPN    77
          UJN    EXC6        SAVE DISPLAY CODE VALUE
 
 EXC5     LDM    ANSI,T4
 EXCC     EQU    *-1
*         LDM    EBCI,T4     (EBCDIC)
          SHN    -6
 EXC6     STD    T7          SAVE DISPLAY CODE VALUE
          AOD    T3
          SBN    3
          NJN    EXC7        IF NOT BYTE 3 OF 3
          STD    T3
          LDN    2
          RAD    T1
 EXC7     LJM    EXCX        RETURN
 ANSI     SPACE 4,10
**        ANSI - TABLE FOR *ASCII* TO DISPLAY CODE CONVERSION.
*         THE ASCII CHARACTER DIVIDED BY 2 IS THE INDEX INTO THIS
*         TABLE.  ONLY THE FIRST 128 CHARACTERS ARE IN THE TABLE.
*         THE PROGRAM USING THE TABLE WILL SUBSTITUTE 00 FOR THE
*         HEX VALUES OF 80-FF.
 
 ANSI     BSS    0
          LOC    0
 
          VFD    6/1R        00        NUL  NULL
          VFD    6/1R]       01        SOH  START OF HEADING
          VFD    6/64        02        STX  START OF TEXT
          VFD    6/1R#       03        ETX  END OF TEXT
          VFD    6/1R$       04        EOT  END OF TRANSMISSION
          VFD    6/63        05        ENQ  ENQUIRY (64 CHARACTER SET)
 ANSIA    EQU    *-1         (63 CHARACTER SET)
*         VFD    6/1R        05        ENQ  ENQUIRY (63 CHARACTER SET)
          VFD    6/1R&       06        ACK  ACKNOWLEDGE
          VFD    6/1R'       07        BEL  BELL
          VFD    6/51        08        BS   BACKSPACE
          VFD    6/1R)       09        HT   HORIZONTAL TAB
          VFD    6/1R*       0A        LF   LINE FEED
          VFD    6/1R+       0B        VT   VERTICAL TAB
          VFD    6/1R,       0C        FF   FORM FEED
          VFD    6/1R-       0D        CR   CARRIAGE RETURN
          VFD    6/1R.       0E        SO   SHIFT OUT
          VFD    6/1R/       0F        SI   SHIFT IN
 
          VFD    6/1R0       10        DLE  DATA LINK ESCAPE
          VFD    6/1R1       11        DC1  DEVICE CONTROL 1 (X-ON)
          VFD    6/1R2       12        DC2  DEVICE CONTROL 2
          VFD    6/1R3       13        DC3  DEVICE CONTROL 3 (X-OFF)
          VFD    6/1R4       14        DC4  DEVICE CONTROL 4 (STOP)
          VFD    6/1R5       15        NAK  NEGATIVE ACKNOWLEDGE
          VFD    6/1R6       16        SYN  SYNCHRONOUS IDLE
          VFD    6/1R7       17        ETB  END OF TRANSMISSION BLOCK
          VFD    6/1R8       18        CAN  CANCEL
          VFD    6/1R9       19        EM   END OF MEDIUM
          VFD    6/00        1A        SUB  SUBSTITUTE (64 CHARACTERS)
 ANSIB    EQU    *           (63 CHARACTER SET)
*         VFD    6/63        1A        SUB  SUBSTITUTE (63 CHARACTERS)
          VFD    6/1R;       1B        ESC  ESCAPE (DRIVER)
          VFD    6/1R[       1C        FS   FILE SEPARATOR
          VFD    6/1R=       1D        GS   GROUP SEPARATOR
          VFD    6/1R>       1E        RS   RECORD SEPARATOR
          VFD    6/1R?       1F        US   UNIT SEPARATOR
 
          VFD    6/1R        20             SPACE
          VFD    6/1R!       21             EXCLAMATION POINT
          VFD    6/64        22             QUOTATION MARKS
          VFD    6/1R#       23             NUMBER SIGN
          VFD    6/1R$       24        $    DOLLAR SIGN
          VFD    6/63        25             PERCENT (64 CHARACTER SET)
 ANSIC    EQU    *-1         (63 CHARACTER SET)
*         VFD    6/1R        25             PERCENT (63 CHARACTER SET)
          VFD    6/1R&       26             AMPERSAND
          VFD    6/1R'       27             APOSTROPHE
          VFD    6/51        28        (    OPENING PARENTHESIS
          VFD    6/1R)       29        )    CLOSING PARENTHESIS
          VFD    6/1R*       2A        *    ASTERISK
          VFD    6/1R+       2B        +    PLUS
          VFD    6/1R,       2C        ,    COMMA
          VFD    6/1R-       2D        -    HYPHEN (MINUS)
          VFD    6/1R.       2E        .    PERIOD
          VFD    6/1R/       2F        /    SLANT
 
          VFD    6/1R0       30        0
          VFD    6/1R1       31        1
          VFD    6/1R2       32        2
          VFD    6/1R3       33        3
          VFD    6/1R4       34        4
          VFD    6/1R5       35        5
          VFD    6/1R6       36        6
          VFD    6/1R7       37        7
          VFD    6/1R8       38        8
          VFD    6/1R9       39        9
          VFD    6/00        3A             COLON (64 CHARACTER SET)
 ANSID    EQU    *           (63 CHARACTER SET)
*         VFD    6/63        3A             COLON (63 CHARACTER SET)
          VFD    6/1R;       3B             SEMICOLON
          VFD    6/1R<       3C             LESS THAN
          VFD    6/1R=       3D             EQUALS
          VFD    6/1R>       3E             GREATER THAN
          VFD    6/1R?       3F             QUESTION MARK
 
          VFD    6/1R@       40             COMMERCIAL AT
          VFD    6/1RA       41        A
          VFD    6/1RB       42        B
          VFD    6/1RC       43        C
          VFD    6/1RD       44        D
          VFD    6/1RE       45        E
          VFD    6/1RF       46        F
          VFD    6/1RG       47        G
          VFD    6/1RH       48        H
          VFD    6/1RI       49        I
          VFD    6/1RJ       4A        J
          VFD    6/1RK       4B        K
          VFD    6/1RL       4C        L
          VFD    6/1RM       4D        M
          VFD    6/1RN       4E        N
          VFD    6/1RO       4F        0
 
          VFD    6/1RP       50        P
          VFD    6/1RQ       51        Q
          VFD    6/1RR       52        R
          VFD    6/1RS       53        S
          VFD    6/1RT       54        T
          VFD    6/1RU       55        U
          VFD    6/1RV       56        V
          VFD    6/1RW       57        W
          VFD    6/1RX       58        X
          VFD    6/1RY       59        Y
          VFD    6/1RZ       5A        Z
          VFD    6/1R[       5B             OPENING BRACKET
          VFD    6/1R\       5C             REVERSE SLANT
          VFD    6/1R]       5D             CLOSING BRACKET
          VFD    6/1R^       5E             CIRCUMFLEX
          VFD    6/65        5F             UNDERLINE
 
          VFD    6/1R@       60             GRAVE ACCENT
          VFD    6/1RA       61        A    LC
          VFD    6/1RB       62        B    LC
          VFD    6/1RC       63        C    LC
          VFD    6/1RD       64        D    LC
          VFD    6/1RE       65        E    LC
          VFD    6/1RF       66        F    LC
          VFD    6/1RG       67        G    LC
          VFD    6/1RH       68        H    LC
          VFD    6/1RI       69        I    LC
          VFD    6/1RJ       6A        J    LC
          VFD    6/1RK       6B        K    LC
          VFD    6/1RL       6C        L    LC
          VFD    6/1RM       6D        M    LC
          VFD    6/1RN       6E        N    LC
          VFD    6/1RO       6F        O    LC
 
          VFD    6/1RP       70        P    LC
          VFD    6/1RQ       71        Q    LC
          VFD    6/1RR       72        R    LC
          VFD    6/1RS       73        S    LC
          VFD    6/1RT       74        T    LC
          VFD    6/1RU       75        U    LC
          VFD    6/1RV       76        V    LC
          VFD    6/1RW       77        W    LC
          VFD    6/1RX       78        X    LC
          VFD    6/1RY       79        Y    LC
          VFD    6/1RZ       7A        Z    LC
          VFD    6/1R<       7B             OPENING BRACE
          VFD    6/1R\       7C             VERTICAL LINE
          VFD    6/1R!       7D             CLOSING BRACE
          VFD    6/1R^        7E             OVERLINE (TILDE)
          VFD    6/65        7F        DEL  DELETE
 
          LOC    *O
 EBCI     SPACE 4
**        EBCI - TABLE FOR EBCDIC TO DISPLAY CODE CONVERSION.
 
*         THE ASCII CHARACTER DIVIDED BY 2 IS THE INDEX INTO THIS
*         TABLE.
 
 
 EBCI     BSS    0
          LOC    0
 
          VFD    6/1R        00        NUL  NULL
          VFD    6/1R]       01        SOH  START OF HEADING
          VFD    6/64        02        STX  START OF TEXT
          VFD    6/1R#       03        ETX  END OF TEXT
          VFD    6/1R        04
          VFD    6/1R)       05        HT   HORIZONTAL TAB
          VFD    6/1R        06
          VFD    6/65        07        DEL  DELETE
          VFD    6/1R        08
          VFD    6/1R        09
          VFD    6/1R        0A
          VFD    6/1R+       0B        VT   VERTICAL TAB
          VFD    6/1R,       0C        FF   FORM FEED
          VFD    6/1R-       0D        CR   CARRIAGE RETURN
          VFD    6/1R.       0E        SO   SHIFT OUT
          VFD    6/1R/       0F        SI   SHIFT IN
 
          VFD    6/1R0       10        DLE  DATA LINK ESCAPE
          VFD    6/1R1       11        DC1  DEVICE CONTROL 1 (X-ON)
          VFD    6/1R2       12        DC2  DEVICE CONTROL 2
          VFD    6/1R3       13        DC3  DEVICE CONTROL 3 (X-OFF)
          VFD    6/1R        14
          VFD    6/1R        15
          VFD    6/51        16        BS   BACKSPACE
          VFD    6/1R        17
          VFD    6/1R8       18        CAN  CANCEL
          VFD    6/1R9       19        EM   END OF MEDIMUM
          VFD    6/1R        1A
          VFD    6/1R        1B
          VFD    6/1R[       1C        FS   FILE SEPERATOR
          VFD    6/1R=       1D        GS   GROUP SEPERATOR
          VFD    6/1R>       1E        RS   RECORD SEPERATOR
          VFD    6/1R?       1F        US   UNIT SEPERATOR
 
          VFD    6/1R        20
          VFD    6/1R        21
          VFD    6/1R        22
          VFD    6/1R        23
          VFD    6/1R        24
          VFD    6/1R*       25        LF   LINE FEED
          VFD    6/1R7       26        ETB  END OF TRANSMISSION BLOCK
          VFD    6/1R;       27        ESC  ESCAPE
          VFD    6/1R        28
          VFD    6/1R        29
          VFD    6/1R        2A
          VFD    6/1R        2B
          VFD    6/1R        2C
          VFD    6/63        2D        ENQ  ENQUIRY (64 CHARACTER SET)
 EBCIA    EQU    *-1         (63 CHARACTER SET)
*         VFD    6/1R        2D        ENQ  ENQUIRY (63 CHARACTER SET)
          VFD    6/1R&       2E        ACK  ACKNOWLEDGE
          VFD    6/1R'       2F        BEL  BELL
 
          VFD    6/1R        30
          VFD    6/1R        31
          VFD    6/1R6       32        SYN  SYNCHROUS IDLE
          VFD    6/1R        33
          VFD    6/1R        34
          VFD    6/1R        35
          VFD    6/1R        36
          VFD    6/1R$       37        EOT  END OF TRANSMISSION
          VFD    6/1R        38
          VFD    6/1R        39
          VFD    6/1R        3A
          VFD    6/1R        3B
          VFD    6/1R4       3C        DC4  DEVICE CONTROL 4
          VFD    6/1R5       3D        NAK  NEGATIVE ACKNOWLEDGE
          VFD    6/1R        3E
          VFD    6/00        3F        SUB  SUBSTITUTE (64 CHARACTER SET
 EBCIB    EQU    *-1         (63 CHARACTER SET)
*         VFD    6/63        3F        SUB  SUBSTITUTE (63 CHARACTER SET
 
          VFD    6/1R        40             SPACE
          VFD    6/1R        41
          VFD    6/1R        42
          VFD    6/1R        43
          VFD    6/1R        44
          VFD    6/1R        45
          VFD    6/1R        46
          VFD    6/1R        47
          VFD    6/1R        48
          VFD    6/1R        49
          VFD    6/1R[       4A             OPENING BRACKET
          VFD    6/1R.       4B        .    PERIOD
          VFD    6/1R<       4C             LESS THAN
          VFD    6/51        4D             OPENING PARENTHESIS
          VFD    6/1R+       4E        +    PLUS
          VFD    6/1R!       4F             LOGICAL OR
 
          VFD    6/1R&       50             AMPERSAND
          VFD    6/1R        51
          VFD    6/1R        52
          VFD    6/1R        53
          VFD    6/1R        54
          VFD    6/1R        55
          VFD    6/1R        56
          VFD    6/1R        57
          VFD    6/1R        58
          VFD    6/1R        59
          VFD    6/1R]       5A             CLOSING BRACKET
          VFD    6/1R$       5B        $    DOLLAR SIGN
          VFD    6/1R*       5C        *    ASTERISK
          VFD    6/1R)       5D        )    CLOSING PARENTHESIS
          VFD    6/1R;       5E             SEMICOLON
          VFD    6/1R^       5F        NOT  LOGICAL NOT
 
          VFD    6/1R-       60        -    HYPHEN (MINUS)
          VFD    6/1R/       61        /    SLANT
          VFD    6/1R        62
          VFD    6/1R        63
          VFD    6/1R        64
          VFD    6/1R        65
          VFD    6/1R        66
          VFD    6/1R        67
          VFD    6/1R        68
          VFD    6/1R        69
          VFD    6/1R\       6A             VERTICAL LINE
          VFD    6/1R,       6B        ,    COMMA
          VFD    6/63        6C             PERCENT (64 CHARACTER SET)
 EBCIC    EQU    *           (63 CHARACTER SET)
*         VFD    6/1R        6C             PERCENT (63 CHARACTER SET)
          VFD    6/65        6D             UNDERSCORE
          VFD    6/1R>       6E             GREATER THAN
          VFD    6/1R?       6F             QUESTION MARK
 
          VFD    6/1R        70
          VFD    6/1R        71
          VFD    6/1R        72
          VFD    6/1R        73
          VFD    6/1R        74
          VFD    6/1R        75
          VFD    6/1R        76
          VFD    6/1R        77
          VFD    6/1R        78
          VFD    6/1R@       79             GRAVE ACCENT
          VFD    6/00        7A             COLON (64 CHARACTER SET)
 EBCID    EQU    *           (63 CHARACTER SET)
*         VFD    6/63        7A            COLON (63 CHARACTER SET)
          VFD    6/1R#       7B             NUMBER SIGN
          VFD    6/1R@       7C             COMMERCIAL AT
          VFD    6/1R'       7D             APOSTROPHE
          VFD    6/1R=       7E        =    EQUALS
          VFD    6/64        7F             QUOTATION MARKS
 
          VFD    6/1R        80
          VFD    6/1RA       81        A    LC
          VFD    6/1RB       82        B    LC
          VFD    6/1RC       83        C    LC
          VFD    6/1RD       84        D    LC
          VFD    6/1RE       85        E    LC
          VFD    6/1RF       86        F    LC
          VFD    6/1RG       87        G    LC
          VFD    6/1RH       88        H    LC
          VFD    6/1RI       89        I    LC
          VFD    6/1R        8A
          VFD    6/1R        8B
          VFD    6/1R        8C
          VFD    6/1R        8D
          VFD    6/1R        8E
          VFD    6/1R        8F
 
          VFD    6/1R        90
          VFD    6/1RJ       91        J    LC
          VFD    6/1RK       92        K    LC
          VFD    6/1RL       93        L    LC
          VFD    6/1RM       94        M    LC
          VFD    6/1RN       95        N    LC
          VFD    6/1RO       96        O    LC
          VFD    6/1RP       97        P    LC
          VFD    6/1RQ       98        Q    LC
          VFD    6/1RR       99        R    LC
          VFD    6/1R        9A
          VFD    6/1R        9B
          VFD    6/1R        9C
          VFD    6/1R        9D
          VFD    6/1R        9E
          VFD    6/1R        9F
 
          VFD    6/1R        A0
          VFD    6/1R^       A1             OVERLINE (TILDE)
          VFD    6/1RS       A2        S    LC
          VFD    6/1RT       A3        T    LC
          VFD    6/1RU       A4        U    LC
          VFD    6/1RV       A5        V    LC
          VFD    6/1RW       A6        W    LC
          VFD    6/1RX       A7        X    LC
          VFD    6/1RY       A8        Y    LC
          VFD    6/1RZ       A9        Z    LC
          VFD    6/1R        AA
          VFD    6/1R        AB
          VFD    6/1R        AC
          VFD    6/1R        AD
          VFD    6/1R        AE
          VFD    6/1R        AF
 
          VFD    6/1R        B0
          VFD    6/1R        B1
          VFD    6/1R        B2
          VFD    6/1R        B3
          VFD    6/1R        B4
          VFD    6/1R        B5
          VFD    6/1R        B6
          VFD    6/1R        B7
          VFD    6/1R        B8
          VFD    6/1R        B9
          VFD    6/1R        BA
          VFD    6/1R        BB
          VFD    6/1R        BC
          VFD    6/1R        BD
          VFD    6/1R        BE
          VFD    6/1R        BF
 
          VFD    6/1R<       C0             OPENING BRACE
          VFD    6/1RA       C1        A
          VFD    6/1RB       C2        B
          VFD    6/1RC       C3        C
          VFD    6/1RD       C4        D
          VFD    6/1RE       C5        E
          VFD    6/1RF       C6        F
          VFD    6/1RG       C7        G
          VFD    6/1RH       C8        H
          VFD    6/1RI       C9        I
          VFD    6/1R        CA
          VFD    6/1R        CB
          VFD    6/1R        CC
          VFD    6/1R        CD
          VFD    6/1R        CE
          VFD    6/1R        CF
 
          VFD    6/1R!       D0             CLOSING BRACE
          VFD    6/1RJ       D1        J
          VFD    6/1RK       D2        K
          VFD    6/1RL       D3        L
          VFD    6/1RM       D4        M
          VFD    6/1RN       D5        N
          VFD    6/1RO       D6        O
          VFD    6/1RP       D7        P
          VFD    6/1RQ       D8        Q
          VFD    6/1RR       D9        R
          VFD    6/1R        DA
          VFD    6/1R        DB
          VFD    6/1R        DC
          VFD    6/1R        DD
          VFD    6/1R        DE
          VFD    6/1R        DF
 
          VFD    6/1R\       E0             REVERSE SLANT
          VFD    6/1R        E1
          VFD    6/1RS       E2        S
          VFD    6/1RT       E3        T
          VFD    6/1RU       E4        U
          VFD    6/1RV       E5        V
          VFD    6/1RW       E6        W
          VFD    6/1RX       E7        X
          VFD    6/1RY       E8        Y
          VFD    6/1RZ       E9        Z
          VFD    6/1R        EA
          VFD    6/1R        EB
          VFD    6/1R        EC
          VFD    6/1R        ED
          VFD    6/1R        EE
          VFD    6/1R        EF
 
          VFD    6/1R0       F0        0
          VFD    6/1R1       F1        1
          VFD    6/1R2       F2        2
          VFD    6/1R3       F3        3
          VFD    6/1R4       F4        4
          VFD    6/1R5       F5        5
          VFD    6/1R6       F6        6
          VFD    6/1R7       F7        7
          VFD    6/1R8       F8        8
          VFD    6/1R9       F9        9
          VFD    6/1R        FA
          VFD    6/1R        FB
          VFD    6/1R        FC
          VFD    6/1R        FD
          VFD    6/1R        FE
          VFD    6/1R        FF
          LOC    *O
          ERRNG  473+ERLB+5-*  IF CODE LONGER THAN ONE PRU
          OVERLAY (MULTI-FILE AUXILIARY PROCESSOR.),(/RLA/OVLM),,MFP
          SPACE  4,10
**        THIS OVERLAY CONTAINS ROUTINES WHICH ARE USED FOR
*         MULTI-FILE OPERATIONS.  IT OVERLAYS PART OF THE
*         READ LABELS OVERLAY AND IS USED IN CONJUCTION WITH
*         READ LABELS WHEN MULTI-FILE TAPES ARE BEING PROCESSED.
          SPACE  4,10
*         ASSEMBLY CONSTANTS
 
 
 BUF      EQU    /RLA/BUF
 DBUF     EQU    /RLA/DBUF
 IBUF     EQU    /RLA/IBUF
 UDTB     EQU    /RLA/UDTB
 CAN      EQU    /RLA/CAN
 CHC      EQU    /RLA/CHC
 CLA      EQU    /RLA/CLA
 C2D      EQU    /RLA/C2D
 DCV      EQU    /RLA/DCV
 ELA      EQU    /RLA/ELA
 FAD      EQU    /RLA/FAD
 FCH      EQU    /RLA/FCH
 RBE      EQU    /RLA/RBE
 RLAX     EQU    /RLA/RLAX
 THL      EQU    /RLA/THL
 WUD      EQU    /RLA/WUD
 
          ENTRY  MFP
 
 PHD      SPACE  4,10
**        PHD - PROCESS HEADER.
*
*         ENTRY  (A) = 0 IF CHECK MULTI-FILE LABELS (*RLCM*) OPERATION.
*                (A) = 1 IF VALIDATE HEADER LABEL (*RLVH*) OPERATION.
*
*         CALLS  CAN, FCH, THL, WUD.
 
 
 PHD      SUBR               ENTRY/EXIT
          STD    T6          SAVE ENTRY
          LDC    BUF         SET UP BUFFER ADDRESSES
          STM    IBUF
          LDD    T6
          ZJN    PHD1        IF CHECK MULTI-FILE LABELS
          ERRNZ  /MTX/RLCM-700
          LDM    CIOE        CHECK IF POSMF
          LPC    1774
          LMC    110
          NJN    PHD3        IF NOT POSMF
 PHD1     LDC    UDTB
          STM    DBUF
          RJM    THL         TRANSFER HEADER LABEL
          RJM    WUD         WRITE UDT
 PHD2     UJN    PHDX        RETURN
 
 PHD3     LDC    PHDA        COMPARE LABEL TO UDT
          STM    DBUF
          LDN    21D         ZERO OUT BUFFER
          STD    T7
          LDN    50D
          RJM    FCH         COPY CHARACTERS
          RJM    THL         TRANSFER HEADER LABEL
          LDN    21D
          STD    T6
          STD    T7
          LDC    UDTB        SET INPUT BUFFER
          STM    IBUF
          LDN    30D
          RJM    CAN         COMPARE FIELDS
          NJN    PHD4        IF NO COMPARE
          LDN    56D
          STD    T6
          STD    T7
          LDN    15D
          RJM    CAN         COMPARE LABEL FIELDS
          NJN    PHD4        IF NO COMPARE
          LDC    BUF         RESET INPUT BUFFER ADDRESS
          STM    IBUF
          LJM    PHDX        RETURN
 
 PHD4     LJM    RBE         RETURN *BEI* ERROR
 REL      SPACE  4,10
**        REL - READ EXTENDED LABELS.
*
*         CALLS  ELA.
 
 
 REL5     LDD    CM          SET SEQUENCE NUMBER
          SHN    14
          ADD    CM+1
          ADN    4
          CRM    TMCB,ON
          LDM    TMCB+2
          SCN    77
          SHN    6
          LMM    TMCB+1
          SHN    6
          STM    TMCB+4
          SHN    6
          STM    TMCB+3
 
 REL      SUBR               ENTRY/EXIT
          LDN    0
          STD    T6
          STD    T7
 REL1     RJM    ELA         GET EXTENDED LABEL ADDRESS
          ZJN    RELX        IF NO EXTENDED LABEL BUFFER
          CRD    CM
          STD    CM+1
          SHN    -14
          STD    CM
          LDD    CM+4
          ZJN    REL3        IF END OF BUFFER
          LMC    80D
          NJN    REL4        IF NOT CORRECT LENGTH
          LDD    CM
          SHN    14
          ADD    CM+1
          ADN    1
          CRM    TMCB,ON
          LDM    TMCB
          LMC    2RHD
          NJN    REL2        IF NOT *HD*
          LDM    TMCB+1
          LMC    2RR1
          NJN    REL2        IF NOT *HDR1*
          LJM    REL5        SET SEQUENCE NUMBER
 
 REL2     LDN    11
          RAD    T7
          SHN    -14
          RAD    T6
          LJM    REL1        LOOP FOR NEXT LABEL
 
 REL3     LDN    /MTX/LAM    LABEL MISSING
          LJM    RET3        RETURN ERROR CODE
 
 REL4     LDN    /MTX/IXL    INCORRECT CHARACTER COUNT IN HEADER
          LJM    RET3        RETURN ERROR CODE
 SSN      SPACE  4,10
**        SSN - SET SEQUENCE NUMBER.
*
*         CALLS  C2D, DCV.
 
 
 SSN      SUBR               ENTRY/EXIT
          LDC    SSNA        SET DESTINATION BUFFER
          STM    DBUF
          LDN    32D         GET SEQUENCE NUMBER
          STD    T6
          LDN    2
          STD    T7
          LDC    30004
          RJM    DCV         CONVERT DECIMAL FIELD
          LDM    SSNA+1      SET LAST SEQUENCE NUMBER+1
          ADN    1
          STD    T6
          RJM    C2D
          STM    SSNA+3
          LDD    T6
          SHN    -6
          RJM    C2D
          LPN    77
          STM    SSNA+2
          LDN    0           CLEAR TAPE MARK COUNT
          STD    PA
          UJN    SSNX        RETURN
 TMC      SPACE  4,10
**        TMC - TAPE MARK CHECK.
*
*         CALLS  CHC, CLA, DCV, FAD, REL, WUD.
 
 
 TMC9     AOD    PB          ADVANCE SECTION
 
 TMC      SUBR               ENTRY/EXIT
          RJM    CLA         CHECK LABELS
          SBN    1
          ZJN    TMC2        IF TAPE MARK
          LDD    PA
          ZJN    TMC1        IF HDR1 NOT PRECEEDED BY TAPE MARK
          LJM    RLAX        READ NEXT BLOCK
 
 TMC1     LDN    /MTX/LAM    LABEL MISSING
          LJM    RET3        RETURN ERROR CODE
 
 TMC2     AOD    PA          INCREMENT TAPE MARK COUNT
          SBN    1
          ZJN    TMC9        IF NOT SECOND TAPE MARK
          LDD    UP
          SHN    21-1
          PJN    TMC3        IF NOT *POSMF 9999*
          LDN    0           CLEAR PARAMETER
          STD    PA
          LDM    UDTB+22     SET SECTION NUMBER TO ONE
          SCN    77
          STM    UDTB+22
          LDN    1
          STM    UDTB+23
          AOM    UDTB+30     INCREMENT SEQUENCE NUMBER
          SHN    -14
          RAM    UDTB+27
          LDM    UDTB+10     SET LABEL NOT EXPIRED
          SCN    2
          LMN    2
          STM    UDTB+10
          RJM    WUD         REWRITE UDT
          LDN    /MTX/BEI    SET EOI INDICATOR
          LJM    RET3        RETURN ERROR CODE
 
 TMC3     RJM    CHC         CHANGE CONTROL POINTS
          LDM    FETO        CHECK EXTENDED LABELS
          SHN    21-5
          PJN    TMC4        IF NOT EXTENDED LABELS
          RJM    REL         READ EXTENDED LABELS
          UJN    TMC5        PROCESS FILE NOT FOUND
 
 TMC4     RJM    FAD         SET FET ADDRESS
          ADN    12
          CRM    TMCB,ON
 TMC5     LDM    TMCB+4
          NJN    TMC6        IF FILE SEQUENCE NUMBER NOT FOUND
          STD    LG
          UJN    TMC7        INDICATE FILE IDENTIFIER NOT FOUND
 
 TMC6     LDC    TMCB        SET BUFFER PARAMETERS
          STM    IBUF
          STM    DBUF
          LDN    8D
          STD    T6
          LDN    12D
          STD    T7
          LDC    30003
          RJM    DCV         CONVERT DECIMAL FIELD
          LDM    TMCB+6      SET SEQUENCE NUMBER DESIRED
          STD    LG
          LDM    SSNA+1      SET HIGHEST EXISTING SEQUENCE NUMBER
 TMC7     STD    LG+1
          LDM    FETO        CHECK IF EXTENDED LABELS
          SHN    21-5
          MJN    TMC8        IF EXTENDED LABELS
          LDM    TMCB+3      RETURN LAST SEQUENCE NUMBER FOUND
          SCN    77
          LMM    SSNA+2
          STM    TMCB+3
          LDM    SSNA+3
          STM    TMCB+4
          RJM    FAD         SET FET ADDRESS
          ADN    12          RETURN LABEL INFORMATION
          CWM    TMCB,ON
 TMC8     LDD    UP          SET END OF SET FLAG
          LPC    7677
          LMD    HN
          STD    UP
          LDN    /MTX/BEI    RETURN END OF SET STATUS
          LJM    RET3        RETURN FATAL ERROR
          SPACE  4,10
**        BUFFERS.
 
 
 PHDA     EQU    *           LABEL COMPARE BUFFER
 TMCB     EQU    *           SEQUENCE NUMBER HOLD
 SSNA     EQU    TMCB+7*5    SEQUENCE NUMBER
 BUFL     EQU    SSNA+4      END OF BUFERS
 
 
          ERROVL
 PRS      SPACE  4,10
**        PRS - PRESET.
*
*         CALLS   MCH.
 
 
 PRS      LDC    PRSA        MODIFY CHANNELS
          RJM    MCH
          LJM    PRSX        RETURN
 
 
 PRSA     CHTB               CHANNEL TABLE
          OVERLAY (OPEN OPERATIONS.)
 OPF      SPACE  4,10
**        OPF - OPEN OPERATION.
*
*         ENTRY  (PB) .NE. 0 IF CHECK TYPE OF *POSMF*.
*
*         CALLS  CCH, CCS, CDN, DCV, ELA, FCH, FHR, GCH, OPH,
*                SCH, WUD.
*
*         MACROS SADT.
 
 
          ENTRY  OPF
 
          SADT   .FE,,4,A
 OPF      LDC    *           READ FET+4
          CRD    CN
          LDD    CN+3        RETURN BLOCK (PRU) SIZE
          LPN    77
          STD    CN+3
          SADT   .BS
          LDC    *
          SHN    14
          STD    CN+2
          SHN    -14
          SHN    6
          RAD    CN+3
          SADT   .FE,,4,A
          LDC    *           RETURN BLOCK SIZE
          CWD    CN
          LDM    UDTB+10     SAVE OPEN STATUS
          STD    CM
          STM    FHRB
          LPC    6777        SET FILE OPENED STATUS
          LMD    TH
          STM    UDTB+10
 OPFA     LDN    0           FET LENGTH - 5
          STD    T3
          SBN    10
          PJN    OPF4        IF FET LONG ENOUGH FOR LABEL PARAMETERS
          LDM    FETO
          SHN    21-5
          PJN    OPF1        IF NOT EXTENDED LABELS
          LDD    T3          FET LENGTH - 5
          SBN    10D-5
          PJN    OPF4        IF FET AT LEAST 10D WORDS LONG
 OPF1     LDD    LT
          SHN    21-12
          PJN    OPF5        IF UNLABELED
          SHN    21-11-21+12
          MJN    OPF5        IF NON-STANDARD LABEL
          LDD    DS
          SHN    21-1
          PJN    OPF2        IF NOT BUSY
          LDN    /MTX/RBS    REQUEUE ON UNIT BUSY
          LJM    RET5        RETURN STATUS TO MAGNET
 
 OPF2     LPN    1
          ZJN    OPF5        IF NOT LOAD POINT
 OPF3     RJM    WUD         REWRITE UDT
          LJM    RET1        RETURN
 
 OPF4     LDD    LT
          SHN    21-12
          MJN    OPF6        IF LABELED
 OPF5     RJM    WUD
          LDN    /MTX/BEI
          LJM    RET3        RETURN ERROR CODE
 
 OPF6     SHN    21-11-21+12
          MJN    OPF5        IF NON-STANDARD LABEL
          LDM    CIOE
          LPN    4
          ZJN    OPF8        IF NOT OPEN WRITE
          LDD    CM
          SHN    21-11
          PJN    OPF7        IF FIRST OPEN SINCE ASSIGNMENT
          LJM    OPF18       TRANSFER HEADER INFORMATION TO FET
 
 OPF7     LJM    OPF11       PROCESS OPEN WRITE
 
 OPF8     LDM    CIOE        CHECK IF *POSMF*
          SHN    -2
          LPC    377
          LMN    22
          STM    OPFB
          ZJN    OPF9        IF *POSMF*
          LDD    DS
          LPN    4
          NJN    OPF9        IF LOAD POINT
          LJM    OPF1        CHECK FOR BUSY
 
 OPF9     RJM    FHR         FIND *HDR1* LABEL
          LDM    FETO
          SHN    21-5
          PJN    OPF10       IF NOT EXTENDED LABELS
          LDN    0
          STD    T6
          STD    T7
          LDN    ZERL
          CRD    CN
          LDC    1
 OPFB     EQU    *-1         *POSMF* FLAG
          ZJN    OPF10       IF *POSMF*
          RJM    ELA
          ZJN    OPF10       IF END OF BUFFER
          CWD    CN          PRESET BUFFER
 OPF10    RJM    OPH         OPEN HEADER
          RJM    WUD         REWRITE UDT
          LJM    RET1        RETURN
 
 OPF11    RJM    FHR         FIND HEADER LABEL
 OPF12    LDN    0           SET TO VALIDATE NUMERIC CHARACTERS
          STM    DCVA
          LDC    BFMS        SET BUFFERS
          STM    IBUF
          LDC    UDTB
          STM    DBUF
          LDN    5           PROCESS FILE IDENTIFIER
          STD    T6
          LDN    21D
          STD    T7
          LDN    17D         COPY CHARACTERS IF SPECIFIED
          RJM    CCS
 OPFC     LDN    41D         PROCESS SET IDENTIFIER
*         UJN    OPF13       (*POSMF 9999* AND NOT FIRST FILE)
          STD    T7
          LDN    6
          RJM    CCS
 OPFD     LDN    38D         PROCESS FILE SECTION NUMBER
*         UJN    OPF13       (*POSMF 9999*)
          STD    T7
          RJM    CDN         CONVERT DECIMAL NUMBER
          LDN    32D         PROCESS FILE SEQUENCE NUMBER
          STD    T6
          LDN    48D
          STD    T7
          RJM    CDN         CONVERT DECIMAL NUMBER
 OPF13    LDN    36D         PROCESS GENERATION NUMBER
          STD    T6
          LDN    58D
          STD    T7
          RJM    CDN         CONVERT DECIMAL NUMBER
          LDN    40D         PROCESS GENERATION VERSION NUMBER
          STD    T6
          LDN    56D
          STD    T7
          RJM    GCH
          ZJN    OPF14       IF NOT SPECIFIED
          SOD    T6
          LDC    20002
          RJM    DCV
          UJN    OPF15       SET CREATION DATE
 
 OPF14    LDN    2           SET GENERATION VERSION NUMBER TO ZERO
          RJM    FCH
 OPF15    LDN    JDAL        SET CREATION DATE
          CRM    BFMS,ON
          LDN    6
          STD    T6
          LDN    61D
          STD    T7
          LDN    5
          RJM    CCH
          LDN    48D         PROCESS EXPIRATION DATE
          STD    T6
          RJM    GCH
          NJN    OPF16       IF SPECIFIED
          LDN    6           DEFAULT TO TODAYS DATE
          STD    T6
 OPF16    LDN    5
          RJM    CCH
          LDN    54D         PROCESS ACCESSIBILTIY
          STD    T6
          LDN    47D
          STD    T7
          RJM    GCH
          NJN    OPF17       IF SPECIFIED
          LDN    1R
 OPF17    RJM    SCH
 OPF18    LDM    OPFB
          ZJN    OPF19       IF *POSMF 9999*
          LDC    LJMI        SET TO RETURN LABEL BLOCK TO FET
          STM    OPHA
          LDC    OPH6
          STM    OPHA+1
          RJM    OPH
          LJM    OPF5        REWRITE UDT AND EXIT WITH *BEI* ERROR
 
 OPF19    LJM    OPF3        REWRITE UDT AND EXIT
 OPH      SPACE  4,10
**        OPH - OPEN READ/ALTER.
*
*         CALLS  CAN, CCH, DCV, ELA, GHD, SCH.
*
*         MACROS MONITOR, SADT.
 
 
 OPH      SUBR               ENTRY/EXIT
          RJM    GHD         PROCESS HEADER LABEL
          LDN    LABW
          STD    T1
          SADT   .LF
          LDC    *
          SBD    T1
          MJN    OPH2        IF NOT ROOM FOR LABEL IN BUFFER
          LDM    FETO
          SHN    21-5
          MJN    OPH2        IF EXTENDED LABELS
          SADT   .FT
          LDC    *           VALIDATE FIRST
          SBN    2
          PJN    OPH1        IF FIRST .GT. 1
          LDN    /MTX/BAE    BUFFER ARGUMENT ERROR
          LJM    RET3        RETURN ERROR CODE
 
          SADT   .FT,,,A
 OPH1     LDC    *           TRANSFER HDR1
          CWM    BUF,T1
 OPH2     LDC    BFMS        SET BUFFERS FOR COMPARISON
*         LJM    OPH6        (OPEN/WRITE)
 OPHA     EQU    *-2
          STM    IBUF
          LDC    BUF
          STM    DBUF
          LDN    5
          STD    T6
          STD    T7
          LDN    17D         COMPARE FILE IDENTIFIER
          RJM    CAN
          NJN    OPH3        IF NO COMPARE
          LDN    6           COMPARE SET IDENTIFICATION
          RJM    CAN
          NJN    OPH3        IF NO COMPARE
          LDN    4           COMPARE FILE SECTION NUMBER
          RJM    CAN
          NJN    OPH3        IF NO COMPARE
          LDN    4           COMPARE FILE SEQUENCE NUMBER
          RJM    CAN
          NJN    OPH3        IF NO COMPARE
          LDN    4           COMPARE GENERATION NUMBER
          RJM    CAN
 OPH3     NJN    OPH4        IF NO COMPARE
          LDN    2           COMPARE GENERATION VERSION NUMBER
          RJM    CAN
          NJN    OPH4        IF NO COMPARE
          LDN    6           COMPARE CREATION DATE
          RJM    CAN
          NJN    OPH4        IF NO COMPARE
          LDN    6           COMPARE EXPIRATION DATE
          RJM    CAN
          NJN    OPH4        IF NO COMPARE
          LDN    1           COMPARE ACCESSIBILITY
          RJM    CAN
          ZJN    OPH6        IF GOOD COMPARE
 OPH4     STD    EP          SET CHARACTER POSITION REJECT OCCURRED
          LDM    CIOE        CHECK IF *POSMF*
          SHN    -2
          LPC    377
          LMN    22
          NJN    OPH5        IF NOT *POSMF*
          STD    EP          CLEAR EP
          LJM    OPF5        REWRITE UDT
 
 OPH5     LDN    /MTX/LPE    SET LABEL PARAMETER ERROR
          LJM    RET3        RETURN ERROR CODE
 
 OPH6     LDM    FETO
          SHN    21-5
          PJN    OPH8        IF NOT EXTENDED LABELS
          LDM    OPFB
          NJN    OPH7        IF NOT *POSMF*
          STD    T6
          STD    T7
          LDN    ZERL        PRESET BUFFER
          CRD    CN
          RJM    ELA
          ZJN    OPH7        IF END OF BUFFER
          CWD    CN
 OPH7     LJM    OPHX        RETURN
 
*         BUILD FET BLOCK TO RETURN TO USER
 
 OPH8     LDC    BUF         SET INPUT BUFFER
          STM    IBUF
          LDC    BFMS        SET DESTINATION BUFFER
          STM    DBUF
          LDN    5           COPY FILE IDENTIFIER
          STD    T6
          LDN    1
          STD    T7
          LDN    17D
          RJM    CCH
          LDN    32D+1       COPY FILE SEQUENCE NUMBER
          STD    T6
          LDN    3
          RJM    CCH
          LDN    40D         COPY GENERATION VERSION NUMBER
          STD    T6
          LDN    2
          RJM    CCH
 
*         RECALCULATE EXPIRATION DATE.
 
          LDN    CN          SET DESTINATION BUFFER
          STM    DBUF
          LDN    49D         CONVERT YEAR OF EXPIRATION
          STD    T6
          LDN    1
          STD    T7
          LDC    20002
          RJM    DCV
          LDN    43D         CONVERT YEAR OF CREATION
          STD    T6
          LDC    20002
          RJM    DCV
          LDN    51D         CONVERT DAY OF EXPIRATION
          STD    T6
          LDC    20003
          RJM    DCV
          LDN    45D         CONVERT DAY OF CREATION
          STD    T6
          LDC    20003
          RJM    DCV
          LDN    CN
          RJM    SCB         SET CENTURY BIAS FOR YEAR OF EXPIRATION
          LDN    CN+1
          RJM    SCB         SET CENTURY BIAS FOR YEAR OF CREATION
          LDC    99D
          LMD    CN          EXPIRATION YEAR
          NJN    OPH8.1      IF YEAR NOT 99
          LDC    999D
          LMD    CN+2        EXPIRATION DAY
          ZJN    OPH11       IF INFINITE EXPIRATION DATE
 OPH8.1   LDN    ZERL        PRESET RESULT
          CRD    CM
          LDD    CN
          SBD    CN+1
          ZJN    OPH10       IF SAME YEAR
          MJN    OPH13       IF LABEL EXPIRED
 OPH9     LDD    CN+1
          LPN    3
          ZJN    OPH9.1      IF LEAP YEAR
          LCN    1
 OPH9.1   ADC    366D        INCREMENT DAYS
          RAD    CN+2
          SHN    -14
          NJN    OPH11       IF OVERFLOW
          AOD    CN+1
          SBD    CN
          NJN    OPH9        IF MORE YEARS
 OPH10    LDD    CN+2        RETENTION DAYS
          SBD    CN+3
          MJN    OPH13       IF LABEL EXPIRED
          STD    CM+4
          ADC    -1000D
          MJN    OPH12       IF LESS THAN 1000 DAYS
 OPH11    LDC    999D
          STD    CM+4
 OPH12    LDD    CM+4
          NJN    OPH14       IF NOT EXPIRED
 OPH13    LDC    2R00        SET RETENTION CYCLE TO ZERO
          STD    CM+3
          STD    CM+4
          UJN    OPH15       STORE CHARACTERS IN BUFFER
 
 OPH14    LDD    MA
          CWD    CM
          MONITOR RDCM       CONVERT DATA
          LDD    MA
          CRD    CM
 OPH15    LDC    BFMS        SET DESTINATION BUFFER
          STM    DBUF
          LDN    23D
          STD    T7
          LDD    CM+3        STORE CHARACTERS IN BUFFER
          RJM    SCH
          LDD    CM+4
          SHN    -6
          RJM    SCH
          LDD    CM+4
          RJM    SCH
          LDN    43D         COPY CREATION DATE
          STD    T6
          LDN    5
          RJM    CCH
          LDN    22D         COPY SET IDENTIFIER
          STD    T6
          LDN    6
          RJM    CCH
          LDN    28D         FILE SECTION NUMBER
          STD    T6
          LDN    4
          RJM    CCH
          LDN    4
          STD    T1
          SADT   .FE,,,A
          LDC    *
          ADN    11
          CWM    BFMS,T1
          LJM    OPHX        RETURN
          TITLE  SUBROUTINES.
 ELA      SPACE  4,10
**        ELA - EXTENDED LABELS ADDRESS PROCESSING.
*
*         ENTRY  (T6 - T7) = POSITION TO START AT IN BUFFER.
*
*         EXIT   (A) = ABSOLUTE ADDRESS.
*                (A) = 0, END OF LABEL BUFFER.
*
*         MACROS SADT.
 
 
 ELA2     LDN    0           INDICATE END OF BUFFER
 
 ELA      SUBR               ENTRY/EXIT
          SADT   .FE,,,A
          LDC    *           GET FET ADDRESS
          ADN    11
          CRD    CM
          LDD    CM+3
          SHN    14
          STD    CM+1
          SHN    -14
          STD    CM+3
          SHN    14
          LMD    CM+4
          SBN    2
          MJN    ELA2        IF NO LABEL BUFFER
          LDD    CM+2
          SHN    6
          LMD    CM+1
          STD    CM+2
          SHN    -14
          STD    CM+1
          LDD    T6
          SBD    CM+1
          SHN    14
          ADD    T7
          SBD    CM+2
          ADN    11          ALLOW FOR LABEL
          PJN    ELA2        IF END OF LABEL BUFFER
          LDD    CM+1        CHECK IF BUFFER WITHIN FL
          ADD    CM+3
          SHN    14
          ADD    CM+2
          ADD    CM+4
          SHN    -6
          SBD    FL
          MJN    ELA1        IF BUFFER WITHIN FL
          LDN    /MTX/BAE    BUFFER ARGUMENT ERROR
          LJM    RET3        RETURN ERROR CODE
 
 ELA1     LDD    CM+3        CALCULATE LABEL ADDRESS
          ADD    T6
          SHN    6
          ADD    RA
          SHN    6
          ADD    CM+4
          ADD    T7
          LJM    ELAX        RETURN
 FHR      SPACE  4,10
**        FHR - FIND *HDR1* LABEL.
*
*         EXIT   (BFMS - BFMS+47) = *HDR1* LABEL IF FOUND, OTHERWISE 0.
*
*         CALLS  CCH, CPO, DCV, ELA, FCH, GCD, GCH.
*
*         MACROS MONITOR, SADT.
 
 
 FHR      SUBR               ENTRY/EXIT
          LDN    CLBL        CLEAR BUFFER
          STD    T1
 FHR1     LDN    0
          STM    BFMS,T1
          SOD    T1
          PJN    FHR1        IF MORE BUFFER TO CLEAR
          LDM    FETO
          SHN    21-5
          PJN    FHR2        IF NOT EXTENDED LABELS
          LJM    FHR14       SEARCH FOR *HDR1* IN USER BUFFER
 
 FHR2     LDN    4           READ FET LABEL PARAMETERS
          STD    T1
          SADT   .FE,,,A
          LDC    *           FET ADDRESS
          ADN    11
          CRM    BFMS-4*5,T1
          LDC    BFMS-4*5    SET INPUT BUFFER ADDRESS
          STM    IBUF
          LDC    BFMS        SET DESTINATION BUFFER ADDRESS
          STM    DBUF
          LDN    1           MOVE FILE IDENTIFIER
          STD    T6
          LDN    5
          STD    T7
          LDN    17D
          RJM    CCH
          LDN    32D
          STD    T7
          LDM    BFMS-4*5+10
          LPN    77
          SHN    14
          ADM    BFMS-4*5+11
          ZJN    FHR4        IF NO FILE SEQUENCE NUMBER
          LMC    3R999
          ZJN    FHR3        IF *999* MUST EXPAND TO *9999*
          LDC    1L0&1L9
 FHR3     LMC    1L9+1
          RJM    FCH
          LDN    3           COPY FILE SEQUENCE NUMBER
          RJM    CCH
 FHR4     LDN    21D         COPY GENERATION VERSION NUMBER
          STD    T6
          LDN    40D
          STD    T7
          LDN    2
          RJM    CCH
          LDN    26D         MOVE CREATION DATE
          STD    T6
          RJM    GCH
          STM    FHRA
          ZJN    FHR5        IF CREATION DATE NOT SPECIFIED
          SOD    T6
          RJM    SCF         SET CENTURY FILL CHARACTER
          LDN    5
          RJM    CCH
 FHR5     LDN    23D
          STD    T6
          RJM    GCH
          NJN    FHR6        IF RETENTION CYCLE
          LJM    FHR12       COPY SET ID
 
 FHR6     LDN    26D
          STD    T6
          LDM    CIOE
          LPN    4
          NJN    FHR7        IF OPEN WRITE
          RJM    CPO         CHECK IF *POSMF 9999*
          ZJN    FHR7        IF *POSMF 9999*
          LDC    0           FIRST CHARACTER OF CREATION DATE
 FHRA     EQU    *-1
          NJN    FHR8        IF CREATION DATE SPECIFIED
          LDC    UDTB        DEFAULT TO CREATION DATE ON TAPE
          STM    IBUF
          LDN    61D
          STD    T6
          UJN    FHR8        COPY EXPIRATION DATE
 
 FHR7     LDN    0           SET TO VALIDATE NUMERIC CHARACTERS
          STM    DCVA
          LDN    JDAL        DEFAULT TO TODAYS DATE
          CRD    CM
          LDN    CM          SET INPUT BUFFER
          STM    IBUF
          LDN    6
          STD    T6
 FHR8     LDN    48D         SET DESTINATION BUFFER ADDRESS
          STD    T7
          RJM    SCF         SET CENTURY FOR EXPIRATION DATE
          LDN    5           COPY EXPIRATION DATE
          RJM    CCH
          LDC    BFMS-4*5    RESET INPUT BUFFER
          STM    IBUF
          LDN    CN          CHANGE DESTINATION BUFFER
          STM    DBUF
          LDN    1           CONVERT RETENTION CYCLE
          STD    T7
          LDN    23D
          STD    T6
          LDC    20003
          RJM    DCV
          LDC    BFMS        CONVERT DAYS FROM JULIAN DATE
          STM    IBUF
          LDN    51D
          STD    T6
          LDC    20003
          RJM    DCV
          LDD    CN
          LMC    999D
          NJN    FHR9        IF NOT INDEFINITE
          LDC    2R99        SET TO YEAR 99
          STM    BFMS+30
          LJM    FHR11       COPY 999 TO DAYS OF EXPIRATION DATE
 
 FHR9     LDD    CN+1        GET TOTAL NUMBER OF DAYS
          RAD    CN
          LDN    49D         CONVERT CREATION YEAR
          STD    T6
          LDC    20002
          RJM    DCV
          LDD    CN+2
          LPN    3
          ZJN    FHR10       IF LEAP YEAR
          LDN    1
 FHR10    ADC    -366D
          ADD    CN
          MJN    FHR11       IF WITHIN THE CURRENT YEAR
          ZJN    FHR11       IF LAST DAY OF CURRENT YEAR
          STD    CN
          AOD    CN+2
          AOM    BFMS+30
          LPN    77
          LMN    1R9+1
          NJN    FHR10       IF NO ROLLOVER
          LCN    1R9+1-1R0
          RAM    BFMS+30
          UJN    FHR10       CONTINUE RETENTION CYCLE CONVERSION
 
 FHR11    LDN    ZERL        CONVERT REMAINING DAYS
          CRD    CM
          LDD    CN
          STD    CM+4
          LDD    MA
          CWD    CM
          MONITOR RDCM
          LDD    MA
          CRD    CM
          LDD    CM+4
          SCN    77
          SHN    6
          LMD    CM+3
          SHN    6
          STM    BFMS+31
          LDD    CM+4
          LPN    77
          SHN    6
          STD    CM+4
          LDM    BFMS+32
          LPN    77
          LMD    CM+4
          STM    BFMS+32
          LDC    BFMS-4*5    RESET INPUT BUFFER ADDRESS
          STM    IBUF
 FHR12    LDC    BFMS        RESTORE DESTINATION BUFFER ADDRESS
          STM    DBUF
          LDN    31D         MOVE SET IDENTIFICATION
          STD    T6
          LDN    22D
          STD    T7
          LDN    6
          RJM    CCH
          LDN    4           MOVE FILE SECTION NUMBER
          RJM    CCH
          LJM    FHR20       CHECK FOR *POSMF*
 
 FHR13    LDN    /MTX/IXL    INCORRECT CHARACTER COUNT IN HEADER
          LJM    RET3        RETURN ERROR CODE
 
*         GET LABEL FROM USER BUFFER.
 
 FHR14    LDN    0           SEARCH FOR *HDR1*
          STD    T6
          STD    T7
 FHR15    RJM    ELA
          ZJN    FHR17       IF END OF LABEL BUFFER
          CRD    CN
          ADN    1
          CRD    CM
          LDD    CN+4
          ZJN    FHR17       IF END OF LABELS IN BUFFER
          LMC    80D
          NJN    FHR13       IF NOT CORRECT LENGTH
          LDD    CM
          LMC    2RHD
          NJN    FHR16       IF NOT *HD*
          LDD    CM+1
          LMC    2RR1
          ZJN    FHR19       IF *R1*
 FHR16    LDN    11          ADVANCE LABEL BUFFER POINTER
          RAD    T7
          SHN    -14
          RAD    T6
          UJN    FHR15       CONTINUE SEARCH
 
 FHR17    LDM    OPFB
          NJN    FHR18       IF NOT *POSMF*
          LDN    /MTX/BAE    *BUFFER ARGUMENT ERROR.*
          LJM    RET3        RETURN ERROR CODE
 
 FHR18    LJM    FHRX        RETURN
 
 FHR19    LDN    10          READ UP LABEL
          STD    T5
          RJM    ELA         SKIP HEADER WORD
          ADN    1
          CRM    BFMS,T5
 FHR20    LDM    OPFB
          NJN    FHR18       IF NOT *POSMF*
          LDD    PB
          NJN    FHR22       IF CHECK TYPE OF *POSMF*
          LDD    UP
          SHN    21-1
          PJN    FHR18       IF NOT *POSMF 9999*
          LDD    UP          CLEAR *POSMF 9999* IN PROGRESS
          SCN    2
          STD    UP
          LDM    FHRC
          STM    OPFD
          LDM    UDTB+10     SET LABEL EXPIRED
          SCN    2
          LMN    2
          STM    UDTB+10
          LDM    UDTB+27     CHECK FILE NUMBER
          LPN    77
          SHN    14
          ADM    UDTB+30
          LMN    1
          ZJN    FHR21       IF POSITIONED AT FIRST FILE
          LDM    FHRD        SKIP TRANSFER OF SETID
          STM    OPFC
 FHR21    LJM    OPF12       RETURN TO TRANSFER FET TO UDT
 
*         CHECK IF *POSMF 9999* AND IF REWIND IS REQUIRED.  IF
*         IT IS A *POSMF 9999*, THE *BEI* ERROR CODE IS RETURNED
*         TO *MAGNET*.  IF NOT *POSMF 9999*, NO ERROR CODE
*         IS RETURNED AND REWIND STATUS IS INDICATED BY
*         RETURNING (PA) = 0 IF REWIND IS NEEDED AND (PA) .NE. 0
*         IF REWIND IS NOT NEEDED.
 
 FHR22    LDN    0           SET EXIT CONDITION
          STD    PA
          LDD    UP          PRESET TYPE OF *POSMF*
          SCN    2
          STD    UP
          RJM    CPO         CHECK IF *9999*
          NJN    FHR23       IF NOT *9999*
          LDN    2           SET *POSMF 9999* IN PROGRESS
          RAD    UP
          LDN    /MTX/BEI    RETURN *POSMF 9999* INDICATION
          LJM    RET3        RETURN ERROR CODE
 
 FHR23    LDD    UP          CHECK WRITE STATUS
          SHN    21-4
          MJN    FHR25       IF LAST OPERATION WRITE - REWIND
          LDC    BFMS        SET BUFFER ADDRESSES
          STM    DBUF
          STM    IBUF
          LDN    32D         GET FIRST CHARACTER OF SEQUENCE NUMBER
          STD    T7
          RJM    GCD         GET CHARACTER
          NJN    FHR26       IF SEQUENCE NUMBER SPECIFIED
          LDN    5
          STD    T7
          RJM    GCD         GET CHARACTER
          NJN    FHR25       IF FI SPECIFIED - REWIND REQUIRED
          LDC    *           SET TO LABEL FLAGS IN UDT WORD *UVSN*
 FHRB     EQU    *-1
          SHN    21-11
          PJN    FHR25       IF FIRST OPEN SINCE ASSIGNMENT
 FHR24    LDN    1           SET NO REWIND REQUIRED
          STD    PA
 FHR25    LJM    RET1        RETURN
 
 FHR26    LDN    32D         CONVERT FET SEQUENCE NUMBER TO BINARY
          STD    T6
          LDN    2
          STD    T7
          LDC    30004       CONVERT DECIMAL FIELD
          RJM    DCV
          LDM    UDTB+27     CLEAR ACCESSIBILITY CHARACTER
          LPN    77
          STM    UDTB+27
          LDM    BFMS        COMPARE UDT TO FET SEQUENCE NUMBER
          LPN    77
          SBM    UDTB+27
          MJN    FHR25       IF REWIND REQUIRED
          NJN    FHR24       IF NO REWIND REQUIRED
          LDM    BFMS+1
          SBM    UDTB+30
          MJN    FHR25       IF REWIND REQUIRED
          ZJN    FHR25       IF REWIND REQUIRED
          UJN    FHR24       SET NO REWIND REQUIRED
 
 
 FHRC     BSS    0
          LOC    OPFD
          UJN    OPF13       SKIP FILE SEQUENCE NUMBER CONVERSION
          LOC    *O
 
 FHRD     BSS    0
          LOC    OPFC
          UJN    OPF13       SKIP TRANSFER OF SETID
          LOC    *O
 GHD      SPACE  4,10
**        GHD - GENERATE *HDR1* LABEL FROM UDT.
*
*         EXIT   (BUF - BUF+50) = *HDR1* LABEL FROM CHARACTER POSITION
*                5 TO 55.
*
*         CALLS  CBD, CCH, SCH.
 
 
 GHD      SUBR               ENTRY/EXIT
          LDN    CLBL        CLEAR BUFFER
          STD    T1
 GHD1     LDN    0
          STM    BUF,T1
          SOD    T1
          PJN    GHD1        IF MORE BUFFER TO CLEAR
          LDC    UDTB        SET INPUT BUFFER
          STM    IBUF
          LDC    BUF         SET DESTINATION BUFFER
          STM    DBUF
          LDC    2RHD        SET *HDR1* IN BUFFER
          STM    BUF
          LDC    2RR1
          STM    BUF+1
          LDN    21D         MOVE FILE IDENTIFIER
          STD    T6
          LDN    5
          STD    T7
          LDN    17D
          RJM    CCH
          LDN    41D         MOVE SET IDENTIFIER
          STD    T6
          LDN    6
          RJM    CCH
          LDN    38D         CONVERT FILE SECTION NUMBER
          STD    T6
          LDC    30004
          RJM    CBD
          LDN    48D         CONVERT FILE SEQUENCE NUMBER
          STD    T6
          LDC    30004
          RJM    CBD
          LDN    58D         CONVERT GENERATION NUMBER
          STD    T6
          LDC    30004
          RJM    CBD
          LDN    56D         CONVERT GENERATION VERSION NUMBER
          STD    T6
          LDC    20002
          RJM    CBD
          LDN    61D         PROCESS CREATION DATE
          STD    T6
          RJM    SCF         SET CREATION DATE CENTURY CHARACTER
          LDN    5           COPY CREATION DATE
          RJM    CCH
          RJM    SCF         SET EXPIRATION DATE CENTURY CHARACTER
          LDN    5           COPY CREATION DATE
          RJM    CCH
          LDN    47D         COPY ACCESSIBILITY
          STD    T6
          LDN    1
          RJM    CCH
          LJM    GHDX        RETURN
          TITLE  CHARACTER PROCESSING SUBROUTINES.
          SPACE  4,10
**        DIRECT CELL USAGE IN FOLLOWING ROUTINES.
*
*         ENTRY  (T5) = NUMBER OF CHARACTERS.
*                (T6) = CHARACTER POSITION IN INPUT BUFFER.
*                (T7) = CHARACTER POSITION IN DESTINATION BUFFER.
*
*         ALL CHARACTER POSITIONS ARE REFERENCED STARTING WITH *1*.
*         THUS, THE CHARACTER POSITION VALUES BEING USED TO ACCESS
*         *BUF* MAY BE REFERENCED DIRECTLY TO THE LABEL STANDARD.
 
 
 IBUF     CON    UDTB        FWA OF FETCH BUFFER
 DBUF     CON    BUF         FWA OF DESTINATION BUFFER
 CAN      SPACE  4,15
**        CAN - COMPARE ALPHANUMERIC FIELDS.
*         COMPARE WILL BE GOOD IF ALL OF INPUT CHARACTER STRING IS
*         BINARY ZERO.
*
*         ENTRY  (A) = NUMBER OF CHARACTERS TO COMPARE.
*                (T6) = CHARACTER POSITION IN INPUT BUFFER.
*                (T7) = CHARACTER POSITION IN DESTINATION BUFFER.
*
*         EXIT   (A) = 0, GOOD COMPARE.
*                (A) .NE. 0, (A) = CHARACTER POSITION AT START.
*                (T6), (T7) = UPDATED.
*
*         USES   T3, T4.
*
*         CALLS  GCD, GCH.
 
 
 CAN5     SOD    T5          UPDATE TO SKIP REMAINDER OF FIELD
          RAD    T6
          LDD    T5
          RAD    T7
          LDD    T3
 
 CAN      SUBR               ENTRY/EXIT
          STD    T5
          STD    T4
          LDD    T6          SAVE STARTING POSITION
          STD    T3
 CAN1     RJM    GCH         GET CHARACTER
          NJN    CAN2        IF SPECIFIED
          SOD    T4
          NJN    CAN1        IF MORE CHARACTERS TO CHECK
          LDD    T5
          RAD    T7
          LDN    0           GOOD COMPARE
          UJN    CANX        RETURN
 
 CAN2     LDD    T3          RESET CHARACTER POSITION
          STD    T6
 CAN3     RJM    GCH         GET CHARACTER
          STD    T4
          NJN    CAN4        IF NOT 00 CHARACTER
          LDN    1R
          STD    T4
 CAN4     RJM    GCD         GET CHARACTER FROM DESTINATION BUFFER
          LMD    T4
          NJN    CAN5        IF NO COMPARE
          SOD    T5
          NJN    CAN3        IF MORE CHARACTERS TO COMPARE
          UJN    CANX        RETURN
 CBD      SPACE  4,15
**        CBD - CONVERT BINARY FIELD TO DECIMAL.
*
*         ENTRY  (A, 21 - 14) = NUMBER OF CHARACTERS IN BINARY FIELD
*                MAXIMUM OF 4.
*                (A, 13 - 0) = NUMBER OF DISPLAY CODE CHARACTERS TO
*                STORE WITH A MAXIMUM OF 6.
*
*         EXIT   RESULT STORED IN DESTINATION BUFFER.
*
*         CALLS  GCH, SCH.
*
*         MACROS MONITOR.
 
 
 CBD      SUBR               ENTRY/EXIT
          STD    T5
          SHN    -14
          STD    T4
          LDN    ZERL        PRESET FIELD TO CONVERT
          CRD    CM
 CBD1     LDD    CM+3        MOVE UP FIELD
          SHN    6
          STD    CM+3
          LDD    CM+4
          SHN    6
          STD    CM+4
          SHN    -14
          RAD    CM+3
          RJM    GCH         GET CHARACTER
          RAD    CM+4
          SOD    T4
          NJN    CBD1        IF MORE FIELD POSITIONS
          LDD    MA          CONVERT DATA
          CWD    CM
          MONITOR RDCM
          LDD    MA
          CRD    CM
          LDD    CM+3        REMOVE *.* FROM DATA
          LPN    77
          SHN    14
          LMD    CM+2
          SHN    6
          STD    CM+3
          LMD    CM+3
          LMD    CM+1
          SHN    6
          STD    CM+2
          LDN    CM+1        REMOVE SPACES
          STD    T1
 CBD2     AOD    T1          ADVANCE TO NEXT BYTE
          LMN    CM+5
          ZJN    CBD5        IF ALL SPACES
          LDI    T1
          ZJN    CBD3        IF ZERO
          LMC    2R
          NJN    CBD4        IF NOT *  *
 CBD3     LDC    2R00
          STI    T1
          UJN    CBD2        LOOP
 
 CBD4     SHN    -6
          NJN    CBD5        IF NOT * *
          LCN    -1R0+1R
          SHN    6
          RAI    T1
 CBD5     LDM    CBDA,T5     SET TO ENTER STORE LOOP
          STD    T1
          LJM    0,T1        STORE CHARACTERS
 
 CBD6     LDD    CM+2        STORE SIXTH CHARACTER
          SHN    -6
          RJM    SCH
 CBD7     LDD    CM+2        STORE FIFTH CHARACTER
          RJM    SCH
 CBD8     LDD    CM+3        STORE FOURTH CHARACTER
          SHN    -6
          RJM    SCH
 CBD9     LDD    CM+3        STORE THIRD CHARACTER
          RJM    SCH
 CBD10    LDD    CM+4        STORE SECOND CHARACTER
          SHN    -6
          RJM    SCH
 CBD11    LDD    CM+4        STORE FIRST CHARACTER
          RJM    SCH
          LJM    CBDX        RETURN
 
 CBDA     BSS    0           INDEXED BY NUMBER OF CHARACTERS TO STORE
          LOC    0
          CON    CBDX
          CON    CBD11
          CON    CBD10
          CON    CBD9
          CON    CBD8
          CON    CBD7
          CON    CBD6
          LOC    *O
 CCH      SPACE  4,15
**        CCH - COPY INPUT BUFFER TO DESTINATION BUFFER.
*
*         ENTRY  (A) = NUMBER OF CHARACTERS TO MOVE.
*                (T6) = CHARACTER POSITION IN INPUT BUFFER.
*                (T7) = CHARACTER POSITION IN DESTINATION BUFFER.
*
*         EXIT   (T6), (T7) = INCREMENTED.
*
*         USES   T5.
*
*         CALLS  GCH, SCH.
 
 
 CCH      SUBR               ENTRY/EXIT
          STD    T5
 CCH1     RJM    GCH         GET LABEL CHARACTER
          RJM    SCH         STORE CHARACTER IN USER BUFFER
          SOD    T5
          NJN    CCH1        IF MORE CHARACTERS TO MOVE
          UJN    CCHX        RETURN
 CCS      SPACE  4,15
**        CCS - COPY CHARACTERS IF SPECIFIED.
*         CHECKS FIELD FOR ALL ZEROES.  IF ALL ZEROES, FIELD IS SPACE
*         FILLED.  OTHERWISE FIELD IS COPIED FROM INPUT BUFFER TO
*         DESTINATION BUFFER.
*
*         ENTRY  (A) = NUMBER OF CHARACTERS TO PROCESS.
*                (T6) = INPUT BUFFER POSITION.
*                (T7) = DESTINATION BUFFER POSITION.
*
*         EXIT   (T6), (T7) = INCREMENTED.
*
*         USES   T5.
*
*         CALLS  FCH, GCH, SCH.
 
 
 CCS2     LDD    MA          COPY FIELD
          CRD    T3
          LDD    T5
 CCS3     RJM    GCH         GET LABEL CHARACTER
          NJN    CCS4        IF NOT 00 CHARACTER
          LDN    1R
 CCS4     RJM    SCH         STORE CHARACTER IN DESTINATION BUFFER
          SOD    T5
          NJN    CCS3        IF MORE CHARACTERS TO MOVE
 
 CCS      SUBR               ENTRY/EXIT
          STD    T5
          LDD    MA          SAVE DIRECT CELLS
          CWD    T3
 CCS1     RJM    GCH         GET CHARACTER
          NJN    CCS2        IF FIELD SPECIFIED
          SOD    T5
          NJN    CCS1        IF MORE CHARACTERS TO CHECK
          LDD    MA          SET DEFAULTS
          CRD    T3
          LDD    T5
          RAD    T6
          LDD    T5
          ADC    1L
          RJM    FCH
          UJN    CCSX        RETURN
 CDN      SPACE  4,10
**        CDN - CONVERT DECIMAL FIELD (4 CHARACTERS).
*         IF FIELD IS NOT DEFINED, A DEFAULT OF 1 IS SET.
*
*         ENTRY  (T6) = CHARACTER POSITION IN INPUT BUFFER.
*                (T7) = CHARACTER POSITION IN DESTINATION BUFFER.
*
*         CALLS  DCV, GCH, SCH.
 
 
 CDN1     LDN    0           SET DEFAULT
          RJM    SCH
          LDN    0
          RJM    SCH
          LDN    1
          RJM    SCH
 
 CDN      SUBR               ENTRY/EXIT
          RJM    GCH         GET CHARACTER
          ZJN    CDN1        IF FIELD NOT DEFINED
          SOD    T6
          LDC    30004
          RJM    DCV
          UJN    CDNX        RETURN
 CPO      SPACE  4,10
**        CPO - CHECK IF *POSMF 9999*.
*         MUST BE CALLED AFTER LABEL IS TRANSFERRED TO BFMS.
*
*         EXIT   (A) = 0 IF *POSMF 9999*
*                (DBUF) = BFMS.
*                (IBUF) = CPOA.
*
*         CALLS  CAN.
*
*         USES   T6, T7.
 
 
 CPO      SUBR               ENTRY/EXIT
          LDM    OPFB
          NJN    CPOX        IF NOT *POSMF*
          LDC    CPOA        CHECK SEQUENCE NUMBER
          STM    IBUF
          LDC    BFMS
          STM    DBUF
          LDN    1
          STD    T6
          LDN    32D
          STD    T7
          LDN    4
          RJM    CAN         COMPARE FIELDS
          UJN    CPOX        RETURN
 
 
 CPOA     DATA   H*9999*
 DCV      SPACE  4,15
**        DCV - CONVERT DECIMAL FIELD TO BINARY.
*
*         ENTRY  (A, 13 - 12) = NUMBER OF CHARACTER POSITIONS IN RESULT.
*                (A, 11 - 0) = NUMBER OF CHARACTERS IN LABEL FIELD.
*                (T6) = CHARACTER POSITION IN INPUT BUFFER.
*                (T7) = CHARACTER POSITION IN DESTINATION BUFFER.
*
*         EXIT   (T6), (T7) = INCREMENTED.
*
*         USES   T1 - T5.
*
*         CALLS  GCH, SCH.
 
 
 DCV7     LDN    /MTX/IXL    INCORRECT LABEL FIELD
          LJM    RET3        RETURN ERROR CODE
 
 DCV      SUBR               ENTRY/EXIT
          STD    T5          NUMBER OF CHARACTERS IN LABEL
          SHN    -14
          STD    T4          NUMBER OF CHARACTER POSITIONS IN UDT
          LDN    0           PRESET RESULT
          STD    T2
          STD    T3
 DCV1     RJM    GCH         GET CHARACTER
          STD    T1
          SBN    1R0
          RAD    T3
          SHN    -14
          RAD    T2
 DCVA     UJN    DCV2        DO NOT VALIDATE CHARACTER
*         PSN                (OPEN WRITE OR POSMF 9999)
 
          LDD    T1
          SBN    1R0
          MJN    DCV7        IF NOT NUMERIC CHARACTER
          SBN    1R9-1R0+1
          PJN    DCV7        IF NOT NUMERIC CHARACTER
 DCV2     SOD    T5          DECREMENT NUMBER OF CHARACTERS TO PROCESS
          ZJN    DCV3        IF ALL DIGITS PROCESSED
          LDD    T2          10D * ACCUMALATED RESULT
          SHN    14
          ADD    T3
          SHN    2+6         * 4
          ADD    T2          * 5
          SHN    14
          ADD    T3
          SHN    1           * 10D
          STD    T3
          SHN    -14
          STD    T2
          UJN    DCV1        LOOP
 
 DCV3     LDD    T4
          LMN    3
          NJN    DCV4        IF NOT 3 CHARACTER POSITIONS
          LDD    T2          STORE VALUE
          RJM    SCH         STORE CHARACTER
          UJN    DCV5        STORE REMAINING CHARACTERS
 DCV4     LMN    2&3
          NJN    DCV6        IF NOT 2 CHARACTER POSIITONS
 DCV5     LDD    T3          STORE VALUE
          SHN    -6
          RJM    SCH         STORE CHARACTER
 DCV6     LDD    T3
          LPN    77
          RJM    SCH         STORE CHARACTER
          LJM    DCVX        RETURN
 FCH      SPACE  4,15
**        FCH - FILL DESTINATION BUFFER WITH CHARACTER(S).
*
*         ENTRY  (A, 17- 12) = CHARACTER TO FILL WITH.
*                (A, 11 - 0) = NUMBER OF CHARACTERS TO FILL.
*                (T7) = CHARACTER POINTER IN DESTINATION BUFFER.
*
*         EXIT   (T7) = INCREMENTED.
*
*         USES   T4.
*
*         CALLS  SCH.
 
 
 FCH      SUBR               ENTRY/EXIT
          STD    T5          SAVE COUNT
          SHN    -14
          STD    T4          SAVE FILL VALUE
 FCH1     LDD    T4          STORE CHARACTER
          RJM    SCH
          SOD    T5
          NJN    FCH1        IF MORE TO FILL
          UJN    FCHX        RETURN
 GCD      SPACE  4,10
**        GCD - GET CHARACTER FROM DESTINATION BUFFER.
*
*         ENTRY  (T7) = CHARACTER POSITION IN DESTINATION BUFFER.
*
*         EXIT   (A) = CHARACTER.
*                (T7) = INCREMENTED.
*
*         USES   T1.
 
 
 GCD1     LDM    -1,T1
          LPN    77
 
 GCD      SUBR               ENTRY/EXIT
          AOD    T7
          SBN    1
          SHN    21
          ADM    DBUF
          STD    T1
          SBM    DBUF
          SHN    -21
          ZJN    GCD1        IF LOWER 6 BITS
          LDI    T1
          SHN    -6
          UJN    GCDX        RETURN
 GCH      SPACE  4,10
**        GCH - GET CHARACTER FROM INPUT BUFFER.
*
*         ENTRY  (T6) = CHARACTER POSITION IN INPUT BUFFER.
*
*         EXIT   (A) = CHARACTER.
*                (T6) = INCREMENTED.
*
*         USES   T1.
 
 
 GCH1     LDM    -1,T1
          LPN    77
 
 GCH      SUBR               ENTRY/EXIT
          AOD    T6
          SBN    1
          SHN    21
          ADM    IBUF
          STD    T1
          SBM    IBUF
          SHN    -21
          ZJN    GCH1        IF LOWER 6 BITS
          LDI    T1
          SHN    -6
          UJN    GCHX        RETURN
 SCB      SPACE  4,10
**        SCB - SET CENTURY BIAS.
*         ADJUSTS BINARY YEAR TO NEXT CENTURY IF REQUIRED.
*
*         ENTRY  (A) = ADDRESS OF CELL CONTAINING YEAR.
*
*         EXIT   ((A)) ADJUSTED UPWARD BY 100D IF ORIGINALLY .LT. 70D.
*
*         USES   T0.
 
 
 SCB      SUBR               ENTRY/EXIT
          STD    T0          SAVE ADDRESS OF YEAR
          LDI    T0
          SBK    70D
          PJN    SCBX        IF YEAR .LE. 1999
          LDC    100D        ADJUST YEAR TO NEXT CENTURY
          RAI    T0
          UJN    SCBX        RETURN
 SCF      SPACE  4,10
**        SCF - SET CENTURY FILL CHARACTER.
*         GENERATES THE *ISO* STANDARD CENTURY CHARACTER, BASED ON THE
*         YEAR IN THE INPUT BUFFER, AND PLACES IT IN THE OUTPUT BUFFER.
*
*         ENTRY  (T6) = CHARACTER POSITION OF YEAR IN INPUT BUFFER.
*                (T7) = CHARACTER POSITION IN OUTPUT BUFFER.
*
*         EXIT   FILL CHARACTER PLACED IN OUTPUT BUFFER,
*                (* * FOR 19XX YEARS, *0* FOR 20XX YEARS).
*                (T6) = (A) = ORIGINAL (T6).
*                (T7) INCREMENTED.
*
*         CALLS  GCH, SCH.
*
*         USES   T6.
 
 
 SCF1     LDN    1R          SPACE FILL
 SCF2     RJM    SCH
          SOD    T6
 
 SCF      SUBR               ENTRY/EXIT
          RJM    GCH         GET TENS DIGIT OF YEAR
          SBN    1R7
          PJN    SCF1        IF YEAR .LE. 1999
          LDN    1R0         ZERO FILL FOR NEXT CENTURY
          UJN    SCF2        STORE CHARACTER AND RETURN
 SCH      SPACE  4,10
**        SCH - STORE CHARACTER IN DESTINATION BUFFER.
*
*         ENTRY  (A) = CHARACTER.
*                (T7) = CHARACTER POSITION IN DESTINATION BUFFER.
*
*         EXIT   (T7) = INCREMENTED.
*
*         USES   T1.
 
 
 SCH1     LDM    -1,T1
          SCN    77
          LMD    T0
 SCH2     STM    -1,T1
 
 SCH      SUBR               ENTRY/EXIT
          LPN    77
          STD    T0          SAVE CHARACTER
          AOD    T7          INCREMENT POSITION
          SHN    21          SET BYTE ADDRESS
          ADM    DBUF
          STD    T1
          SBM    DBUF
          SHN    -21
          NJN    SCH1        IF EVEN CHARACTER
          LDM    -1,T1
          LPN    77
          SHN    14
          LMD    T0
          SHN    6
          UJN    SCH2        STORE CHARACTER
 UDA      SPACE  4,10
**        UDA - UDT ADDRESS OF LABEL PARAMETERS (UUFN)
*
*         EXIT   (T1) = WORD COUNT TO WRITE.
*
*         CALLS  UAD.
 
 
 UDA      SUBR               ENTRY/EXIT
          LDN    /MTX/UUDTL
          STD    T1
          RJM    UAD
          ADN    /MTX/UUFN
          UJN    UDAX        RETURN
 WUD      SPACE  4,10
**        WUD - WRITE UNIT DESCRIPTOR TABLE.
*         OPERATION ONLY PERFORMED IF AT MAGNET CP.
*
*         CALLS  CEC, UDA.
 
 
 WUD      SUBR               ENTRY/EXIT
          LDM    CECB
          LPN    77
          ZJN    WUD1        IF AT MAGNET CP
          LDN    0           CHNAGE TO MAGNET CP
          RJM    CEC
 WUD1     RJM    UDA         GET UDT LABEL ADDRESS ADDRESS
          CWM    UDTB,T1
          UJN    WUDX        RETURN
          SPACE  4,10
**        ADDRESS RELOCATION.
 
 
 TADD     TSAD               ADDRESS RELOCATION TABLE
 
 PRS      SPACE  4,10
**        PRS - PRESET.
*
*         CALLS  MCH, UDA.
 
 
 PRS      LDC    PRSA        MODIFY CHANNELS
          RJM    MCH
          LDC    /SRU/ITCL*100  SET SRU INCREMENT
          STM    //CECA
          LDN    F0040
          STM    //ITMA
          LDC    TADD        SET UP FOR ADDRESS RELOCATION
          STD    CN
          RJM    UDA
          CRM    UDTB,T1
          SBN    /MTX/UUFN+/MTX/UUDTL-/MTX/UCIA
          CRD    T1          GET FET LENGTH - 5
          LDD    T1+1
          SHN    -6
          RAM    OPFA
          LJM    PRSX        RETURN
 
 
 PRSA     CHTB               CHANNEL TABLE
          SPACE  4,10
          ERROVL
          SPACE  4,10
**        BUFFERS.
 
 
 UDTB     EQU    PRSA
 UDTBL    EQU    UDTB+/MTX/UUDTL*5
 BUF      EQU    UDTBL
          OVERLAY (TAPE POSITIONING OPERATIONS.),(/READ/OVLS+5),,SKP
 SKP      SPACE  4,10
**        SKP - SKIP.
*         THIS ROUTINE SKIPS BLOCKS IN A FORWARD DIRECTION.  *SKP* IS
*         OVERLAYED BY *SKR* FOR SKIP REVERSE.
*
*         EXIT   TO *RET1* OF NORMAL COMPLETION.
*                TO *RET2* IF DROP OUT BLOCK COUNT REACHED.
*                TO *RET3* IF TAPE MARK.
*
*         CALLS  DBF, SLL, /READ/RDF, UAD.
 
 
          ENTRY  SKP         FROM *PRS*
 SKP      BSS    0
 .OSKR    EQU    *
 
 SKP1     LDN    0
          STM    IDFE        CLEAR CHUNK COUNT FOR LI FORMAT
          LJM    /READ/RDF   READ TAPE (RETURN AT *SKP2*)
 
 SKP2     UJN    SKP3        NOT SI FORMAT, 9/18 TRACK
 SKPA     EQU    *-1
*         LDD    ES          (9/18 TRACK SI FORMAT)
          LPN    40
          ZJN    SKP3        IF NO FILL STATUS
          SOD    BY          ADJUST BYTE COUNT
 SKP3     RJM    DBF         DETERMINE BLOCK TYPE FORWARD
          AOD    BL+1        INCREMENT BLOCK COUNTER
          SHN    -14
          RAD    BL
          LDD    T2
          LMN    14
 SKPB     UJN    SKP6        IF NOT TAPE MARK
*         NJN    SKP6        (LABELED OR I/SI/LI FORMAT)
          SOD    BL+1        ADJUST BLOCK COUNT
          PJN    SKP4        IF NO UNDERFLOW
          SOD    BL
          AOD    BL+1
 SKP4     PSN
          PSN
*         RJM    SLL         (S,L FORMAT LABELED TAPE)
 SKP5     LDN    /MTX/BEI    SET TAPE MARK ENCOUNTERED
          LJM    RET3        RETURN ERROR CODE
 
 SKP6     AOD    BT          INCREMENT BLOCKS TRANSFERRED
          AOD    CN+4        INCREMENT BLOCKS SKIPPED
          RJM    UAD
          ADN    /MTX/UBLC
          CWD    CN
          LDD    T7
          NJN    SKP7        IF NOT TERMINATION CONDITION
          LDD    PA
          SHN    14
          ADD    PB
          ZJN    SKP10       IF END OF SKIP
          SBN    1
          ZJN    SKP10       IF END OF SKIP
          STD    PB
          SHN    -14
          STD    PA
 SKP7     LDD    CN+4
          ADC    -SBLK
          MJN    SKP8        IF NOT TIME TO CHECK ERROR FLAG
          LDD    TH
          RAD    PA
          UJN    SKP11       RETURN STATUS TO *MAGNET*
 
 SKP8     LDD    DF          CHECK DROP OUT FLAG
          NJN    SKP9        IF DROP OUT SET
          LJM    SKP1        READ TAPE
 
 SKP9     LJM    RET2        REQUEUE
 
 SKP10    LDM    LNUM        SET OPERATION COMPLETE
          SHN    2
          STD    PA
 SKPD     LDD    T2          SET EOR/EOF STATUS
*         LDN    0           (PRU SKIP)
          LPN    10
 SKPE     ADN    20
*         PSN                (READSKP OR PRU SKIP)
          ADM    CIOE        MERGE IN CIO CODE
          LPC    774
          STD    PB
          LDN    10          SET EOR/EOF FLAG
          RAD    UP
 SKP11    LJM    RET1        RETURN
 
          BSS    6
 .OSKRL   EQU    *
 DBF      SPACE  4,10
**        DBF - DETERMINE BLOCK TYPE FORWARD.
*
*         EXIT   (A) = (T7) = 0, IF TERMINATION MET.
*                (T2) = TERMINATION STATUS.
*
*         USES   BL, BL+1, T1, T2, T7.
*
*         CALLS  *CRE*, IDF, *REM*, UBW, VDA.
*
*         MACROS CALL.
 
 
 DBF      SUBR               ENTRY/EXIT
          LDM    BUF-1,BY    SAVE LEVEL NUMBER
 DBFA     EQU    *-2
*         LDM    BUFB+4      (LI FORMAT)
          STM    IDFC
 DBFB     RJM    VDA         VALIDATE DATA I FORMAT
*         PSN                ALL OTHER FORMATS
*         PSN
          LDD    EP
          LPN    77
          SHN    14
          LMD    EC
          ZJN    DBF5        IF NO ERROR
          LMN    /MTX/BEI
          NJN    DBF2        IF NOT TAPE MARK
          LDN    1           SET TAPE MARK INDICATION
 DBF1     STM    UBWB
 DBFC     EQU    *-2
*         UJN    DBF5        (CTS)
          RJM    UBW         UPDATE BID WINDOW
          UJN    DBF5        SKIP ERROR PROCESSOR CALL
 
 DBF2     LMN    /MTX/STE&/MTX/BEI
          NJN    DBF3        IF NOT STATUS ERROR
 DBFD     UJN    DBF3        PROCESS ERRORS
*         LDN    4           (PO=N OR MTX/ATS SKIPEI OR POSMF)
          UJN    DBF1        SET UNUSABLE BID
 
 DBF3     UJN    DBF4        LOAD READ ERROR PROCESSOR
 DBFE     EQU    *-1
*         AOD    BL+1        INCREMENT BLOCK COUNT (SKIP BACK)
          SHN    -14
          RAD    BL
 DBFF     BSS    0
*         CALL   CRE         LOAD ERROR PROCESSOR (CTS)
 DBF4     CALL   REM         LOAD READ ERROR PROCESSOR
          UJN    DBF5        FORWARD SKIP
*         SOD    BL+1        (REVERSE SKIP - DECREMENT BLOCK COUNT)
 DBFG     EQU    *-1
          PJN    DBF5        IF NO UNDERFLOW
          AOD    BL+1
          SOD    BL
 DBF5     RJM    IDF         PROCESS INTERNAL DATA FORMAT
          STD    T2          SAVE STATUS
          LDD    MD
 DBFH     LPN    10          (S, L, F FORMAT)
*         LPN    14          (I, SI, LI FORMAT)
          ZJN    DBF6        IF PRU OPERATION
          STD    T1
          LDD    T2          DETERMINE IF TERMINATION MET
          SBD    T1
          MJN    DBF6        IF TERMINATION NOT MET
          LDD    T1
          LMN    4
          NJN    DBF6        IF NOT EOR
          LDM    LNUM
 DBFI     SBN    0           LEVEL NUMBER
 DBF6     SHN    -21         SET TERMINATION FLAG
          STD    T7
          LJM    DBFX        RETURN
 DBR      SPACE  4,10
 
*         THE FOLLOWING CODE GETS OVERLAID IF NOT USING READ REVERSE.
*         ISMT GCR, CTS, AND LI FORMAT DO NOT USE READ REVERSE.
 
 .DBRR    EQU    *
 
**        DBR - DETERMINE BLOCK TYPE REVERSE.
*
*         USES   CM - CM+4.
*
*         CALLS  DBF.
 
 
 DBR2     RJM    DBF         DETERMINE BLOCK TYPE FORWARD
 
 DBR      SUBR               ENTRY/EXIT
 DBRA     UJN    DBR2        DETERMINE BLOCK TYPE
*         LDD    BY          (USING READ REVERSE)
          ZJN    DBR2        IF NO DATA READ
 
*         THE FOLLOWING CODE GETS OVERLAID IF 9 TRACK SI
*         FORMAT SKIP REVERSE OPERATION OR IF MTS 9 TRACK, I
*         FORMAT SKIP REVERSE.
 
 .DBRO    EQU    *           BEGINNING OF OVERLAID AREA
 
          LDC    BUF
          STM    DBRC
          LDD    WC
          LPN    1
 DBRB     UJN    DBR1        DO NOT SKIP FIRST BYTE
*         ZJN    DBR1        (9 TRACK I FORMAT - IF EVEN WORD COUNT)
          AOM    DBRC        SKIP FIRST BYTE (I FORMAT)
 DBR1     LDD    MA          SAVE FIRST FOUR BYTES
          CWM    BUF,ON
 DBRC     EQU    *-1
          SBN    1
          CRD    CM
          LDD    CM          STORE LAST FOUR BYTES
          STM    BUF-1,BY
          LDD    CM+1
          STM    BUF-2,BY
          LDD    CM+2
          STM    BUF-3,BY
          LDD    CM+3
          STM    BUF-4,BY
          LJM    DBR2        DETERMINE BLOCK TYPE FORWARD
 
 .DBROL   EQU    *-.DBRO     LENGTH OF OVERLAID AREA
 .DBRRL   EQU    *-.DBRR     LENGTH OF OVERLAID AREA
 IDF      SPACE  4,10
**        IDF - PROCESS INTERNAL DATA FORMAT.
*
*         EXIT   (A) = TERMINATION STATUS.
*
*         CALLS  CFP.
 
 
 IDF2     LDN    17          SET LEVEL 17
          STM    LNUM
          LDN    14          RETURN EOI
 
 IDF      SUBR               ENTRY/EXIT
          LDD    EC
          LMN    /MTX/BEI
          ZJN    IDF2        IF TAPE MARK
          LDD    BY
          ADC    0
 IDFE     EQU    *-1         (LI FORMAT CHUNK COUNT)
          ZJN    IDF2        IF NO BYTES READ
          LMM    /READ/MRDA
 IDFA     EQU    *-1
*         RJM    CFP         (LI FORMAT)
*         LMM    /READ/RCTA  (CTS)
          LMN    1
          STM    LNUM        SET 0 LEVEL NUMBER
 IDFB     ZJN    IDFX        IF FULL PRU
*         PSN                (NOT I/SI/LI FORMAT)
          LDC    *           EXTRACT LEVEL NUMBER
 IDFC     EQU    *-1
          LPN    77
 IDFD     LDN    0           (NOT I/SI/LI FORMAT)
*         PSN                (I/SI/LI FORMAT)
          STM    LNUM
          LMN    17
          ZJN    IDF1        IF EOF
          LCN    4
 IDF1     ADN    10
          UJN    IDFX        RETURN
 VDA      SPACE  4,10
**        VDA - VALIDATE DATA.
*         CHECKS I FORMAT TRAILER BYTES OR LI FORMAT PREFIX BYTES.
*         IF LI FORMAT, *VDA* IS OVERLAYED WITH *VLI*.
 
 
 VDA      SUBR               ENTRY/EXIT
          LDD    BY
          ZJN    VDAX        IF NO DATA READ
          LDD    EC
          ZJN    VDA1        IF NO PREVIOUS ERRORS ENCOUNTERED
          LMN    /MTX/STE
          NJN    VDAX        IF NOT STATUS ERROR CODE
 VDAA     EQU    *-1
*         UJN    VDAX        (CTS)
          LDM    MTDS
          LPC    7777
 VDAB     EQU    *-1
*         LPC    7077        (MTS UNIT)
          NJN    VDAX        IF ERRORS REPORTED FROM HARDWARE
 VDA1     LDD    EP
          SHN    21-12
          MJN    VDAX        IF OPPOSITE PARITY BEING TRIED
          LDM    BUF-4,BY    SAVE BLOCK LENGTH
          STM    //BNEI
          LDM    BUF-3,BY
          STM    //BNEI+1
          LMD    BL
          SHN    14
          LMM    BUF-2,BY
          STM    //BNEI+2
          LMD    BL+1
          ZJN    VDA2        IF BLOCK NUMBER CORRECT
          LDN    /MTX/BNE
          STD    EC
 VDA2     LJM    VDAX        RETURN
          SPACE  4,10
          BUFFER
          BSS    7           SO *VLI* DOES NOT OVERFLOW
 VDAL     EQU    *-VDAX      LENGTH OF *VDA*
 CFP      SPACE  4,10
**        CFP - CHECK FULL PRU FOR LI FORMAT.
*
*         ENTRY  (BUFB - BUFB+4) = LI FORMAT BLOCK PREFIX.
*
*         EXIT   (A) = 1 IF FULL PRU.
 
 
 CFP      SUBR               ENTRY/EXIT
          LDM    BUFB        GET BYTE COUNT
          SHN    14
          ADM    BUFB+1
          ADC    -50005+1    CHECK FULL PRU
          UJN    CFPX        RETURN
 SLB      SPACE  4,10
**        SLB - SKIP LONG BLOCK.
*         THIS CODE IS OVERLAYED WITH *SLI* FOR LI FORMAT.
*
*         ENTRY  AT *SLB* FROM *MRD* OR *RCT* WHEN *LBBY* BYTES HAVE
*                BEEN READ.
*
*         USES   T2.
 
 
 SLB      PSN                MAKE ROUTINE AS LONG AS *SLI*
          LDN    2           INPUT 2 BYTES
          IAM    BUFB,CH
          LCN    0
          STD    T2
 SLB1     LDC    400         INPUT DATA
          IAM    BUFB,CH
          NJN    SLB3        IF END OF BLOCK
          SOD    T2
          NJN    SLB1        IF NOT BLOCK TOO LONG
 SLBL     EQU    *-SLB       LENGTH OF CODE THAT CAN BE OVERLAYED
 SLB2     LJM    /READ/MRD4.1  SET BLOCK TOO LARGE
 SLBA     EQU    *-1
*         LJM    /READ/RCT4  (CTS)
 
 SLB3     LJM    /READ/MRD4  CALCULATE REMAINDER OF CM WORD COUNT
 SLBB     EQU    *-1
*         LJM    /READ/RCT5  (CTS)
          SPACE  4,10
          BUFFER BUFB
 SKR      SPACE  4,10
**        SKR - SKIP REVERSE.
*         THE FOLLOWING CODE OVERLAYS *SKP* IF THE OPERATION IS
*         SKIP REVERSE.
*
*         EXIT   TO *RET1* IF NORMAL COMPLETION.
*                TO *RET2* TO REQUEUE.
*
*         CALLS  BKS, DBF, DBR, /READ/RDF, UAD.
 
 
 .BSKR    BSS    0
          LOC    .OSKR
 SKR4     UJN    SKR5        NOT SI FORMAT, 9/18 TRACK
 SKRA     EQU    *-1
*         LDD    ES          (9/18 TRACK SI FORMAT)
          LPN    40
          ZJN    SKR5        IF NO FILL STATUS
          SOD    BY          ADJUST BYTE COUNT
          SOD    WC          ADJUST WORD COUNT
 SKR5     SOD    BL+1        DECREMENT BLOCK COUNT
          PJN    SKR6        IF NO UNDERFLOW
          AOD    BL+1
          SOD    BL
 SKR6     RJM    DBR         DETERMINE BLOCK TYPE REVERSE
 SKRB     EQU    *-1
*         RJM    DBF         (GCR ISMT OR CTS)
 SKRC     PSN
          PSN
*         RJM    BKS         (GCR ISMT OR CTS)
          LDD    MD
          SHN    21-11
          MJN    SKR7        IF NOT FIRST PASS
          LDD    TH          SET NOT FIRST PASS FLAG
          RAD    MD
          UJN    SKR8        CHECK FOR DROP OUT
 
 SKR7     AOD    BT          INCREMENT BLOCKS TRANSFERRED
          AOD    CN+4        INCREMENT BLOCKS SKIPPED
          RJM    UAD
          ADN    /MTX/UBLC
          CWD    CN
          LDD    T7
          NJN    SKR8        IF TERMINATION NOT MET
          LDD    PA          CHECK SKIP TERMINATION
          SHN    14
          ADD    PB
          SBN    1
          ZJN    SKR9        IF END OF SKIP
          STD    PB          UPDATE SKIP COUNT
          SHN    -14
          STD    PA
 SKR8     LDD    CN+4
          ADC    -SBLK
          MJN    SKR11       IF NOT TIME TO CHECK ERROR FLAG
          LDD    TH          SET CHECK ERROR FLAG INDICATOR
          RAD    PA
          LDD    T7
          ZJN    SKR2.1      IF TERMINATION MET
          AOD    MD          SET NOT END OF RECORD FLAG
          UJN    SKR2.1      RETURN STATUS TO *MAGNET*
 
 SKR9     LDD    MD          CLEAR REVERSE AND RECORD FLAGS
          LPC    3763
          STD    MD
*         LDN    1           SET TO SKIP FORWARD ONE BLOCK
*         STD    PB
*         LDN    0
*         STD    PA          CLEAR PARAMETER
 SKR10    LJM    RET2        REQUEUE
 
 SKR11    LDD    DF          CHECK DROP OUT FLAG
          NJN    SKR10       IF DROP OUT SET
 
 SKR      BSS    0           ENTRY
          LDD    BL
          ADD    BL+1
          NJN    SKR3        IF NOT BOI
          LDD    MD
          SHN    21-11
          PJN    SKR1        IF FIRST PASS
          LDD    PA
          SHN    14
          ADD    PB
          LMN    1
          ZJN    SKR2        IF END OF SKIP
 SKR1     LDN    50
 SKR2     ADN    1
          STD    PB
          LDN    0
          STD    PA
 SKR2.1   LJM    RET1        RETURN
 
 SKR3     PSN
          PSN
*         RJM    BKS         (GCR ISMT OR CTS)
          LDN    0
          STM    IDFE        CHUNKS TRANSFERRED FOR LI FORMAT
          LJM    /READ/RDF   READ TAPE (RETURN AT *SKR4)
 
          ERRNG  .OSKRL-*    OVERLAID CODE OVERFLOWED
 
          LOC    *O
 .BSKRL   EQU    *
 PRS      SPACE  4,10
**        PRS - PRESET.
*         ISMT GCR AND CTS HARDWARE CAN NOT DO READ BACKWARDS.  READ
*         BACKWARDS MUST BE REPLACED BY BACKSPACE BLOCK, READ FORWARD,
*         BACKSPACE BLOCK.
*
*         EXIT   (/READ/ISKR) = 0 IF USING READ REVERSE FOR SKIP
*                                 REVERSE.
*                TO *SKP* IF SKIP FORWARD.
*                TO *SKR* IF SKIP REVERSE.
*
*         USES   T1, T2, CN - CN+4.
*
*         CALLS  DTS, MCH, UAD.
 
 
 PRS      LDN    0           CLEAR READ BACKWARDS FLAG
          STM    /READ/ISKR
          LDD    HP
          SHN    21-7
          PJP    PRS1        IF NOT CTS
          LDC    LDNI+CRE/10000
          STM    DBFF        LOAD CTS ERROR PROCESSOR
          LDC    /READ/RCTA
          STM    PRSD        ADDRESS OF BYTE COUNT TO INPUT
          STM    PRSE
          STM    IDFA
          LDC    /READ/RCTB
          STM    PRSF        ADDRESS OF INPUT ADDRESS
          LDC    /READ/RCTC
          STM    PRSG
          ISTORE DBFC,(UJN DBF5)  SKIP UPDATING BLOCK ID WINDOW
          LDC    UJNI-NJNI
          RAM    VDAA        SKIP CHECKING ATS STATUS
          LDC    /READ/RCT4
          STM    SLBA        SET BLOCK TOO LARGE
          LDC    /READ/RCT5
          STM    SLBB        CALCULATE REMAINDER OF CM WORD COUNT
          LDC    /READ/RCTG
          STM    PRSA
          LDD    FM
          SHN    -6
          LMN    /MTX/TFLI
          NJN    PRS1        IF NOT LI FORMAT
          LDC    STMI
          STM    /READ/RCTM  CLEAR CHUNK COUNTER
 PRS1     LDD    FM
          SHN    -6
          LMN    /MTX/TFI
          NJN    PRS2        IF NOT I FORMAT
          LDC    UJNI+2      DO NOT PROCESS DATA
          STM    /READ/MRDH
 PRSA     EQU    *-1
*         STM    /READ/RCTG  (CTS)
          LDD    HP
          LPN    40
          ZJN    PRS2        IF NOT MTS UNIT
          LDC    7077
          STM    VDAB
 PRS2     LDC    LJMI
          STM    /READ/RDFC
          LDC    SKP2
          STM    /READ/RDFC+1
          LDD    PA          INSURE CHECK ERROR FLAG BIT IS CLEAR
          LPN    77
          STD    PA
          LDD    MD
          SHN    21-13
          MJN    PRS5        IF REVERSE MOTION
          LDD    MD          CHECK IF SKIP TO EOI
          LPN    14
          NJN    PRS3        IF NOT PRU SKIP
          STM    SKPE        DO NOT SET EOR/EOF STATUS
          LDC    LDNI
          STM    SKPD
          UJN    PRS4        CONTINUE PRESET
 
 PRS3     LMN    14
          NJN    PRS4        IF NOT SKIPEI
          AOM    PRSH        SET SKIPEI OR POSMF IN PROGRESS
          ISTORE DBFD,(LDN 4)  SET UNUSABLE BID IF ERROR
 PRS4     LJM    PRS18       CONTINUE PRESET
 
 PRS5     LDC    .BSKRL-.BSKR-1
          STD    T1
 PRS6     LDM    .BSKR,T1    REVERSE MOTION CODE
          STM    .OSKR,T1
          SOD    T1
          PJN    PRS6        IF MORE CODE TO MOVE
          LDC    .BKSML-1
          STD    T1
          LDD    HP
          SHN    21-7
          PJN    PRS7        IF NOT CTS
          LDC    /PRESET/GPS
          STM    BKSA-.DBRR+.BKSM
          STM    BKSD-.DBRR+.BKSM
          LDC    MJNI+77+BKS0-BKSB (MJN BKS0)
          STM    BKSB-.DBRR+.BKSM
          LDC    UJNI+2
          STM    BKSC-.DBRR+.BKSM
          STM    BKSF-.DBRR+.BKSM
          LDC    MJNI+77+BKS1-BKSE (MJN BKS1)
          STM    BKSE-.DBRR+.BKSM
          UJN    PRS9        INDICATE NOT USING SKIP REVERSE
 
 PRS7     SHN    21-10-21+7+22
          MJN    PRS8        IF 639 TAPE CONTROLLER
          LDD    FM
          SHN    -6
          SBN    /MTX/TFLI
          NJP    PRS11       IF NOT LI FORMAT
          UJN    PRS9        INDICATE NOT USING READ REVERSE
 
 PRS8     LDM    //RELA
          ZJN    PRS9        IF UNIT NOT CONNECTED, ASSUME GCR
          RJM    DTS         GET UNIT STATUS
          LDM    ATUS        CHECK DENSITY
          LPN    30
          LMN    30
          NJN    PRS11       IF NOT GCR
 PRS9     AOM    /READ/ISKR  INDICATE NOT USING READ REVERSE
          LDC    RJMI        SET UP *RJM BKS*
          STM    SKR3
          STM    SKRC
          LDC    BKS
          STM    SKR3+1
          STM    SKRC+1
          LDC    DBF
          STM    SKRB
 PRS10    LDM    .BKSM,T1
          STM    .DBRR,T1
          SOD    T1
          PJN    PRS10       IF MORE CODE TO MOVE
          UJN    PRS12       CHECK CONTROLLER TYPE
 
 PRS11    LDC    F0140       READ REVERSE
          STM    ITMA
 PRS12    LDD    HP
          LPC    221
          LMN    1
          NJN    PRS14       IF CTS/ATS-TYPE CONTROLLER OR 7 TRACK
          LDD    FM
          SHN    -6
          LMN    /MTX/TFI
          NJN    PRS14       IF NOT I FORMAT
          LDN    .DBRSL-1    SET LENGTH OF LEVEL NUMBER ROUTINE
          STD    T1
 PRS13    LDM    .DBRS,T1    MOVE CODE
          STM    .DBRO,T1
          SOD    T1
          PJN    PRS13       IF MORE CODE TO MOVE
          LDC    UJNI+PRS22-PRSB  DISABLE INSTRUCTION MODIFICATION
          ERRNG  PRSB-PRS22+37B
          STM    PRSB
          LDN    0           DESELECT VALIDATE DATA FOR I FORMAT
          STM    DBFB
          STM    DBFB+1
          STM    .DBRSB
 PRS14    LDD    HP
          SHN    21-7
          PJN    PRS15       IF NOT CTS
          LDC    6125
          STM    /PRESET/WFEA  WAIT NOT BUSY MASK
          UJN    PRS16       CONTINUE PRESET
 
 PRS15    LDC    4425
          STM    //WEOA
 PRS16    LDC    SKR4
          STM    /READ/RDFC+1
          LDC    SKRA        SET TO MODIFY CORRECT INSTRUCTION
          STM    PRSC
          LDC    AODI+BL+1
          STM    DBFE
          LDC    SODI+BL+1
          STM    DBFG
          LDD    FM
          SHN    -6
          SBN    /MTX/TFSI+1
          PJN    PRS18       IF NOT I OR SI FORMAT
          LDM    /READ/ISKR
          NJN    PRS18       IF NOT USING READ REVERSE
          LDC    LDDI+BY     SET TO SET LEVEL NUMBER
          STM    DBRA
 PRS18    LDM    LNUM        SET LEVEL NUMBER
          SHN    -10
          RAM    DBFI
          LDM    CIOE
          LPC    774
          LMN    20
          NJN    PRS19       IF NOT READSKP
          STM    SKPE        RETURN 31 STATUS IF EOF READ
 PRS19    LDD    FM
          SHN    -6
          SBN    /MTX/TFSI+1
          MJN    PRS20       IF I OR SI FORMAT
          SBN    /MTX/TFLI-/MTX/TFSI-1
          NJP    PRS23       IF NOT LI FORMAT
          LDC    RJMI
          STM    IDFA-1
          LDC    CFP         CHECK FOR FULL PRU
          STM    IDFA
          LDC    LDMI
          STM    DBFA        GET LEVEL NUMBER
          LDC    BUFB+4
          STM    DBFA+1
 PRS20    LDN    0           SET I/SI/LI FORMAT LEVEL NUMBER CHECK
          STM    IDFD
          LDN    4
          RAM    DBFH
          LDD    FM
          SHN    -6
          LMN    /MTX/TFSI
          ZJN    PRS23       IF SI FORMAT
 PRSB     LDD    HP
*         UJN    PRS22       (MTS CONTROLLER REVERSE SKIP)
          SHN    21-7
          MJN    PRS21       IF CTS
          SHN    21-0-21+7
          PJN    PRS22       IF 7 TRACK
 PRS21    LDM    /READ/ISKR
          NJN    PRS22       IF NOT USING READ REVERSE
          LDC    ZJNI-UJNI
          RAM    DBRB
 PRS22    UJN    PRS24       COMPLETE PRESET
 
 PRS23    LDN    0
          STM    DBFB
          STM    DBFB+1
          LDD    FM
          SHN    -6
          LMN    /MTX/TFSI
          ZJN    PRS25       IF SI FORMAT
 PRS24    LJM    PRS28       COMPLETE PRESET
 
 PRS25    LDD    HP
          LPN    1
          ZJN    PRS28       IF 7 TRACK
          LDC    LDDI+ES     SET TO CHECK FOR FILL STATUS
          STM    SKPA
*         STM    SKRA        (SKIP REVERSE)
 PRSC     EQU    *-1
          LDD    MD
          SHN    21-13
          PJN    PRS28       IF SKIP FORWARD
          LDM    /READ/ISKR
          NJN    PRS28       IF NOT USING READ REVERSE
          LDN    .DBRML      LENGTH OF ATS LEVEL NUMBER ROUTINE
          STD    T1
          LDD    HP
          LPN    40
          ZJN    PRS26       IF NOT MTS CONTROLLER
          LDN    .DBRSL-1    SET LENGTH OF MTS LEVEL NUMBER ROUTINE
          STD    T1
          LDN    .DBRS-.DBRM
 PRS26    ADC    .DBRM
          ADD    T1          ADD LENGTH
          STD    T2
 PRS27    LDI    T2          MOVE CODE
          STM    .DBRO,T1
          SOD    T2
          SOD    T1
          PJN    PRS27       IF MORE CODE TO MOVE
 PRS28    LDD    PA
          ADD    PB
          NJN    PRS29       IF SKIP COUNT SPECIFIED
          AOD    PB
 PRS29    LDD    MD
          SHN    21-13
          MJN    PRS32       IF SKIP REVERSE
          LDD    FM
          SHN    -6
          SBN    /MTX/TFSI+1
          MJN    PRS31       IF I/SI FORMAT
          SBN    /MTX/TFLI-/MTX/TFSI-1
          ZJN    PRS31       IF LI FORMAT
          LDD    LT
          SHN    21-12
          PJN    PRS32       IF NOT LABELED
          LDC    RJMI        SET *RJM  SLL* TO DECREMENT SKIP COUNT
          STM    SKP4
          LDC    SLL
          STM    SKP4+1
          LDN    .DBSLL-1    SET LENGTH OF *SLL* SUBROUTINE
          STD    T1
 PRS30    LDM    .DBSL,T1    MOVE CODE
          STM    .DBRO,T1
          SOD    T1
          PJN    PRS30       IF MORE CODE TO MOVE
 PRS31    LDC    NJNI-UJNI
          RAM    SKPB
 PRS32    LDD    FM
          SHN    -6
          SBN    /MTX/TFSI+1
          MJN    PRS33       IF I OR SI FORMAT
          SBN    /MTX/TFLI-/MTX/TFSI-1
          ZJN    PRS33       IF LI FORMAT
          LDN    0           SET TO ALWAYS RETURN EOR
          STM    IDFB
          LDC    5001        SET MAXIMUM BLOCK LENGTH
          STM    /READ/MRDA
 PRSD     EQU    *-1
*         STM    /READ/RCTA  (CTS)
 PRS33    LDD    FM
          SHN    -6
          SBN    /MTX/TFL
          ZJN    PRS35       IF L FORMAT
          SBN    /MTX/TFLI-/MTX/TFL
          NJN    PRS34       IF NOT LI FORMAT
          LDC    SLBY        CHUNK LENGTH FOR SKIPPING IN LI FORMAT
          UJN    PRS36       SET LENGTH OF LAST INPUT
 
 PRS34    LDD    OV
          ZJN    PRS37       IF NOT POSSIBLE LONG BLOCKS
          LDD    FM
          SHN    -6
          LMN    /MTX/TFF
          NJN    PRS37       IF NOT F FORMAT
 PRS35    LDC    LBBY        SET UP FOR LONG BLOCKS
 PRS36    STM    /READ/MRDA
 PRSE     EQU    *-1
*         STM    /READ/RCTA  (CTS)
          LDC    BUFB
          STM    /READ/MRDB
 PRSF     EQU    *-1
*         STM    /READ/RCTB  (CTS)
          LDC    SLB
          STM    /READ/MRDC
 PRSG     EQU    *-1
*         STM    /READ/RCTC  (CTS)
 PRS37    LDC    PRSI        MODIFY CHANNELS
          RJM    MCH
 PRSH     LDN    0           SET SKIP STATUS
*         LDN    1           (SKIPEI OR POSMF OPERATION)
          STM    /READ/SKEI
          LDD    SP          SET PO=N FLAG
          LPN    2
          ZJN    PRS38       IF NOT PO=N OPTION
          ISTORE DBFD,(LDN 4)  SET UNUSABLE BID IF ERROR
 PRS38    LDD    FM
          SHN    -6
          SBN    /MTX/TFLI
          NJN    PRS41       IF NOT LI FORMAT
          LDK    .SLIL-1     LENGTH OF CODE TO MOVE - 1
          STD    T1
 PRS39    LDM    .SLI,T1     REPLACE *SLB* WITH *SLI*
          STM    SLI,T1
          SOD    T1
          PJN    PRS39       IF MORE CODE TO MOVE
          LDC    SLIA
          RJM    MCH         MODIFY CHANNELS FOR *SLI*
          LDK    .VLIL-1
          STD    T1          LENGTH OF CODE TO MOVE - 1
 PRS40    LDM    .VLI,T1     REPLACE *VDA* WITH *VLI*
          STM    VLIX,T1
          SOD    T1
          PJN    PRS40       IF MORE CODE TO MOVE
 PRS41    LDC    PRS42       SET TO RETURN
          STD    BT
          LJM    PRSX        RETURN
 
 PRS42    RJM    UAD         READ BLOCK ACCUMULATOR
          ADN    /MTX/UBLC
          CRD    CN
          LDD    MD
          SHN    21-13
          MJP    SKR         IF SKIP REVERSE
          LJM    SKP         SKIP FORWARD
 
 PRSI     CHTB
          SPACE  4,10
*         THE FOLLOWING CODE GETS MOVED TO .DBRO IF 9 TRACK
*         SI FORMAT SKIP REVERSE ON ATS CONTROLLER.
 
 .DBRM    BSS    0           ATS CONTROLLER ROUTINE
          LOC    .DBRO
          LDD    MA          READ FIRST WORD FROM BUFFER
          CWM    BUF,ON
          SBN    1
          CRD    CM
          LDD    WC
          LPN    1
          ZJN    .DBRM1      IF EVEN WORD COUNT
          LDN    73          SET FOR SHN -4 INSTRUCTION
 .DBRM1   ADC    SHNI
          STM    .DBRMA
          LDD    CM          SAVE LEVEL NUMBER
 .DBRMA   SHN    **
*         SHN    0           (EVEN WORD COUNT)
*         SHN    -4          (ODD WORD COUNT)
          LPN    17
          STM    BUF-1,BY
          LJM    DBR2        DETERMINE IF TERMINATION MET
 
          LOC    *O
 .DBRML   EQU    *-.DBRM     LENGTH OF ATS ROUTINE
          ERRMI  .DBROL-.DBRML  OVERLAID CODE OVERFLOWED
 
 
*         THE FOLLOWING CODE GETS MOVED TO .DBRO IF 9 TRACK
*         I/SI FORMAT SKIP REVERSE ON MTS CONTROLLER.
 
 .DBRS    BSS    0           MTS ROUTINE
          LOC    .DBRO
          LDD    WC          SET BYTE TO START READ
          LPN    1
          LMN    1
          STD    T1
          ADC    BUF
          STM    .DBRSA
          LDD    MA          SAVE FIRST WORD
          CWM    *,ON
*         CWM    BUF,ON      (ODD WORD COUNT)
*         CWM    BUF+1,ON    (EVEN WORD COUNT)
 .DBRSA   EQU    *-1
          SBN    1
          CRD    CM
          LDD    T1
 .DBRSB   ZJN    .DBRS1      IF ODD WORD COUNT
*         PSN                (I FORMAT - ALWAYS SHIFT -10)
          LDN    67          SET FOR SHN -10
 .DBRS1   ADC    SHNI
          STM    .DBRSC
          LDD    CM          SAVE LEVEL NUMBER
 .DBRSC   SHN    **
*         SHN    0           (ODD WORD COUNT)
*         SHN    -10         (EVEN WORD COUNT)
          LPN    17
          STM    BUF-1,BY
          LJM    DBR2        DETERMINE IF TERMINATION MET
 
          LOC    *O
 .DBRSL   EQU    *-.DBRS     LENGTH OF OVERLAID CODE
          ERRMI  .DBROL-.DBRSL  OVERLAID CODE OVERFLOWED
 SLL      SPACE  4,10
**        SLL - SKIP COUNT MODIFIER FOR S, L FORMATS.
*
*         THE FOLLOWING CODE GETS MOVED TO .DBRO IF S, L FORMAT ON A
*         LABELED TAPE.
 
 .DBSL    BSS    0
          LOC    .DBRO
 SLL      SUBR               ENTRY/EXIT
          LDD    PA
          SHN    14
          ADD    PB
          ZJN    SLLX        IF END OF SKIP
          SBN    1           DECREMENT SKIP COUNT
          STD    PB
          SHN    -14
          STD    PA
          UJN    SLLX        RETURN
 
          LOC    *O
 .DBSLL   EQU    *-.DBSL     LENGTH OF S, L FORMAT LABELED ROUTINE
          ERRMI  .DBROL-.DBSLL  OVERLAID CODE OVERFLOWED
 BKS      SPACE  4,10
**        BKS - BACKSPACE TAPE.
*         WAIT BACKSPACE FUNCTION COMPLETE.  FOR ISMT THE TIMEOUT IS
*         APPROXIMATELY 25 FEET OF TAPE.
*
*         THE FOLLOWING CODE GETS MOVED TO *.DBRR* IF NOT USING READ
*         REVERSE.  ISMT GCR, CTS, AND LI FORMAT DO NOT USE READ
*         REVERSE.
*
*         EXIT   (DS) = GENERAL STATUS.
*
*         CALLS  FCN, /PRESET/GPS, STW.
 
 
 .BKSM    BSS    0
          LOC    .DBRR
 BKS2     CON    0           ENTERED VIA *RJM* FROM //STW
          SOD    T2
          NJN    BKS1        IF NOT TIMEOUT
          LDC    ERR         RESET ERROR EXIT
          STM    STWC
          UJN    BKS1        ATTEMPT 1 MORE TIME
 
 BKS      SUBR               ENTRY/EXIT
 BKS0     LDN    2           WAIT NOT BUSY
          RJM    STW
 BKSA     EQU    *-1
*         RJM    /PRESET/GPS GET AND PROCESS GENERAL STAUS (CTS)
          PSN    0
 BKSB     EQU    *-1
*         MJN    BKS0        IF COMMAND RETRY (CTS)
          LDC    F0113       BACKSPACE
          RJM    FCN
          LDN    27
          STD    T2
          LDC    BKS2        SET RETURN ON TIMEOUT FROM //STW
          STM    STWC
 BKSC     EQU    *-2
*         UJN    *+2         DO NOT CHANGE STWC (CTS)
 BKS1     LDN    2           WAIT NOT BUSY
          RJM    STW
 BKSD     EQU    *-1
*         RJM    /PRESET/GPS GET AND PROCESS GENERAL STATUS (CTS)
          PSN
 BKSE     EQU    *-1
*         MJN    BKS1        COMMAND RETRY (CTS)
          LDC    ERR         RESET ERROR EXIT
          STM    STWC
 BKSF     EQU    *-2
*         UJN    *+2         DO NOT STORE INTO STWC (CTS)
          UJN    BKSX        RETURN
          LOC    *O
 .BKSML   EQU    *-.BKSM
          ERRMI  .DBRRL-.BKSML  OVERLAID CODE OVERFLOW
 SLI      SPACE  4,15
**        SLI - SKIP LI FORMAT BLOCK.
*         NOTE THAT THE MAXIMUM BLOCK SIZE IS DATA (2400*20) PLUS
*         PREFIX (5) PLUS PAD (1).  THIS ROUTINE OVERLAYS *SLB*
*         FOR LI FORMAT.
*
*         ENTRY  AT *SLI* FROM *MRD* OR *RCT* (FOR CTS) WHEN *SLBY*
*                   BYTES HAVE BEEN READ.
*                (IDFE) = 0.
*
*         EXIT   (IDFE) = CHUNK COUNT READ.
*                TO *SLB2* IF BLOCK TOO LONG.
*                TO *SLB3* IF END OF BLOCK.
 
 
 .SLI     BSS    0
          LOC    SLB
 SLI      LDN    7
          IAM    BUFB+5,CH
 SLI1     AOM    IDFE
          LMN    20
          ZJN    SLB2        IF BLOCK TOO LONG
          LDC    SLBY
          IAM    BUFB+5,CH
          ZJN    SLI1        IF NOT END OF BLOCK
          UJN    SLB3        END OF BLOCK
 
          LOC    *O
 .SLIL    EQU    *-.SLI      LENGTH OF CODE TO MOVE
          ERRMI  SLBL-.SLIL  IF CODE OVERFLOWS
 
 SLIA     CHTB               CHANNEL TABLE
 VLI      SPACE  4,10
**        VLI - VALIDATE LI FORMAT PREFIX.
*         THIS ROUTINE OVERLAYS *VDA* FOR LI FORMAT.
*
*         ENTRY  (BY) = BYTES READ IN LAST CHUNK.
*                (IDFE) = FULL CHUNKS READ.
 
 
 .VLI     BSS    0
          LOC    VDAX
 VLI      SUBR               ENTRY/EXIT
          LDD    BY          BYTES IN LAST CHUNK
          ADM    IDFE
          ZJN    VLIX        IF NO DATA READ
          LDD    EC
          ZJN    VLI1        IF NO PREVIOUS ERRORS ENCOUNTERED
          LMN    /MTX/STE
          NJN    VDAX        IF NOT STATUS ERROR CODE
 VLIA     EQU    *-1
*         UJN    VLIX        (CTS)
          LDM    MTDS
          NJN    VLIX        IF ERRORS REPORTED FROM HARDWARE
 VLI1     LDM    IDFE
          NJN    VLI2        IF PREFIX WAS READ
          LDD    BY
          SBN    5
          MJN    VLI3        IF NO PREFIX
 VLI2     LDM    BUFB+1      SAVE BLOCK LENGTH
          STM    //BNEI
          LDM    BUFB
          STM    //BNEU
          LDM    BUFB+2      SAVE BLOCK NUMBER
          STM    //BNEI+1
          LMD    BL
          SHN    14
          LMM    BUFB+3
          STM    //BNEI+2
          LMD    BL+1
          ZJN    VLI4        IF BLOCK NUMBER CORRECT
 VLI3     LDN    /MTX/BNE
          STD    EC
 VLI4     LJM    VLIX        RETURN
 
          LOC    *O
 .VLIL    EQU    *-.VLI      LENGTH OF CODE TO MOVE
          ERRMI  VDAL-.VLIL  IF CODE OVERFLOWS
          OVERLAY (MTS/ATS READ ERROR PROCESSOR.),(BUFB+5),P
 REM      SPACE  4,20
**        REM - READ ERROR PROCESSOR.
*         FIRST PART OF CODE USED AS A BUFFER.
*
*         ENTRY  (EP, 12) = OPPOSITE PARITY MODE.
*                (EP, 11) = LOAD POINT ERROR FLAG.
*                (EP, 10 - 6) = CLIPPING LEVEL.
*                (EP, 5 - 0) = REENTRY CODE.
*                (EP+1, 13 - 11) = CLIPPING LEVEL BEING TRIED.
*                (EP+1, 10 - 6) = RETRY COUNT.
*                (EP+1, 5 - 3) = NORMAL PARITY REREAD COUNT.
*                (EP+1, 2 - 0) = OPPOSITE PARITY REREAD COUNT.
*
*         EXIT   (A) = 0.
*
*         CALLS  BKS, CFC, EBW, *EMM*, EOT, LPR, MCH, PNE, POT,
*                PRS, PTM, RDA.
*
*         MACROS CALL.
 
 
*         THE FOLLOWING CODE IS OVERLAID BY IN POINTERS AND
*         TEMPORARY STORAGE AFTER PRESET.
 
          ENTRY  REM
 REM      SUBR               ENTRY
          LDM    //LOV       SAVE CALLERS EXIT ADDRESS
          STM    REMH
          LDC    REM1        SET ADDRESS TO ENTER AT
          STM    //LOV
          UJN    REMX        RETURN
 
 REM1     LDD    MA          SAVE IN POINTER
          CWD    CN
          CRM    INPA,ON
          LDC    CTAB        MODIFY CHANNELS
          RJM    MCH
          LDM    ITMA        SET BACKSPACE/FORESPACE FUNCTION
          LPC    100
          LMC    F0113
          STM    BKSA
          RJM    PRS         PRESET INSTRUCTIONS
          RJM    EBW         EVALUATE BID WINDOW
          RJM    CFC         RECONNECT UNIT
          LDM    //STER      RESTORE STATUS
          STD    DS
          LPN    1
          NJN    REM2        IF READY
          LDN    /MTX/RDR    SET NOT READY
          STD    EC
          UJN    REM2.1      NO LOAD POINT RECOVERY IF NOT READY
 
 REM2     RJM    LPR         CHECK FOR LOAD POINT RECOVERY
*         UJN    REM2.1      (NOT ATS CONTROLLER)
 REMK     EQU    *-2
          MJN    REM2.1      IF NO LOAD POINT ERROR OR ERROR RECOVERED
          CALL   EMM         ISSUE MESSAGE
          LDN    0
          STD    EC
          AOD    EI
          LJM    RET2        RETRY ON *BFR* ERROR
 
 REM2.1   RJM    PNE         PROCESS NOISE ERRORS
          LDD    EC
          LMN    /MTX/BEI
          NJN    REM3        IF NOT TAPE MARK
          LDD    EP
          SHN    21-12
          MJN    REM6        IF OPPOSITE PARITY
          RJM    PTM         PROCESS TAPE MARK
          UJN    REM5        SET TO ACCEPT DATA AS WRITTEN
 
 REM3     LMN    /MTX/STE&/MTX/BEI
          ZJN    REM4        IF STATUS ERROR
          LJM    REM9        CHECK FOR ERROR PROCESSING INHIBITED
 
 REM4     LDD    DS
          SHN    21-3
          PJN    REM6        IF NOT EOT
          SHN    22+3-13
          MJN    REM6        IF OTHER ERRORS
          RJM    EOT         PROCESS END OF TAPE
 REM5     AOM    REMI        SET TO ACCEPT DATA AS WRITTEN
          LJM    REM16       POSITION TAPE
 
 REM6     LDD    DS
          SHN    21-13
          PJN    REM9        IF NO ALERT
          LDM    MTDS
          LPC    7077
 REMA     EQU    *-1
*         LPC    7777        (ATS UNIT)
          NJN    REM8        IF NO CORRECTED ERROR
          LDM    MTDS+3
 REMB     EQU    *-1
*         LDM    MTDS+1      (ATS UNIT)
 REMC     SHN    -13
*         SHN    -11         (ATS UNIT)
          LPN    3
          ZJN    REM8        IF NOT CORRECTED ERROR
          LDN    /MTX/OTF    SET ON-THE-FLY ERROR
 REM7     STD    EC
          AOM    REMI        SET ACCEPT DATA
          UJN    REM9        CHECK FOR ERROR PROCESSING INHIBITED
 
 REM8     LDM    MTDS
          LMN    16
 REME     ZJN    REM7        IF AGC FAILURE
*         PSN                (MTS UNIT)
          LMN    10&16
          NJN    REM9        IF NOT BLANK TAPE
          LDN    /MTX/BTA
          STD    EC
 REM9     LDD    SP
          LPN    4
          ZJN    REM12       IF ERROR PROCESSING NOT INHIBITED
 REM10    STM    REMI        SET ACCEPT DATA FLAG
          LDN    4           SET UNUSEABLE BID
          STM    REMF
          LDD    EC
          LMN    /MTX/BTL
          NJN    REM11       IF NOT *BLOCK TOO LARGE*
          RJM    BKS         INSURE POSITIONED AFTER BAD BLOCK
          RJM    RDA         SKIP BLOCK
 REM11    UJN    REM15       SKIP MESSAGE ISSUE
 
 REM12    LDD    FN
          LMN    /MTX/SKP
          NJN    REM13       IF NOT SKIP OPERATION
          LDM    /READ/SKEI
          NJN    REM10       IF SKIPEI OF POSMF
 REML     EQU    *-1
*         PSN                (LI FORMAT)
 REM13    LDD    EC
          ZJN    REM16       IF NO ERROR
          LDD    FM
          SHN    -6
          LMN    /MTX/TFF
          ADD    EP
          NJN    REM14       IF NOT F FORMAT AND/OR NOT FIRST ATTEMPT
          LDD    HP
          LPN    1
          NJN    REM14       IF 9 TRACK
          SOM    POTH        SET TO ATTEMPT OPPOSITE PARITY
          UJN    REM15       CHECK FOR FATAL ERROR
 
 REM14    RJM    CIS         CHECK ISMT GCR SKIP REVERSE
          LDC    -0          RESTORE BID
 REMF     EQU    *-1
          STM    UBWB
          CALL   EMM         DIAGNOSE ERROR
          RJM    CFC         CONNECT IF NEEDED
 REM15    LDD    EC
          SBN    /MTX/BFAT
          MJN    REM16       IF NOT FATAL ERROR
          SBN    /MTX/MFAT-/MTX/BFAT
          PJN    REM16       IF NOT FATAL ERROR
          LJM    RET4        RETURN FATAL ERROR
 
 REM16    RJM    POT         POSITION TAPE
 REMG     LDN    0
          NJN    REM17       IF ERROR RETURN
          LJM    *
 REMH     EQU    *-1
 
 REM17    LJM    RET3        RETURN ERROR CODE
 
 REMI     CON    0           ACCEPT DATA FLAG
 INPA     EQU    REMX        IN POINTER FOR SUCCESSFUL READ
 POTO     EQU    INPA+5      COUNT OF BLOCKS SKIPPED
 POTP     EQU    POTO+1      (EP), (EP+1) ON ENTRY
 POTQ     EQU    POTP+2      SAVE AREA FOR DETAILED STATUS
 TBDW     EQU    POTQ+10     TEMPORARY BID WINDOW
 EOT      SPACE  4,10
**        EOT - END OF TAPE PROCESSOR.
 
 
 EOT1     LMN    2&1
          NJN    EOTX        IF NOT DISCARD BLOCK AT EOT
 EOT2     LDN    /MTX/BEI    RETURN END OF TAPE
          RAM    REMG
 
 EOT      SUBR               ENTRY/EXIT
          LDD    SP
          SHN    -12
          ZJN    EOTX        IF READ TO TAPE MARK
          LMN    1
          NJN    EOT1        IF NOT ACCEPT BLOCK AT EOT
          LDM    /READ/STAP
          SHN    21-3
          PJN    EOTX        IF END OF TAPE ENCOUNTERED THIS BLOCK
          UJN    EOT2        RETURN END OF TAPE STATUS
 PNE      SPACE  4,20
**        PNE - PROCESS NOISE ERRORS.
*         ISSUE MESSAGE IF NOISE SKIPPED, ERROR PROCESSING NOT
*         INHIBITED AND NOT A TAPE MARK.
*
*         ENTRY  (/READ/MRDP) .NE. 0 IF NOISE SKIPPED. (MTS)
*                (MTDS+5, 8-5) = LENGTH OF LARGEST NOISE BLOCK. (MTS)
*                (MTDS+6, 10) .NE. 0 IF NOISE SKIPPED. (ATS)
*                (//STER) = (DS) = GENERAL STATUS FROM READ.
*
*         EXIT   (EC) = 0 IF NO ERRORS ON BLOCK FOLLOWING NOISE.
*                MAXIMUM NOISE SIZE ALWAYS RETURNED FOR ATS.
*
*         USES   T0, T1.
*
*         CALLS  CFC, DTS, *EMM*.
*
*         MACROS CALL.
 
 
 PNE7     LDM    MTDS+6
          SHN    21-12
          PJN    PNEX        IF NOISE NOT SKIPPED
          LDD    FM          SET NOISE SIZE
          LPN    37
          LJM    PNE2        ISSUE MESSAGE
 
 PNE8     RJM    DTS         GET DETAILED STATUS
 
 PNE      SUBR               ENTRY/EXIT
          LDD    SP
          LPN    4
          NJN    PNEX        IF ERROR PROCESSING INHIBITED
          LDD    DS          CHECK FOR TAPE MARK
          LPN    20B
          NJN    PNEX        IF TAPE MARK, EXIT
          LDD    EC
          ZJN    PNE8        IF NOT POSSIBLE NOISE
          LDD    BY          SAVE BYTE COUNT OF NEXT BLOCK
          STM    PNEB
          LDD    HP
          LPN    20
          NJN    PNE7        IF ATS-TYPE CONTROLLER
          LDM    /READ/MRDP
          ZJN    PNEX        IF NOISE NOT SKIPPED
          LDM    MTDS+5
          SHN    -4
          LPN    37
          ADN    1
          STD    T0          NUMBER OF FRAMES + 1
          LDD    HP
          LPN    1
          NJN    PNE1        IF 9 TRACK
          LDD    T0          CONVERT FRAMES TO BYTES
          SHN    -1          (FRAMES+1)/2
          UJN    PNE2        SAVE BYTE COUNT OF LARGEST NOISE BLOCK
 
 PNE1     LDD    T0
          SHN    1           2(FRAMES+1) = FR
 
*         APPROXIMATE 1/3 OF FR.
 
          SHN    2           4*FR
          ADD    T0          5*FR
          SHN    2           20*FR
          ADD    T0          21*FR
          SHN    14 (-6)     (21*FR)/64
          STD    T1
          SHN    6+2         4*21*FR  (84*FR)
          ADD    T0          85*FR
          ADD    T1          (85*FR)+((21*FR)/64)
          SHN    -8D         ((85*FR)+((21*FR)/64))/256
 PNE2     STD    BY          BYTE COUNT OF LARGEST NOISE BLOCK
          LDD    EC          SAVE ERROR CODE
          STM    PNED
          LDD    DS          SAVE STATUS
          STM    PNEC
          LDN    /MTX/NBE    SET NOISE ERROR CODE
          STD    EC
 PNEA     LDC    400
*         UJN    PNE3        (ATS UNIT)
          STM    //STER
 PNE3     CALL   EMM         ISSUE MESSAGE
          RJM    CFC         CONNECT IF NEEDED
          LDC    *           RESET BYTE COUNT
 PNEB     EQU    *-1
          STD    BY
          LDC    *           RESET STATUS
 PNEC     EQU    *-1
          STM    //STER
          STD    DS
          LDC    *           CHECK IF OTHER ERRORS
 PNED     EQU    *-1
          STD    EC
          LMN    /MTX/STE
          NJN    PNE6        IF ERRORS ON FOLLOWING BLOCK
          LDM    MTDS
          LPC    7077
 PNEE     EQU    *-1
*         LPC    7777        (ATS UNIT)
          NJN    PNE5        IF OTHER ERRORS
          STD    EC          CLEAR ERROR CODE
          LDD    DS          CLEAR ALERT BIT
          LPC    3777
          STD    DS
          STM    //STER
          AOM    REMI        SET TO ACCEPT DATA
 PNE4     LDC    POT11       SET TO ISSUE RECOVERED MESSAGE
          STM    POTA
          AOD    EI          INCREMENT ITERATION COUNT
 PNE5     LJM    PNEX        RETURN
 
 PNE6     LMN    /MTX/BEI&/MTX/STE
          NJN    PNE5        IF NOT TAPE MARK
          LDC    LDNI+/MTX/BEI  SET TO RETURN TAPE MARK IF READ LABELS
          STM    POTG
          UJN    PNE4        SET TO ISSUE MESSAGE
 POT      SPACE  4,15
**        POT - POSITION TAPE.
*
*         ENTRY  TAPE IS POSITIONED AFTER THE BAD PRU.
*                (EP) AND (EP+1) CONTAIN CURRENT RECOVERY CONDITIONS.
*
*         EXIT   (CN - CN+4) = CORRECT *IN* POINTER.
*                TAPE IS POSITIONED BETWEEN LAST GOOD RECORD AND
*                BAD PRU.  (EP) AND (EP+1) CONTAIN NEXT RECOVERY
*                CONDITIONS.
*
*         CALLS  BKS, CEC, CFC, CIF, CKR, *EMM*, FCN, HNG, ITM, POS,
*                RDA, *RLA*, RSP, SCL, UBW, WIP.
*
*         MACROS CALL.
 
 
 POT      SUBR               ENTRY/EXIT
          LDD    EP+1        SAVE PARAMETERS FOR POSSIBLE RECOVERY
          STM    POTO+1
          LDD    EP
          STM    POTO
          LPN    77
          NJN    POT1        IF NOT FIRST ENTRY
          LDC    200         SET INITIAL RETRY COUNT TO 2
          STD    EP+1
 
*         CHECK FOR LEGAL REENTRY CODE.  SET RECOVERY PROCESS ADDRESS.
 
          LDN    2
 POT1     SBN    2
          STD    T1
          SBN    POTCL
          PJN    POT2        IF INCORRECT
          LDD    T1
          LPN    1
          ZJN    POT3        IF VALID
 POT2     RJM    HNG         HANG PP (NO RETURN)
 
*         SET UP ERROR RECOVERY PROCESS.
 
 POT3     LDM    POTC,T1     SET PROCESSING ADDRESS
          STM    POTB        STORE IN JUMP
          LDM    POTC+1,T1
          STD    SC
          SHN    21-12
          PJN    POT4        IF NOT OPPOSITE PARITY MODE
          LDC    -2000       CLEAR OPPOSITE PARITY FLAG
          RAD    EP
 POT4     LDM    REMI
          ZJN    POT5        IF NOT ACCEPT DATA
          LDM    REMF        UPDATE BID WINDOW
          STM    UBWB
          RJM    UBW
          LDN    0           CLEAR ERROR CODE
          STD    EC
          LJM    POT13       CLEAR ERROR PARAMETER
*         LJM    POT11       (RECOVERED TAPE MARK OR NOISE)
 POTA     EQU    *-1
 
*         SET UP PRESET CONDITIONS AND JUMP TO ERROR PROCESSOR.
 
 POT5     LDN    ZERL        PRESET CONDITIONS
          CRD    T4
          LDD    EC
          STD    T4
          LMN    /MTX/BEI
          LJM    *           JUMP TO PROCESSOR
 POTB     EQU    *-1         ADDRESS SET UP FROM TABLE *POTC*
 
**        LIST OF RETURN PROCESSORS INDEXED BY REENTRY CODE (EP 5-0).
*
*T,       12/ ADDRESS,1/R,1/P
*         R      REVERSE DIRECTION MODE.
*         P      OPPOSITE PARITY MODE.
 
 POTC     BSS    0           LIST OF PROCESSORS INDEXED BY REENTRY CODE
          LOC    0
          CON    POT17,0     EP 5-0 = 0 OR 2 CODE  (0 = FIRST ENTRY)
          CON    POT23,0     EP 5-0 = 4 CODE
          CON    POT23,2000  EP 5-0 = 6 CODE
          CON    POT29,0     EP 5-0 = 10 CODE
          CON    POT34,0     EP 5-0 = 12 CODE
          LOC    *O
 POTCL    EQU    *-POTC
 
*         COMMON CODE FOR ALL ERROR PROCESSORS TO DO THE REREAD OF
*         THE BAD PRU.
 
 POT6     CON    0           RETURN ADDRESS OF ERROR PROCESSOR
          STD    T1          SAVE REENTRY CODE
 POTD     AOD    EI          INCREMENT ERROR ITERATION
*         PSN                (7 TRACK F FORMAT, FIRST RETRY)
          LDD    CP          CHECK CONTROL POINT ERROR FLAGS
          ADN    STSW
          CRD    CM
          LDD    CM+1
          LPN    37
          SBN    SPET
          MJN    POT7        IF NO ERROR *SPET* OR ABOVE
          LDN    /MTX/EFT    SET ERROR FLAG TERMINATION
          LJM    RET3        RETURN FATAL ERROR
 
*         FIND CURRENT REENTRY POINT.  SET UP REENTRY CODE IN (EP 5-0).
 
 POT7     LDD    EP          SET REENTRY CODE FOR RETURN
          LPC    700
          LMD    T1
          STD    EP          BITS 5 - 0 = REENTRY CODE, CLIPPING FLAGS
          LDM    POTC-1,T1   LOAD DIRECTION/PARITY FLAGS FROM TABLE
          LPC    7000
          RAD    EP
          LPC    7000
          RAM    POTE
          LDD    EP          CHECK NEED TO TOGGLE PARITY FOR NEXT READ
          SHN    21-12
          PJN    POT7.1      IF NOT OPPOSITE PARITY MODE
          LDN    5           TOGGLE PARITY MODE FOR NEXT READ
          RJM    FCN         FUNCTION TO TOGGLE ODD/EVEN PARITY MODE
 POT7.1   LDC    0
 POTE     EQU    *-1         DIRECTION/PARITY FLAGS (EP 11-10)
          NJN    POT8        IF CANNOT REQUEUE
          LJM    RET2        REQUEUE
 
*         CHECK OPERATION AND REREAD PRU.
 
 POT8     RJM    RSP         RESET PARAMETERS
          LDD    FN
          LMN    /MTX/RLA
          NJN    POT9        IF NOT READ LABELS
          LDC    /RLA/CLA4   SET TO RELOAD ERROR PROCESSOR
          STM    /READ/MRD
 POT9     RJM    CKR         CHECK READY
          LJM    POT10
 POTI     EQU    *-1
*         LJM    RLB         (LONG BLOCK)
*         LJM    RLI         (LI FORMAT)
 
 POT10    LDC    *           RESET CORRECT READ FUNCTION
 POTF     EQU    *-1
          STM    //ITMA
          RJM    ITM         INITIATE TAPE MOTION
          LJM    /READ/MRD+1 RETURN TO READ DRIVER
 
*         COMMON CODE IF NO ERROR OR ERROR HAS BEEN RECOVERED.
 
 POT11    LDM    POTO+1      RESTORE EP AND EP+1
          STD    EP+1
          LDM    POTO
          STD    EP
          SHN    -3          CHECK IF DIFFERENT CLIP LEVEL
          LPN    70
          ZJN    POT12       IF NORMAL CLIP
 
*         SET BLOCK ID TO INVALID WITH CLIP LEVEL IN BITS 5-3.
 
          LMN    4           SET BLOCK RECOVERED AT ALTERNATE CLIP
          STM    BIDW,WP
          LDN    0
 POT12    STD    EC
          LDM    REMF        RESTORE BID
          STM    UBWB
          LDM    POTF        RESET CORRECT READ FUNCTION
          STM    //ITMA
          CALL   EMM         ISSUE RECOVERED MESSAGE
          RJM    CFC         CONNECT IF NEEDED
 POT13    LDN    0           CLEAR ERROR PARAMETER
          STD    EI
          STD    EP
          STD    EP+1
          LDD    FN
          LMN    /MTX/RLA
          ZJN    POT14       IF READ LABELS
          RJM    RSP         RESET PARAMETERS FOR NEXT OPERATION
          LDD    MA          RESTORE IN POINTER
          CWM    INPA,ON
          LDD    MA
          CRD    CN
          LJM    POTX        RETURN
 
*         RELOAD READ LABELS OVERLAY.
 
 POT14    LDN    0           SET ERROR CODE
*         LDN    /MTX/BEI    (RECOVERED TAPE MARK)
 POTG     EQU    *-1
          STD    EC
 POT15    LDM    CECB
          LPN    77
          ZJN    POT16       IF AT MAGNET CONTROL POINT
          LDN    0           CHANGE TO MAGNET,S CP
          RJM    CEC
 POT16    CALL   RLA         RELOAD READ LABELS OVERLAY (NO RETURN)
 
*         ENTRY POINT FOR PROCESSOR ONE  (EP 5-0) = 2.
 
 POT17    LDD    EC          LOAD ERROR CODE
          NJN    POT18       IF ERROR
          LJM    POT11       IF NO ERROR ON LAST REREAD
 
*         NON - NOISE ERROR RECOVERY.
 
 POT18    LDD    EP+1        SET RETRY COUNT TO 5
          LPC    3077
          LMC    500
          STD    EP+1
 POT19    LDD    EP+1        SET PARITY REREAD COUNTS
          SCN    77
          LMN    52          NORMAL REREAD=5, OPPOSITE REREAD=2
          STD    EP+1
          SHN    -11
          ZJN    POT20       IF NOT ALTERNATE CLIPPING LEVEL
          LCN    30          REDUCE RETRY ATTEMPTS
          RAD    EP+1
 POT20    LDD    EP+1
          LPC    3000
          SHN    -3
          LMD    EP
          LPC    300
          ZJN    POT21       IF CORRECT CLIPPING LEVEL
          LDD    EP+1
          SHN    -11
          RJM    SCL
 POT21    LDN    1
*         LDN    0           (ATTEMPT OPPOSITE PARITY)
 POTH     EQU    *-1
          NJN    POT22       IF NOT 7-TRACK F FORMAT, FIRST RETRY
          STM    POTD        SET TO NOT COUNT ITERATION
          LDC    UJNI-NJNI   PREVENT BID WINDOW UPDATE
          RAM    /READ/MRDP
          LJM    POT27       BACKSPACE
 
*         REREAD MANY TIMES.
 
 POT22    RJM    CIF         CHECK INTERNAL FORMAT
          RJM    BKS         BACKSPACE
          RJM    POS         POSITION TO LAST GOOD RECORD
          LDN    4           SET REENTRY CODE TO 4 (POT27)
          RJM    POT6        JUMP TO COMMON CODE TO REREAD (NO RETURN)
 
*         ENTRY POINT FOR PROCESSOR TWO  (EP 5-0) = 4.
 
 POT23    NJN    POT24       IF NOT TAPE MARK
          LJM    POT38       PROCESS RECOVERED ERROR
 
 POT24    LDD    EC          LOAD ERROR CODE
          NJN    POT25       IF ERROR
          LJM    POT38       PROCESS RECOVERED ERROR
 
 POT25    LDD    EP+1
          LPN    70
          ZJN    POT26       IF RETRIES EXHAUSTED
          LCN    10
          RAD    EP+1
          UJN    POT22       REREAD
 
*         CHECK FOR SEVEN OR NINE TRACK UNIT.
 
 POT26    LDD    HP
          LPN    1
          NJN    POT28       IF 9 TRACK TAPE
          LDD    EP+1
          SHN    -11
          NJN    POT28       IF OPTIONAL CLIPPING BEING TRIED
          LDD    EP+1
          LPN    7
          ZJN    POT28       IF OPPOSITE PARITY ATTEMPTS MADE
 POT27    SOD    EP+1
          RJM    BKS         BACKSPACE
          RJM    POS         POSITION TO LAST GOOD RECORD
          LDN    6           SET REENTRY CODE TO 6 (POT27)
          RJM    POT6        JUMP TO COMMON CODE TO REREAD (NO RETURN)
 
*         CLEAN THE TAPE.
*         THIS IS NOT PERFORMED ON RETRIES AT OPTIONAL CLIP LEVELS.
 
 POT28    LDD    EP+1
          SHN    -11
          NJN    POT31       IF OPTIONAL CLIPPING LEVEL
          RJM    BKS         BACK OVER BAD RECORD
          RJM    POS         POSITION TO LAST GOOD RECORD
 
*         REREAD THE ERROR BLOCK NON - STOP.
 
          AOM    POTE        SET NO REQUEUE
          LDN    10          SET REENTRY CODE TO 10 (POT41)
          RJM    POT6        JUMP TO COMMON CODE TO REREAD (NO RETURN)
 
*         ENTRY POINT FOR PROCESSOR FOUR  (EP 5-0) = 10.
 
 POT29    LDD    EC
          NJN    POT30       IF ERROR
          LJM    POT11       ISSUE RECOVERED MESSAGE
 
*         RETRY THE ALGORITHM.
 
 POT30    LDC    -100
          RAD    EP+1
          LPC    700
          ZJN    POT31       IF RETRIES EXHAUSTED
          LJM    POT19       SET PARITY REREAD COUNTS
 
*         TRY THE OTHER CLIPPING LEVELS.
 
 POT31    RJM    BKS         BACKSPACE OVER BAD PRU
          LDD    EP+1
          SBD    TH
          PJN    POT32       IF NOT FIRST TIME
          ADC    3000        SET FIRST CLIP LEVEL TO TRY
 POT32    STD    EP+1
          SHN    -11
 POTM     ZJN    POT33       IF ALL CLIPPING LEVELS EXHAUSTED
*         UJN    POT33       (FSC ADAPTOR AND NINE TRACK UNIT)
          RJM    SCL         SELECT NEW CLIP LEVEL
 
*         RESET RETRY COUNT FOR FORWARD REREADS.
 
          LDD    EP+1        RESET RETRY COUNT
          LPC    3077
          LMC    200
          STD    EP+1
          LDN    2           SET UP REENTRY CODE TO 2 (POT22)
          RJM    POT6        JUMP TO COMMON CODE (NO RETURN)
 
 POT33    LDD    FN          LEAVE POSITIONED BEFORE BLOCK IF LABEL
          LMN    /MTX/RLA
          ZJN    POT35       IF READ LABELS
          LDN    12          SET UP REENTRY CODE TO 12 (POT46)
          RJM    POT6        JUMP TO COMMON CODE (NO RETURN)
 
*         ENTRY POINT FOR PROCESSOR FIVE  (EP 5-0) = 12.
 
 POT34    LDN    4           SET UNUSABLE BID
          STM    UBWB
          RJM    UBW         UPDATE BID WINDOW
          LDD    EC
          LMN    /MTX/BTL
          NJN    POT35       IF NOT *BLOCK TOO LARGE*
          RJM    BKS         INSURE POSITIONED PAST BAD BLOCK
          RJM    RDA         SKIP BLOCK
 POT35    LDD    FN
          LMN    /MTX/RDF
          ZJN    POT36       IF READ
          LJM    RET4        RETURN FATAL ERROR
 
*         UNRECOVERABLE READ ERROR.
 
 POT36    LDM    FETO
          SHN    21-10
          PJN    POT37       IF ERROR PROCESSING NOT SET
          RJM    RSP         RESET PARAMETERS
          RJM    WIP         WRITE IN POINTER TO BUFFER
          LDD    MD
          SHN    21-5
          PJN    POT37       IF NOT 200 READ
          LDD    CN+3        READ CONTROL WORD
          SHN    6
          ADD    RA
          SHN    6
          ADD    CN+4
          CRD    CM
          LDC    4000        SET UNRECOVERED ERROR INDICATION
          RAD    CM
          LDD    CN+3        REWRITE CONTROL WORD
          SHN    6
          ADD    RA
          SHN    6
          ADD    CN+4
          CWD    CM
 POT37    LDC    RET4        SET TO GIVE FATAL USER ERROR
          STM    /READ/WCBD
 POTR     EQU    *-1
*         STM    /RLI/UIPC   (LI FORMAT)
          LJM    POT13       CLEAR ERROR PARAMETER
 
*         ERROR RECOVERED.
 
 POT38    LDM    POTO
          SHN    21-12
          MJN    POT39       IF OPPOSITE PARITY MODE
          LJM    POT11       ISSUE RECOVERED MESSAGE
 
 POT39    LDD    FM
          SHN    -6
          LMN    /MTX/TFF
          NJN    POT40       IF NOT F FORMAT
          RJM    BKS
          RJM    POS         POSITION TO LAST GOOD RECORD
          LDN    0           CLEAR ERROR PARAMETERS
          STD    EI
          STD    EP
          STD    EP+1
          LDD    MD          TOGGLE MODE
          LMC    100
          STD    MD
          LDD    UP
          LMN    1
          STD    UP
          LJM    RET2        REQUEUE
 
*         TAPE RECOVERED IN OPPOSITE PARITY MODE.
 
 POT40    LDN    /MTX/OPA    TAPE WRITTEN IN OPPOSITE PARITY
          STD    EC
          LDD    FN
          LMN    /MTX/RLA
          ZJN    POT41       IF READ LABELS
          LDM    REMF        RESTORE BID
          STM    UBWB
          CALL   EMM
          AOD    BL+1        INCREMENT BLOCK COUNT
          SHN    -14
          RAD    BL
          RJM    CFC         CONNECT IF NEEDED
          LJM    RET4        RETURN FATAL ERROR
 
 POT41    LJM    POT15       RELOAD READ LABELS
 PTM      SPACE  4,10
**        PTM - PROCESS TAPE MARK.
*
*         EXIT   IF NOT LABELED, EOF STATUS SET IN (RS) AND (MD).
*                (REMF) SET TO 1 IF TAPE MARK.
 
 
 PTM4     LDN    /MTX/BEI    RETURN POSSIBLE EOI
          RAM    REMG
 
 PTM      SUBR               ENTRY/EXIT
          LDN    1           SET TAPE MARK INDICATION
          STM    REMF
          LDD    EP
          LPN    77
          ZJN    PTM1        IF FIRST ENTRY
          LDC    POT11       SET RECOVERED TAPE MARK
          STM    POTA
          LDC    LDNI+/MTX/BEI  SET TO RETURN TAPE MARK IF READ LABELS
          STM    POTG
 PTM1     LDD    FN
          LMN    /MTX/RLA
          ZJN    PTMX        IF READ LABELS
          LDD    LT
          SHN    21-12
          MJN    PTM4        IF LABELED
          LDD    DS
          LPN    10
          NJN    PTM4        IF EOT
          LDD    FM
          SHN    -6
          SBN    /MTX/TFSI+1
          MJN    PTM4        IF INTERNAL MODES
          SBN    /MTX/TFLI-/MTX/TFSI-1
          ZJP    PTM4        IF LI FORMAT
          LDD    MD          SET EOF STATUS
          SCN    14
          LMN    10
          STD    MD
          LDN    2
          STD    TB
          LDD    FM
          SHN    -6
          LMN    /MTX/TFS
          ZJN    PTM2        IF S FORMAT
          LMN    /MTX/TFL&/MTX/TFS
          NJN    PTM3        IF NOT L FORMAT
 PTM2     LDM    //CIOE
          LPC    770
          LMC    260
          NJN    PTM3        IF NOT 260 READ CODE
          LDN    26          SET TO RETURN 271 STATUS
          STD    TB
 PTM3     LJM    PTMX        RETURN
          TITLE  SUBROUTINES.
 ABC      SPACE  4,10
**        ABC - ADJUST BYTE COUNT FOR 9 TRACK TAPES.
*
*         ENTRY  (BY) = BYTE COUNT.
*                (DS) = DEVICE STATUS.
*
*         (ABCA) = 0 IF NO BYTE ADJUSTMENT.
 
 
 ABC      SUBR               ENTRY/EXIT
          LDD    HP
          LPN    1
          ZJN    ABCX        IF 7 TRACK
 
*         CORRECT 9 TRACK BYTE COUNT.
 
 ABCA     LDD    DS
*         UJN    ABC1        (ATS UNIT)
          LPN    40
          ZJN    ABC1        IF NO ODD COUNT
          LDD    BY
          LPN    2
          ZJN    ABC1        IF NOT MODULO 4, 2 OR 3
          SOD    BY
 
*         ADJUST BUFFER LENGTH FOR I FORMAT.
 
 ABC1     LDD    FM
          SHN    -6
*         LMN    /MTX/TFI
          ERRNZ  /MTX/TFI
          NJN    ABCX        IF NOT I FORMAT
          LDD    BY
          ZJN    ABCX        IF NO DATA READ
          SBN    1
          ZJN    ABCX        IF POSSIBLE TAPE MARK READ
          STD    T2          CALCULATE WORD COUNT
          SHN    1           13*BYTES
          ADD    T2
          SHN    2
          ADD    T2
          SHN    14  (-6)    (13*BYTES)/64
          STD    T0
          SHN    6+2         4*13*BYTES  (52*BYTES)
          SBD    T2          51*BYTES
          ADD    T0          (51*BYTES)+((13*BYTES)/64)
          SHN    -8D         WORDS = ((51*BYTES)+((13*BYTES)/64))/256
          LPN    1
          STM    ABCB        SET EXIT CONDITION
          LJM    ABCX        RETURN
 
 
 ABCB     CON    0
 BKS      SPACE  4,10
**        BKS - BACKSPACE TAPE.
*
*         EXIT   (A) = NEGATIVE IF BOT.
*
*         CALLS  CKR, FCN, RTR, STW, WFC.
 
 
 BKS      SUBR               ENTRY/EXIT
          LDN    2           WAIT NOT BUSY
          RJM    STW
          RJM    CKR         CHECK READY
          LDC    F0113       BACKSPACE
 BKSA     EQU    *-1
          RJM    FCN
          RJM    WFC         WAIT FUNCTION COMPLETE
          LDD    DS          RETURN LOAD POINT STATUS
          SHN    21-2
          UJN    BKSX        RETURN
 BTW      SPACE  4,10
**        BTW - BUILD TEMPORARY WINDOW.
*
*         ENTRY  (A) = NUMBER OF BLOCKS TO MOVE BACK.
*
*         EXIT   (TBDW) = TEMPORARY BID WINDOW IF FIRST BKSP NOT AT
*                         LOAD POINT.
*
*         USES   T8, T9.
*
*         CALLS  BKS, SOB.
 
 
 BTW      SUBR               ENTRY/EXIT
          STD    T8          SAVE ENTRY CONDITION
          LDC    F0113       INSURE BACKSPACE FUNCTION SET
          STM    BKSA
          LDN    4           SETUP FIRST BID BYTE
          STM    TBDW
 BTW1     RJM    BKS         BACKSPACE
          MJN    BTW2        IF BOT
          SOD    T8
          NJN    BTW1        LOOP FOR NEXT BLOCK
 BTW2     LDM    POSB        SET BID POINTER
          STD    T9
          LDM    POSA        CHECK FOR LOAD POINT ON FIRST BKSP
          SBD    T8
          ZJN    BTWX        IF FIRST BKSP AT LOAD POINT
          LDN    0           CLEAR PRU COUNTER
          STD    T8
 BTW3     RJM    SOB         SET UP AND READ ONE BLOCK
          LDM    UBWB
          STM    TBDW+1,T8
          AOD    T9          INCREMENT POINTER
          LPN    7           RESET POINTER FOR POSSIBLE WRAP AROUND
          STD    T9
          AOD    T8
          LMM    POSA
          NJN    BTW3        LOOP FOR NEXT BLOCK
          LJM    BTWX        RETURN
 CBW      SPACE  4,15
**        CBW - COMPARE BID WINDOWS.
*
*         COMPARE THE PERMANENT WINDOW (BIDW) TO THE TEMPORARY
*         WINDOW (TBDW).
*
*         ENTRY  (T1) = FIRST BYTE IN BIDW TO COMPARE.
*                (T2) = FIRST BYTE IN TBDW TO COMPARE.
*
*         EXIT   (A) = 0 IF MATCH OR NOT BLOCK ID EQUIPMENT.
*                (A, 13-6) = NUMBER OF INVALID BLOCK ID-S.
*                (A, 5-0) = NUMBER OF VALID BLOCK ID MISMATCHES.
*
*         USES   T1 - T4.
 
 
 CBW      SUBR               ENTRY/EXIT
          LDD    CF          CHECK IF BLOCK ID EQUIPMENT
          LPC    300
          LMC    300
          ZJN    CBWX        IF NO BLOCK ID
          LDN    0
          STD    T4
          STD    T3
          LDD    T1          SAVE (T1)
          STM    CBWA
 CBW1     LDM    BIDW,T1     LOAD HISTORY BLOCK ID
          LMN    4
          ZJN    CBW3        IF INVALID BID IN HISTORY
          LDM    TBDW,T2     LOAD BID FROM TEMP WINDOW
          LMN    4           INVALID CHECK
          NJN    CBW2        IF NOT INVALID BID IN TEMP WINDOW
          AOD    T3          CHECK NEXT BID
          UJN    CBW3        CONTINUE
 
 CBW2     LDM    BIDW,T1     LOAD BID FROM HISTORY
          LMM    TBDW,T2
          ZJN    CBW3        IF NO ERROR
          AOD    T4
 CBW3     LDD    WP
          SBM    CBWA
          ZJN    CBW4        IF ONLY ONE BLOCK ID TO COMPARE
          AOD    T2
          AOD    T1          INCREMENT POINTER
          LPN    7           RESET POINTER FOR POSSIBLE WRAP AROUND
          STD    T1
          LMD    WP
          NJN    CBW1        IF NOT END OF COMPARE
 CBW4     LDD    T3          FORM BID COMPARE RESULTS EXIT
          SHN    6
          ADD    T4
          LJM    CBWX        RETURN
 
 
 CBWA     CON    0           STORAGE FOR (T1)
 CFC      SPACE  4,10
**        CFC - CHECK IF CONNECT NEEDED.
*
*         ENTRY  (RELA) = 0 IF CONNECT NEDDED.
*
*         CALLS  CUI.
 
 
 CFC      SUBR               ENTRY/EXIT
          LDD    DS
          SHN    21-11
          PJN    CFC1        IF UNIT CONNECTED
          LDN    0
          STM    //RELA
 CFC1     LDM    //RELA
          NJN    CFCX        IF CONNECTED
          STD    T1          SAVE DETAILED STATUS
 CFC2     LDM    MTDS,T1
          STM    POTQ,T1
          AOD    T1
          LMN    10
          NJN    CFC2        IF NOT END OF DETAILED STATUS
          RJM    CUI         CONNECT UNIT
          LDN    0           RESTORE DETAILED STATUS
          STD    T1
 CFC3     LDM    POTQ,T1
          STM    MTDS,T1
          AOD    T1
          LMN    10
          NJN    CFC3        IF NOT END OF DETAILED STATUS
          UJN    CFCX        RETURN
 CIF      SPACE  4,10
**        CIF - CHECK INTERNAL FORMAT (I AND LI).
*
*         CALLS  BKS, RDA.
 
 
 CIF2     RJM    BKS         BACKSPACE
 
 CIF      SUBR               ENTRY/EXIT
          LDD    EC
          LMN    /MTX/BNE
          NJN    CIFX        IF NOT BLOCK NUMBER ERROR
          LDM    //BNEI
 CIFA     EQU    *-1
*         LDM    /RLI/VDAE   (LI FORMAT)
          LMD    BY
 CIFB     EQU    *-1
*         PSN                (LI FORMAT)
          NJN    CIFX        IF BLOCK LENGTH ERROR
          LDD    EI
          SCN    7
          NJN    CIF1        IF 10 ATTEMPTS
          LDM    //BNEI+2
          SBD    BL+1
          ZJN    CIFX        IF CORRECT BLOCK
          PJN    CIF2        IF MISSED A BLOCK
          RJM    RDA         SKIP OVER BLOCK
          UJN    CIFX        RETURN
 
 CIF1     LDM    //BNEI+1    SET BLOCK NUMBER TO CURRENT BLOCK NUMBER
          STD    BL
          LDM    //BNEI+2
          STD    BL+1
          LJM    RET4        RETURN FATAL ERROR
 CIS      SPACE  4,10
**        CIS - CHECK IF ISMT GCR SKIP REVERSE.
*
*         CALLS  BKS.
 
 
 CIS      SUBR               ENTRY/EXIT
          LDD    FN
          LMN    /MTX/SKP
          NJN    CISX        IF NOT SKIP FUNCTION
          LDM    /READ/ISKR
          ZJN    CISX        IF NOT ISMT GCR SKIP REVERSE
          RJM    BKS         POSITION TAPE CORRECTLY FOR RECOVERY
          LDN    F0013       SET FORESPACE FUNCTION
          STM    BKSA
          LDN    0           FORCE REQUEUE
          STM    POTE+1
          UJN    CISX        RETURN
 
 CKR      SPACE  4,10
**        CKR - CHECK READY.
*         IF UNIT NOT READY, A TIME OUT WILL BE PERFORMED WAITING FOR
*         UNIT TO BECOME READY BEFORE GIVING A FATAL ERROR.  THIS
*         SHOULD ALLOW RECOVERY FROM MOMENTARY NOT READY CONDITONS.
*
*         CALLS  CFC, FCN.
 
 
 CKR      SUBR               ENTRY/EXIT
          LCN    0           PRESET TIME OUT
          STM    CKRA
 CKR1     LDN    F0012       GET STATUS
          RJM    FCN
          ACN    CH
          IAN    CH+40B
          DCN    CH+40
          SHN    21-0
          MJN    CKRX        RETURN IF READY
          SHN    22-11
          PJN    CKR2        IF UNIT CONNECTED
          RJM    CFC         CONNECT UNIT
 CKR2     SOM    CKRA
          NJN    CKR1        IF NO TIME OUT
          LDN    /MTX/RDR    READY DROP
          LJM    RET3        RETURN ERROR CODE
 
 
 CKRA     CON    7777        TIME OUT COUNTER
 IMU      SPACE  4,10
**        IMU - ISSUE MESSAGE TO ERROR LOG AND UNLOAD TAPE.
*
*         ENTRY  (A) = *TCF* OR *BFR*.
*
*         EXIT   TO *RET4*.
*
*         CALLS  *EMM*, FCN, WFC.
 
 
 IMU      BSS    0           ENTRY
          STD    EC
          CALL   EMM         ISSUE MESSAGE TO ERROR LOG
          AOD    EI
          LDC    F0110
          RJM    FCN         UNLOAD THE TAPE
          RJM    WFC         WAIT END OF OPERATION
          LJM    RET4        RETURN ERROR CODE
 POS      SPACE  4,15
**        POS - POSITION TAPE.
*
*         ENTRY  (POSA) = NUMBER OF BLOCKS TO BACKUP.
*                TAPE POSITIONED BEFORE BAD BLOCK.
*
*         EXIT   TAPE POSITION VERIFIED.
*                SINGLE BLOCK MISPOSITION MESSAGES ISSUED AS NEEDED.
*
*         USES   T1, T2, T9.
*
*         CALLS  BKS, BTW, CBW, CFC, *EMM*, SOB.
*
*         MACROS CALL.
 
 
 POS5     STD    EC
          LDM    REMF        RESTORE BID
          STM    UBWB
          CALL   EMM         ISSUE ERROR MESSAGE
          RJM    CFC         CONNECT IF NEEDED
 
 POS      SUBR               ENTRY/EXIT
          LDD    WP
          SBM    POSA
          ADN    1
          PJN    POS1        IF NO WRAP AROUND
          ADN    10
 POS1     STM    POSB        STORE STARTING POINTER
          LDC    0
 POSA     EQU    *-1
          RJM    BTW         BUILD TEMPORARY WINDOW
          LDN    1
          STD    T2
          LDC    *
 POSB     EQU    *-1
          STD    T1
          RJM    CBW         COMPARE WINDOWS
          ZJN    POSX        IF GOOD COMPARE
          SHN    -6          CHECK FOR INVALIDS IN RECOVERY WINDOW
          NJN    POSX        IF INVALIDS
          LDN    2           CHECK FOR TOO FAR BACKWARD
          STD    T2
          LDM    POSB
          STD    T1
          RJM    CBW
          LPN    77          CHECK FOR ONLY MISCOMPARES
          NJN    POS3        IF NOT TOO FAR BACKWARD
          LDD    WP
          STD    T9
          RJM    SOB         SET UP AND READ ONE BLOCK
          LDM    UBWB
          LMM    BIDW,WP
          NJN    POS2        IF POSITION LOST
          LDN    /MTX/SMB    ISSUE SINGLE BLOCK MISPOSITION MESSAGE
          LJM    POS5        ISSUE ERROR MESSAGE
 
 POS2     LDN    /MTX/PLO    ISSUE POSITION LOST MESSAGE
          STD    EC
          LDM    REMF        RESTORE ORIGINAL BID FOR MESSAGE
          STM    UBWB
          CALL   EMM         ISSUE MESSAGE
          RJM    CFC         CONNECT IF NEEDED
          LJM    RET4        RETURN FATAL ERROR
 
 POS3     LDN    0           CHECK FOR TOO FAR FORWARD
          STD    T2
          LDM    POSB
          STD    T1
          RJM    CBW
          LPN    77          CHECK FOR ONLY MISCOMPARES
 POS4     NJN    POS2        IF POSITION LOST
          RJM    BKS         CORRECT FOR TOO FAR FORWARD AND RETRY
          LDM    POSA
          RJM    BTW
          LDN    1
          STD    T2
          LDM    POSB
          STD    T1
          RJM    CBW
          LPN    77          CHECK FOR ONLY MISCOMPARES
          NJN    POS4        IF POSITION LOST
          LDN    /MTX/SMF    ISSUE SINGLE BLOCK MISPOSITION MESSAGE
          LJM    POS5        ISSUE ERROR MESSAGE
 RCI      SPACE  4,10
**        RCI - READ *CIO* INFORMATION FROM *MAGNET,S FL.
*
*         EXIT   (T6 - T7) = FET ADDRESS.
*                (T1 - T5) = UCIC WORD.
*
*         USES   CM - CM+4.
*
*         CALLS  HNG.
*
*         MACROS DELAY, MONITOR, PAUSE.
 
 
 RCI3     LDD    MA          READ UDT WORDS
          CRD    T6-3
          ADN    2
          CRD    T1
 
 RCI      SUBR               ENTRY/EXIT
 RCI1     LDM    UADA        SET FWA OF DESIRED UDT WORDS
          ADN    /MTX/UCIA
          STD    CM+4
          LDC    300         REQUEST THREE WORDS
          STD    CM+3
          LDN    0           REQUEST READ FROM *MAGNET*
          STD    CM+1
          LCN    7777-/SSD/MTSI  SET *MAGNET* SUBSYSTEM IDENTIFICATION
          STD    CM+2
          MONITOR TDAM
          LDD    CM+1
          ZJN    RCI3        IF DONE
          SBN    2
          PJN    RCI2        IF MOVE NOT IN PROGRESS
          PAUSE  NE
          DELAY
          UJN    RCI1        REISSUE REQUEST
 
 RCI2     RJM    HNG         HANG PP
 RDA      SPACE  4,10
**        RDA - READ DATA.
*
*         EXIT   (A) = (T4) = 0, NO ERROR.
*                (BY) = BYTE COUNT OF BLOCK.
*                (UBWB) SET TO 1 IF TAPE MARK.
*
*         CALLS  ABC, CKR, FCN, ITM, MCC, WEO.
 
 
 RDA      SUBR               ENTRY/EXIT
          RJM    CKR         CHECK FOR READY
          LDN    F0040       READ FORWARD
          RJM    FCN         PROCESS FUNCTION
          ACN    CH
 RDA1     LCN    0           SET DATA PARAMETERS
          STD    T3
          LDN    20
          STD    T2
          LDC    1010        SET BUFFER SIZE
 
*         INPUT DATA.
 
          STD    BY          INPUT FIRST 1010 BYTES (104D CM WORDS)
          IAM    EBUF,CH
          ZJN    RDA2        IF NOT END OF DATA
          LMC    -0
          RAD    BY
          LJM    RDA6        ADJUST BYTE COUNT
 
 RDA2     LDN    50
          IAM    XBUF,CH
          NJN    RDA3        IF END OF DATA
          SOD    T3
          NJN    RDA2        IF NOT END OF INPUT
          LDN    50
          IAM    XBUF,CH
          NJN    RDA3        IF END OF DATA
          SOD    T2
          NJN    RDA2        IF NOT TIME OUT
          LDD    EC          PRESERVE ERROR CODE
          RJM    MCC
          LCN    0
          STD    BY
          LJM    RDA7        WAIT FOR END OF OPERATION
 
 RDA3     LMC    -0
          ADN    50
          RAD    BY
 RDA4     AOD    T3
          SHN    -14
          NJN    RDA5        IF ROLLOVER
          LDN    50
          RAD    BY
          UJN    RDA4        LOOP
 
 RDA5     AOD    T2
          LMN    21
          ZJN    RDA6        IF ALL BYTES COUNTED
          LCN    0           SET BYTE COUNT TO 7777
          STD    BY
 RDA6     RJM    ABC         ADJUST BYTE COUNT
 RDA7     RJM    WEO         WAIT END OF OPERATION
          SCN    74
          ZJN    RDA9        IF NO ERRORS
          SHN    21-10
 RDAA     PJN    RDA8        IF NOT NOISE
*         UJN    RDA8        (ATS UNIT)
          LDN    42          ISSUE REPEAT READ
          RJM    FCN
          ACN    CH
          LJM    RDA1        REINITIATE READ
 
 RDA8     LDM    MTDS
          LPC    7077
 RDAB     EQU    *-1
*         LPC    7777
          ZJN    RDA9        IF ONLY WARNING STATUS
          LCN    0
 RDA9     STM    RDAC
          LDC    *           SET EXIT CONDITION
 RDAC     EQU    *-1
          STD    T4
          LDM    ABCB
          ZJN    RDA10       IF NO BYTE ADJUSTMENT
          SOD    BY
 RDA10    LDD    DS
          LPN    20
          LMN    20
          NJN    RDA11       IF NOT TAPE MARK
          STD    BY
          LDN    1           SET TAPE MARK INDICATION
          STM    UBWB
          LDD    HP
          LPN    1
          NJN    RDA11       IF 9 TRACK
          LDD    MD
          SHN    21-6
          MJN    RDA11       IF 7 TRACK CODED
          LDN    0           CLEAR ERROR INDICATION
          STD    T4
 RDA11    LDD    T4
          LJM    RDAX        RETURN
 RSP      SPACE  4,10
**        RSP - RESET PROCESSOR FOR NEXT OPERATION.
*
*         EXIT   (CN - CN+4) = IN POINTER PRIOR TO READ.
*
*         CALLS  /CPP/CAL, *CPP*, /CPP/INM, RCI, /CPP/SFP.
*
*         MACROS CALL.
 
 
 RSP      SUBR               ENTRY/EXIT
          LDM    /READ/WOCN  RESTORE WORD COUNT
          STD    WC
          CALL   CPP         RELOAD ADDRESS RELOCATOR
          LDD    FN
          LMN    /MTX/RDF
          NJN    RSPX        IF NOT READ DATA
          RJM    RCI         READ UDT
          RJM    /CPP/CAL    CALCULATE PARAMETERS
          LDN    2           READ IN
          RJM    /CPP/SFP
          UJN    RSPX        RETURN
 SCL      SPACE  4,10
**        SCL - SET CLIPPING LEVEL.
*
*         ENTRY  (A) = CLIPPING LEVEL DESIRED.
*
*         CALLS  FCN.
 
 
 SCL      SUBR               ENTRY/EXIT
          SHN    6
          STD    T1
          LDD    EP
          LPC    7077
          LMD    T1
          STD    EP
          LPC    300
          ZJN    SCLX        RETURN IF NORMAL CLIPPING LEVEL
          ADN    6
          RJM    FCN
          UJN    SCLX        RETURN
 SOB      SPACE  4,10
**        SOB - SET UP AND READ ONE BLOCK.
*
*         ENTRY  (T9) = POINTER TO BID WINDOW.
*
*         EXIT   (UBWB) = BID OF READ CORRECTED FOR CLIPPING LEVEL AND
*                READ ERRORS.
*
*         USES   T0.
*
*         CALLS  RDA, FCN.
 
 
 SOB2     RJM    RDA         READ A BLOCK
          ZJN    SOBX        IF GOOD READ
 SOB3     LDN    4           SET UNUSABLE BID
          STM    UBWB
 
 SOB      SUBR               ENTRY/EXIT
          LDD    MD          CHECK IF PARITY CHANGE NEEDED
          SHN    -5
          LMM    BIDW,T9
          LPN    2
          ZJN    SOB1        IF NO CHANGE NEEDED
          LDD    HP
          LPN    1
          NJN    SOB1        IF 9 TRACK
          LDN    5           TOGGLE TO OPPOSITE PARITY
          RJM    FCN
 SOB1     LDM    BIDW,T9     CHECK IF CHANGE IN CLIPPING LEVEL NEEDED
          SHN    21-2
          PJN    SOB2        IF NO CHANGE NEEDED
          LPN    7           SET CLIPPING LEVEL
          SHN    6
          ADN    6
          RJM    FCN
          RJM    RDA         READ A BLOCK
          NJN    SOB3        IF ERROR
          LDM    BIDW,T9     ADD CLIPPING LEVEL TO LAST BID
          LPN    74
          STD    T0
          LDM    UBWB
          SCN    74
          LMD    T0
          STM    UBWB
          LJM    SOBX        RETURN
 WFC      SPACE  4,10
**        WFC - WAIT BACKSPACE FUNCTION COMPLETE.
*         TIMES OUT APPROXIMATELY 25 FEET OF TAPE.
*
*         EXIT   (DS) = UNIT STATUS.
*
*         USES   T2.
*
*         CALLS  //STW.
 
 
 WFC2     CON    0           ENTERED VIA *RJM* FROM //STW
          SOD    T2
          NJN    WFC1        IF NOT TIMEOUT
          LDC    //ERR       RESET ERROR EXIT
          STM    //STWC
          UJN    WFC1        ATTEMPT 1 MORE WAIT
 
 WFC      SUBR               ENTRY/EXIT
          LDN    77          SET DELAY TO MAXIMUM
          STD    T2
          LDC    WFC2        SET RETURN ON TIMEOUT FROM //STW
          STM    //STWC
 WFC1     LDN    2           WAIT NOT BUSY
          RJM    //STW
          LDC    //ERR       RESET ERROR EXIT
          STM    //STWC
          UJN    WFCX        RETURN
 WIP      SPACE  4,15
**        WIP - WRITE IN POINTER PRIOR TO READ TO USER BUFFER.
*
*         ENTRY  (INPA - INPA+4) = POINTER TO NEXT BUFFER LOCATION.
*                (CN - CN+4) = IN POINTER PRIOR TO READ.
*
*         EXIT   IN POINTER WRITTEN TO USER CIO BUFFER.
*                PARITY ERROR BIT SET IN FET+0.
*
*         USES   CM - CM+4.
*
*         CALLS  RCI.
 
 
 WIP      SUBR               ENTRY/EXIT
          LDM    INPA+3      CALCULATE ABSOLUTE BUFFER ADDRESS
          SHN    6
          ADD    RA
          SHN    6
          ADM    INPA+4
          CWD    CN          WRITE OLD IN POINTER TO BUFFER
          RJM    RCI         READ UDT INFORMATION
          LDD    T6          READ FET+0
          SHN    6
          ADD    RA
          SHN    6
          ADD    T7
          CRD    CM
          LDD    CM+4        SET PARITY ERROR BIT
          LPC    777
          LMC    4000
          STD    CM+4
          LDD    CM+3
          SCN    3
          STD    CM+3
          LDD    T6          REWRITE FET+0
          SHN    6
          ADD    RA
          SHN    6
          ADD    T7
          CWD    CM
          LJM    WIPX        RETURN
          SPACE  4,10
 ADDR     TSAD   SMER
          SPACE  4,10
**        BUFFERS FOR READING DURING READ RECOVERY.
 
 
 EBUF     BSS    0
 XBUF     EQU    EBUF+1012
          ERRNG  7777-XBUF-50 WRAPPED AROUND
 ERROVL   SPACE  4,10
          ERROVL
 CTAB     SPACE  4,10
          SPACE  4,10
**        NOTE - CODE AFTER THIS POINT WILL BE DESTROYED WHEN CALLING
*         THE ERROR PROCESSOR *EMM* OR WHEN THE TAPE IS POSITIONED.
*         ALL CALLS TO THIS CODE MUST BE DONE PRIOR TO THAT POINT.
          SPACE  4,10
**        CTAB - CHANNEL TABLE.
 
 
 CTAB     CHTB
 EBW      SPACE  4,20
**        EBW - EVALUATE BID WINDOW.
*
*         ENTRY  (BIDW) = BID WINDOW.
*
*         EXIT   (POSA) = NUMBER OF BLOCKS TO BACKSPACE.
*                NUMBER OF BLOCKS TO BACKSPACE = 2 IF
*                  1) NO BID PRESENT.
*                  2) INVALID HISTORY BLOCK ID ENCOUNTERED.
*                  3) 9 TRACK *NRZI* *CRC* CORRECTABLE ERROR.  THIS IS
*                     BECAUSE OF HARDWARE RESTRICTIONS ON THE NEXT
*                     READ.
*                  4) .GT. 5 BLOCK ID-S ENCOUNTERED.
*                  5) END OF BLOCK ID WINDOW ENCOUNTERED.
*                (REMF) = BID FROM LAST READ.
*                (T2) = NUMBER OF DIFFERENT BLOCK ID-S.
*                (T4) = NUMBER OF SAME BLOCK ID-S.
*
*         USES   T1 - T4.
 
 
 EBW      SUBR               ENTRY/EXIT
          LDD    CF          CHECK IF BID PRESENT
          LPC    300
          LMC    300
          NJN    EBW2        IF BID PRESENT
 EBW1     LJM    EBW11       FORCE BACKSPACE OF TWO BLOCKS
 
 EBW2     LDM    UBWB        SAVE CURRENT BID
          STM    REMF
 EBW3     LDD    HP          CHECK IF 9 TRACK NRZI CRC CORRECTABLE ERROR
          LPN    1
          ZJN    EBW4        IF NOT 9 TRACK
          LDM    DNCV
          LPN    70
          LMN    /MTX/D08*10
          NJN    EBW4        IF NOT 800 (NRZI)
          LDM    MTDS+3
 EBWA     EQU    *-1
*         LDM    MTDS+6      (ATS CONTROLLER)
 EBWB     SHN    21-12
*         SHN    21-11       (ATS CONTROLLER)
          MJN    EBW1        IF CRC CORRECTABLE ERROR
 EBW4     LDD    WP          SET UP DIRECTS
          STD    T1
          LDN    0
          STD    T2
          STD    T4
          LCN    0
          STD    T3
 EBW5     LDD    T2          CHECK FOR MAX COUNT OF 5
          ADD    T4
          SBN    5
          PJN    EBW1        IF MAX COUNT REACHED, FORCE SET 2
          LDM    BIDW,T1
          LMN    4
          ZJN    EBW12       IF INVALID, STOP SCAN
          LPN    1
          ZJN    EBW7        IF NOT TAPE MARK
          AOD    T2          FORCE BACKSPACE OVER TAPE MARK
 EBW6     STM    POSA        SET BACKSPACE COUNT
          LJM    EBWX        RETURN
 
 EBW7     LDM    BIDW,T1
          SBD    T3
          NJN    EBW8        IF NOT SAME
          AOD    T4          INCREMENT SAME BID COUNT
          UJN    EBW9        CONTINUE BID SCAN
 
 EBW8     AOD    T2          INCREMENT DIFFERENT COUNT
          SBN    2
          MJN    EBW9        IF NOT TWO DIFFERENT BID-S
          LDD    T2
          ADD    T4
          UJN    EBW6        NUMBER OF BACKSPACES TO DO
 
 EBW9     LDM    BIDW,T1
          STD    T3          SAVE LAST BID
          SOD    T1          REDUCE POINTER
          PJN    EBW10       IF NO OVERFLOW
          LPN    7
          STD    T1
 EBW10    LMD    WP          CHECK FOR END OF WINDOW
          NJN    EBW13       IF NOT END OF BID WINDOW
 EBW11    LDN    2           FORCE BACKSPACE OF TWO BLOCKS
          UJN    EBW6        EXIT
 
 EBW12    LDD    T2
          ADD    T4
          ZJN    EBW11       IF END OF WINDOW
          UJN    EBW6        SET BACKSPACE COUNT AND EXIT
 
 EBW13    LJM    EBW5        CHECK NEXT BID
 LPR      SPACE  4,20
**        LPR - LOAD POINT RECOVERY.
*
*         ENTRY  DETAIL STATUS BUFFERS SET UP.
*
*         EXIT   (A) .LT. 0 IF NOT *TCF* OR *BFR* ERROR OR
*                           IF *TCF* OR *BFR* ERROR WAS RECOVERED.
*                (A) = 0 IF RETRY ON *BFR* ERROR.
*
*         ERROR  TO *IMU* IF LOAD POINT PROBLEM.
*                (A) = *TCF* OR *BFR*.
*
*         USES   T1.
*
*         CALLS  *EMM*, FCN, WFC.
*
*         MACROS CALL.
 
 
 LPR      SUBR               ENTRY/EXIT
          LDD    EC
          NJN    LPR0        IF ERROR
          RJM    DTS         GET DETAILED STATUS
 
*         SAVE CURRENT EQUIPMENT STATUS.
 
 LPR0     LDD    DS          SAVE GENERAL STATUS
          STM    LPRA
          LDM    UBWB        SAVE BLOCK ID
          STM    LPRB
          LDN    0           SAVE DETAIL STATUS
          STD    T1
 LPR1     LDM    MTDS,T1     MOVE ALL DETAIL STATUS WORDS
          STM    LPRC,T1
          AOD    T1          INCREMENT STATUS WORD COUNTER
          SBN    16
          NJN    LPR1        IF NOT ALL STATUS WORDS MOVED
          LDM    ATUS+2      GET DETAIL STATUS WORD 13
          SHN    21-2        POSITION CLEANER ACTIVE BIT
          PJN    LPR2        IF CLEANER PARKED
          LDD    EP          SET LOAD POINT ERROR FLAG
          LPC    6700
          ADC    1002
          STD    EP
          LDD    EP+1
          LPC    7077
          ADC    200
          STD    EP+1
          LDN    /MTX/TCF    CLEANER ACTIVE
          LJM    IMU         ISSUE MESSAGE TO ERROR LOG AND UNLOAD TAPE
 
 LPR2     LDM    MTDS        LOAD DETAIL STATUS WORD 3
          LPC    177         MASK ERROR CODES
          SBN    7
          ZJN    LPR4        IF ERROR CODE 7
          SBN    3
          ZJN    LPR4        IF ERROR CODE 12
          SBN    1
          ZJN    LPR4        IF ERROR CODE 13
          LDD    EC
          NJN    LPR3        IF NON-LOAD POINT ERROR
          LDD    EP
          SHN    21-11
          PJN    LPR3        IF NO PREVIOUS LOAD POINT ERROR
          LDN    0           CLEAR ERROR CODE
          STD    EC
          LDD    EP          CLEAR LOAD POINT ERROR FLAG
          LPC    6777
          STD    EP
 LPR3     LCN    1
          LJM    LPRX        RETURN NO LOAD POINT ERROR OR RECOVERED
 
 LPR4     LDD    EP          SET LOAD POINT ERROR FLAG
          LPC    6700
          ADC    1002
          STD    EP
          LDD    EP+1
          LPC    7077
          ADC    200
          STD    EP+1
          LDD    EI
          LPN    77          ERROR ITERATION
          ZJN    LPR6        IF FIRST TRY ON BAD HEADER
          LPN    7
          ZJN    LPR5        IF ITERATION IS A MULTIPLE OF 4
          SBN    4
          NJN    LPR6        IF NOT A MULTIPLE OF 4
 LPR5     LDN    /MTX/BFR    BAD PHASE/GCR HEADERS
          LJM    IMU         ISSUE MESSAGE TO ERROR LOG AND UNLOAD TAPE
 
*         REWIND TO LOAD POINT AND ATTEMPT REREAD.
 
 LPR6     LDN    F0010
          RJM    FCN         REWIND TAPE TO LOAD POINT
          RJM    WFC         WAIT FOR BACKSPACE TO COMPLETE
 
*         RESTORE EQUIPMENT ERROR STATUS BEFORE EXIT.
 
          LDN    0
          STD    T1
          LDM    LPRA        RESTORE GENERAL STATUS
          STD    DS
          LDM    LPRB        RESTORE BLOCK ID
          STM    UBWB
 LPR7     LDM    LPRC,T1     RESTORE ERROR STATUS
          STM    MTDS,T1
          AOD    T1          INCREMENT COUNTER
          SBN    16
          NJN    LPR7        IF NOT ALL STATUS WORDS MOVED
*         LDN    0
          LJM    LPRX        TRY TO REWRITE FROM LOAD POINT
 
 
 LPRA     CON    0           GENERAL STATUS
 LPRB     CON    0           BLOCK ID
 LPRC     BSSZ   16          DETAILED STATUS
 PRS      SPACE  4,10
**        PRS - PRESET.
*
*         CALLS  DME.
 
 
 PRS4     STM    REME        MTS - DO NOT CHECK FOR AGC FAILURE
          LDM    PRSD        DISABLE LOAD POINT RECOVERY
          STM    REMK
          LJM    PRS1        CHECK FOR LONG BLOCK PROCESSING
 
 PRS      SUBR               ENTRY/EXIT
          LDM    //ITMA      SAVE READ FUNCTION
          STM    POTF
          LDN    F0040       SET FORWARD READ
          STM    //ITMA
          LDD    HP
          LPN    20
          ZJN    PRS4        IF NOT ATS-TYPE CONTROLLER
 
*         MODIFY INSTRUCTIONS FOR ATS-TYPE CONTROLLER.
 
          LDM    PRSA
          STM    ABCA
          LDC    SHNI+66
          STM    REMC
          LCN    0
          STM    PNEE
          STM    REMA
          STM    RDAB
          LDC    UJNI-PJNI
          RAM    RDAA
          LDM    PRSB
          STM    PNEA
          LDC    MTDS+1
          STM    REMB
          LDN    MTDS+6-MTDS-3
          RAM    EBWA
          LDC    SHNI+21-11
          STM    EBWB
          LDD    HP
          LPN    1
          ZJN    PRS1        IF NOT NINE TRACK UNIT
          LDC    UJNI-ZJNI
          RAM    POTM        NO CLIP LEVEL CHANGES FOR NINE TRACK FSC
          LDD    FN
          SBN    /MTX/RDF
          NJN    PRS1        IF NOT READ FUNCTION
          LDD    FM
          SHN    -6
          SBN    /MTX/TFLI
          NJN    PRS1        IF NOT LI FORMAT
          STM    ADDR        NO INSTRUCTION MODIFICATION
          STM    CIFB
          STM    REML        NOT SKIPEI OR POSMF
          LDC    /RLI/VDAE
          STM    CIFA        *VDAE* = 0 IF CORRECT BLOCK LENGTH
          LDC    /RLI/UIPC
          STM    POTR        SET TO GIVE FATAL USER ERROR
          LDC    /RLI/RLI
          UJN    PRS2        SET ENTRY TO REREAD
 
 PRS1     LDM    /READ/TDAA
          NJN    PRS3        IF NOT LONG BLOCK
          LDC    RLB
 PRS2     STM    POTI        ENTRY TO REREAD
 PRS3     LJM    PRSX        RETURN
 
 
 PRSA     BSS    0
          LOC    ABCA
          UJN    ABC1        ADJUST BUFFER LENGTH
          LOC    *O
 
 PRSB     BSS    0
          LOC    PNEA
          UJN    PNE3        ISSUE ERROR MESSAGE
          LOC    *O
 
 PRSD     BSS    0
          LOC    REMK
          UJN    REM2.1      DISABLE LOAD POINT RECOVERY
          LOC    *O
          OVERLAY (CTS READ ERROR PROCESSOR.),(BUFB+5),P
 CRE      SPACE  4,10
**        CRE - CTS READ ERROR PROCESSOR.
*
*         ENTRY  (EC) = ERROR CODE.
*
*         CALLS  CEP, MCH, POS, PRS, PTM, RRA.
 
 
          ENTRY  CRE
 CRE      SUBR               ENTRY/EXIT
 
*         THE FOLLOWING CODE IS OVERLAID BY THE IN POINTER.
 
 CREA     EQU    *
          LDM    //LOV       SET RETURN ADDRESS
          STM    CRE
          LDC    CTAB        MODIFY CHANNELS
          RJM    MCH
          RJM    PRS         PRESET
          LDD    MA          SAVE IN POINTER
          CWD    CN
          CRM    CREA,ON
          LDD    DS
          LPN    1
          NJN    CRE1        IF READY
          LDN    /MTX/RDR    SET NOT READY
          STD    EC
 CRE1     LDD    EC
          LMN    /MTX/BEI
          NJN    CRE3        IF NOT TAPE MARK
          RJM    PTM         PROCESS TAPE MARK
 CRE2     UJN    CREX        RETURN
 
 CRE3     LDD    SP
          LPN    4
          ZJN    CRE6        IF ERROR PROCESSING ALLOWED
 CRE4     LDN    20
          STM    POSB        SKIP ONE BLOCK
          RJM    POS         POSITION TAPE PAST BAD BLOCK
          NJN    CRE5        IF ERROR
          RJM    CEP         CLEAR ERROR PARAMETERS
          UJN    CRE2        RETURN
 
 CRE5     LDN    0
          STM    POSB        INDICATE NO EXTRA BLOCK TO SKIP
 CRE6     LDD    FN
          LMN    /MTX/SKP
          NJN    CRE7        IF NOT SKIP OPERATION
          LDM    /READ/SKEI
          NJN    CRE4        IF SKIPEI OF POSMF
 CRE7     RJM    RRA         READ RECOVERY ALGORITHM
          UJN    CRE2        RETURN
 CEP      SPACE  4,10
**        CEP - CLEAR ERROR PARAMETERS.
*
*         EXIT   (CN+3, CN+4) = CORRECT IN POINTER.
*                TO *RLA* IF READ LABELS.
*
*         USES   CN - CN+3.
*
*         CALLS  CEC, RSP.
*
*         MACROS CALL.
 
 
 CEP      SUBR               ENTRY/EXIT
          LDN    0           CLEAR ERROR PARAMETER
          STD    EI
          STD    EP
          LDD    FN
          LMN    /MTX/RLA
          ZJN    CEP1        IF READ LABELS
          RJM    RSP         RESET PARAMETERS FOR NEXT OPERATION
          LDD    MA          RESTORE IN POINTER
          CWM    CREA,ON
          LDD    MA
          CRD    CN
          UJN    CEPX        RETURN
 
 CEP1     LDN    0           SET ERROR CODE
 CEPA     EQU    *-1
*         LDN    /MTX/BEI    (RECOVERED TAPE MARK)
          STD    EC
          LDM    CECB
          LPN    77
          ZJN    CEP2        IF AT MAGNET CONTROL POINT
          LDN    0           CHANGE TO MAGNET,S CP
          RJM    CEC
 CEP2     CALL   RLA         RELOAD READ LABELS OVERLAY (NO RETURN)
 POS      SPACE  4,15
**        POS - POSITION TAPE.
*         THIS ROUTINE USES THE LOCATE BLOCK COMMAND TO POSITION
*         THE TAPE TO THE EXPECTED BLOCK POSITION.
*
*         ENTRY  (BL, BL+1) = NOS BLOCK POSITION.
*                (WP, EP+1) = PHYSICAL BLOCK ID WHEN (BL,BL+1) = 0.
*
*         EXIT   (A) = 0 IF NO ERROR.
*                TO *ERR* IF CHANNEL MALFUNCTION.
*
*         USES   T3.
*
*         CALLS  /PRESET/GPS, /PRESET/ICF, /PRESET/RBI.
 
 
 POS      SUBR               ENTRY/EXIT
          RJM    /PRESET/RBI READ BLOCK ID
          LDM    BIDW
          STM    POSA
          SBN    20
          ZJN    POS1        IF FIRST SEGMENT
          STM    POSA        SET PHYSICAL REFERENCE BLOCK ID
 POS1     LDD    BL+1
          SHN    4
          ADD    EP+1
          ADM    POSB        EXTRA BLOCKS TO POSITION
          STM    POSA+2      MOVE BLOCK NUMBER TO PARAMETERS
          SHN    -14
          STM    POSA+1
          LDD    BL
          SHN    4
          ADD    WP
          RAM    POSA+1
          LDN    F0016       LOCATE BLOCK
          RJM    /PRESET/ICF ISSUE FUNCTION
          ACN    CH
          LDN    3
          OAM    POSA,CH     OUTPUT THE 3 PARAMETER WORDS
          STD    T3          WORDS NOT TRANSFERRED
          FJM    *,CH        WAIT FOR DATA TO BE TAKEN
 POS2     LDN    0           WAIT FOR END OF OPERATION
          RJM    /PRESET/GPS GET AND PROCESS GENERAL STATUS
          MJN    POS2        IF COMMAND RETRY
          SHN    21-13
          MJN    POS3        IF ERROR
          LDD    T3
          ZJN    POS4        IF ALL WORDS TRANSFERRED
          LDN    /MTX/CMF    CHANNEL MALFUNCTION
          RJM    ERR         REPORT ERROR (NO RETURN)
 
 POS3     LDN    /MTX/STE    STATUS ERROR
          STD    EC
 POS4     LJM    POSX        RETURN
 
 
 POSA     DATA   0           LOCATE BLOCK PARAMETERS
          DATA   0           UPPER 12 BITS OF BLOCK NUMBER
          DATA   0           8/LOWER BITS OF BLOCK NUMBER / 4 UNUSED
 
 POSB     DATA   0           8/ADDER TO BLOCK POSITION, 4/0
 PTM      SPACE  4,10
**        PTM - PROCESS TAPE MARK.
*
*         EXIT   (EC) = 0.
*                TO *CEP* IF READ LABEL.
*                TO *RET3* IF LABELED TAPE OR FORMAT IS I, SI, LI.
*
*         CALLS  *CEM*, CEP.
*
*         MACROS CALL.
 
 
 PTM4     LDN    /MTX/BEI    RETURN POSSIBLE EOI
          LJM    RET3        RETURN ERROR CODE
 
 PTM      SUBR               ENTRY/EXIT
          LDN    0
          STD    EC          CLEAR ERROR CODE
          LDD    EI
          ZJN    PTM1        IF FIRST ENTRY
          CALL   CEM         LOG RECOVERED ERROR
          LDC    LDNI+/MTX/BEI  SET TO RETURN TAPE MARK IF READ LABELS
          STM    CEPA
 PTM1     RJM    CEP         CLEAR PARAMETERS (NO RETURN IF READ LABEL)
          LDD    LT
          SHN    21-12
          MJN    PTM4        IF LABELED
          LDD    FM
          SHN    -6
          SBN    /MTX/TFSI+1
          MJN    PTM4        IF INTERNAL MODES
          SBN    /MTX/TFLI-/MTX/TFSI-1
          ZJN    PTM4        IF LI FORMAT
          LDD    MD          SET EOF STATUS
          SCN    14
          LMN    10
          STD    MD
          LDN    2
          STD    TB
          LDD    FM
          SHN    -6
          LMN    /MTX/TFS
          ZJN    PTM2        IF S FORMAT
          LMN    /MTX/TFL&/MTX/TFS
          NJN    PTM3        IF NOT L FORMAT
 PTM2     LDM    //CIOE
          LPC    770
          LMC    260
          NJN    PTM3        IF NOT 260 READ CODE
          LDN    26          SET TO RETURN 271 STATUS
          STD    TB
 PTM3     LJM    PTMX        RETURN
 RCI      SPACE  4,10
**        RCI - READ *CIO* INFORMATION FROM *MAGNET,S FL.
*
*         EXIT   (T6 - T7) = FET ADDRESS.
*                (T1 - T5) = UCIC WORD.
*
*         USES   CM - CM+4.
*
*         CALLS  HNG.
*
*         MACROS DELAY, MONITOR, PAUSE.
 
 
 RCI3     LDD    MA          READ UDT WORDS
          CRD    T6-3
          ADN    2
          CRD    T1
 
 RCI      SUBR               ENTRY/EXIT
 RCI1     LDM    UADA        SET FWA OF DESIRED UDT WORDS
          ADN    /MTX/UCIA
          STD    CM+4
          LDC    300         REQUEST THREE WORDS
          STD    CM+3
          LDN    0           REQUEST READ FROM *MAGNET*
          STD    CM+1
          LCN    7777-/SSD/MTSI  SET *MAGNET* SUBSYSTEM IDENTIFICATION
          STD    CM+2
          MONITOR TDAM
          LDD    CM+1
          ZJN    RCI3        IF DONE
          SBN    2
          PJN    RCI2        IF MOVE NOT IN PROGRESS
          PAUSE  NE
          DELAY
          UJN    RCI1        REISSUE REQUEST
 
 RCI2     RJM    HNG         HANG PP
 RRA      SPACE  4,25
**        RRA - READ RECOVERY ALGORITHM.
*         THIS ROUTINE DOES ERROR RECOVERY AS FOLLOWS.
*         IF (EI) = 0 LOG ERROR, POSITION TAPE, AND REQUEUE.
*         IF (EI) = 1 LOG ERROR, LOAD CCC MICROCODE, POSITION TAPE,
*                     AND REQUEUE.
*         IF (EI) = 2 LOG UNRECOVERED ERROR, RETURN FATAL CODE.  IF
*                     THE ERROR IS A LOAD POINT ERROR, THE TAPE IS
*                     UNLOADED.
*
*         ENTRY  (EC) = ERROR CODE.
*                (EI) = RETRY COUNT.
*
*         EXIT   (EP) .NE. 0 IF RECOVERY ALGORITHM NOT COMPLETE.
*                (EI) = (EI)+1 IF RECOVERY ALGORITHM NOT COMPLETE.
*                TO *ERR* IF MICROCODE LOAD FAILED.
*                TO *RET2* TO REQUEUE THE REQUEST.
*                TO *RET4* TO RETURN A FATAL ERROR.
*
*         USES   CN, CN+1, EC, CM - CM+4.
*
*         CALLS  *CEM*, CEP, /PRESET/ICF, POS, /PRESET/RCU, RSP, WFC,
*                WIP, *0CT*.
*
*         MACROS CALL, EXECUTE.
 
 
 RRA      SUBR               ENTRY/EXIT
 RRA1     CALL   CEM         LOG CTS ERROR MESSAGE
          LDD    EC          LOAD ERROR CODE
          NJN    RRA2        IF ERROR
          LJM    RRA10       IF RECOVERED ERROR
 
 RRA2     LDC    LDNI        FORCE DROP OUT
          STM    //PNRC
          AOD    EP          FORCE REPORTING OF RECOVERED ERROR
          AOD    EI          INCREMENT RETRY COUNT
          SBN    1
          ZJP    RRA3        IF FIRST ERROR
          SBN    1
          NJP    RRA4        IF RETRIES FAILED
          CHTE   *
          LDN    CH          SET CHANNEL NUMBER
          STD    CN
          LDC    ERLB        SET BUFFER ADDRESS
          STD    CN+1
          EXECUTE  0CT,ERLA+5  LOAD CTS/CCC MICROCODE
          LDD    CN
          ZJN    RRA2.2      IF MICROCODE LOADED
          STD    EC
          SHN    0-13
          PJN    RRA2.1      IF ERROR CODE ALREADY SAVED
          LDN    /MTX/CMF
          STD    EC
 RRA2.1   LDM    CN+1        SAVE FUNCTION
          STM    /PRESET/ICFA
          RJM    ERR         REPORT ERROR (NO RETURN)
 
 RRA2.2   RJM    /PRESET/RCU RECONNECT UNIT
 RRA3     RJM    POS         POSITION TAPE
          NJP    RRA1        IF LOCATE BLOCK FAILED
          STD    EC          CLEAR ERROR CODE
          LJM    RET2        REQUEUE THE REQUEST
 
*         UNRECOVERABLE ERROR.
 
 RRA4     LDD    EC
          LMN    /MTX/STE
          NJN    RRA6        IF NOT STATUS ERROR
          LDM    CTGS
          LPC    177
          LMN    CE007
          NJN    RRA6        IF NOT BURST ID OR BLOCK ID ERROR
          LDD    DS
          SHN    21-2
          PJN    RRA6        IF NOT AT LOAD POINT
          LDN    /MTX/BFR    LOAD POINT ERROR
          STD    EC
          CALL   CEM         LOG THE ERROR
          LDC    F0110       UNLOAD TAPE
          RJM    /PRESET/ICF ISSUE CTS FUNCTION
          RJM    WFC         WAIT FOR COMPLETION
          UJN    RRA7        RETURN FATAL ERROR
 
 RRA6     LDD    FN
          LMN    /MTX/RDF
          ZJN    RRA8        IF READ
 RRA7     LJM    RET4        RETURN FATAL ERROR
 
 RRA8     LDM    FETO
          SHN    21-10
          PJN    RRA9        IF ERROR PROCESSING NOT SET
          RJM    RSP         RESET PARAMETERS
          RJM    WIP         WRITE IN POINTER TO BUFFER
          LDD    MD
          SHN    21-5
          PJN    RRA9        IF NOT 200 READ
          LDD    CN+3        READ CONTROL WORD
          SHN    6
          ADD    RA
          SHN    6
          ADD    CN+4
          CRD    CM
          LDC    4000        SET UNRECOVERED ERROR INDICATION
          RAD    CM
          LDD    CN+3        REWRITE CONTROL WORD
          SHN    6
          ADD    RA
          SHN    6
          ADD    CN+4
          CWD    CM
 RRA9     LDC    RET4        SET TO GIVE FATAL USER ERROR
          STM    /READ/WCBD
 RRAA     EQU    *-1
*         STM    /RLI/UIPC   (LI FORMAT)
 RRA10    RJM    CEP         CLEAR ERROR PARAMETERS
          LJM    RRAX        RETURN
 RSP      SPACE  4,10
**        RSP - RESET PROCESSOR FOR NEXT OPERATION.
*
*         EXIT   (CN+3 - CN+4) = IN POINTER PRIOR TO READ.
*
*         CALLS  /CPP/CAL, *CPP*, RCI, /CPP/SFP.
*
*         MACROS CALL.
 
 
 RSP      SUBR               ENTRY/EXIT
          LDM    /READ/WOCN  RESTORE WORD COUNT
          STD    WC
          CALL   CPP         RELOAD ADDRESS RELOCATOR
          LDD    FN
          LMN    /MTX/RDF
          NJN    RSPX        IF NOT READ DATA
          RJM    RCI         READ UDT
          RJM    /CPP/CAL    CALCULATE PARAMETERS
          LDN    2           READ IN
          RJM    /CPP/SFP
          UJN    RSPX        RETURN
 WFC      SPACE  4,10
**        WFC - WAIT FOR COMPLETION.
*
*         CALLS  /PRESET/GPS.
 
 
 WFC      SUBR               ENTRY/EXIT
 WFC1     LDN    0           WAIT FOR END OF OPERATION
          RJM    /PRESET/GPS
          MJN    WFC1        IF COMMAND RETRY
          UJN    WFCX        RETURN
 WIP      SPACE  4,15
**        WIP - WRITE IN POINTER PRIOR TO READ TO USER BUFFER.
*
*         ENTRY  (CREA - CREA+4) = POINTER TO NEXT BUFFER LOCATION.
*                (CN+3 - CN+4) = IN POINTER PRIOR TO READ.
*
*         EXIT   IN POINTER WRITTEN TO USER CIO BUFFER.
*                PARITY ERROR BIT SET IN FET+0.
*
*         USES   CM - CM+4.
*
*         CALLS  RCI.
 
 
 WIP      SUBR               ENTRY/EXIT
          LDM    CREA+3     CALCULATE ABSOLUTE BUFFER ADDRESS
          SHN    6
          ADD    RA
          SHN    6
          ADM    CREA+4
          CWD    CN          WRITE OLD IN POINTER TO BUFFER
          RJM    RCI         READ UDT INFORMATION
          LDD    T6          READ FET+0
          SHN    6
          ADD    RA
          SHN    6
          ADD    T7
          CRD    CM
          LDD    CM+4        SET PARITY ERROR BIT
          LPC    777
          LMC    4000
          STD    CM+4
          LDD    CM+3
          SCN    3
          STD    CM+3
          LDD    T6          REWRITE FET+0
          SHN    6
          ADD    RA
          SHN    6
          ADD    T7
          CWD    CM
          LJM    WIPX        RETURN
          SPACE  4,10
          ERRNG  ERLA-*      CODE OVERFLOWS HELPER OVERLAY
          ERRPL  ERLA+5+ZCTL-ERLB  *0CT* OVERFLOWS INTO BUFFER
 CTAB     SPACE  4,10
**        CTAB - CHANNEL TABLE.
 
 
 CTAB     CHTB
 PRS      SPACE  4,10
**        PRS - PRESET.
 
 
 PRS      SUBR               ENTRY/EXIT
          LDD    FN
          LMN    /MTX/RDF
          NJN    PRSX        IF NOT READ FUNCTION
          LDD    FM
          SHN    -6
          LMN    /MTX/TFLI
          NJN    PRSX        IF NOT LI FORMAT
          LDC    /RLI/UIPC
          STM    RRAA        SET TO RETURN FATAL ERROR
          LJM    PRSX        EXIT PRESET
          OVERLAY (WRITE FUNCTION PROCESSOR.),,,WRITE
 .IM      SET    2           GENERATE ADDRESSES FOR ERROR PROCESSOR
 STAT     EQU    PRSX        STATUS AT START OF WRITE
 BYWR     EQU    STAT+1      BYTES ATTEMPTED TO WRITE
 BYRM     EQU    BYWR+1      BYTES NOT WRITTEN
 OPTU     EQU    PRSX        OUT POINTER UPPER FOR CTS RETRY
 OPTL     EQU    BYRM+1      OUT POINTER LOWER FOR CTS RETRY
 WTF      SPACE  4,10
**        WTF - WRITE TAPE.
*
*         CALLS  IBF, ITM, /WLB/ODA, RCB, WRT.
*
*         MACROS SADT.
 
 
          ENTRY  WTF
 WTF      RJM    RCB         READ CENTRAL BUFFER
*         RJM    RCB         (CTS, NOT LONG BLOCKS)
*         RJM    ITM         (4X PPU SPEED - MOTION AHEAD ENABLED)
*         UJN    WTF1        (LONG BLOCKS)
 WTFA     EQU    *-2
          RJM    ITM         INITIATE TAPE MOTION
*         UJN    WTF2        (CTS)
*         RJM    RCB         (4X PPU SPEED - MOTION AHEAD ENABLED)
 WTFB     EQU    *-1
          UJN    WTF2        WRITE TO TAPE
 
 WTF1     RJM    ITM         INITIATE TAPE MOTION
*         RJM    /WLB/ODA    (LONG BLOCKS)
 WTFC     EQU    *-1
 WTF2     RJM    IBF         PROCESS I/SI FORMAT
 WTFD     EQU    *-2
*         UJN    *+2         (LONG BLOCKS)
          RJM    WRT         PROCESS WRITE
          LDC    *
 WTFE     EQU    *-1
          NJN    WTF4        IF EXIT CONDITIONS
          LDD    DF
 WTFF     ZJN    WTF1        IF NO DROP OUT
*         PSN                (PRU WRITE)
*         ZJN    WTF2        IF NO DROP OUT (CTS AND NOT LONG BLOCK)
 WTF3     LJM    RET2        REQUEUE
*         LJM    WTF8        (PRU WRITE)
 WTFG     EQU    *-1
 
 WTF4     SBN    10
          PJN    WTF6        IF ERROR
          ADN    10-1
          NJN    WTF5        IF NO EOF TO WRITE
          SADT   .FE,,3,A
          LDC    *           UPDATE OUT (NEEDED FOR 204 WRITE)
          CWD    CN
          LJM    RET1        RETURN TO WRITE EOF
 
 WTF5     SBN    4-1
          NJN    WTF8        IF NOT MODE CHANGE
          LDD    MD          TOGGLE MODE
          LMD    HN
          STD    MD
          LDD    UP
          LMN    1
          STD    UP
          UJN    WTF3        REQUEUE
 
 WTF6     ZJN    WTF7        IF CONTROL WORD ERROR
          LDN    /MTX/BAE&/MTX/BCW  BUFFER ARGUMENT ERROR
 WTF7     LMN    /MTX/BCW    BUFFER CONTROL WORD ERROR
          LJM    RET3        RETURN ERROR CODE
 
 WTF8     LDN    1
          LJM    RET         SET FET COMPLETE
*         LJM    EOF         (I/SI FORMAT EOF REQUIRED)
 WTFH     EQU    *-1
 CKS      SPACE  4,10
 CNW      SPACE  4,20
**        CNW - CHECK NEXT WRITE.
*
*         ENTRY  (CN+3 - CN+4) = OUT POINTER.
*
*         EXIT   (WTFE) = 0, NEXT WRITE OKAY.
*                      1, EOF WRITE REQUIRED.
*                      2, NOT ENOUGH DATA.
*                      4, TOGGLE MODE (F FORMAT).
*                     10, BUFFER CONTROL WORD ERROR.
*                     11, BUFFER ARGUMENT ERROR.
*                (BY) = BYTES TO WRITE.
*                (T6) = WORD COUNT (INCLUDING CONTROL WORDS).
*                (MA+0 - MA+4) = ENTRY VALUE IF CALLED FROM *WRT*.
*
*         USES   CM - CM+4.
*
*         CALLS  COB, CDO, SIF, XBF, CNL (LONG BLOCKS).
*
*         MACROS SADT.
 
 
 CNW9     LDN    2           SET NOT ENOUGH DATA
 
*         ENTER HERE FROM LONG BLOCKS.
 
 CNW10    STM    WTFE
 
 CNW      SUBR               ENTRY/EXIT
          RJM    CDO         CHECK DROP OUT FLAG
          LDN    F0050
          STM    ITMA        WRITE FUNCTION
 CNWA     LDD    WC
*         LDN    2           (204 WRITE)
*         LDN    1           (264 WRITE)
*         LJM    /3M /CNL    (LONG BLOCKS - FLAG FOR OTHER OVERLAYS)
          STD    CM+4
 CNWB     LDN    0           SET UNUSED BIT COUNT
*         LDN    *           (S/L 14, 24, 34 SET FROM FET)
          STD    CM+2
          RJM    COB         CHECK OUTPUT BUFFER
 CNWC     SBD    CM+4
*         STD    CM+4        (S/L 14, 24, 34 CODES)
 CNWD     PJN    CNW1        IF ENOUGH DATA
*         NJN    CNW1        (S/L 14, 24, 34 CODES)
 CNWE     UJN    CNW9        (204/264 WRITE AND ALL S/L FORMAT)
*         RAD    CM+4        ADJUST WORD COUNT
          LDD    MD
          SHN    21-3
          PJN    CNW9        IF NOT EOR/EOF WRITE
          SHN    21-10-21+3+22
          MJN    CNW9        IF EOR/EOF WRITTEN THIS OPERATION
 CNW1     UJN    CNW2
 CNWF     EQU    *-1
*         LDD    CN+3        (204/264 WRITE)
          SHN    6           READ CONTROL WORD
          ADD    RA
          SHN    6
          ADD    CN+4
          CRD    CM
 CNW2     LDD    CM+4        PRESERVE BYTE COUNT 204 WRITE
 CNWG     UJN    CNW3
*         STD    BY          (204 WRITE)
          ADN    4           ROUND UP BYTE COUNT
          STD    CM+4        DIVIDE BY 5
          SHN    1           13* BYTES
          ADD    CM+4
          SHN    2
          ADD    CM+4
          SHN    14   (-6)   (13*BYTES)/64
          STD    T0
          SHN    6+2         4*13*BYTES  (52*BYTES)
          SBD    CM+4        51*BYTES
          ADD    T0          (51*BYTES)+((13*BYTES)/64)
          SHN    -8D
          STD    CM+4
 CNWH     UJN    CNW3        (NOT F FORMAT)
*         LDD    MD
          LMD    CM
          SHN    -4
          LPN    4
          NJN    CNW5        IF MODE CHANGE
          LDD    CM+4
 CNW3     ADN    0           ALLOW FOR CONTROL WORDS
 CNWI     EQU    *-1
*         ADN    1           (264 WRITE)
*         ADN    2           (204 WRITE)
          STD    T6          PRESET FIRST PART WORD COUNT
          SADT   .BS,C,1
          ADC    -*
          PJN    CNW4        IF BLOCK LENGTH ERROR
          RJM    COB         CHECK OUTPUT BUFFER
          SBD    T6
          MJN    CNW8        IF NOT ENOUGH DATA
          SBD    T6
          SHN    -21
          ADC    LDNI
          STM    WRTI
          LDD    CM+2        CHECK UBC FIELD
 CNWJ     SBN    1           (I, SI FORMAT INCLUDING 204/260 WRITE)
*         SBN    12D         (204 WRITE ALL OTHER FORMATS)
*         SBN    57D         (264 WRITE ALL OTHER FORMATS)
*         SBN    57D         (ALL S/L FORMAT EXCEPT 204)
          MJN    CNW6        IF VALID UBC
 CNW4     LDN    10          SET BUFFER CONTROL WORD ERROR
 CNW5     UJN    CNW7        SET EXIT CONDITION
 
 CNW6     LDD    CM+4        SET BYTE COUNT
          SHN    2
          ADD    CM+4
 CNWK     STD    BY
*         PSN                (204 WRITE AND NOT I/SI FORMAT)
          RJM    XBF         PROCESS ALL EXCEPT I, SI FORMAT
 CNWL     EQU    *-2
*         RJM    SIF         (SI FORMAT 9/18 TRACK)
*         LDN    0           I FORMAT(9 TRACK ATS OR CTS), I/SI 7 TRACK
*         LDN    0
 CNW7     LJM    CNW10       RETURN
 
 CNW8     LJM    CNW9        SET NOT ENOUGH DATA
 COB      SPACE  4,10
**        COB - CHECK OUTPUT BUFFER.
*
*         EXIT   (A) = WORD COUNT.
*                TO LOCATION *CNW10*, IF BUFFER ARGUMENT ERROR.
*
*         USES   T1 - T5.
*
*         MACROS SADT.
 
 
 COB2     LDD    T1+3        LENGTH = IN - OUT
          SBD    CN+3
          SHN    14
          ADD    T1+4
          SBD    CN+4
          PJN    COBX        IF IN .GE. OUT
          SADT   .LF
          ADC    *           (LIMIT - FIRST)
          MJN    COB1        IF BUFFER ARGUMENT ERROR
 
 COB      SUBR               ENTRY/EXIT
          SADT   .FE,,2,A
          LDC    *           READ IN
          CRD    T1
          LDD    T1+3
          LPN    37
          STD    T1+3
          SHN    14
          LMD    T1+4
          SADT   .LM,C
          ADC    -*
          MJN    COB2        IF IN .LT. LIMIT
 COB1     LDN    11          SET BUFFER ARGUMENT ERROR
          UJN    CNW7        SET EXIT CONDITION
 PWR      SPACE  4,10
**        RCB - READ CENTRAL BUFFER.
*
*         ENTRY  (CN+3 - CN+4) = OUT POINTER.
*                (T6) = WORD COUNT.
*
*         EXIT   (CN+3 - CN+4) UPDATED.
*                (T7) = SECOND PART WORD COUNT IF BUFFER WRAP.
*
*         MACROS SADT.
 
 
 RCB2     LDD    T7
          ZJN    RCB3        IF NO SECOND PART
          SADT   .FT,,,A
          LDC    *           (FIRST+RA)
          CRM    *,T7
 RCBB     EQU    *-1
          UJN    RCB4        RESET OUT
 
 RCB3     LDD    T6          UPDATE OUT
          RAD    CN+4
          SHN    -14
          RAD    CN+3
          SHN    14
          LMD    CN+4
          SADT   .LM,C
          ADC    -*          - LIMIT
          MJN    RCBX        IF LIMIT NOT REACHED
          SADT   .FT
 RCB4     LDC    *           RESET TO FIRST
          ADD    T7
          STD    CN+4
          SHN    -14
          STD    CN+3
 
 RCB      SUBR               ENTRY/EXIT
          LDD    T6
          ZJN    RCBX        IF NO DATA
          LDN    0           INITIALIZE SECOND HALF WORD COUNT
          STD    T7
          LDD    CN+3        DETERMINE IF BUFFER WRAP
          SHN    14
          LMD    CN+4
          ADD    T6
          SADT   .LM,C
          ADC    -*          (-LIMIT)
          MJN    RCB1        IF LIMIT NOT REACHED
          STD    T7          SECOND HALF WORD COUNT
          LMC    -0
          RAD    T6
 RCB1     LDD    T6          READ DATA
          SHN    2
          ADD    T6
          ADM    RCBA
          STM    RCBB
          LDD    CN+3        READ FIRST PART
          SHN    6
          ADD    RA
          SHN    6
          ADD    CN+4
          CRM    BUF,T6
 RCBA     EQU    *-1
*         CRM    BUFC,T6     (204, 264 WRITE)
          LJM    RCB2        READ SECOND PART
 WRT      SPACE  4,15
**        WRT - WRITE TAPE.
*
*         FOR CTS THE FIRST PART OF *WRT* IS OVERLAYED WITH *WCT*.
*
*         ENTRY  (BY) = BYTES TO WRITE.
*
*         EXIT   (CN+3, CN+4) = OUT POINTER.
*
*         USES   CM - CM+4, CN - CN+3.
*
*         CALLS  CNW, RCB, UBW, *WEM*, WEO.
*
*         MACROS CALL, SADT.
 
 
 WRT      SUBR               ENTRY/EXIT
 WRTA     LDD    BY
*         UJN    WRT2        (LONG BLOCKS)
          STM    BYWR        SAVE BYTES BEING OUTPUT
          OAM    BUF,CH      OUTPUT BLOCK
          FJM    *,CH
          NJN    WRT1        IF ABNORMAL TERMINATION
          DCN    CH+40
 WRT1     STM    BYRM        SAVE BYTES REMAINING
          LDM    UBWB        USE HARDWARE CHECKSUM
          STD    LG+1
          NJN    WRT2        IF NONZERO
          AOM    LG+1        FORCE NONZERO CHECKSUM
 WRT2     LDD    DS          SAVE STATUS AT START OF WRITE
          STM    STAT
          LDD    UP          CLEAR EOR/EOF LAST BLOCK FLAG
          SCN    10
          STD    UP
          LDD    MD          CLEAR EOR/EOF THIS OPERATION FLAG
          LPC    7377
          STD    MD
 WRTB     LDC    *           BLOCK LENGTH - I, SI FORMAT
*         PSN                (NOT I, SI FORMAT)
*         LDD    BY          (NOT I, SI FORMAT)
 WRTC     LMC    5000        CHECK FOR FULL BLOCK
*         LMC    5004        (I FORMAT)
*         LDN    0           (WRITE LABELS)
*         LDN    0           (WRITE LABELS)
          ZJN    WRT3        IF NOT EOR/EOF WRITTEN
          LDN    10          SET EOR/EOF FLAGS
          RAD    UP
          LDC    400
          RAD    MD
 WRT3     LDD    MA
          CWD    CN          SAVE OLD OUT POINTER
 WRTD     RJM    CNW         CHECK NEXT WRITE
*         UJN    WRT3.1      (WRITE LABELS)
          LDM    WTFE
          ADD    DF
 WRTE     NJN    WRT3.1      IF NO MORE DATA OR DROP OUT SET
*         UJN    WRT3.1      (LONG BLOCKS)
          RJM    RCB         READ NEXT BLOCK FROM CENTRAL BUFFER
 WRT3.1   RJM    WEO         WAIT END OF OPERATION
          ZJN    WRT4        IF NO ERROR
          LDN    /MTX/STE    STATUS ERROR
 WRT4     STD    EC
 WRTF     NJN    WRT4.1      IF ERROR
*         UJN    WRT4.1      (MTS UNIT)
 
          LDM    MTDS+1
          SHN    21-11
          PJN    WRT4.1      IF NO GCR CORRECTION
          AOM    ECNT+2      INCREMENT COUNTER
          SHN    -14
          RAM    ECNT+1      INCREMENT ON OVERFLOW
 WRT4.1   LDM    UBWB        USE HARDWARE CHECKSUM
          STD    LG+1
          NJN    WRT4.2      IF NONZERO
          AOD    LG+1
 WRT4.2   LDD    EC
          ADD    EI
          ZJN    WRT5        IF NO ERROR NOR VERIFICATION REQUIRED
          LDD    MA
          CRD    CN          RESET TO OLD OUT POINTER
          LDD    DS          SAVE STATUS FOR ERROR PROCESSOR
          STM    //STER
          CALL   WEM
 
*         RETURN HERE IF END OF TAPE OR IF ERROR WAS RECOVERED.
 
          LDD    MA
          CWD    CN          RESTORE MA BACK TO OLD OUT POINTER
          LDM    WTFE
          ADD    DF
 WRTG     NJN    WRT5        IF NO MORE DATA OR DROP OUT SET
*         UJN    WRT5        (WRITE LABELS OR LONG BLOCKS)
          LDM    WRTK
          LMC    WRTX
          NJN    WRT5        IF END OF TAPE
          RJM    RCB         READ CENTRAL BUFFER
 WRT5     LDD    LG+1        SAVE LAST GOOD RECORD INFORMATION
          STD    LG
          RJM    UBW         UPDATE BID WINDOW
 WRTH     PSN                ALL NORMAL WRITES
*         UJN    WRT7        WRITE LABELS
          LDD    MA
          CRD    CM          SET TO OLD OUT POINTER
          UJN    WRT5.1      WRITE OUT TO FET
 
          BSS    7           ALLOW SPACE FOR THE END OF *WCT*
 
*         START OF COMMON CODE WITH *WCT*.  *WCT* OVERLAYS THE FIRST
*         PART OF *WRT* FOR CTS.
 
 WRT5.1   BSS    0
          SADT   .FE,,3,A
          LDC    *           WRITE OUT TO FET
          CWD    CM
 WRTI     LDN    0
          ZJN    WRT6        IF AT LEAST ONE MORE BLOCK
          LDD    OA          RECALL CPU
          CWM    WRTL,ON
 WRTJ     EQU    *-2
*         UJN    *+2         (NOT BUFFERED WRITE)
 WRT6     AOD    BL+1        INCREMENT BLOCK COUNT
          SHN    -14
          RAD    BL
 WRT7     AOD    BT          INCREMENT BLOCKS WRITTEN
          LJM    WRTX        RETURN
 WRTK     EQU    *-1
*         LJM    /3M /EOTEXIT  (RETURN ERROR ON END OF TAPE)
 
 WRTL     CON    DRCM        DRIVER RECALL CPU MONITOR FUNCTION
          SPACE  4,10
          USE    OVLB
 OVLB     BSS    0           ORIGIN FOR LONG BLOCK PROCESSOR
 
*         THE FOLLOWING ROUTINES CANNOT USE ADDRESS MODIFICATION.
 
 IBF      SPACE  4,10
**        IBF - INTERNAL BLOCK FORMAT.
*         THIS ROUTINE SETS UP THE I FORMAT TRAILER BYTES AND ADJUSTS
*         THE BYTE COUNT SO AN EVEN BYTE COUNT IS WRITTEN.
*
*         ENTRY  (BY) = BYTE COUNT OF BLOCK.
*
*         EXIT   (BY) = ADJUSTED BYTE COUNT OF BLOCK,
*                   INCLUDING TERMINATOR.
 
 
 IBF      SUBR               ENTRY/EXIT
 IBFA     LDM    LNUM        SET LEVEL NUMBER IN TERMINATOR
*         LDM    BUF,BY      (204 WRITE)
          LPN    17
          STM    BUF+3,BY
          LMN    17
          NJN    IBF1        IF NOT EOF BLOCK
          LDD    BY
          ZJN    IBF1        IF NO DATA IN BLOCK
          LDN    0           CLEAR LEVEL NUMBER
          STM    BUF+3,BY
 IBF1     LDD    BY          CHECK FOR FULL BLOCK
          LMC    5000
 IBFB     NJN    IBF2        IF NOT FULL BLOCK I FORMAT
*         ZJN    IBF3        (IF FULL BLOCK SI FORMAT)
 IBFC     STM    BUF+3,BY    CLEAR LEVEL NUMBER
*         PSN                (SI FORMAT)
*         PSN                (SI FORMAT)
 IBF2     LDN    4           ADJUST BLOCK SIZE FOR TERMINATOR
          RAD    BY
          STM    BUF-4,BY    SET BLOCK LENGTH
          LDD    BL          SET BLOCK NUMBER
          STM    BUF-3,BY
          LDD    BL+1
          STM    BUF-2,BY
          LDN    0           CLEAR EXTRA BYTE
          STM    BUF,BY
 
*         ADJUST BYTE COUNT FOR 9/18 TRACK.
 
 IBF3     LDD    BY
          STM    WRTB+1      SAVE BYTE COUNT
 IBFE     EQU    *-1
*         STM    WCTC+1      (CTS)
 IBFD     LPN    0
*         LPN    1           (9/18 TRACK)
          RAD    BY
          LJM    IBFX        RETURN
 SIF      SPACE  4,10
**        SIF - PROCESS SI FORMAT 9 TRACK (ATS).
*         PROCESS I/SI FORMAT 9 TRACK (MTS).
*         PROCESS SI FORMAT (CTS).
*
*         EXIT   (A) = 0.
*                (ITMA) = 250 IF 3N+2 OR ODD WRITE REQUIRED.
*                       = 50 OTHERWISE.
 
 
 SIF1     ZJN    SIF2        IF 50 WRITE FUNCTION
          LDC    F0250-F0050
 SIF2     ADN    F0050       ADD FUNCTION
          STM    //ITMA
          LDN    0           SET EXIT CONDITION
 
 SIF      SUBR               ENTRY/EXIT
          LDD    BY
          LPN    1
 SIFA     UJN    SIF1        ATS CONTROLLER
*         ADD    BY          (MTS CONTROLLER I FORMAT)
*         LDD    BY          (MTS CONTROLLER SI FORMAT)
          LPN    2
          SHN    -1
          UJN    SIF1        SET EXIT
 EOF      SPACE  4,10
**        EOF - WRITE I/SI FORMAT EOF.
*
*         EXIT   (A) = 1.
*                TO *RET* TO SET FET COMPLETE.
*                (BY) = 0.
*                (T6) = 0.
*
*         CALLS  IBF, ITM, WRT.
 
 
 EOF      BSS    0           ENTRY
          LDN    0           SET TO WRITE EOF
          STD    BY
          STD    T6
          LDN    17          SET LEVEL NUMBER
          STM    LNUM
          LDN    F0050
          STM    //ITMA
          RJM    //ITM       INITIATE TAPE MOTION
 EOFB     EQU    *-2
*         UJN    *+2         (CTS)
          RJM    IBF         PROCESS I/SI FORMAT BLOCK WRITE
          RJM    WRT         PROCESS WRITE
 EOFC     EQU    *           (USED TO TELL WHERE *WRT* CALLED FROM)
          LCN    14          CLEAR EOF INDICATOR
          RAD    MD
          LDN    1
          LJM    RET         SET FET COMPLETE
 BUFFER   SPACE  4,10
          BUFFER
 
 .XBFA    BSS    0
          LOC    OVLB
 XBF      SPACE  4,15
**        XBF - EXTERNAL BLOCK FORMAT.
*
*         ENTRY  (CM+2) = UBC.
*                (T6) = WORD COUNT.
*                (CN+3 - CN+4) = OUT POINTER.
*
*         EXIT   (A) = 0, IF NO EOF WRITE NEEDED.
*                (A) = 1, IF EOF NEEDED.
*                (A) = 2, IF NOT ENOUGH DATA.
*                (A) = 10, IF BAD CONTROL WORD.
*                (ITMA) = 250 IF 3N+2 WRITE REQUIRED.
*                       = 50 OTHERWISE.
*
*         CALLS  RCB.
 
 
 XBF7     LDN    14          SET EOF STATUS
          RAD    MD
          LDN    1
          UJN    XBFX        RETURN
 
 XBF8     LDD    MA          SAVE OUT POINTER
          CWD    CN
          RJM    RCB         READ CENTRAL BUFFER
          LDM    BUF
          LMN    17
          ZJN    XBF7        IF EOF WRITE
          LDD    MA          BACK UP FET POINTER
          CRD    CN
          UJN    XBF2        CONTROL WORD ERROR
 
 XBF9     LDD    FM          CHECK FOR NOISE
          LPN    37
          SBD    BY
          SBN    1
          PJN    XBF2        IF NOISE
 XBFD     EQU    *-1
*         LDN    0           (CTS)
          LDN    0
 
 XBF      SUBR               ENTRY/EXIT
          LDC    F0050       SET FUNCTION
 XBFE     EQU    *-1
*         LDC    F0250       CTS S FORMAT CODED WRITE
          STM    //ITMA
          LDD    BY
 XBFA     ZJN    XBF8        IF POSSIBLE 204 CODE EOF WRITE
*         PSN                ALL OTHERS
 XBF1     LDD    CM+2        ADJUST BYTE OCUNT
          SBN    12D
          MJN    XBF3        IF LESS THAN ONE BYTE
          STD    CM+2
          SOD    BY
          PJN    XBF1        IF VALID CONTROL WORD
 XBF2     LDN    10          INCORRECT WORD
          UJN    XBFX        RETURN
 
*         THE FOLLOWING CODE IS EXECUTED FOR ATS CONTROLLER S, L AND
*         F FORMAT 9 TRACK BINARY TAPES.  IT IS ALSO EXECUTED FOR
*         CTS.  FOR MTS CONTROLLER S, L, AND F FORMAT 9 TRACK BINARY
*         TAPES, THE AREA IS OVERLAID BY CODE AT .MXBO.  FOR 7 TRACK
*         CODED/BINARY AND 9 TRACK CODED TAPES THE AREA IS OVERLAID
*         BY CODE AT .MXCO.
 
 .MXBA    BSS    0
 
 XBF3     LDD    BY
          LPN    1
          NJN    XBF5        IF ODD BYTE COUNT
          LDD    CM+2
          SBN    8D
          PJN    XBF6        IF .GT. 8 UNUSED BITS
 XBF4     UJN    XBF9        CHECK FOR NOISE
 
 XBF5     LDD    CM+2
          SBN    4
          PJN    XBF4        IF 4 OR MORE UNUSED BITS
          AOD    BY          INCREMENT BYTE COUNT
 XBF6     LDC    250         SET 3N+2 WRITE FUNCTION
          STM    //ITMA
          UJN    XBF4        CHECK FOR NOISE
 
 .XBFB    BSS    0
          ERRNG  BUFC-*      OVERFLOWED INTO BUFFER
          LOC    *O
 .XBFL    EQU    *-.XBFA
 MXB      SPACE  4,10
**        MXB - SET BYTE COUNT AND WRITE FUNCTION FOR
*               EXTERNAL 9 TRACK MTS TAPES.
 
 
 .MXBO    BSS    0
          LOC    .MXBA
 
          LDD    BY          SET BYTE COUNT MODULO 4
          LPN    3
          STD    T0
          SHN    1
          ADD    T0          BYTE COUNT * 3
          SHN    2           BYTE COUNT * 12
          SBD    CM+2        MINUS UBC
          PJN    MXB1        IF NOT UNDERFLOW
          ADN    48D
 MXB1     ADN    7           ROUND UP
          SHN    -3+21       DIVIDE BY 8
          PJN    MXB3        IF EVEN FRAME COUNT WRITE
          LDC    250         SET ODD FRAME COUNT WRITE
          STM    //ITMA
 MXB2     LJM    XBF9        CHECK FOR NOISE
 
 MXB3     LDD    T0          CHECK FOR SPECIAL CASE
          LMN    1
          NJN    MXB2        IF NOT ODD CASE
          AOD    BY
          UJN    MXB2        CHECK FOR NOISE
 
          ERRNG  BUFC-*
          LOC    *O
 .MXBL    EQU    *-.MXBO     LENGTH OF MTS 9 TRACK CODE
          SPACE  4,10
**        SET WRITE FUNCTION FOR 7 TRACK CODED/BINARY OR
*         9/18 TRACK CODED TAPES.
 
 
 .MXCO    BSS    0
          LOC    .MXBA
          ADN    6
          MJN    MXC1        IF EVEN CHARACTER COUNT
          LDC    F0250       SET SHORT WRITE
          STM    //ITMA
 MXC1     LJM    XBF9        CHECK FOR NOISE
          ERRNG  BUFC-*      CODE OVERFLOW BUFFER
          LOC    *O
 .MXCL    EQU    *-.MXCO     9 TRACK CODED OR 7 TRACK CODE LENGTH
 PRS      SPACE  4,25
**        PRS - PRESET.
*         THIS ROUTINE DOES CODE MODIFICATION FOR WRITE AND WRITE
*         LABEL FUNCTIONS.
*
*         EXIT   TO *PRSX* TO LOAD *CPP* OVERLAY, THEN RETURN AT
*                   *PRS54* IF WRITE DATA AND NOT LONG BLOCK.  WHEN
*                   PRESET IS COMPLETE EXIT TO *WTF*.
*                TO *PRSX* TO LOAD WRITE LABEL OVERLAY IF WRITE
*                   LABEL FUNCTION.
*                TO *PRSX* WITH (SC) = (SC)+1 TO LOAD LONG BLOCK
*                   OVERLAY FOR F AND L FORMAT.
*                TO *PRSX* WITH (SC) = (SC)+2 TO LOAD LONG BLOCK
*                   OVERLAY FOR LI FORMAT.
*                TO *RET3* IF NOT READY, NO WRITE ENABLE, OR ILLEGAL
*                   CODED FORMAT ERROR.
*                TO *WTF4* IF OTHER ERROR.
*                (WP, EP+1) PLUS THE BLOCK NUMBER IN (BL,BL+1) IS THE
*                   PHYSICAL BLOCK NUMBER IF CTS.
*
*         USES   CN, CN+4, T1, T8, CM - CM+4, T3 - T7.
*
*         CALLS  CNW, MCH, /PRESET/RBI, UAD.
 
 
 PRS      BSS    0           ENTRY
 
*         VALIDATE WRITE ACCESS.
 
          LDN    /MTX/WTB    200 BPI WRITE SUB-CODE
          STD    T0
          LDM    DNCV        CHECK FOR 200 BPI WRITE
          LPN    70
          LMN    /MTX/D02*10
          ZJN    PRS7        IF 200 BPI WRITE
          AOD    T0          WRITE ACCESS DISABLED SUB-CODE
          ERRNZ  /MTX/NWR-/MTX/WTB-1
          LDD    SP
          SHN    21-3
          MJN    PRS7        IF READ ONLY ACCESS
          AOD    T0          LABEL NOT EXPIRED SUB-CODE
          ERRNZ  /MTX/LNE-/MTX/NWR-1
          RJM    UAD
          ADN    /MTX/UVSN
          CRD    CM
          LDD    CM+3
          SHN    21-1
          MJN    PRS6        IF LABEL EXPIRED
          LDD    SP
          SHN    21-10
          MJN    PRS7        IF ENFORCING LABEL EXPIRATION
 PRS6     SOD    T0          WRITE ACCESS DISABLED SUB-CODE
          ERRNZ  /MTX/LNE-/MTX/NWR-1
          LDD    DS
          SHN    21-7
          MJN    PRS10       IF UNIT WRITE ENABLED
          SHN    0-0-21+7+22
          LPN    1
          ZJN    PRS8        IF UNIT NOT READY
 PRS7     LDD    T0          SET ERROR SUB-CODE
          STM    ERSC
          LDN    /MTX/NWE&/MTX/RDR  NO WRITE ENABLE
 PRS8     LMN    /MTX/RDR    READY DROP
          LJM    RET3        RETURN ERROR CODE
 
*         COMPLETE PRESET.
 
 PRS10    LDD    HP
          SHN    21-7
          PJN    PRS11       IF NOT CTS
          LDD    BL
          ADD    BL+1
          NJN    PRS11       IF STARTING BLOCK ID ALREADY SAVED
          RJM    /PRESET/RBI READ BLOCK ID
          AOM    /PRESET/PICA  LOCATE BLOCK NECESSARY IN ERROR RECOVERY
          LDM    BIDW+1
          STD    WP          SAVE CURRENT BLOCK ID
          LDM    BIDW+2
          STD    EP+1
 PRS10.2  LDD    FN
          LMN    /MTX/WLA
          NJN    PRS11       IF NOT WRITE LABEL
          LDD    PB
          SHN    -6
          LMN    1
          ZJN    PRS12       IF WRITE TRAILER LABEL
 PRS11    RJM    UAD         SET FILE WRITTEN FLAG
          ADK    /MTX/UVRI
          CRD    T3
          ADN    /MTX/UTMS-/MTX/UVRI
          CRD    CM
          AOD    T3+3        GET REEL NUMBER
          STD    CM+2
          RJM    UAD
          ADN    /MTX/UTMS
          CWD    CM
 PRS12    LDD    FM          SET TAPE FORMAT
          SHN    -6
          STD    T8
          LDD    FN
          LMN    /MTX/WTF
          NJN    PRS13       IF NOT WRITE DATA
          LDD    T8
          LMN    /MTX/TFLI
          NJN    PRS13       IF NOT LI FORMAT
          LDN    2
          RAD    SC          SET TO LOAD *WLI* OVERLAY
          LJM    PRSX        RETURN
 
 PRS13    LDC    PRSB
          RJM    MCH         MODIFY CHANNELS
          LDN    F0050       WRITE FUNCTION
          STM    //ITMA
          LDD    HP
          SHN    21-7
          PJP    PRS15       IF NOT CTS
          ISTORE /PRESET/GPSC,(UJN /PRESET/GPS6.1) DO NOT SEND CONTINUE
          LDC    WCTL-1
          STD    T1
 PRS14    LDM    .WCT,T1     REPLACE *WRT* WITH *WCT*
          STM    WRTX,T1
          SOD    T1
          PJN    PRS14       IF MORE CODE TO MOVE
          LDC    WCTK
          RJM    MCH         MODIFY CHANNEL INSTRUCTIONS
          ISTORE WTFB-1,(UJN WTF2)  SKIP INITIATE TAPE MOTION
          LDC    WCTC+1
          STM    IBFE        LOCATION TO STORE BLOCK LENGTH
          ISTORE WTFF,(ZJN WTF2)  JUMP ADDRESS IF NO DROP OUT
          LDC    WCTD+1
          STM    PRSA        ADDRESS TO SET MAXIMUM BLOCK SIZE
          LDC    UJNI+2
          STM    EOFB        SKIP INITIATE TAPE MOTION
          LDC    6331        GENERAL STATUS BITS TO TEST
          STM    /PRESET/WFEA
          LDC    201         GENERAL STATUS BITS THAT SHOULD BE SET
          STM    /PRESET/WFEB
          UJN    PRS16       CONTINUE PRESET
 
 PRS15    LDC    4635        GENERAL STATUS BITS TO TEST
          STM    //WEOA
          LDC    201
          STM    //WEOB      GENERAL STATUS BITS THAT SHOULD BE SET
 PRS16    LDD    FN          CHECK SOFTWARE FUNCTION
          LMN    /MTX/WTF
          ZJN    PRS17       IF WRITE FUNCTION
          LDN    /MTX/TFF    PROCESS AS IF F FORMAT
          STD    T8
 PRS17    LDD    T8
          SBN    /MTX/TFSI+1
          PJN    PRS18       IF S/L/F FORMAT
          LJM    PRS28       PRESET I/SI FORMAT
 
*         PRESET FOR S/L/F FORMAT.
 
 PRS18    LDN    .XBFL-1     MOVE CODE FOR S/L/F FORMATS
          STD    T1
 PRS19    LDM    .XBFA,T1
          STM    OVLB,T1
          SOD    T1
          PJN    PRS19       IF MORE CODE TO MOVE
          LDD    MD          CHECK MODE
          SHN    21-6
          PJN    PRS22       IF NOT CODED
 PRS20    LDN    .MXCL-1     TRANSFER 9/18 TRACK CODED OR 7 TRACK CODE
          STD    T1
 PRS21    LDM    .MXCO,T1
          STM    .MXBA,T1
          SOD    T1
          PJN    PRS21       IF MORE CODE TO MOVE
          UJN    PRS24       CONTINUE WITH CODED PROCESSING
 
 PRS22    LDD    HP          CHECK TRACK TYPE
          SHN    21-7
          MJN    PRS24       IF CTS
          SHN    21-0-21+7
          PJN    PRS20       IF 7 TRACK BINARY
          LDD    HP          CHECK CONTROLLER TYPE
          LPN    40
          ZJN    PRS24       IF NOT MTS CONTROLLER
          LDN    .MXBL-1     MOVE CODE FOR MTS 9 TRACK BINARY S/L/F
          STD    T1
 PRS23    LDM    .MXBO,T1
          STM    .MXBA,T1
          SOD    T1
          PJN    PRS23       IF MORE CODE TO MOVE
 PRS24    LDC    UJNI+2      PROCESS WRITE
          STM    WTFD
          LDD    HP
          SHN    21-7
          PJN    PRS25       IF NOT CTS
          LDN    0
          STM    WCTC
          STM    XBFD        NO NOISE FOR CTS
          LDC    LDDI+BY
          STM    WCTC+1
          LDC    UJNI+2      SKIP *IBF* DURING COMMAND RETRY
          STM    WCTH
          UJN    PRS26       CONTINUE PRESET
 
 PRS25    LDN    0           SET NON I/SI FORMAT BYTE COUNT
          STM    WRTB
          LDC    LDDI+BY
          STM    WRTB+1
 PRS26    LDD    MD
          LPN    40
          NJN    PRS27       IF 204 WRITE
          STM    XBFA
 PRS27    LJM    PRS36       CONTINUE PRESET
 
*         PRESET FOR I/SI FORMAT.
 
 PRS28    LDD    HP
          SHN    21-7
          MJN    PRS29       IF CTS
          SHN    21-0-21+7
          PJN    PRS33       IF 7 TRACK
 PRS29    AOM    IBFD
          LDD    HP
          LPN    40
          ZJN    PRS32       IF NOT MTS CONTROLLER
          LDD    T8
          LMN    /MTX/TFI
          ZJN    PRS30       IF I FORMAT
          LDC    LDDI&ADDI   SET FOR SI FORMAT
 PRS30    LMC    ADDI+BY
          STM    SIFA
 PRS31    LDC    SIF
          UJN    PRS34       SET CALL TO SIF
 
 PRS32    LDD    T8
          LMN    /MTX/TFSI
          ZJN    PRS31       IF SI FORMAT
 PRS33    LDC    LDNI
          STM    CNWL
 PRS34    STM    CNWL+1
          LDD    T8
          LMN    /MTX/TFI
          ZJN    PRS35       IF NOT SI FORMAT
          LDC    0           SET TO INITIALIZE SI BLOCK
          ORG    *-1
          LOC    IBFB
          ZJN    IBF3        IF FULL BLOCK SI FORMAT
          LOC    *O
          STM    IBFB
          LDN    0
          STM    IBFC
          STM    IBFC+1
          LCN    4
 PRS35    ADN    4
          RAM    WRTC+1      SET MAXIMUM BLOCK SIZE
 PRSA     EQU    *-1
*         RAM    WCTD+1      (CTS)
          LDD    MD
          LPN    40
          ZJN    PRS36       IF NOT 204 WRITE
          LDN    BY          SET TO GET LEVEL NUMBER FROM TRAILER
          RAM    IBFA
          LDC    BUF
          STM    IBFA+1
 PRS36    LDD    MD
          LPN    60
          SHN    -4
          STD    T7
          ZJN    PRS38       IF NOT CONTROL WORD
          LMC    LDNI
          STM    CNWA
          LPN    3
          RAM    CNWI
          LDC    LDDI+CN+3
          STM    CNWF
          LDC    BUFC
          STM    RCBA
          LDD    T8
          SBN    /MTX/TFSI+1
          MJN    PRS38       IF I OR SI FORMAT
          LDD    T7
          LPN    2
          ZJN    PRS37       IF NOT 204 WRITE
          LCN    -12D+57D
 PRS37    ADC    SBNI+57D
          STM    CNWJ
 PRS38    LDD    T7
          LPN    2
          ZJN    PRS40       IF NOT 204 WRITE
          LDC    STDI+BY
          STM    CNWG
          LDD    T8
          LMN    /MTX/TFF
          NJN    PRS39       IF NOT F FORMAT
          LDC    LDDI+MD     ENABLE MODE CHANGE
          STM    CNWH
 PRS39    UJN    PRS42       CONTINUE PRESET
 
 PRS40    LDD    T7
          NJN    PRS42       IF CONTROL WORD WRITE
          LDM    CIOE        SET TYPE OF WRITE OPERATION
          SHN    -3
          SHN    2
          LMD    MD
          LPN    14
          LMD    MD
          STD    MD
          LPN    14
          NJN    PRS41       IF NOT PRU WRITE (004)
*         LDN    0
          STM    WTFF
          LDC    WTF8
          STM    WTFG
 PRS41    LDD    MD
          LPN    14
          LMN    4
          ZJN    PRS42       IF WRITE (014)
          LDC    UJNI+2      BYPASS *DRCM*
          STM    WRTJ
 PRS42    LDD    T8
          SBN    /MTX/TFSI+1
          MJN    PRS43       IF I OR SI FORMAT
          LDD    T7
          LPN    2
          LMN    2
          NJN    PRS43       IF NOT 204 WRITE
          STM    CNWK
 PRS43    LDD    T8
          LMN    /MTX/TFS
          ZJN    PRS44       IF S FORMAT
          LMN    /MTX/TFL&/MTX/TFS
          NJN    PRS46       IF NOT L FORMAT
 PRS44    LDD    T7
          NJN    PRS45       IF CONTROL WORD OPERATION
*         LDN    0
          STM    WTFF        SET FOR PRU OPERATION
          LDC    WTF8
          STM    WTFG
          LDC    STDI+CM+4
          STM    CNWC
          LDM    LNUM        SET UBC
          LPN    77
          RAM    CNWB
          LDC    SBNI+57D
          STM    CNWJ
          LDC    NJNI-PJNI
          RAM    CNWD
 PRS45    UJN    PRS47       CONTINUE PRESET
 
 PRS46    LDD    T7
          NJN    PRS47       IF CONTROL WORD WRITE
          LDC    RADI+CM+4
          STM    CNWE
 PRS47    LDM    LNUM        SET LEVEL NUMBER
          SHN    -10
          STM    LNUM
          LDD    FN
          LMN    /MTX/WTF
          NJN    PRS48       IF NOT WRITE DATA
          LDD    MD
          LPN    14
          LMN    14
 PRS48    NJN    PRS50       IF NOT EOF WRITE
          LDD    T8
          SBN    /MTX/TFSI+1
          PJN    PRS49       IF NOT I/SI FORMAT
          LDC    EOF         SET TO WRITE EOF
          STM    WTFH
          LDM    LNUM
          LMN    17
          NJN    PRS49       IF NOT LEVEL 17
          STM    LNUM        DO NOT WRITE DOUBLE EOF
 PRS49    LDD    MD          CLEAR EOR/EOF FLAG THIS OPERATION
          LPC    7377
          STD    MD
          LDD    UP          CHECK LAST OPERATION EOR/EOF
          LPN    30
          LMN    20
          ZJN    PRS50       IF LAST OPERATION INCOMPLETE WRITE
          LDM    CIOE
          SHN    21-12
          MJN    PRS50       IF DATA IN BUFFER
          LDC    400         SET EOR/EOF FLAG THIS OPERATION
          RAD    MD
 PRS50    LDD    UP
          SCN    24          CLEAR BLANK TAPE FLAG
          LMN    20          SET LAST OPERATION WRITE FLAG
          STD    UP
          LDC    PRSC        SET UP FOR INSTRUCTION MODIFICATION
          STD    CN
          LDN    3           SET TO RETURN OUT POINTER
          STD    CN+4
          LDC    /SRU/ITRW*100  SET SRU INCREMENT
          STM    //CECA
          LDD    OV
          ZJN    PRS52       IF NOT POSSIBLE LONG BLOCKS
          LDD    T8
          LMN    /MTX/TFL
          ZJN    PRS51       IF L FORMAT
          LMN    /MTX/TFF&/MTX/TFL
          NJN    PRS52       IF NOT F FORMAT
 PRS51    LDD    FN
          LMN    /MTX/WTF
          NJN    PRS53       IF NOT WRITE
          AOD    SC          SET TO LOAD LONG BLOCK OVERLAY
 PRS52    LDD    FN
          LMN    /MTX/WTF
          NJN    PRS53       IF NOT WRITE DATA
          LDC    PRS54       SET TO RETURN HERE IF NOT LONG BLOCKS
          STD    BT
 PRS53    LJM    PRSX        RETURN
 
*         RETURN HERE AFTER ALL ROUTINES LOADED IF WRITE DATA.
 
 PRS54    LDD    HP
          SHN    21-7
          PJN    PRS55       IF NOT CTS
          LDD    CN+3
          STM    OPTU        SAVE OUT POINTER FOR COMMAND RETRY
          LDD    CN+4
          STM    OPTL
 PRS55    RJM    CNW         CHECK FIRST WRITE
          ZJN    PRS56       IF WRITE OK
          LJM    WTF4        PROCESS ERROR CONDITION
 
 PRS56    LDD    HP
          SHN    21-7
          PJN    PRS59       IF NOT CTS
          LDD    MD
          SHN    21-6
          PJN    PRS58       IF NOT CODED
          LDD    BY
          LMN    LABL
          ZJN    PRS57       IF CORRECT LENGTH FOR LABEL
          LDN    /MTX/SCI    CODED I/O NOT SUPPORTED
          LJM    RET3        RETURN ERROR CODE
 
 PRS57    LDC    F0250
          STM    ITMA        SHORT WRITE
          STM    XBFE
          LDC    LDNI+CCW/10000
          STM    WCTA        DO CODE CONVERSION
          LDC    LDNI+CLBL
          STM    WCTB        LENGTH TO WRITE
 PRS58    UJN    PRS61       SET BLOCKS WRITTEN FLAG
 
 PRS59    SHN    21-5-21+7
          PJN    PRS60       IF NOT MTS UNIT
          LDC    UJNI-NJNI
          RAM    WRTF
 PRS60    LDM    DLYA
          LPN    14
          ZJN    PRS61       IF 1X PPU SPEED
          LPN    4
          ZJN    PRS61       IF 2X PPU SPEED
          LDC    ITM         ENABLE MOTION AHEAD
          STM    WTFA+1
          LDC    RCB
          STM    WTFB
 PRS61    LDC    4000        SET BLOCKS WRITTEN FLAG
          STD    BT
          LJM    WTF         INITIATE WRITE
 
 
 PRSB     CHTB
 PRSC     TSAD
 WCT      SPACE  4,15
**        WCT - WRITE CARTRIDGE TAPE.
*
*         THIS ROUTINE OVERLAYS THE FIRST PART OF *WRT* FOR CTS.
*         THE LENGTH OF THIS ROUTINE MUST BE THE SAME AS THE LENGTH
*         OF THE FIRST PART OF *WRT*.
*
*         ENTRY  (BY) = BYTES TO TRANSFER.
*
*         EXIT   (CN+3, CN+4) = OUT POINTER.
*                TO */WLB/ODAB* IF COMMAND RETRY FOR LONG BLOCKS.
*
*         USES   CM - CM+4, CN - CN+2.
*
*         CALLS  CNW, *CWP*, IBF, ITM, LOV, RCB, /PRESET/WFE.
*
*         MACROS CALL.
 
 
 .WCT     BSS    0
          LOC    WRTX
 WCT      SUBR               ENTRY/EXIT
 WCT1     UJN    WCT2        WRITE DATA, NOT LONG BLOCKS
 WCTA     EQU    *-1
*         LDN    CCW/10000   (CODE CONVERSION OVERLAY NUMBER)
*         UJN    WCT3        (LONG BLOCKS)
          RJM    LOV         LOAD OVERLAY AND DO CODE CONVERSION
 WCT2     RJM    ITM
          LDD    BY
 WCTB     EQU    *-1
*         LDN    CLBL        (CTS LABEL LENGTH)
          OAM    BUF,CH      OUTPUT BLOCK
          FJM    *,CH
 
*         DELAY 10 MICROSECONDS TO PREVENT A HARDWARE ERROR IN THE
*         CCC.  THE DISCONNECT WOULD SOMETIMES CAUSE THE LAST BYTE TO
*         BE LOST.
 
          LDN    20
          SBN    1
          NJN    *-1
          DCN    CH+40
 WCT3     LDD    UP
          SCN    10          CLEAR EOR/EOF LAST BLOCK FLAG
          STD    UP
          LDD    MD
          LPC    7377        CLEAR EOR/EOF THIS OPERATION FLAG
          STD    MD
          LDC    *           BLOCK LENGTH (I, SI FORMAT)
 WCTC     EQU    *-2
*         PSN                (NOT I, SI FORMAT)
*         LDD    BY          (NOT I, SI FORMAT)
          LMC    5000
 WCTD     EQU    *-2
*         LMC    5004        (I FORMAT)
*         LDN    0           (WRITE LABEL)
*         LDN    0           (WRITE LABEL)
          ZJN    WCT4        IF NOT EOR/EOF WRITTEN
          LDN    10
          RAD    UP          SET EOR/EOF FLAGS
          LDC    400
          RAD    MD
 WCT4     LDD    MA
          CWD    CN          SAVE OLD OUT POINTER
          RJM    CNW         CHECK NEXT WRITE
 WCTE     EQU    *-2
*         UJN    WCT5        (WRITE LABEL)
          LDM    WTFE
          ADD    DF
          NJN    WCT5        IF NO MORE DATA OR DROP OUT SET
 WCTF     EQU    *-1
*         UJN    WCT5        (LONG BLOCKS)
          RJM    RCB         READ NEXT BLOCK FROM CENTRAL BUFFER
 WCT5     RJM    /PRESET/WFE WAIT FOR END OF OPERATION
          PJP    WCT8        IF NOT COMMAND RETRY
          LDM    OPTU        RESET OUT POINTER
 WCTG     EQU    *-2
*         UJN    WCT7        (WRITE LABELS)
          STD    CN+3
          LDM    OPTL
          STD    CN+4
          LDD    MD
          LPC    7377        CLEAR EOR/EOF THIS OPERATION FLAG
          STD    MD
          RJM    CNW         CHECK NEXT WRITE
          LDM    WCT
          LMC    EOFC
          NJN    WCT6        IF NOT CALLED FROM *EOF*
          STD    T6
          STD    BY          SET TO WRITE EOF
          RJM    IBF
          UJN    WCT7        ISSUE THE CONTINUE FUNCTION
 
*         FOR LONG BLOCKS, THE FOLLOWING CODE IS OVERLAYED WITH
*         */WLB/.WCT*.
 
*         LDN    F0002       (LONG BLOCKS)
*         STM    ITMA        (LONG BLOCKS)
*         LJM    /WLB/ODAB   (LONG BLOCKS)
 
 WCT6     RJM    RCB         READ CENTRAL BUFFER
          RJM    IBF         PROCESS I/SI FORMAT
 WCTH     EQU    *-2
*         UJN    *+2         (NOT I/SI FORMAT)
 WCT7     LDN    F0002
          STM    ITMA        CONTINUE IS THE NEXT FUNCTION
          LJM    WCT1        RETRY THE WRITE
 WCTI     EQU    *-1
*         LJM    WCT2        (WRITE LABEL)
 
 WCT8     ZJN    WCT9        IF NO ERROR
          LDN    /MTX/STE    STATUS ERROR
 WCT9     STD    EC
          ADD    EI
          ZJN    WCT10       IF NO ERROR OR NO RECOVERED ERROR
          LDD    MA
          CRD    CN          RESET TO OLD OUT POINTER
          CALL   CWP
 
*         RETURN HERE IF END OF TAPE OR RECOVERED ERROR.
 
          LDM    WTFE
          ADD    DF
          NJN    WCT10       IF NO MORE DATA OR DROP OUT
 WCTJ     EQU    *-1
*         UJN    WCT10       (LONG BLOCKS)
*         UJN    WRT7        (WRITE LABEL)
          LDM    WRTK
          LMC    WRTX
          NJN    WCT10       IF END OF TAPE
          RJM    RCB         READ CENTRAL BUFFER
 WCT10    LDD    MA
 WCTM     EQU    *-1
*         UJN    WRT7        (WRITE LABEL)
          CRD    CM
          LDD    CM+3
          STM    OPTU        SAVE OUT POINTER FOR COMMAND RETRY
          LDD    CM+4
          STM    OPTL
 
 WCTL     EQU    *-WCTX      LENGTH OF *WCT*
          ERRNZ  WRT5.1-*    ADJUST *BSS* BEFORE *WRT5.1*
 
          LOC    *O
 
 WCTK     CHTB               CHANNEL TABLE
 SMA      SPACE  4,10
          OVERLAY (WRITE LONG BLOCK PROCESSOR.),(BUFC+12),,WLB
 .IM      SET    1           SET FOR ADDRESS MODIFICATION ON ERRORS
 
*         LOCAL TO OVERLAY DEFINITIONS.
 
 NC       EQU    PA          NUMBER OF CHUNKS
 BC       EQU    PB          BYTE COUNT LAST CHUNK
 ODA      SPACE  4,10
**        ODA - OUTPUT DATA.
*
*         CALLS  ADP, CRA, ITM, OPA, OPD, OPI, OPL, RDA, SRQ.
*
*         MACROS CHTE.
 
 
 ODA      SUBR               ENTRY/EXIT
          RJM    //ITM       INITIATE TAPE MOTION
*         UJN    *+2         (ANY GCR UNIT AT 1X PPU SPEED
*                            OR 200 IPS GCR UNIT AT 2X SPEED)
*         UJN    *+2         (CTS)
 ODAA     EQU    *-1
 ODAB     LDN    0           ALLOW FOR CONTROL WORD
*         LDN    1           (204/264 WRITE)
          RJM    ADP
          LDN    0           PRESET CHUNKS OUTPUT COUNT
          STD    CM+7
          LDC    LBBY
          STD    BY
          LDM    OPAB        SET FIRST CHUNK FLAGS
*         LDM    OPIB        (CYBER 180)
 ODAC     EQU    *-1
          STM    OPAA
*         STM    OPIA        (CYBER 180)
*         STM    OPDA        (MTS)
 ODAD     EQU    *-1
          LDN    PSNI        ENABLE WAIT FOR *1LT*
          STM    OPLA
*         STM    OPEA        (CYBER 180)
*         STM    ODAF        (MTS)
 ODAF     EQU    *-1
          LDD    NC
          ZJN    ODA5        IF *1LT* NOT NEEDED
          SBN    2
          PJN    ODA1        IF *1LT* NEEDED
          LDD    BC
          ZJN    ODA4        IF *1LT* NOT NEEDED
          ADC    LBBY-LCKS   SET BYTE COUNT FOR CHECKSUM
          MJN    ODA2        IF .LT. L TAPE SIZE
 ODA1     LDN    0
 ODA2     ADC    LCKS
          STM    RDAB
          LDC    LDNI+1
          STM    ODAL        SET *1LT* CALLED FLAG
          LDN    0           SET UP POINTERS FOR *1LT*
          RJM    ADP
 ODAG     LDN    1           SEND REQUEST TO *1LT*
*         UJN    ODA3        (ANY GCR UNIT AT 1X PPU SPEED
*                            OR 200 IPS GCR UNIT AT 2X SPEED)
*         UJN    ODA3        (CTS)
          RJM    SRQ
 ODA3     UJN    ODA8        OUTPUT DATA
 
 ODA4     LDC    LBBY
          STD    BC
          LDC    /MTX/LBWD
          STM    .WC
 ODA5     LDM    OPLB        SET *1LT* NOT NEEDED FLAGS
*         LDM    OPEB        (CYBER 180)
 ODAH     EQU    *-1
          STM    OPLA
*         STM    OPEA        (CYBER 180)
 ODAI     EQU    *-1
          LDD    BC
          STM    RDAB        SET BYTE COUNT FOR CHECKSUM
          STD    BY
          LJM    ODA11       SET UP TO READ NEXT BLOCK
 
 ODA6     LDN    2           INCREMENT CHUNK COUNT
          RAD    CM+7
          SBD    NC
          PJN    ODA9        IF NO MORE FULL CHUNKS
          ADN    1
          NJN    ODA7        IF NOT 1 CHUNK LEFT
          LDD    BC
          ZJN    ODA9        IF ZERO REMAINDER
 ODA7     LDC    /MTX/LBWD   SKIP OVER DATA *1LT* OUTPUT
          RJM    ADP
 ODA8     LDC    /MTX/LBWD   SET UP TO READ NEXT DATA CHUNK
          RJM    RDA         READ DATA
          RJM    OPD         OUTPUT DATA
*         RJM    OPA         (ATS NON-CYBER 180)
*         RJM    OPI         (CYBER 180)
 ODAJ     EQU    *-1
          ZJN    ODA6        IF FULL BLOCK OUTPUT
          UJP    ODA14       STORE BYTES NOT WRITTEN
 
 ODA9     ZJN    ODA10       IF TRANSFER NOT COMPLETE FOR *1MT*
          LDM    .WC         ADVANCE POINTER OVER *1LT,S* CHUNK
          RJM    ADP
          UJN    ODA15       CHECK IF *1LT* WAS CALLED
 
 ODA10    AOD    CM+7        COUNT CHUNK
          LDC    /MTX/LBWD   SKIP OVER DATA *1LT* OUTPUT
          RJM    ADP
          LDD    BC
          ZJN    ODA12       IF POSSIBLE OUTPUT COMPLETE
          STD    BY
 ODA11    LDM    .WC         SET UP TO READ UP NEXT BLOCK
          UJN    ODA13       READ DATA
 
 ODA12    LDD    NC
          LPN    1
          ZJN    ODA15       IF OUTPUT COMPLETE
          LDC    /MTX/LBWD
 ODA13    RJM    RDA         READ DATA
          RJM    OPD         OUTPUT DATA
*         RJM    OPL         (ATS NON-CYBER 180 - OUTPUT LAST CHUNK)
*         RJM    OPE         (CYBER 180 - OUTPUT LAST CHUNK)
 ODAK     EQU    *-1
          FJM    *,CH
          NJN    ODA14       IF INCOMPLETE TRANSFER
 
*         A 10 MICROSECOND DELAY MUST BE DONE TO PREVENT POSSIBLE LOSS
*         OF THE LAST BYTE OF THE TRANSFER BY THE CCC FOR CTS.
 
          LDN    20
          SBN    1
          NJN    *-1
          DCN    CH+40
 ODA14    STM    /WRITE/BYRM
 ODA15    LDN    0
 ODAL     EQU    *-1
          ZJN    ODA17       IF *1LT* NOT CALLED
          SOM    ODAL        CLEAR *1LT* CALLED FLAG
 ODA16    RJM    CRA         CHECK REQUEST ACCEPTANCE FROM *1LT*
          LMN    2
          NJN    ODA16       IF NOT ACCEPT
          STD    CM          ACKNOWLEDGE *1LT*
          LDM    CPDA
          ADN    2
          CWD    CM
 ODA17    LDD    CM+7
          ZJN    ODA18       IF NO FULL CHUNKS OUTPUT
          LCN    0           SET TO NOT CONTROL BACKSPACE
          STM    /WRITE/BYWR
 ODA18    LDN    0           SKIP TRAILER CONTROL WORD IF PRESENT
 ODAM     EQU    *-1
*         LDN    1           (204 WRITE)
          RJM    ADP
          LJM    ODAX        RETURN
          TITLE  SUBROUTINES.
 ADP      SPACE  4,15
**        ADP - ADVANCE POINTER.
*
*         ENTRY  (CN+3 - CN+4) = OUT POINTER.
*                (A) = WORDS TO INCREMENT OUT BY.
*
*         EXIT   (T4 - T5) = STARTING OUT POINTER.
*                (CN+3 - CN+4) = UPDATED OUT POINTER.
*                (T6) = FIRST PART WORD COUNT.
*                (T7) = SECOND PART WORD COUNT.
*
*         MACROS SADT.
 
 
 ADP      SUBR               ENTRY/EXIT
          STD    T6
          LDD    CN+3        SAVE OUT
          STD    T4
          LDD    CN+4
          STD    T5
          LDN    0           PRESET SECOND PART WORD COUNT
          STD    T7
          LDD    T6          UPDATE OUT
          RAD    CN+4
          SHN    -14
          RAD    CN+3
          SHN    14
          LMD    CN+4
          SADT   .LM,C
          ADC    -*          (-LIMIT)
          MJN    ADPX        IF NO WRAP AROUND
          STD    T7          SET SECOND PART WORD COUNT
          SADT   .FT
          ADC    *           (FIRST)
          STD    CN+4
          SHN    -14
          STD    CN+3
          LDD    T6          RESET FIRST PART WORD COUNT
          SBD    T7
          STD    T6
          UJN    ADPX        RETURN
 CNL      SPACE  4,10
**        CNL - CHECK NEXT WRITE LONG BLOCKS.
*
*         ENTRY  (CN+3 - CN+4) = OUT POINTER.
*
*         EXIT   SEE /WRITE/CNW.
*
*         CALLS  /WRITE/COB, /WRITE/XBF.
*
*         MACROS SADT.
 
 
 CNL17    LDN    2           SET NOT ENOUGH DATA
 CNL18    LJM    /WRITE/CNW10  EXIT WITH NEXT WRITE STATUS
 
 CNL      BSS    0           ENTRY
          LDN    ZERL        PRESET CONTROL WORD
          CRD    CM
          RJM    /WRITE/COB  CHECK OUTPUT BUFFER
          ZJN    CNL17       IF NO DATA
 CNLA     UJN    CNL1        PROCESS CONTROL WORD WRITE
*         STD    CM+4        (NOT 204/264 WRITE)
          SHN    -14
          STD    CM+3
 CNLB     LDN    0           SET UBC
          STD    CM+2
          UJN    CNL2        CALCULATE NUMBER OF CHUNKS
 
 CNL1     LDD    CN+3        READ CONTROL WORD
          SHN    6
          ADD    RA
          SHN    6
          ADD    CN+4
          CRD    CM
 CNL2     LDC    /MTX/LBWD   WORDS PER CHUNK
 CNLC     EQU    *-1
*         LDC    LBBY        BYTES PER CHUNK (204 WRITE)
          STD    T1
          LDN    0
          STD    NC
 
*         DETERMINE NUMBER OF CHUNKS AND REMAINDER.
 
 CNL3     LDD    CM+4
          SBD    T1
          STD    CM+4
          PJN    CNL4        IF NO UNDERFLOW
          AOD    CM+4
          SOD    CM+3
          MJN    CNL5        IF UNDERFLOW
 CNL4     AOD    NC          COUNT CHUNK
          UJN    CNL3        LOOP
 
 CNL5     LDD    T1
          RAD    CM+4
          STD    BY          PRESET BYTES AND WORDS IN LAST BLOCK
          STD    BC
          STM    .WC
 CNLD     UJN    CNL6        (204 WRITE)
*         LDD    CM+4        BYTES = 5 * CM WORDS  (NOT 204 WRITE)
          SHN    2
          RAD    BY
          UJN    CNL7        CHECK FOR LEGAL BLOCK SIZE
 
 CNL6     LDD    CM+4        ROUND UP BYTES
          ADN    4
          STD    T2
          SHN    1           13*BYTES
          ADD    T2
          SHN    2
          ADD    T2
          SHN    14  (-6)    (13*BYTES)/64
          STD    T0
          SHN    6+2         4*13*BYTES  (52*BYTES)
          SBD    T2          51*BYTES
          ADD    T0          (51*BYTES)+((13*BYTES)/64)
          SHN    -8D         WORDS = ((51*BYTES)+((13*BYTES)/64))/256
          STM    .WC
 
*         CHECK IF LEGAL BLOCK SIZE.
 
 CNL7     LDD    NC
          STD    T1
          LDM    .WC
          STD    T7
          LDN    0
          STD    T6
 CNL8     SOD    T1
          MJN    CNL9        IF END OF CHUNKS
          LDC    /MTX/LBWD
          RAD    T7
          SHN    -14
          RAD    T6
          UJN    CNL8        LOOP
 
 CNL9     LDD    T6
          SHN    14
          LMD    T7
          SADT   .BS,C,1
          ADC    -*
          PJN    CNL11       IF BLOCK TOO LARGE
          LDD    FM
          SHN    -6
          LMN    /MTX/TFF
          NJN    CNL12       IF NOT F FORMAT
          LDD    MD
          LMD    CM
          SHN    -4
          LPN    4
          ZJN    CNL12       IF NO MODE CHANGE
 CNL10    LJM    CNL18       EXIT WITH NEXT WRITE STATUS
 
 CNL11    LDN    10          SET BUFFER CONTROL WORD ERROR
          UJN    CNL10       EXIT WITH NEXT WRITE STATUS
 
 CNL12    LDD    MD          CHECK IF ENOUGH DATA
          LPN    60
          SHN    -4
          RAD    T7
          SHN    -14
          RAD    T6
          RJM    /WRITE/COB  CHECK OUTPUT BUFFER
          SHN    6
          SBD    T6
          SHN    14
          SBD    T7
          PJN    CNL13       IF ENOUGH DATA IN OUTPUT BUFFER
          LJM    CNL17       SET NOT ENOUGH DATA
 
 CNL13    LDM    /WRITE/CNWJ
          LPN    77
          LMC    -0
          ADD    CM+2
          PJP    CNL11       IF INCORRECT UBC
          LDN    2           PRESET FOR POSSIBLE 204 EOF WRITE
          STD    T6
          LDD    NC
          ZJN    CNL14       IF ONLY PARTIAL CHUNK
          LDD    HN          SET TO PREVENT NOISE BLOCK ERROR
          RAD    BY
 CNL14    RJM    /WRITE/XBF
          STD    CM+4
          LDD    NC
          ZJN    CNL15       IF ONLY PARTIAL CHUNK
          LDC    -100
 CNL15    ADD    BY
          STD    BC
          PJN    CNL16       IF NO UNDERFLOW IN BYTE COUNT
          ADC    LBBY        RESET BYTE COUNT
          STD    BC
          LDC    /MTX/LBWD   SET WORD COUNT IN LAST CHUNK
          STM    .WC
          SOD    NC          DECREMENT CHUNK COUNT
 CNL16    LDD    CM+4
          LJM    CNL18       EXIT WITH NEXT WRITE STATUS
 CPD      SPACE  4,10
**        CPD - CHECK PP (1LT) DROP OUT.
*
*         ENTRY  (CPDA) = PP INPUT REGISTER ADDRESS.
*
*         EXIT   (A) = 0, IF *1LT* STILL AROUND.
*
*         USES   CM - CM+4.
*
*         MACROS CHTE.
 
 
 CPD      SUBR               ENTRY/EXIT
          LDC    *           (ADDRESS OF *1LT* INPUT REGISTER)
 CPDA     EQU    *-1
          CRD    CM
          LDD    CM+1
          SCN    77
          SHN    6
          LMD    CM
          LMC    3RT1L
          ZJN    CPD1        IF *1LT*
          SHN    14
          LMN    1R1
          NJN    CPDX        IF NOT *1LT* LOADING
 CPD1     LDD    CM+3        CHECK FOR CORRECT CHANNEL
          CHTE   *
          LMN    CH
          LPN    77
          UJN    CPDX        RETURN
 CRA      SPACE  4,10
**        CRA - CHECK REQUEST ACCEPTANCE FROM *1LT*.
*
*         EXIT   (A) = REQUEST BYTE.
*                (CM - CM+4) = REQUEST/RETURN WORD.
 
 
 CRA      SUBR               ENTRY/EXIT
          LDM    CPDA
          ADN    2
          CRD    CM
          LDD    CM
          UJN    CRAX        RETURN
 ITS      SPACE  4,10
**        ITS - INDICATE *1MT* TRANSFER STARTED.
*
*         ENTRY  (A) = BYTE COUNT.
*
*         EXIT   (A) = BYTE COUNT.
 
 
 ITS      SUBR               ENTRY/EXIT
          STD    T0          SAVE BYTE COUNT
          LDM    CPDA        INDICATE *1MT* TRANSFER STARTED
          ADN    3
          CWD    ON
          LDD    T0          RESTORE (A)
          UJN    ITSX        RETURN
          SPACE  4,10
 .OPAA    BSS    0           START OF WRITE ROUTINE OVERLAYS
 OPE      SPACE  4,10
**        OPE - OUTPUT ENDING DATA FROM CYBER 180 IOU.
*
*         ENTRY  (A) = NUMBER OF BYTES TO OUTPUT.
*
*         EXIT   (A) = BYTES LEFT.
*
*         CALLS  WTS.
 
 
 OPE      SUBR               ENTRY/EXIT
 OPEA     UJN    OPE2        OUTPUT DATA
*         PSN                (*1LT* USED)
          RJM    WTS         WAIT FOR *1LT* TRANSFER TO START
 OPE1     IJM    OPEX,CH     IF *1LT* WROTE PARTIAL BLOCK
          SCF    OPE1,CH     WAIT FOR *1LT* TO CLEAR CHANNEL FLAG
 OPE2     OAM    BUFB,CH     OUTPUT CHUNK
          UJN    OPEX        RETURN
 
 
 OPEB     BSS    0
          LOC    OPEA
          UJN    OPE2        OUTPUT DATA
          LOC    *O
 OPI      SPACE  4,10
**        OPI - OUTPUT DATA FROM CYBER 180 IOU.
*
*         IF THERE ARE MULTIPLE CHUNKS IN THE BLOCK, THIS ROUTINE
*         IS USED FOR ALL BUT THE LAST CHUNK.  *OPE* IS USED FOR THE
*         LAST CHUNK.
*
*         ENTRY  (A) = NUMBER OF BYTES TO OUTPUT.
*
*         EXIT   (A) = BYTES REMAINING IF INCOMPLETE TRANSFER.
*
*         CALLS  ITS, WTS.
 
 
 OPI      SUBR               ENTRY/EXIT
 OPIA     UJN    OPI2        FIRST CHUNK
*         PSN                (NOT FIRST CHUNK)
          RJM    WTS         WAIT FOR *1LT* TRANSFER TO START
 OPI1     IJM    OPIX,CH     IF *1LT* WROTE ONLY PARTIAL CHUNK
          SCF    OPI1,CH     WAIT FOR *1LT* TO CLEAR CHANNEL FLAG
          RJM    ITS         INDICATE *1MT* TRANSFER STARTED
 OPI2     OAM    BUFB,CH     OUTPUT DATA
          NJN    OPIX        IF INCOMPLETE TRANSFER
          CCF    *,CH        SIGNAL *1LT* TO START OUTPUT
          STM    OPIA        SET UP FOR SUBSEQUENT CHUNKS
          UJN    OPIX        RETURN
 
 
 OPIB     BSS    0
          LOC    OPIA
          UJN    OPI2        OUTPUT NEXT BLOCK
          LOC    *O
 
 
 .OPALC   EQU    *-.OPAA     END OF OVERLAID AREA
 RDA      SPACE  4,15
**        RDA - READ DATA FROM CENTRAL.
*
*         ENTRY  (A) = WORDS TO READ.
*                (T4 - T5) = OUT POINTER.
*                (T6) = FIRST PART WORD COUNT.
*                (T7) = SECOND PART WORD COUNT.
*
*         EXIT   (/WRITE/BYWR) = BY.
*
*         CALLS  ADP, /WRITE/CKS, ITM, SRQ.
*
*         MACROS SADT.
 
 
 RDA      SUBR               ENTRY/EXIT
          RJM    ADP         ADVANCE POINTERS
          LDD    T6
          ZJN    RDAX        IF NO FIRST PART
          SHN    2
          ADD    T6
          ADC    BUFB
          STM    RDAA
          LDD    T4          READ FIRST PART
          SHN    6
          ADD    RA
          SHN    6
          ADD    T5
          CRM    BUFB,T6
          LDD    T7
          ZJN    RDA1        IF NO SECOND PART
          SADT   .FT,,,A
          LDC    *           READ SECOND PART
          CRM    *,T7
 RDAA     EQU    *-1
 RDA1     LDC    0           SET BYTE COUNT FOR CHECKSUM
 RDAB     EQU    *-1
          ZJN    RDA3        IF NOT FIRST CHUNK
 RDAC     UJN    RDA2        CHECKSUM DATA
*         RJM    ITM         (ATS GCR UNIT, 1X PPU SPEED OR 200 IPS)
*         RJM    ITM         (CTS)
          CON    ITM
          LDM    ODAL
          LPN    77
          ZJN    RDA2        IF *1LT* NOT NEEDED
          LDN    1           SEND REQUEST TO *1LT*
          RJM    SRQ
 RDA2     LDM    UBWB        USE HARDWARE CHECKSUM
          STD    LG+1
          NJN    RDA2.1      IF NON ZERO CHECKSUM
          AOD    LG+1
 RDA2.1   LDN    0           CLEAR FIRST CHUNK FLAG
          STM    RDAB
 RDA3     LDD    BY
          STM    /WRITE/BYWR  SET BYTES TO WRITE
          LJM    RDAX        RETURN
 SRQ      SPACE  4,10
**        SRQ - SEND REQUEST TO *1LT* TO START BLOCK.
*
*         ENTRY  (A) = REQUEST CODE.
*                (T4 - T5) = POINTER.
*                (BC) = BYTE COUNT OF LAST CHUNK.
*                (NC) = NUMBER OF CHUNKS.
*
*         USES   T1, T2, T3, CM - CM+4.
*
*         CALLS  CPD, CRA, HNG.
 
 
 SRQ      SUBR               ENTRY/EXIT
          STD    T1
 SRQA     UJN    SRQ1        NO CHANNEL FLAG
*         PSN                (CYBER 180 IOU)
          SCF    *+2,CH      SET CHANNEL FLAG
          LDM    CPDA        INDICATE *1MT* TRANSFER STARTED
          ADN    3
          CWD    ON
 SRQ1     RJM    CRA         CHECK *1LT* ACCEPT
          NJN    SRQ2        IF *1LT* OUT OF SYNC
          LDM    CPDA        CHECK *1LT* FUNCTION
          ADN    1
          CRD    CM
          LDD    CM
          LMN    PRLM
          ZJN    SRQ3        IF *1LT* PAUSING
          LDD    BC          SET BYTE COUNT
          STD    T2
          LDD    NC          SET NUMBER OF CHUNKS
          STD    T3
          LDM    CPDA        ENTER REQUEST
          ADN    2
          CWD    T1
          RJM    CPD         CHECK IF PP DROPPED OUT
          NJN    SRQ2        IF *1LT* MISSING
          LJM    SRQX        RETURN
 
 SRQ2     RJM    HNG         HANG PP
 
 SRQ3     LJM    RET2        REQUEUE REQUEST
 WTS      SPACE  4,10
**        WTS - WAIT FOR *1LT* TRANSFER TO START.
*
*         ENTRY  (A) = BYTE COUNT.
*
*         EXIT   (A) = BYTE COUNT.
*
*         USES   CM - CM+4.
 
 
 WTS3     LDD    T0          RESTORE (A)
 
 WTS      SUBR               ENTRY/EXIT
          STD    T0          SAVE BYTE COUNT
 WTS1     LDM    CPDA        CHECK *1MT*/*1LT* INTERLOCK
          ADN    3
          CRD    CM
          LDD    CM
          ZJN    WTS3        IF *1LT* TRANSFER STARTED
          LDN    24          DELAY 10 MICROSECONDS
 WTS2     SBN    1
          NJN    WTS2        IF NOT DONE
          UJN    WTS1        CHECK INTERLOCK
          SPACE  4,10
 .WC      CON    0           WORD COUNT OF LAST CHUNK
          SPACE  4,10
          BUFFER BUFB
 CALL     SPACE  4,10
 .IM      SET    0           DISABLE ADDRESS MODIFICATION ON ERRORS
 
**        *1LT* CALL BLOCK.
*
*T        18/  1LT,6/ CP,6/ HP,6/ 1,1/ CF,11/ CHANNEL,12/ PPIA
*T,       12/  -0,24/  FIRST,24/  LIMIT
 
 
 CALL     VFD    18/3R1LT,6/0
          CON    1           WRITE
          CHTE   *
          CON    CH          CHANNEL
          CON    0           *1MT* INPUT REGISTER ADDRESS
          CON    -0
          SADT   .FT,,,,SE
          CON    0,0
          SADT   .LM,,,,SE
          CON    0,0
          TITLE  PRESET.
 PRS      SPACE  4,10
**        PRS - PRESET.
*
*         EXIT   TO */WRITE/WTF1* TO WRITE BLOCK.
*                TO */WRITE/WTF4* IF ERROR FROM *CNW*.
*                TO *RET2* TO REQUEUE IF *1LT* NOT ASSIGNED.
*
*         CALLS  CEC, *CPP*, /WRITE/CNW, CPD, MCH, SRC.
*
*         MACROS MONITOR, PAUSE.
 
 
 PRS      LDC    PRSB        MODIFY CHANNELS IN RESIDENT
          RJM    MCH
          LDN    0
          STD    T3          CLEAR TAPE OUTPUT TYPE
          LDK    MABL        CHECK MAINFRAME TYPE
          CRD    CM
          LDD    CM+1
          SHN    -6
          LPN    41
          LMN    1
          ZJN    PRS1        IF CYBER 180
          AOD    T3
          LDD    HP
          LPN    60
          SHN    6
          RAM    CALL+3
          SHN    21-12
          PJN    PRS1        IF MTS CONTROLLER
          AOD    T3
 PRS1     RJM    SRC         SET RESIDENT CONTROLLER ROUTINE
          LDC    LJMI        SET CALL FOR CHECK NEXT WRITE
          STM    /WRITE/CNWA
          LDC    CNL
          STM    /WRITE/CNWA+1
          LDD    HP
          SHN    21-7
          PJN    PRS1.2      IF NOT CTS
          LDN    .WCTL-1
          STD    T1          LENGTH OF CODE TO MOVE
 PRS1.1   LDM    .WCT,T1
          STM    /WRITE/WCT6,T1  MOVE COMMAND RETRY CODE
          SOD    T1
          PJN    PRS1.1      IF MORE CODE TO MOVE
          ISTORE /WRITE/WCTA,(UJN /WRITE/WCT3)
          ISTORE /WRITE/WCTF,(UJN /WRITE/WCT5)
          ISTORE /WRITE/WCTJ,(UJN /WRITE/WCT10)  SKIP READ CM BUFFER
          UJN    PRS1.3      CONTINUE PRESET
 
 PRS1.2   LDM    PRSC
          STM    /WRITE/WRTA
          LDM    PRSD
          STM    /WRITE/WRTE
          LDM    PRSE
          STM    /WRITE/WRTG
 PRS1.3   LDM    PRSF
          STM    /WRITE/WTFA
          LDC    UJNI+2
          STM    /WRITE/WTFD
          LDC    ODA
          STM    /WRITE/WTFC
          LDM    /WRITE/CNWB  SET UBC
          LPN    77
          RAM    CNLB
          LDD    MD
          LPN    60
          ZJN    PRS2        IF NOT CONTROL WORD OPERATION
          AOM    ODAB
          LDD    MD
          LPN    40
          ZJN    PRS3        IF NOT 204 WRITE
          LDC    LBBY        SET BLOCK LENGTH
          STM    CNLC
          AOM    ODAM
          UJN    PRS4        CONTINUE PRESET
 
 PRS2     LDC    STDI+CM+4   MODIFY INSTRUCTIONS FOR NON-CONTROL WORD
          STM    CNLA
 PRS3     LDC    LDDI+CM+4
          STM    CNLD
 PRS4     LDC    PRSA        SET FOR INSTRUCTION MODIFICATION
          STD    CN
          LDC    PRS5        SET TO RETURN CONTROL HERE AFTER LOAD
          STD    BT
          LJM    PRSX        RETURN
 
*         RETURN HERE AFTER ALL ROUTINES LOADED.
*         BUILD CALL TO *1LT*.
 
 PRS5     LDD    HP
          SHN    21-7
          PJN    PRS5.1      IF NOT CTS
          ISTORE /WRITE/WTFF,(ZJN /WRITE/WTF1)
          LDD    CN+3
          STM    /WRITE/OPTU SAVE OUT POINTER FOR COMMAND RETRY
          LDD    CN+4
          STM    /WRITE/OPTL
 PRS5.1   RJM    /WRITE/CNW  CHECK FIRST WRITE
          ZJN    PRS6        IF WRITE OK
          LJM    /WRITE/WTF4 PROCESS ERROR CONDITION
 
 PRS6     LDD    CP          MERGE CP NUMBER
          SHN    -7
          RAM    CALL+1
          LDD    HP
          LPC    7700        ALLOW *1LT* TO TEST FOR CTS
          RAM    CALL+2
          LDD    IA          SET INPUT REGISTER ADDRESS IN CALL
          STM    CALL+4
          LDN    CMCL        CHECK MOVE FLAG
          CRD    CM
          LDD    CM
          SHN    7
          LMD    CP
          ZJN    PRS7        IF MOVE FLAG
          LDD    MA          WRITE REQUEST BLOCK
          CWM    CALL,TR
          LDN    1           SET TO NOT QUEUE REQUEST
          STD    CM+1
          MONITOR RPPM       REQUEST PP
          LDD    CM+1
          NJN    PRS8        IF PP ASSIGNED
 PRS7     LJM    RET2        REQUEUE
 
 PRS8     STM    CPDA        SAVE PP INPUT REGISTER ADDRESS
 PRS9     LDN    77          DELAY
          SBN    1
          NJN    *-1
          LDD    MA          CHECK FOR *1LT* ACKNOWLEDGE
          ADN    1
          CRD    CM
          LDD    CM
          ZJN    PRS11       IF *1LT* READY
          RJM    CPD         CHECK FOR *1LT* DROP
          NJN    PRS7        IF *1LT* GONE
          LDN    CMCL        CHECK MOVE FLAG
          CRD    CM
          LDD    CM
          SHN    7
          LMD    CP
          NJN    PRS9        IF NO MOVE FLAG FOR THIS CP
          RJM    CEC         CHANGE BACK TO MAGNET CP
 PRS10    RJM    CPD         CHECK PP DROP
          NJN    PRS7        IF *1LT* GONE
          PAUSE  NE
          UJN    PRS10       LOOP
 
 PRS11    LDC    /SRU/ITWL*100  SET SRU INCREMENT
          STM    //CECA
          LDC    4000        SET BLOCKS WRITTEN FLAG
          STD    BT
          LDD    HP
          SHN    21-7
          MJN    PRS12       IF CTS
          SHN    21-4-21+7
          PJN    PRS13       IF NOT ATS UNIT
 
*         CHECK IF MOTION AHEAD ALLOWED. MOTION AHEAD IS NOT ALLOWED
*         ON ANY GCR UNIT AT 1X PPU SPEED OR ON A 200 IPS GCR UNIT.
 
          SHN    21-1-21+4
          PJN    PRS13       IF UNIT NOT CAPABLE OF 6250 BPI
          LDM    DLYA
          LPN    14
          ZJN    PRS12       IF 1X PPU SPEED
          LDD    HP
          LPN    10
          LMN    10
          NJN    PRS13       IF NOT 200 IPS UNIT
 PRS12    LDC    UJNI+2      DISABLE MOTION AHEAD
          STM    ODAA-1
          LDC    RJMI
          STM    RDAC
          LDC    UJNI+ODA3-ODAG
          STM    ODAG
 PRS13    LJM    /WRITE/WTF1 ENTER WRITE CODE
 
 PRSA     TSAD   SLBP
 PRSB     CHTB
 PRSC     BSS    0
          LOC    /WRITE/WRTA
          UJN    /WRITE/WRT2 SET UP FOR LONG BLOCK WRITE
          LOC    *O
 
 PRSD     BSS    0
          LOC    /WRITE/WRTE
          UJN    /WRITE/WRT3.1  LONG BLOCKS
          LOC    *O
 
 PRSE     BSS    0
          LOC    /WRITE/WRTG
          UJN    /WRITE/WRT5 LONG BLOCKS
          LOC    *O
 
 PRSF     BSS    0
          LOC    /WRITE/WTFA
          UJN    /WRITE/WTF1 LONG BLOCKS
          LOC    *O
          TITLE  PRESET SUBROUTINES.
 SRC      SPACE  4,15
**        SRC - SET RESIDENT CONTROLLER ROUTINE.
*
*         ENTRY  (T3) = CONTROLLER/PP TYPE.
*                       0 = CYBER 180 IOU.
*                       1 = MTS CONTROLLER (NON-CYBER 180).
*                       2 = ATS CONTROLLER (NON-CYBER 180).
*
*         EXIT   TAPE OUTPUT ROUTINE PRESET.
*
*         USES   T1, T2.
*
*         CALLS  MCH.
 
 
 SRC      SUBR               ENTRY/EXIT
          LDM    SRCB,T3     ADDRESS OF OUTPUT ROUTINE
          ZJN    SRC2        IF RESIDENT ROUTINE USED
          STM    SRCA
          LDN    .OPALC-1    BYTES TO COPY
          STD    T1
 SRC1     LDM    **,T1
 SRCA     EQU    *-1
          STM    .OPAA,T1    COPY OVER RESIDENT TAPE IO ROUTINE
          SOD    T1
          PJN    SRC1        IF COPY NOT COMPLETE
          LDM    SRCC,T3     ADDRESS OF CHANNEL TABLE
          RJM    MCH         UPDATE CHANNELS
 SRC2     LDM    SRCD,T3     ADDRESS OF ADDRESSES TO MODIFY
          STD    T2
 SRC3     LDI    T2          ADDRESS TO CHANGE
          STD    T1
          ZJN    SRCX        IF END OF TABLE ENCOUNTERED
          AOD    T2
          LDI    T2
          STI    T1          CHANGE CONTENTS OF ADDRESS
          AOD    T2
          UJN    SRC3        CONTINUE MODIFYING ADDRESSES
 
*         ADDRESS OF OUTPUT ROUTINES.
 
 SRCB     CON    0           CYBER 180 IOU
          CON    .OPD        MTS (NON-CYBER 180)
          CON    .OPA        ATS (NON-CYBER 180)
 
*         ADDRESSES OF CHANNEL TABLES.
 
 SRCC     CON    0           CYBER 180 IOU
          CON    .OPDA       MTS (NON-CYBER 180)
          CON    .OPAC       ATS (NON-CYBER 180)
 
*         ADDRESSES OF ADDRESS MODIFICATION TABLES.
 
 SRCD     CON    SRCE        CYBER 180 IOU
          CON    SRCG        MTS (NON-CYBER 180)
          CON    SRCF        ATS (NON-CYBER 180)
 
 
**        ADDRESS MODIFICATION TABLES.
 
 SRCE     CON    ODAJ,OPI    CYBER 180 IOU
          CON    ODAK,OPE
          CON    SRQA,PSNI
          CON    ODAD,OPIA
          CON    ODAC,OPIB
          CON    ODAH,OPEB
          CON    ODAI,OPEA
          CON    ODAF,OPEA
          CON    0
 
 SRCF     CON    ODAJ,OPA    ATS (NON-CYBER 180)
          CON    ODAK,OPL
          CON    0
 
 SRCG     CON    ODAF,ODAF   MTS (NON-CYBER 180)
          CON    ODAD,OPDA
          CON    0
 OPA      SPACE  4,10
 .OPA     BSS    0           ATS OUTPUT ROUTINES (NON-CYBER 180)
          LOC    .OPAA
 OPA      SPACE  4,10
**        OPA - OUTPUT DATA TO ATS UNIT (NON-CYBER 180).
*
*         ENTRY  (A) = NUMBER OF BYTES TO OUTPUT.
*                (OPAA) = 0 IF NOT FIRST CHUNK.
*
*         EXIT   (A) = BYTES REMAINING IF INCOMPLETE TRANSFER.
 
 
 OPA      SUBR               ENTRY/EXIT
 OPAA     UJN    OPA1        FIRST CHUNK
*         PSN                (NOT FIRST CHUNK)
          AJM    *,CH        WAIT FOR *1LT* TO OUTPUT CHUNK
          PSN                DELAY TO ALLOW *1LT* TO REACTIVATE CHANNEL
          PSN
 OPA1     OAM    BUFB,CH     OUTPUT DATA
          FJM    *,CH
          DCN    CH+40       INDICATE TO *1LT* TO RESUME OUTPUT
          NJN    OPAX        IF INCOMPLETE TRANSFER
          ACN    CH
          STM    OPAA        CLEAR FIRST CHUNK FLAG
          UJN    OPAX        RETURN
 
 
 OPAB     BSS    0
          LOC    OPAA
          UJN    OPA1        OUTPUT DATA
          LOC    OPAB+1
 OPL      SPACE  4,10
**        OPL - OUTPUT LAST PARTIAL CHUNK TO ATS UNIT (NON-CYBER 180).
*
*         ENTRY  (A) = NUMBER OF BYTES TO TRANSFER.
*
*         EXIT   (A) = BYTES REMAINING IF INCOMPLETE TRANSFER.
*                CHANNEL FULL STATUS NOT CHECKED.
 
 
 OPL      SUBR               ENTRY/EXIT
 OPLA     PSN                WAIT FOR *1LT*
*         UJN    OPL1        (*1LT* NOT NEEDED)
          AJM    *,CH        WAIT FOR *1LT* TO OUTPUT CHUNK
          PSN                DELAY TO ALLOW *1LT* TO REACTIVATE CHANNEL
          PSN
 OPL1     OAM    BUFB,CH     OUTPUT PARTIAL CHUNK
          UJN    OPLX        RETURN
 
 
 OPLB     BSS    0
          LOC    OPLA
          UJN    OPL1        OUTPUT DATA
 
 
          LOC    *O
 .OPAL    EQU    *-.OPA
 
          ERRNG  .OPALC-.OPAL  ATS WRITE ROUTINE OVERFLOW
 
 .OPAC    CHTB               TABLE OF CHANNELS FOR ATS CODE
          SPACE  4,10
 .OPD     BSS    0           MTS OUTPUT ROUTINE (NON-CYBER 180)
          LOC    .OPAA
 OPD      SPACE  4,10
**        OPD - OUTPUT DATA TO MTS UNIT (NON-CYBER 180).
*
*         ENTRY  (A) = NUMBER OF BYTES TO OUTPUT.
*
*         EXIT   (A) = BYTES REMAINING IF INCOMPLETE TRANSFER.
 
 
 OPD2     FJM    OPD1,CH     IF *1LT* OUTPUTTING DATA
          FJM    OPD1,CH     IF *1LT* OUTPUTTING DATA
          FJM    OPD1,CH     IF *1LT* OUTPUTTING DATA
          OAM    BUFB,CH     OUTPUT DATA
 
 OPD      SUBR               ENTRY/EXIT
 OPD1     FJM    OPD1,CH     IF *1LT* OUTPUTTING DATA
          FJM    OPD1,CH     IF *1LT* OUTPUTTING DATA
          UJN    OPD2        CONTINUE CHECK FOR *1LT* OUTPUT
 
 
 OPDA     BSS    1           SCRATCH STORAGE
 
 
          LOC    *O
 .OPDL    EQU    *-.OPD
 
          ERRNG  .OPALC-.OPDL  MTS WRITE ROUTINE OVERFLOW
 
 .OPDA    CHTB               TABLE OF CHANNELS FOR MTS CODE
          SPACE  4,10
 .WCT     BSS    0
          LOC    /WRITE/WCT6
          LDN    F0002       CONTINUE FUNCTION
          STM    ITMA
          LJM    /WLB/ODAB   GO RETRY THE COMMAND
 
          ERRMI  /WRITE/WCT8-*  IF CODE OVERFLOWS
 
          LOC    *O
 .WCTL    EQU    *-.WCT      LENGTH OF CODE TO MOVE
          OVERLAY (WRITE LI FORMAT.),,,WLI
 .IM      SET    0           GENERATE ADDRESSES FOR OVERLAY
 NC       EQU    PA          NUMBER OF CHUNKS
 BC       EQU    PB          BYTE COUNT LAST CHUNK
 WLI      SPACE  4,15
**        WLI - WRITE LI FORMAT.
*         THIS OVERLAY DOES ALL LI FORMAT WRITES.
*
*         ENTRY  AT *WLI* FROM *PRS* TO WRITE FIRST BLOCK.
*                AT *WLI1* FROM *PRS* IF NO BLOCK TO WRITE.
*
*         EXIT   TO *RET* IF COMPLETE.
*                TO *RET2* TO REQUEUE REQUEST.
*                TO *RET3* TO REPORT AN ERROR.
*                TO *EOF* TO WRITE EOF.
*
*         CALLS  ODA, WRT.
 
 
 WLI      RJM    ODA         OUTPUT DATA
          RJM    WRT         CHECK FOR END OF OPERATION
          LDC    *
 WLIA     EQU    *-1
          NJN    WLI1        IF EXIT CONDITIONS
          LDD    DF
          ZJN    WLI         IF NO DROP OUT
 WLIB     EQU    *-1
*         PSN                (PRU WRITE 004)
          LJM    RET2        REQUEUE
 WLIC     EQU    *-1
*         LJM    WLI3        (PRU WRITE 004)
 
 WLI1     SBN    10
          MJN    WLI3        IF NO ERROR
          ZJN    WLI2        IF BUFFER TOO LONG ERROR
          LDN    /MTX/BAE&/MTX/BCW  BUFFER ARGUMENT ERROR
 WLI2     LMN    /MTX/BCW    BLOCK TOO LONG ERROR
          LJM    RET3        RETURN ERROR CODE
 
 WLI3     LDN    1
          LJM    RET         SET FET COMPLETE
 WLID     EQU    *-1
*         LJM    EOF         (LI FORMAT EOF REQUIRED)
 ADP      SPACE  4,15
**        ADP - ADVANCE POINTER.
*
*         ENTRY  (CN+3 - CN+4) = OUT POINTER.
*                (A) = WORDS TO INCREMENT OUT BY.
*
*         EXIT   (T4 - T5) = STARTING OUT POINTER.
*                (CN+3 - CN+4) = UPDATED OUT POINTER.
*                (T6) = FIRST PART WORD COUNT.
*                (T7) = SECOND PART WORD COUNT.
*
*         MACROS SADT.
 
 
 ADP      SUBR               ENTRY/EXIT
          STD    T6
          LDD    CN+3        SAVE OUT
          STD    T4
          LDD    CN+4
          STD    T5
          LDN    0           PRESET SECOND PART WORD COUNT
          STD    T7
          LDD    T6          UPDATE OUT
          RAD    CN+4
          SHN    -14
          RAD    CN+3
          SHN    14
          LMD    CN+4
          SADT   .LM,C
          ADC    -*          (-LIMIT)
          MJN    ADPX        IF NO WRAP AROUND
          STD    T7          SET SECOND PART WORD COUNT
          SADT   .FT
          ADC    *           (FIRST)
          STD    CN+4
          SHN    -14
          STD    CN+3
          LDD    T6          RESET FIRST PART WORD COUNT
          SBD    T7
          STD    T6
          UJN    ADPX        RETURN
 CNW      SPACE  4,25
**        CNW - CHECK NEXT WRITE.
*         THIS ROUTINE DETERMINES IF THERE IS DATA TO WRITE.  IF SO,
*         THE NUMBER OF CHUNKS AND BLOCKS IS DETERMINED AND THE BLOCK
*         PREFIX IS BUILT.  IF (014, 204, 264) WRITE, ONE BLOCK IS
*         PRESENT, BUT NOT 2 BLOCKS, THEN A *DRCM* MONITOR FUNCTION
*         IS ISSUED TO GET THE CPU TO PUT MORE DATA IN THE BUFFER.
*
*         ENTRY  (CN+3 - CN+4) = OUT POINTER.
*
*         EXIT   (A) = (WLIA) = 0, NEXT WRITE OKAY.
*                               2, NOT ENOUGH DATA.
*                              10, BLOCK TOO LONG ERROR.
*                              11, BUFFER ARGUMENT ERROR.
*                (NC) = FULL CHUNKS TO WRITE.
*                (BC) = BYTES IN REMAINDER TO WRITE.
*                (.WC) = WORDS IN REMAINDER TO WRITE.
*
*         USES   T1, T2, T6, T7, CM - CM+4.
*
*         CALLS  CDO, COB, SLN.
*
*         MACROS SADT.
 
 
 CNW14    LDN    2           SET NOT ENOUGH DATA
 CNW15    STM    WLIA
 
 CNW      SUBR               ENTRY/EXIT
          RJM    CDO         CHECK DROP OUT FLAG
          LDN    F0050
          STM    ITMA        WRITE FUNCTION
          LDN    1           WORD COUNT = 10000
 CNWA     EQU    *-1
*         LDN    0           (204 WRITE)
          STD    CM+3
          LDN    0
 CNWB     EQU    *-1
*         LDN    2           (204 WRITE)
          STD    CM+4
          RJM    COB         CHECK OUTPUT BUFFER
          STD    T1
          SHN    6
          SBD    CM+3
          SHN    14
          SBD    CM+4
          PJN    CNW1        IF ENOUGH DATA
          LDD    T1
 CNWC     EQU    *-1
*         UJN    CNW14       (204 WRITE)
          STD    CM+4
          SOD    CM+3        USE WORD COUNT IN BUFFER
          LDD    MD
          SHN    21-3
          PJN    CNW14       IF NOT EOR/EOF WRITE
          SHN    21-10-21+3+22
          MJN    CNW14       IF EOR/EOF WRITTEN THIS OPERATION
 CNW1     UJN    CNW2
 CNWD     EQU    *-1
*         LDD    CN+3        (204 WRITE)
          SHN    6
          ADD    RA
          SHN    6
          ADD    CN+4
          CRD    CM          READ CONTROL WORD
 CNW2     LDC    /MTX/LBWD   WORDS PER CHUNK
 CNWE     EQU    *-1
*         LDC    LBBY        BYTES PER CHUNK (204 WRITE)
          STD    T1
          LDN    0
          STD    NC
 
*         DETERMINE NUMBER OF CHUNKS AND REMAINDER.
 
 CNW3     LDD    CM+4
          SBD    T1
          STD    CM+4
          PJN    CNW4        IF NO UNDERFLOW
          AOD    CM+4
          SOD    CM+3
          MJN    CNW5        IF UNDERFLOW
 CNW4     AOD    NC          COUNT CHUNK
          UJN    CNW3        LOOP
 
 CNW5     LDD    T1
          RAD    CM+4
          STD    BC
          STM    .WC
          LDD    CM+4
 CNWF     EQU    *-1
*         UJN    CNW6        (204 WRITE)
          SHN    2
          RAD    BC          BYTES = 5 * CM WORDS
          UJN    CNW7        CHECK IF LEGAL BLOCK SIZE
 
 CNW6     LDD    CM+4        ROUND UP BYTES
          ADN    4
          STD    T2
          SHN    1           13*BYTES
          ADD    T2
          SHN    2
          ADD    T2
          SHN    14  (-6)    (13*BYTES)/64
          STD    T0
          SHN    6+2         4*13*BYTES  (52*BYTES)
          SBD    T2          51*BYTES
          ADD    T0          (51*BYTES)+((13*BYTES)/64)
          SHN    -8D         WORDS = ((51*BYTES)+((13*BYTES)/64))/256
          STM    .WC         SAVE REMAINDER (IN CM WORDS)
 
*         CHECK IF LEGAL BLOCK SIZE.
 
 CNW7     LDD    NC
          STD    T1
          LDM    .WC
          STD    T7
          LDN    0
          STD    T6
 CNW8     SOD    T1
          MJN    CNW9        IF END OF CHUNKS
          LDC    /MTX/LBWD
          RAD    T7
          SHN    -14         T6,T7 IS BLOCK LENGTH IN CM WORDS
          RAD    T6
          UJN    CNW8        LOOP
 
 CNW9     LDD    T6
          SHN    14
          LMD    T7
          SADT   .BS,C,1
          ADC    -*
          MJN    CNW10       IF BLOCK NOT TOO LARGE
          LDN    10          SET BLOCK TOO LONG ERROR
          UJP    CNW15       EXIT WITH NEXT WRITE STATUS
 
*         PUT BYTE COUNT AND BLOCK NUMBER IN BLOCK PREFIX.
 
 CNW10    LDD    T6          T6,T7 IS CM WORD COUNT
          SHN    2
          ADD    T6
          STD    T2
          LDD    T7
          SHN    2
          ADD    T7
          ADN    5           INCLUDE LENGTH OF PREFIX
          STM    BUFB-4      LOWER 12 BITS OF BYTE COUNT
          SHN    -14
          ADD    T2
          STM    BUFB-5      UPPER BITS OF BYTE COUNT
          LDD    BL
          STM    BUFB-3
          LDD    BL+1
          STM    BUFB-2      SET BLOCK NUMBER
 
*         CHECK IF ENOUGH DATA IN OUTPUT BUFFER.
 
          LDD    MD
          LPN    40
          SHN    -4
          RAD    T7          ALLOW FOR CONTROL WORD
          SHN    -14
          RAD    T6
          RJM    COB         CHECK OUTPUT BUFFER
          SHN    6
          SBD    T6
          SHN    14
          SBD    T7
          MJN    CNW13       IF NOT ENOUGH DATA IN OUTPUT BUFFER
 
*         IF ONE BLOCK IS PRESENT, BUT NO SECOND BLOCK, ISSUE *DRCM*.
 
          SHN    6
          SBD    T6
          SHN    14
          SBD    T7
          PJN    CNW11       IF SECOND BLOCK IN CM
 CNWG     EQU    *-1
*         UJN    CNW11       (NOT 014, 204, OR 264 WRITE)
          LDM    CNW
          ADC    -PRS
          PJN    CNW11       IF CALLED FROM PRESET
          LDD    OA
          CWM    CNWH,ON
 CNW11    RJM    SLN         SAVE LEVEL NUMBER
          LDN    0
 CNW12    LJM    CNW15       RETURN
 
 CNW13    LJM    CNW14       SET NOT ENOUGH DATA
 
 
 CNWH     CON    DRCM        DRIVER RECALL CPU MONITOR FUNCTION
 COB      SPACE  4,10
**        COB - CHECK OUTPUT BUFFER.
*
*         ENTRY  (CN+3,CN+4) = OUT POINTER.
*
*         EXIT   (A) = WORD COUNT.
*                TO LOCATION *CNW12*, IF BUFFER ARGUMENT ERROR.
*
*         USES   T1 - T5.
*
*         MACROS SADT.
 
 
 COB2     LDD    T1+3        LENGTH = IN - OUT
          SBD    CN+3
          SHN    14
          ADD    T1+4
          SBD    CN+4
          PJN    COBX        IF IN .GE. OUT
          SADT   .LF
          ADC    *           (LIMIT - FIRST)
          MJN    COB1        IF BUFFER ARGUMENT ERROR
 
 COB      SUBR               ENTRY/EXIT
          SADT   .FE,,2,A
          LDC    *           READ IN
          CRD    T1
          LDD    T1+3
          LPN    37
          STD    T1+3
          SHN    14
          LMD    T1+4
          SADT   .LM,C
          ADC    -*
          MJN    COB2        IF IN .LT. LIMIT
 COB1     LDN    11          SET BUFFER ARGUMENT ERROR
          UJN    CNW12       SET EXIT CONDITION
 CPD      SPACE  4,10
**        CPD - CHECK PP (1LT) DROP OUT.
*
*         ENTRY  (CPDA) = PP INPUT REGISTER ADDRESS.
*
*         EXIT   (A) = 0, IF *1LT* STILL AROUND.
*
*         USES   CM - CM+4.
*
*         MACROS CHTE.
 
 
 CPD      SUBR               ENTRY/EXIT
          LDC    *
 CPDA     EQU    *-1
          CRD    CM
          LDD    CM+1
          SCN    77
          SHN    6
          LMD    CM
          LMC    3RT1L
          ZJN    CPD1        IF *1LT*
          SHN    14
          LMN    1R1
          NJN    CPDX        IF NOT *1LT* LOADING
 CPD1     LDD    CM+3
          CHTE   *
          LMN    CH
          LPN    77
          UJN    CPDX        RETURN
 CRA      SPACE  4,10
**        CRA - CHECK REQUEST ACCEPTANCE FROM *1LT*.
*
*         EXIT   (A) = REQUEST BYTE.
*                (CM - CM+4) = REQUEST/RETURN WORD.
 
 
 CRA      SUBR               ENTRY/EXIT
          LDM    CPDA
          ADN    2
          CRD    CM
          LDD    CM
          UJN    CRAX        RETURN
 EOF      SPACE  4,10
**        EOF - WRITE LI FORMAT EOF.
*
*         EXIT   TO *RET* WITH (A) = 1 TO SET FET COMPLETE.
*
*         CALLS  ITM, WRT.
 
 
 EOF      BSS    0           ENTRY
          RJM    ITM         INITIATE TAPE MOTION
          LDN    17
          STM    BUFB-1      LEVEL NUMBER
          LDD    BL
          STM    BUFB-3      BLOCK NUMBER
          LDD    BL+1
          STM    BUFB-2
          LDN    0
          STM    BUFB-5      BYTE COUNT UPPER
          LDN    5
          STM    BUFB-4      BYTE COUNT LOWER
          LDN    6
          OAM    BUFB-5,CH
          FJM    *,CH
          STM    /WRITE/BYRM BYTES NOT WRITTEN
 
*         DELAY 10 MICROSECONDS TO PREVENT A HARDWARE ERROR IN THE
*         CCC.  THE DISCONNECT WOULD SOMETIMES CAUSE THE LAST BYTE TO
*         BE LOST.
 
          LDN    20
          SBN    1
          NJN    *-1
          DCN    CH+40
          RJM    WRT         PROCESS WRITE
 EOFA     EQU    *           (USED TO TELL WHERE *WRT* CALLED FROM)
          LCN    14          CLEAR EOF INDICATOR
          RAD    MD
          LDN    1
          LJM    RET         SET FET COMPLETE
 ITS      SPACE  4,10
**        ITS - INDICATE  *1MT* TRANSFER STARTED.
*
*         ENTRY  (A) = BYTE COUNT.
*
*         EXIT   (A) = BYTE COUNT.
 
 
 ITS      SUBR               ENTRY/EXIT
          STD    T0          SAVE BYTE COUNT
          LDM    CPDA        INDICATE *1MT* TRANSFER STARTED
          ADN    3
          CWD    ON
          LDD    T0          RESTORE (A)
          UJN    ITSX        RETURN
 ODA      SPACE  4,10
**        ODA - OUTPUT DATA.
*         THIS ROUTINE WRITES THE 1ST, 3RD, ... CHUNKS OF THE BLOCK
*         TO TAPE.
*
*         ENTRY  (NC) = FULL CHUNKS.
*                (BC) = BYTE COUNT IN REMAINDER.
*                (.WC) = WORD COUNT IN REMAINDER.
*
*         USES   CM, CM+7, BY.
*
*         CALLS  ADP, CRA, OPA, OPE, OPI, OPL, RDA.
 
 
 ODA      SUBR               ENTRY/EXIT
          LDN    0           ALLOW FOR CONTROL WORD
 ODAA     EQU    *-1
*         LDN    1           (204 WRITE)
          RJM    ADP
          LDN    0           PRESET CHUNKS OUTPUT COUNT
          STD    CM+7
          LDC    LBBY
          STD    BY
          STM    RDAB        SET FIRST CHUNK FLAG
          LDD    NC
          ZJN    ODA3        IF *1LT* NOT NEEDED
          SBN    2
          PJN    ODA1        IF *1LT* NEEDED
          LDD    BC
          ZJN    ODA2        IF *1LT* NOT NEEDED
 ODA1     AOM    ODAD        SET *1LT* CALLED FLAG
          UJN    ODA6        OUTPUT DATA
 
 ODA2     LDC    LBBY
          STD    BC
          LDC    /MTX/LBWD
          STM    .WC
 ODA3     LDD    BC
          STD    BY
          LJM    ODA9        SET UP TO READ NEXT CHUNK
 
 ODA4     STM    RDAB        INDICATE NOT FIRST CHUNK
          STM    /WRITE/BYRM BYTES NOT TRANSFERRED
          LDN    2           INCREMENT CHUNK COUNT
          RAD    CM+7
          SBD    NC
          PJN    ODA7        IF NO MORE FULL CHUNKS
          ADN    1
          NJN    ODA5        IF NOT 1 CHUNK LEFT
          LDD    BC
          ZJN    ODA7        IF ZERO REMAINDER
 ODA5     LDC    /MTX/LBWD   SKIP OVER DATA *1LT* OUTPUT
          RJM    ADP
 ODA6     LDC    /MTX/LBWD   SET UP TO READ NEXT DATA CHUNK
          RJM    RDA         READ DATA
          RJM    OPI         OUTPUT DATA
 ODAB     EQU    *-1
*         RJM    OPA         (NOT USING CHANNEL FLAG)
          ZJN    ODA4        IF FULL BLOCK OUTPUT
          UJN    ODA12       STORE BYTES NOT WRITTEN
 
 ODA7     ZJN    ODA8        IF TRANSFER NOT COMPLETE FOR *1MT*
          LDM    .WC         ADVANCE POINTER OVER *1LT,S* CHUNK
          RJM    ADP
          UJN    ODA13       CHECK IF *1LT* WAS CALLED
 
 ODA8     LDC    /MTX/LBWD   SKIP OVER DATA *1LT* OUTPUT
          RJM    ADP
          LDD    BC
          ZJN    ODA10       IF POSSIBLE OUTPUT COMPLETE
          STD    BY
 ODA9     LDM    .WC         SET UP TO READ NEXT CHUNK
          UJN    ODA11       READ DATA
 
 ODA10    LDD    NC
          LPN    1
          ZJN    ODA13       IF OUTPUT COMPLETE
          LDC    /MTX/LBWD
 ODA11    RJM    RDA         READ DATA FROM CENTRAL
          RJM    OPE         OUTPUT DATA
 ODAC     EQU    *-1
*         RJM    OPL         (NOT USING CHANNEL FLAG)
          FJM    *,CH
 ODA12    STM    /WRITE/BYRM SAVE BYTES NOT TRANSFERRED
 
*         DELAY 10 MICROSECONDS TO PREVENT A HARDWARE ERROR IN THE
*         CCC.  THE DISCONNECT WOULD SOMETIMES CAUSE THE LAST BYTE TO
*         BE LOST.
 
          LDN    20
          SBN    1
          NJN    *-1
          DCN    CH+40
 ODA13    LDN    0
 ODAD     EQU    *-1
          ZJN    ODA15       IF *1LT* NOT CALLED
          SOM    ODAD        CLEAR *1LT* CALLED FLAG
 ODA14    RJM    CRA         CHECK REQUEST ACCEPTANCE FROM *1LT*
          LMN    2
          NJN    ODA14       IF NOT ACCEPT
          STD    CM          ACKNOWLEDGE *1LT*
          LDM    CPDA
          ADN    2
          CWD    CM
 ODA15    LDN    0           SKIP TRAILER CONTROL WORD IF PRESENT
 ODAE     EQU    *-1
*         LDN    1           (204 WRITE)
          RJM    ADP
          LJM    ODAX        RETURN
 OPE      SPACE  4,10
 .OPE     BSS    0           START OF OVERLAYED ATS WRITE ROUTINES
 OPE      SPACE  4,10
**        OPE - OUTPUT ENDING DATA FROM CYBER 180 IOU.
*
*         ENTRY  (BY) = NUMBER OF BYTES TO OUTPUT.
*                (RDAB) = 0 IF NOT FIRST CHUNK OF BLOCK.
*
*         EXIT   (A) = BYTES NOT TRANSFERRED.
*
*         CALLS  ITS, WTS.
 
 
 OPE1     LDD    BY
          LPC    7776        WRITE EVEN BYTE COUNT
          ADN    1
          RJM    WTS         WAIT FOR *1LT* TRANSFER TO START
 OPE2     IJM    OPEX,CH     IF *1LT* WROTE ONLY PARTIAL CHUNK
          SCF    OPE2,CH     WAIT FOR *1LT* TO CLEAR CHANNEL FLAG
          OAM    BUFB,CH
 
 OPE      SUBR               ENTRY/EXIT
          LDM    RDAB
          ZJN    OPE1        IF NOT FIRST CHUNK (IF *1LT* NEEDED)
          LDD    BY
          ADN    5+1         BLOCK PREFIX PLUS PAD
          LPC    7776        WRITE EVEN BYTE COUNT
          OAM    BUFB-5,CH
          UJN    OPEX        RETURN
 OPI      SPACE  4,10
**        OPI - OUTPUT DATA FROM CYBER 180 IOU.
*
*         IF THERE ARE MULTIPLE CHUNKS IN THE BLOCK, THIS ROUTINE
*         IS USED FOR ALL BUT THE LAST CHUNK.  *OPE* IS USED FOR THE
*         LAST CHUNK.
*
*         ENTRY  (BY) = NUMBER OF BYTES TO OUTPUT.
*                (RDAB) = 0 IF NOT FIRST CHUNK.
*
*         EXIT   (A) = BYTES NOT TRANSFERRED.
*
*         CALLS  ITS, WTS.
 
 
 OPI1     LDD    BY
          RJM    WTS         WAIT FOR *1LT* TRANSFER TO START
 OPI2     IJM    OPIX,CH     IF *1LT* WROTE ONLY PARTIAL CHUNK
          SCF    OPI2,CH     WAIT FOR *1LT* TO CLEAR CHANNEL FLAG
          RJM    ITS         INDICATE *1MT* TRASFER STARTED
          OAM    BUFB,CH     OUTPUT DATA
 OPI4     NJN    OPIX        IF INCOMPLETE TRANSFER
          CCF    *,CH        SIGNAL *1LT* TO START OUTPUT
 
 OPI      SUBR               ENTRY/EXIT
          LDM    RDAB
          ZJN    OPI1        IF NOT FIRST CHUNK
          LDD    BY
          ADN    5           ALLOW FOR BLOCK PREFIX
          OAM    BUFB-5,CH   OUTPUT DATA
          UJN    OPI4        CHECK IF ALL BYTES TRANSFERRED
 
 
 .OPEL    EQU    *-.OPE      LENGTH OF CODE TO BE OVERLAYED
 RDA      SPACE  4,15
**        RDA - READ DATA FROM CENTRAL.
*
*         ENTRY  (A) = WORDS TO READ.
*                (T4 - T5) = OUT POINTER.
*                (T6) = FIRST PART WORD COUNT.
*                (T7) = SECOND PART WORD COUNT.
*
*         EXIT   (BY) = BYTES TO WRITE.
*
*         CALLS  ADP, ITM, SRQ.
*
*         MACROS SADT.
 
 
 RDA      SUBR               ENTRY/EXIT
          RJM    ADP         ADVANCE POINTERS
          LDD    T6
          ZJN    RDA1        IF NO DATA
          SHN    2
          ADD    T6
          ADC    BUFB
          STM    RDAA
          LDD    T4          READ FIRST PART
          SHN    6
          ADD    RA
          SHN    6
          ADD    T5
          CRM    BUFB,T6
          LDD    T7
          ZJN    RDA1        IF NO SECOND PART
          SADT   .FT,,,A
          LDC    *           READ SECOND PART
          CRM    *,T7
 RDAA     EQU    *-1
 RDA1     LDC    0
 RDAB     EQU    *-1
          ZJN    RDA2        IF NOT FIRST CHUNK
          RJM    ITM         INITIATE TAPE MOTION
          LDM    ODAD
          LPN    77
          ZJN    RDA2        IF *1LT* NOT NEEDED
          LDN    1           SEND REQUEST TO *1LT*
          RJM    SRQ
 RDA2     LJM    RDAX        RETURN
 SLN      SPACE  4,10
**        SLN - SAVE LEVEL NUMBER.
*         THIS ROUTINE PUTS THE LEVEL NUMBER IN THE BLOCK PREFIX.
*
*         ENTRY  (CN+3,CN+4) = OUT POINTER.
*                (T6,T7) = LENGTH OF BLOCK INCLUDING CONTROL WORDS.
*                (LNUM) = LEVEL NUMBER IF NOT CONTROL WORD WRITE.
*
*         USES   T4, T5, CM - CM+4.
*
*         MACROS SADT.
 
 
 SLN2     LPN    17
          STM    BUFB-1      SAVE LEVEL NUMBER
          NJN    SLN3        IF NOT EOF BLOCK
          LDM    BUFB-5
          SHN    14
          ADM    BUFB-4
          LMN    5
          ZJN    SLNX        IF NO DATA IN BLOCK
          LDN    0
          STM    BUFB-1      CLEAR LEVEL NUMBER
 SLN3     LDM    BUFB-5
          SHN    14
          ADM    BUFB-4
          LMC    50005
          NJN    SLNX        IF NOT FULL BLOCK
          STM    BUFB-1      CLEAR LEVEL NUMBER
 
 SLN      SUBR               ENTRY/EXIT
          LDM    LNUM
          UJN    SLN2        SAVE LEVEL NUMBER
 SLNA     EQU    *-1
*         LDD    CN+3        (204 WRITE)
          STD    T4          SAVE OUT
          LDD    CN+4
          STD    T5
          LDD    T6
          SHN    14
          ADD    T7
          SBN    1           BACK UP TO TRAILER CONTROL WORD
          STD    T7
          SHN    -14
          STD    T6
          LDD    T7          UPDATE OUT
          RAD    T5
          SHN    -14
          ADD    T6
          RAD    T4
          SHN    14
          LMD    T5
          SADT   .LM,C
          ADC    -*          (-LIMIT)
          MJN    SLN1        IF NO WRAP AROUND
          SADT   .FT
          ADC    *           (FIRST)
          STD    T5
          SHN    -14
          STD    T4
 SLN1     LDD    T4
          SHN    6
          ADD    RA
          SHN    6
          ADD    T5
          CRD    CM          READ CONTROL WORD
          LDD    CM          GET LEVEL NUMBER
          LJM    SLN2        SAVE LEVEL NUMBER
 SRQ      SPACE  4,10
**        SRQ - SEND REQUEST TO *1LT* TO START BLOCK.
*
*         ENTRY  (A) = REQUEST CODE.
*                (T4 - T5) = POINTER.
*                (BC) = BYTE COUNT OF LAST CHUNK.
*                (NC) = NUMBER OF CHUNKS.
*
*         USES   T1, T2, T3, CM - CM+4.
*
*         CALLS  CPD, CRA, HNG.
 
 
 SRQ      SUBR               ENTRY/EXIT
          STD    T1
          PSN
 SRQA     EQU    *-1
*         UJN    SRQ1        (NOT USING CHANNEL FLAG)
          SCF    *+2,CH      SET CHANNEL FLAG
          LDM    CPDA        INDICATE *1MT* TRANSFER STARTED
          ADN    3
          CWD    ON
 SRQ1     RJM    CRA         CHECK *1LT* ACCEPT
          NJN    SRQ2        IF *1LT* OUT OF SYNC
          LDM    CPDA        CHECK *1LT* FUNCTION
          ADN    1
          CRD    CM
          LDD    CM
          LMN    PRLM
          ZJN    SRQ3        IF *1LT* PAUSING
          LDD    BC          SET BYTE COUNT
          STD    T2
          LDD    NC
          STD    T3
          LDM    CPDA        ENTER REQUEST
          ADN    2
          CWD    T1
          RJM    CPD         CHECK IF PP DROPPED OUT
          NJN    SRQ2        IF *1LT* MISSING
          LJM    SRQX        RETURN
 
 SRQ2     RJM    HNG         HANG PP
 
 SRQ3     LJM    RET2        REQUEUE REQUEST
 WRT      SPACE  4,12
**        WRT - WRITE TAPE.
*
*         THIS ROUTINE CHECKS END OF OPERATION STATUS AND CHECKS TO
*         DETERMINE IF ANOTHER BLOCK CAN BE TRANSFERRED.  FOR CTS
*         THE FIRST PART OF *WRT* IS OVERLAYED WITH *WCT*.
*
*         EXIT   (LG,LG+1) = BLOCK ID UPDATED.
*                (BL,BL+1) = BLOCK NUMBER UPDATED.
*                (BT) = BLOCKS TRANSFERRED UPDATED.
*
*         USES   CM - CM+4.
*
*         CALLS  CNW, UBW, *WEM*, WEO.
*
*         MACROS CALL, SADT.
 
 
 WRT      SUBR               ENTRY/EXIT
          LDM    UBWB
          STD    LG+1
          NJN    WRT1        IF BLOCK ID NONZERO
          AOD    LG+1
 WRT1     LDD    DS          SAVE STATUS AT START OF WRITE
          STM    /WRITE/STAT
          LDD    UP          CLEAR EOR/EOF LAST BLOCK FLAG
          SCN    10
          STD    UP
          LDD    MD          CLEAR EOR/EOF THIS OPERATION FLAG
          LPC    7377
          STD    MD
          LDM    BUFB-4
          LMN    5
          NJN    WRT2        IF NOT FULL BLOCK
          LDM    BUFB-5
          LMN    5
          ZJN    WRT3        IF NOT EOR/EOF WRITTEN
 WRT2     LDN    10          SET EOR/EOF FLAGS
          RAD    UP
          LDC    400
          RAD    MD
 WRT3     RJM    CNW         CHECK NEXT WRITE
          RJM    WEO         WAIT END OF OPERATION
          ZJN    WRT4        IF NO ERROR
          LDN    /MTX/STE    STATUS ERROR
 WRT4     STD    EC
          NJN    WRT5        IF ERROR
          LDM    MTDS+1
          SHN    21-11
          PJN    WRT5        IF NO GCR CORRECTION
          AOM    ECNT+2      INCREMENT COUNTER
          SHN    -14
          RAM    ECNT+1      INCREMENT ON OVERFLOW
 WRT5     LDM    UBWB        CURRENT BLOCK ID
          STD    LG+1
          NJN    WRT6        IF NONZERO
          AOD    LG+1
 WRT6     LDM    /WRITE/BYRM
          ZJN    WRT6.1      IF ALL BYTES TRANSFERRED
          LDD    EC
          NJN    WRT6.1      IF ERROR CODE ALREADY PRESENT
          LDN    /MTX/CMF    CHANNEL MALFUNCTION
          STD    EC
 WRT6.1   LDD    EC
          ADD    EI
          ZJN    WRT7        IF NO ERROR OR NO VERIFICATION REQUIRED
          LDD    DS          SAVE STATUS FOR ERROR PROCESSOR
          STM    //STER
          CALL   WEM
 
*         RETURN HERE IF END OF TAPE OR IF ERROR WAS RECOVERED.
 
 WRT7     LDD    LG+1        SAVE LAST GOOD RECORD INFORMATION
          STD    LG
          RJM    UBW         UPDATE BID WINDOW
          UJN    WRT8        WRITE OUT TO FET
 
          BSS    0           ALLOW SPACE FOR THE END OF *WCT*
 
*         START OF COMMON CODE WITH *WCT*.  *WCT* OVERLAYS THE FIRST
*         PART OF *WRT* FOR CTS.
 
 WRT8     BSS    0
          SADT   .FE,,3,A
          LDC    *           WRITE OUT TO FET
          CWD    CN
          AOD    BL+1        INCREMENT BLOCK COUNT
          STM    BUFB-2      PUT BLOCK NUMBER IN PREFIX
          SHN    -14
          RAD    BL
          STM    BUFB-3
          AOD    BT          INCREMENT BLOCKS WRITTEN
          LJM    WRTX        RETURN
 WRTK     EQU    *-1
*         LJM    /3M /EOTEXIT  (RETURN ERROR ON END OF TAPE)
 WTS      SPACE  4,10
**        WTS - WAIT FOR *1LT* TRANSFER TO START.
*
*         ENTRY  (A) = BYTE COUNT.
*
*         EXIT   (A) = BYTE COUNT.
*
*         USES   CM - CM+4.
 
 
 WTS3     LDD    T0          RESTORE (A)
 
 WTS      SUBR               ENTRY/EXIT
          STD    T0          SAVE BYTE COUNT
 WTS1     LDM    CPDA        CHECK *1MT*/*1LT* INTERLOCK
          ADN    3
          CRD    CM
          LDD    CM
          ZJN    WTS3        IF *1LT* TRANSFER STARTED
          LDN    24          DELAY 10 MICROSECONDS
 WTS2     SBN    1
          NJN    WTS2        IF NOT DONE
          UJN    WTS1        CHECK INTERLOCK
          SPACE  4,10
 .WC      CON    0           WORD COUNT OF LAST CHUNK
          SPACE  4,10
          ERRMI  BUFB-5-*    IF CODE OVERLAYS BLOCK PREFIX
 CALL     SPACE  4,10
 .IM      SET    0           DISABLE ADDRESS MODIFICATION ON ERRORS
 
**        *1LT* CALL BLOCK.
*
*T        18/  1LT,6/ CP,6/ HP,6/ 2,1/ CF,11/ CHANNEL,12/ PPIA
*T,       12/  -0,24/  FIRST,24/  LIMIT
 
 
 CALL     VFD    18/3R1LT,6/0
          CON    2           WRITE LI FORMAT
          CHTE   *
          CON    CH          CHANNEL
          CON    0           *1MT* INPUT REGISTER ADDRESS
          CON    -0
          SADT   .FT,,,,SE
          CON    0,0
          SADT   .LM,,,,SE
          CON    0,0
          TITLE  PRESET.
 PRS      SPACE  4,15
**        PRS - PRESET.
*
*         EXIT   (CN+3, CN+4) = OUT POINTER.
*                TO *WLI* TO WRITE.
*                TO *WLI1* IF ERROR.
*                TO *RET2* IF PP NOT ASSIGNED FOR *1LT*.
*
*         USES   CN, T1, CM - CM+4.
*
*         CALLS  CNW, *CPP*, MCH.
*
*         MACROS MONITOR, PAUSE.
 
 
 PRS      LDC    PRSA
          RJM    MCH         MODIFY CHANNELS
          LDK    MABL        CHECK MAINFRAME TYPE
          CRD    CM
          LDD    CM+1
          SHN    -6
          LPN    41
          LMN    1
          ZJN    PRS2        IF USING CHANNEL FLAG
          LDN    .OPAL-1     BYTES TO COPY
          STD    T1
 PRS1     LDM    .OPA,T1
          STM    .OPE,T1     COPY OVER RESIDENT TAPE IO ROUTINE
          SOD    T1
          PJN    PRS1        IF COPY NOT COMPLETE
          LDC    .OPAC       ADDRESS OF CHANNEL TABLE
          RJM    MCH         MODIFY CHANNELS
          LDC    OPA
          STM    ODAB        SET JUMP TO OUTPUT ROUTINE
          LDC    OPL
          STM    ODAC
          ISTORE SRQA,(UJN SRQ1)  SKIP SETTING CHANNEL FLAG
          LDD    HP
          LPN    20
          SHN    6
          RAM    CALL+3      INDICATE IF ATS CONTROLLER
 PRS2     LDD    HP
          SHN    21-7
          PJN    PRS4        IF NOT CTS
          ISTORE /PRESET/GPSC,(UJN /PRESET/GPS6.1) DO NOT SEND CONTINUE
          LDC    WCTL-1
          STD    T1
 PRS3     LDM    .WCT,T1     REPLACE *WRT* WITH *WCT*
          STM    WRTX,T1
          SOD    T1
          PJN    PRS3        IF MORE CODE TO MOVE
          LDC    WCTF
          RJM    MCH         MODIFY CHANNEL INSTRUCTIONS
          LDC    6331        GENERAL STATUS BITS TO TEST
          STM    /PRESET/WFEA
          LDC    201         GENERAL STATUS BITS THAT SHOULD BE SET
          STM    /PRESET/WFEB
          UJN    PRS5        CONTINUE PRESET
 
 PRS4     LDC    4635        GENERAL STATUS BITS TO TEST
          STM    //WEOA
          LDC    201
          STM    //WEOB      GENERAL STATUS BITS THAT SHOULD BE SET
 PRS5     LDD    MD
          LPN    40
          ZJP    PRS6        IF NOT CONTROL WORD
          LDC    LDNI
          STM    CNWA
          ADN    2
          STM    CNWB        SET WORD COUNT TO 2
          ISTORE CNWC,(UJN CNW14)  IF NOT ENOUGH WORDS
          LDC    LDDI+CN+3
          STM    CNWD
          LDC    LBBY        BYTES PER CHUNK
          STM    CNWE
          ISTORE CNWF,(UJN CNW6)  SKIP CONVERSION TO BYTES
          AOM    ODAA        SET TO SKIP CONTROL WORD
          AOM    ODAE        SET TO SKIP CONTROL WORD
          LDC    LDDI+CN+3
          STM    SLNA        GET LEVEL NUMBER FROM CONTROL WORD
          UJN    PRS8        CONTINUE PRESET
 
 PRS6     LDM    CIOE        SET TYPE OF WRITE OPERATION
          SHN    -3
          SHN    2
          LMD    MD
          LPN    14
          LMD    MD
          STD    MD
          LPN    14
          NJN    PRS7        IF NOT PRU WRITE (004)
*         LDN    0
          STM    WLIB
          LDC    WLI3
          STM    WLIC
 PRS7     LDD    MD
          LPN    14
          LMN    4
          ZJN    PRS8        IF WRITE (014)
          ISTORE CNWG,(UJN CNW11)  BYPASS *DRCM*
 PRS8     LDM    LNUM        SET LEVEL NUMBER
          SHN    -10
          STM    LNUM
          LDD    MD
          LPN    14
          LMN    14
          NJN    PRS10       IF NOT EOF WRITE
          LDC    EOF         SET TO WRITE EOF
          STM    WLID
          LDM    LNUM
          LMN    17
          NJN    PRS9        IF NOT LEVEL 17
          STM    LNUM        DO NOT WRITE DOUBLE EOF
 PRS9     LDD    MD          CLEAR EOR/EOF FLAG THIS OPERATION
          LPC    7377
          STD    MD
          LDD    UP          CHECK LAST OPERATION EOR/EOF
          LPN    30
          LMN    20
          ZJN    PRS10       IF LAST OPERATION INCOMPLETE WRITE
          LDM    CIOE
          SHN    21-12
          MJN    PRS10       IF DATA IN BUFFER
          LDC    400         SET EOR/EOF FLAG THIS OPERATION
          RAD    MD
 PRS10    LDD    UP
          SCN    24          CLEAR BLANK TAPE FLAG
          LMN    20          SET LAST OPERATION WRITE FLAG
          STD    UP
          LDC    PRSB        SET UP FOR INSTRUCTION MODIFICATION
          STD    CN
          LDN    3           SET TO RETURN OUT POINTER
          STD    CN+4
          LDC    /SRU/ITWL*100  SET SRU INCREMENT
          STM    //CECA
          LDC    PRS11       SET TO RETURN HERE
          STD    BT
          LJM    PRSX        RETURN
 
*         RETURN HERE AFTER ALL ROUTINES LOADED.
*         BUILD CALL TO *1LT*.
 
          IFGT   BUFB,*,1
          BSS    BUFB-*      ENSURE PREFIX DOES NOT OVERLAY *PRS*
 PRS11    LDD    HP
          SHN    21-7
          PJN    PRS12       IF NOT CTS
          LDD    CN+3
          STM    /WRITE/OPTU SAVE OUT POINTER FOR COMMAND RETRY
          LDD    CN+4
          STM    /WRITE/OPTL
 PRS12    RJM    CNW         CHECK FIRST WRITE
          ZJN    PRS13       IF WRITE OK
          LJM    WLI1        PROCESS ERROR CONDITION
 
 PRS13    LDD    CP          MERGE CP NUMBER
          SHN    -7
          RAM    CALL+1
          LDD    HP
          LPC    7700        ALLOW *1LT* TO TEST FOR CTS
          RAM    CALL+2
          LDD    IA          SET INPUT REGISTER ADDRESS IN CALL
          STM    CALL+4
          LDN    CMCL        CHECK MOVE FLAG
          CRD    CM
          LDD    CM
          SHN    7
          LMD    CP
          ZJN    PRS14       IF MOVE FLAG
          LDD    MA          WRITE REQUEST BLOCK
          CWM    CALL,TR
          LDN    1           SET TO NOT QUEUE REQUEST
          STD    CM+1
          MONITOR RPPM       REQUEST PP
          LDD    CM+1
          NJN    PRS15       IF PP ASSIGNED
 PRS14    LJM    RET2        REQUEUE
 
 PRS15    STM    CPDA        SAVE PP INPUT REGISTER ADDRESS
 PRS16    LDN    77          DELAY
          SBN    1
          NJN    *-1
          LDD    MA          CHECK FOR *1LT* ACKNOWLEDGE
          ADN    1
          CRD    CM
          LDD    CM
          ZJN    PRS18       IF *1LT* READY
          RJM    CPD         CHECK FOR *1LT* DROP
          NJN    PRS14       IF *1LT* GONE
          LDN    CMCL        CHECK MOVE FLAG
          CRD    CM
          LDD    CM
          SHN    7
          LMD    CP
          NJN    PRS16       IF NO MOVE FLAG FOR THIS CP
          RJM    CEC         CHANGE BACK TO MAGNET CP
 PRS17    RJM    CPD         CHECK PP DROP
          NJN    PRS14       IF *1LT* GONE
          PAUSE  NE
          UJN    PRS17       LOOP
 
 PRS18    LDC    4000        SET BLOCKS WRITTEN FLAG
          STD    BT
          LJM    WLI         ENTER WRITE CODE
          SPACE  4,10
 PRSA     CHTB
 PRSB     TSAD
          ERRMI  ERLA-*      IF OVERFLOW INTO *CPP*
 WCT      SPACE  4,15
**        WCT - WRITE CARTRIDGE TAPE.
*
*         THIS ROUTINE CHECKS END OF OPERATION STATUS AND CHECKS TO
*         DETERMINE IF ANOTHER BLOCK CAN BE TRANSFERRED.  FOR CTS
*         THIS ROUTINE OVERLAYS THE FIRST PART OF *WRT*.  THE LENGTH
*         OF THIS ROUTINE MUST BE THE SAME AS THE LENGTH OF THE FIRST
*         PART OF *WRT*.
*
*         EXIT   TO *WRT8* IF NO ERROR.
*                TO *CWP* WITH (EC) = ERROR CODE IF ERROR.
*                TO *EOF* IF COMMAND RETRY AND EOF WRITE.
*                TO *WLI* IF COMMAND RETRY AND NOT EOF WRITE.
*
*         USES   CM - CM+4.
*
*         CALLS  CNW, *CWP*, /PRESET/WFE.
 
 
 .WCT     BSS    0
          LOC    WRTX
 WCT      SUBR               ENTRY/EXIT
          LDD    UP
          SCN    10          CLEAR EOR/EOF LAST BLOCK FLAG
          STD    UP
          LDD    MD
          LPC    7377        CLEAR EOR/EOF THIS OPERATION FLAG
          STD    MD
          LDM    BUFB-4
          LMN    5
          NJN    WCT1        IF NOT FULL BLOCK
          LDM    BUFB-5
          LMN    5
          ZJN    WCT2        IF NOT EOR/EOF WRITTEN
 WCT1     LDN    10
          RAD    UP          SET EOR/EOF FLAGS
          LDC    400
          RAD    MD
 WCT2     RJM    CNW         CHECK NEXT WRITE
          RJM    /PRESET/WFE WAIT FOR END OF OPERATION
          PJN    WCT3        IF NOT COMMAND RETRY
          LDM    /WRITE/OPTU RESET OUT POINTER
          STD    CN+3
          LDM    /WRITE/OPTL
          STD    CN+4
          LDD    MD
          LPC    7377        CLEAR EOR/EOF THIS OPERATION FLAG
          STD    MD
          RJM    CNW         CHECK NEXT WRITE
          LDN    F0002
          STM    ITMA        CONTINUE IS THE NEXT FUNCTION
          LDM    WCT
          LMC    EOFA
          ZJP    EOF         IF CALLED FROM *EOF*
          LJM    WLI         RETRY THE WRITE
 
 WCT3     ZJN    WCT4        IF NO ERROR
          LDN    /MTX/STE    STATUS ERROR
 WCT4     STD    EC
          LDM    /WRITE/BYRM
          ZJN    WCT5        IF ALL BYTES TRANSFERRED
          LDD    EC
          NJN    WCT5        IF ERROR CODE ALREADY PRESENT
          LDN    /MTX/CMF    CHANNEL MALFUNCTION
          STD    EC
 WCT5     LDD    EC
          ADD    EI
          ZJN    WCT6        IF NO ERROR OR NO RECOVERED ERROR
          CALL   CWP         WRITE ERROR PROCESSOR
 
*         RETURN HERE IF END OF TAPE OR RECOVERED ERROR.
 
 WCT6     LDD    CN+3
          STM    /WRITE/OPTU SAVE OUT POINTER FOR COMMAND RETRY
          LDD    CN+4
          STM    /WRITE/OPTL
 
 WCTL     EQU    *-WCTX      LENGTH OF *WCT*
          ERRNZ  WRT8-*      ADJUST *BSS* BEFORE *WRT8*
 
          LOC    *O
 
 WCTF     CHTB               CHANNEL TABLE FOR *WCT*
 OPA      SPACE  4,10
 .OPA     BSS    0
          LOC    .OPE
 OPA      SPACE  4,10
**        OPA - OUTPUT DATA TO ATS UNIT (NON-CYBER 180).
*
*         IF THERE ARE MULTIPLE CHUNKS IN THE BLOCK, THIS ROUTINE
*         IS USED FOR ALL BUT THE LAST CHUNK.  *OPL* IS USED FOR THE
*         LAST CHUNK.
*
*         ENTRY  (BY) = NUMBER OF BYTES TO OUTPUT.
*                (RDAB) = 0 IF NOT FIRST CHUNK.
*
*         EXIT   (A) = BYTES NOT TRANSFERRED.
 
 OPA1     AJM    *,CH        WAIT FOR *1LT* TO OUTPUT CHUNK
          LDD    BY          DELAY TO ALLOW *1LT* TO REACTIVATE CHANNEL
          OAM    BUFB,CH     OUTPUT DATA
          FJM    *,CH
          DCN    CH+40       INDICATE TO *1LT* TO RESUME OUTPUT
          NJN    OPAX        IF INCOMPLETE TRANSFER
          ACN    CH
 
 OPA      SUBR               ENTRY/EXIT
          LDM    RDAB
          ZJN    OPA1        IF NOT FIRST CHUNK
          LDD    BY
          ADN    5           ALLOW FOR BLOCK PREFIX
          OAM    BUFB-5,CH   OUTPUT DATA
          FJM    *,CH
          DCN    CH+40       INDICATE TO *1LT* TO RESUME OUTPUT
          NJN    OPAX        IF INCOMPLETE TRANSFER
          ACN    CH
          UJN    OPAX        RETURN
 OPL      SPACE  4,10
**        OPL - OUTPUT LAST PARTIAL CHUNK TO ATS UNIT (NON-CYBER 180).
*
*         ENTRY  (BY) = NUMBER OF BYTES TO TRANSFER.
*                (RDAB) = 0 IF NOT FIRST CHUNK OF BLOCK.
*
*         EXIT   (A) = BYTES NOT TRANSFERRED.
 
 
 OPL1     AJM    *,CH        WAIT FOR *1LT* TO OUTPUT CHUNK
          LDD    BY          DELAY TO ALLOW *1LT* TO REACTIVATE CHANNEL
          LPC    7776        WRITE EVEN BYTE COUNT
          ADN    1
          OAM    BUFB,CH     OUTPUT PARTIAL CHUNK
 
 OPL      SUBR               ENTRY/EXIT
          LDM    RDAB
          ZJN    OPL1        IF NOT FIRST CHUNK
          LDD    BY
          ADN    5+1
          LPC    7776        WRITE EVEN BYTE COUNT
          OAM    BUFB-5,CH   OUTPUT PARTIAL CHUNK
          UJN    OPLX        RETURN
 
 
          LOC    *O
 .OPAL    EQU    *-.OPA      LENGTH OF CODE
 
          ERRNG  .OPEL-.OPAL IF CODE OVERFLOWS
 
 .OPAC    CHTB               CHANNEL TABLE FOR *OPA*/*OPL*
          OVERLAY (WRITE LABEL PROCESSOR.),(BUF+CLBL+10),,WLA
 WLA      SPACE  4,15
**        WLA - WRITE LABELS PROCESSOR.
*
*         ENTRY  (PB) = 6/OPERATION TYPE, 6/SECTION.
*
*         USES   T1, T2, CM - CM+4, CN - CN+4.
*
*         CALLS  /CPP/CPP, HNG, ITM, RUD, UAD, /WRITE/WRT,
*                LABEL PROCESSORS.
*
*         MACROS CALL.
 
 
          ENTRY  WLA
 WLA      RJM    RUD
          LDC    4000        SET BLOCKS WRITTEN FLAG
          STD    BT
          RJM    UAD         GET CIO FUNCTION
          ADK    /MTX/UFRQ
          CRD    CM
          ADK    /MTX/UCIA-/MTX/UFRQ
          CRD    CN
          LDD    PB          CHECK FUNCTION
          SHN    -6
          SBN    /MTX/WLVR/100
          ZJN    WLA2        IF WRITE VOL1, HDR1 AFTER REEL SWAP
          LDD    CM
          LMN    /MTX/CIO
          NJN    WLA2        IF NOT PROCESSING CIO REQUEST
          LDD    CN
          SHN    -6
          LPN    17
          LMN    /CIO/CLO
          ZJN    WLA1        IF CLOSE
          LMN    /CIO/OPE&/CIO/CLO
          NJN    WLA2        IF NOT OPEN
 WLA1     CALL   CPP         CHANGE CONTROL POINTS
          LDN    ZERL        SET ADDRESS RELOCATION
          CRD    CN
          LDC    TADD
          STD    CN
          RJM    /CPP/CPP
          UJN    WLA3        SELECT LABEL TYPE
 
 WLA2     LDM    FETO        INSURE NO EXTENDED LABELS
          SCN    40
          STM    FETO
 WLA3     LDD    LT
          LPC    1000
          ZJN    WLA4        IF ANSI LABELS
          LDN    3
 WLA4     STD    T1          SET LABEL TYPE INDEX
          LDM    LTYP,T1     SET ADDRESS OF LABEL OPERATION TABLE
          STM    WLAA
          ADN    1
          STM    WLAB
          LDM    LTYP+1,T1   SET LENGTH OF LABEL
          STD    BY
          LDD    PB          SET UP TO PROCESS LABEL
          SHN    -6
          SHN    1
          STD    T2
          RAM    WLAB
          STM    WLAF
          LDD    T2
          SBM    LTYP+2,T1
          PJN    WLA6        IF UNDEFINED OPERATION
          LDM    *,T2
 WLAA     EQU    *-1
          ZJN    WLA4        IF SEQUENCE NOT DEFINED
          STM    WLAC
          LDD    PB          SET SECTION
          LPN    77
          STD    T1
          SBM    *
 WLAB     EQU    *-1
          MJN    WLA7        IF LEGAL SECTION
 WLA6     RJM    HNG         HANG PP
 WLA7     LDM    *,T1
 WLAC     EQU    *-1
          STM    WLAD
          RJM    *           PROCESS LABEL
 WLAD     EQU    *-1
          ZJN    WLA9        IF NO WRITE REQUIRED
          SHN    -21         SAVE ADVANCE SECTION FLAG
          STM    WLAE
 
*         ENTER HERE ON RETRY FROM WRITE ERROR RECOVERY.
 
 WLA8     LDD    HP
          SHN    21-7
          PJN    WLA8.1      IF NOT CTS
          LDC    F0250       SHORT WRITE
          STM    ITMA
          UJN    WLA8.2      WRITE TAPE
 
 WLA8.1   RJM    //ITM       INITIATE TAPE MOTION
 WLA8.2   RJM    /WRITE/WRT  WRITE TAPE
          LDC    *
 WLAE     EQU    *-1
          ZJN    WLA9        IF ADVANCE SECTION
          AOD    PA          ADVANCE SUBSECTION
          UJN    WLA10       CONTINUE LABEL PROCESSING
 
 WLA9     AOD    PB          ADVANCE TO NEXT SECTION
 WLA10    LDD    PB
          LPN    77
          SBM    *
 WLAF     EQU    *-1
          PJN    WLA11       IF ALL SECTIONS PROCESSED
          LJM    WLA3        SELECT NEXT LABEL TYPE
 WLAG     EQU    *-1
*         LJM    RET2        (RECOVERED PARITY ERROR)
 
 WLA11    LJM    RET1        EXIT
          SPACE  4,10
**        TABLE OF LABEL TYPES AND SIZES.
*T,       12/ TYPE,12/ SIZE
 
 LTYP     BSS    0
          LOC    0
          CON    ANS,LABL,ANSL  ANSI LABELS
*         CON    ANS,CLBL,ANSL  (CTS)
          LOC    *O
 LTYPL    EQU    *-LTYP
 FAD      SPACE  4,10
**        FAD - SET FET ADDRESS.
*
*         THIS ROUTINE IS HERE BECAUSE ADDRESS MODIFICATION DOES NOT
*         WORK ABOVE 3777B.
*
*         EXIT   (A) = FET ADDRESS.
*
*         MACROS SADT.
 
 
 FAD      SUBR               ENTRY/EXIT
          SADT   .FE,,,A
          LDC    *
          UJN    FADX        RETURN
 WTE      SPACE  4,15
**        WTE - WRITE TAPE MARK ERROR PROCESSOR.
*
*         THIS ROUTINE IS OVERLAYED WITH *CPE* FOR CTS.
*
*         ENTRY  (A) = 0 IF NOT NOT READY ERROR.
*                (A) .NE. 0 IF NOT READY OR NO WRITE ENABLE.
*
*         EXIT   TO *RET3* IF READY DROP, NO WRITE ENABLE, OR WRITE
*                TAPE MARK FAILURE.
*                (EP) = 3 IF NO WRITE ENABLE.
*
*         USES   EC, EI, EP, LG, LG+1, T2, T3.
*
*         CALLS  *EMM*, FCN, UBW, WEO, WFC.
*
*         MACROS CALL.
 
 
 WTE23    LDD    LG+1        SET LAST GOOD BLOCK INFORMATION
          STD    LG
          LDN    0           CLEAR RETRY COUNTER
          STD    EI
          LDN    1           SET TAPE MARK INDICATION
          STM    UBWB
          RJM    UBW         UPDATE WINDOW
 
 WTE      SUBR               ENTRY/EXIT
          ZJN    WTE2        IF CHECK STATUS
 
*         NOT READY OR NO WRITE ENABLE.
 
 WTE0     LPN    1
          NJN    WTE1        IF NOT READY
          LDN    3           SET SUB ERROR CODE
          STD    EP
          LDN    /MTX/NWE    NO WRITE ENABLE
          LJM    RET3        RETURN ERROR CODE
 
 WTE1     LDN    /MTX/RDR    DROP READY ERROR CODE
          STD    EC
          CALL   EMM         CALL ERROR HANDLER
          LDD    EC
          LJM    RET3        RETURN
 
 WTE2     STD    LG+1
          STD    EC
          STM    /WRITE/BYWR
          STM    /WRITE/BYRM
          STD    T3          CLEAR REPOSITIONING COUNT
          RJM    WEO         WAIT END OF OPERATION
 
*         CHECK FOR TAPE MARK STATUS IN REVERSE.
 
 WTE3     LDC    F0113       BACKSPACE OVER TAPE MARK
          RJM    FCN
          RJM    WFC         WAIT END OF OPERATION
          STM    WTEB        SAVE BACKSPACE STATUS FOR ANALYSIS
          LPN    20          TAPEMARK STATUS BIT
          STM    WTEA        SAVE STATUS OF BKSP OF CURRENT TAPE MARK
          LDM    BIDW,WP     LOAD LAST GOOD RECORD BLOCK ID
          SBN    1
          ZJP    WTE5        IF LAST GOOD RECORD IS TAPE MARK
 WTE3.1   AOD    T3          INCREASE REPOSITIONING COUNT
          LDN    13          FORESPACE OVER TAPE MARK
          RJM    FCN
          RJM    WFC         WAIT END OF OPERATION
          LPN    20
          ZJN    WTE4        IF TAPE MARK NOT SEEN ON FORESPACE
          LDM    WTEA
          ZJN    WTE4.1      IF TAPE MARK NOT SEEN ON BACKSPACE
          LJM    WTE23       TAPE MARK SEEN IN BOTH DIRECTIONS
 
 WTE4     LDM    BIDW,WP     LOAD BLOCK ID FROM WINDOW
          SBM    UBWB
          NJN    WTE4.1      IF NOT LAST GOOD DATA RECORD
          SOD    T3          ADJUST REPOSITIONING COUNT
          AOD    EI          INCREMENT RETRY COUNTER
          LJM    WTE17       REWRITE THE TAPE MARK
 
 WTE4.1   SOD    T3          REDUCE REPOSITIONING COUNT
          LDC    F0113       BACKSPACE OVER THIS BLOCK
          RJM    FCN
          RJM    WFC         WAIT END OF OPERATION
 
*         TAPE MARK RECOVERY.
 
 WTE5     AOD    EI          SET SINGLE RETRY
          LDD    WP          POINTER TO LAST GOOD BLOCK ID
          STD    T2
 WTE8     LDM    BIDW,T2     LOAD BLOCK ID FROM WINDOW
          SBN    4           INVALID BLOCK ID
          ZJP    WTE14       IF LAST BLOCK ID IN WINDOW
 
*         BACKSPACE OVER TAPE MARKS AND LAST GOOD DATA BLOCK.
 
          SOD    T3          REDUCE REPOSITIONING COUNT
          LDC    F0113       BACKSPACE OVER PRU
          RJM    FCN
          RJM    WFC         WAIT END OF OPERATION
          SHN    21-4
          PJN    WTE11       IF NO TAPE MARK
          LDM    BIDW,T2
          SBN    1
          NJN    WTE11       IF BLOCK ID WINDOW AND STATUS MISMATCH
          SOD    T2          REDUCE WINDOW POINTER
          PJN    WTE9        IF NO WRAP AROUND
          LDN    7
          STD    T2
 WTE9     SBD    WP
          NJN    WTE8        IF MORE IN BLOCK ID WINDOW
          UJP    WTE14.1     LAST BLOCK ID IN WINDOW
 
*         FORESPACE OVER LAST GOOD DATA BLOCK.
 
 WTE11    LDD    HP
          LPN    1
          NJN    WTE12       IF 9 TRACK
          LDD    MD          CURRENT PARITY TO BE USED ON FORESPACE
          SHN    -5
          LMM    BIDW,T2     PARITY THAT BLOCK WAS WRITTEN AT
          LPN    2
          ZJN    WTE12       IF NO CHANGE NEEDED
          LDN    5           TOGGLE TO OPPOSITE PARITY
          RJM    FCN
 WTE12    AOD    T3          INCREASE REPOSITIONING COUNT
          LDN    13          FORESPACE OVER LAST GOOD DATA BLOCK
          RJM    FCN
          RJM    WFC         WAIT END OF OPERATION
          SHN    21-13
          PJN    WTE13       IF NO ALERT ON FORESPACE
          LDM    BIDW,T2     LOAD BLOCK ID
          LPN    2
          NJN    WTE14       IF WRITTEN AS EVEN PARITY
 WTE13    SHN    7
          MJN    WTE13.1     IF TAPE MARK STATUS FORESPACE
          LDM    BIDW,T2
          SBM    UBWB
          ZJN    WTE13.2     IF BLOCK ID MATCHES
          AOM    WTEA
          LPN    62
          ZJN    WTE12       IF NO TAPE MARK AND NEXT BLOCK NOT CHECKED
 WTE13.1  UJN    WTE15       FATAL ERROR WRITING TAPE MARK
 
 WTE13.2  LDM    WTEA
          LPN    1
          ZJN    WTE14       IF MATCH FOUND ON EXPECTED BLOCK
          SOD    T3          ADJUST REPOSITIONING COUNT
 
*         FORESPACE OVER TAPE MARKS IF ANY.
 
 WTE14    LDD    T2
          SBD    WP
          ZJN    WTE16       IF NO TAPE MARKS
 WTE14.1  AOD    T2          INCREMENT TEMP WINDOW POINTER
          LPN    7
          STD    T2
          AOD    T3          INCREASE REPOSITIONING COUNT
          LDN    13          FORESPACE OVER TAPE MARK
          RJM    FCN
          RJM    WFC         WAIT END OF OPERATION
          LPN    20
          NJN    WTE14       IF TAPE MARK IN STATUS
 WTE15    LJM    WTE19       FATAL ERROR ON WRITING TAPE MARK
 
*         CHECK IF CURRENT TAPE MARK SEEN ON BACKSPACE.
 
 WTE16    STD    T3          CLEAR REPOSITIONING COUNT
          LDC    0           CURRENT TAPE MARK STATUS/FLAGS
 WTEA     EQU    *-1
          LPN    20
          ZJN    WTE17       IF NO TAPE MARK STATUS ON BACKSPACE
          RAM    WTEA        BLOCK THIS PATH
          LJM    WTE3.1      CHECK FOR TAPE MARK
 
*         ISSUE ERASES AND REWRITE TAPE MARK.
 
 WTE17    LDD    EI          RETRY COUNTER
          STD    T2          MAKE ERASE COUNTER
          SBN    6
          PJN    WTE19       IF MAX RETRY REACHED
 WTE18    LDN    52          ISSUE ERASE
          RJM    FCN
          RJM    WEO
          SOD    T2          REDUCE ERASE COUNTER
          NJN    WTE18       IF LOOP ERASE FUNCTIONS
          LDN    F0051       ISSUE WRITE TAPE MARK
          RJM    FCN
          RJM    WEO
          LDN    /MTX/TME    WRITE TAPE MARK ERROR CODE
          STD    EC
          LDD    DS          SET UP DETAIL STATUS
          STM    //STER
          CALL   EMM         CALL ERROR HANDLER
          LJM    WTE3        REVERIFY TAPE MARK
 
*         ERROR ON TAPE MARK RECOVERY.  REPOSITION TAPE FOR POSSIBLE
*         SUBSEQUENT *CLOSER* OPERATION.
 
 WTE19    LDD    T3          ERROR REPOSITIONING COUNT
          SHN    21-13
          PJN    WTE21       IF BACKSPACE REPOSITIONING NEEDED
          AOD    T3          INCREASE REPOSITIONING COUNT
          SHN    -14         CHECK FOR OVERFLOW
          NJN    WTE22       IF REPOSITIONING DONE OR NOT REQUIRED
          LDC    13          FORESPACE ONE BLOCK
 WTE20    RJM    FCN
          RJM    WFC         WAIT END OF OPERATION
          UJN    WTE19       CHECK IF MORE REPOSITIONING REQUIRED
 
 WTE21    ZJN    WTE22       IF REPOSITIONING DONE OR NOT REQUIRED
          SOD    T3          REDUCE REPOSITIONING COUNTER
          LDC    F0113
          UJN    WTE20       BACKSPACE ONE BLOCK
 
 WTE22    LDN    /MTX/TME    WRITE TAPE MARK FAILURE
          STD    EC
          LDD    DS          SET UP DETAIL STATUS
          STM    //STER
          CALL   EMM         CALL ERROR HANDLER
          LDD    EC
          LJM    RET3        RETURN TO MAGNET
 
 
 WTEB     BSSZ   1           INITIAL BACKSPACE STATUS FOR ANALYSIS
 WFC      SPACE  4,10
**        WFC - WAIT BACKSPACE FUNCTION COMPLETE.
*         TIMES OUT APPROXIMATELY 25 FEET OF TAPE.
*
*         EXIT   (A) = (DS) = UNIT STATUS.
*
*         USES   T4.
*
*         CALLS  //STW.
 
 WFC2     CON    0           ENTERED VIA *RJM* FROM //STW
          SOD    T4
          NJN    WFC1        IF NOT TIMEOUT
          LDC    //ERR       RESET ERROR EXIT
          STM    //STWC
          UJN    WFC1        ATTEMPT 1 MORE WAIT
 
 
 WFC      SUBR               ENTRY/EXIT
          LDC    2000        SET TIME OUT
          STD    T4
          LDC    WFC2        SET RETURN ON TIMEOUT IN //STW
          STM    //STWC
 WFC1     LDN    0           WAIT NOT BUSY
          RJM    //STW
          LDC    //ERR       RESET ERROR EXIT
          STM    //STWC
          LDD    DS
          UJN    WFCX        RETURN
 WFM      SPACE  4,10
**        WFM - WRITE FILE MARK.
*
*         COUNTS TAPE MARK AS A DATA BLOCK IF NOT LABEL OPERATION.
*
*         CALLS  WTM.
 
 
 WFM      SUBR               ENTRY/EXIT
          LDD    UP          SET EOR/EOF FLAG
          SCN    10
          LMN    10
          STD    UP
          LDD    MD          CLEAR TAPE MARK REQUEST
          SCN    14
          STD    MD
          RJM    WTM         WRITE TAPE MARKS
          LDD    PB
          SHN    -6
          NJN    WFM1        IF LABELING OPERATION
          AOD    BL+1        COUNT BLOCK
          SHN    -14
          RAD    BL
 WFM1     LDN    0
          UJN    WFMX        RETURN
          SPACE  4,10
          ERRNG  BUFB-*      OVERFLOWED INTO WRITE RECOVERY
          TITLE  ANSI LABEL PROCESSORS.
          SPACE  4,10
**        TABLE OF LABEL OPERATIONS.
 
 
 ANS      INDEX              ANSI LABELS OPERATION TABLE
          INDEX  /MTX/WLTM/40,(WEF,WEFL)  WRITE TAPE MARK
          INDEX  /MTX/WLTR/40,(ETL,ETLL)  WRITE TRAILER LABEL
          INDEX  /MTX/WLEV/40,(EVL,EVLL)  WRITE END OF VOLUME LABEL
          INDEX  /MTX/WLVH/40,(VLL,VLLL)  WRITE VOL1, HDR1
          INDEX  /MTX/WLME/40,(EFL,EFLL)  WRITE MULTI-FILE EOF
          INDEX  /MTX/WLVR/40,(VLL,VLLL)  WRITE VOL1, HDR1 ON REEL SWAP
          INDEX  /MTX/WLMX/40             TERMINATE TABLE
 ANSL     EQU    *-ANS       LENGTH OF TABLE
 
 EFL      BSS    0
          LOC    0
          CON    WFM         WRITE FILE MARK
          CON    EOF         WRITE *EOF1*
          CON    WFM         WRITE FILE MARK
          CON    CWS         CLEAR WRITE STATUS
          LOC    *O
 EFLL     EQU    *-EFL
 
 EVL      BSS    0
          LOC    0
          CON    ERA
          CON    WFM
          CON    EOV
          CON    EVO
          CON    UTL
          CON    WFM
          CON    WFM
          CON    WFM
          CON    CWS
          LOC    *O
 EVLL     EQU    *-EVL
 
 ETL      BSS    0
          LOC    0
          CON    WFM
          CON    EOF
          CON    EFO
          CON    UTL
          CON    WFM
          CON    WFM
          CON    WFM
          CON    CWS
          LOC    *O
 ETLL     EQU    *-ETL
 
 VLL      BSS    0
          LOC    0
          CON    VOL
          CON    UVL
          CON    HDR
          CON    OHD
          CON    UHL
          CON    WFM
          LOC    *O
 VLLL     EQU    *-VLL
 
 WEF      BSS    0
          LOC    0
          CON    WFM
          LOC    *O
 WEFL     EQU    *-WEF
          SPACE  4,10
**        COMMON EXIT CONDITIONS.
*         (A) = 0, NO WRITE REQUIRED, SECTION NUMBER WILL BE ADVANCED.
*         (A) = 40XXXX, WRITE BLOCK, DON,T ADVANCE SECTION NUMBER.
*         (A) = XXXX, WRITE BLOCK, ADVANCE SECTION NUMBER.
 ELA      SPACE  4,10
**        ELA - EXTENDED LABELS ADDRESS PROCESSING.
*
*         ENTRY  (T6 - T7) = POSITION TO START AT IN BUFFER.
*
*         EXIT   (A) = ABSOLUTE ADDRESS.
*                (A) = 0, END OF LABEL BUFFER.
*
*         CALLS  FAD.
 
 
 ELA      SUBR               ENTRY/EXIT
          LDM    FETO
          SHN    21-5
          PJN    ELA0        IF NO EXTENDED LABELS
          RJM    FAD         GET FET ADDRESS
          ADN    11
          CRD    CM
          LDD    CM+3
          SHN    14
          STD    CM+1
          SHN    -14
          STD    CM+3
          SHN    14
          LMD    CM+4
          SBN    2
          MJN    ELA0        IF NO LABEL BUFFER
          LDD    CM+2
          SHN    6
          LMD    CM+1
          STD    CM+2
          SHN    -14
          STD    CM+1
          LDD    T6
          SBD    CM+1
          SHN    14
          ADD    T7
          SBD    CM+2
          ADN    11          ALLOW FOR LABEL
          MJN    ELA1        IF NOT END OF LABEL BUFFER
 ELA0     LDN    0           INDICATE END OF BUFFER
          LJM    ELAX        RETURN
 
 ELA1     LDD    CM+1        CHECK IF BUFFER WITHIN FL
          ADD    CM+3
          SHN    14
          ADD    CM+2
          ADD    CM+4
          SHN    -6
          SBD    FL
          MJN    ELA2        IF BUFFER WITHIN FL
          LDN    /MTX/BAE    BUFFER ARGUMENT ERROR
          LJM    RET3        RETURN ERROR CODE
 
 ELA2     LDD    CM+3        CALCULATE LABEL ADDRESS
          ADD    T6
          SHN    6
          ADD    RA
          SHN    6
          ADD    CM+4
          ADD    T7
          LJM    ELAX        RETURN
 ERA      SPACE  4,10
**        ERA - ERASE.
*
*         SKIP OVER THE EOT MARKER SO THAT THE FIRST TAPE MARK IN THE
*         TRAILER LABEL SEQUENCE CAN BE WRITTEN AFTER THE EOT MARKER.
*         THIS WILL REDUCE THE POSSIBILITY OF AN ERROR OCCURRING WHEN
*         LATER READING THE FIRST TAPE MARK.
*
*         EXIT   (A) = 0.
*
*         CALLS  FCN, WEO.
 
 
 ERA      SUBR               ENTRY/EXIT
          LDN    52          SKIP OVER EOT BLOCK (ERASE)
 ERAA     EQU    *-1
*         UJN    ERA1        (CTS)
          RJM    FCN
          RJM    WEO         WAIT FOR END OF OPERATION
 ERA1     LDN    0           NO WRITE REQUIRED, ADVANCE SECTION
          UJN    ERAX        RETURN
 EOV      SPACE  4,10
**        EOV - WRITE END OF VOLUME LABEL.
*         WRITE 3 TAPE MARKS IF UNLABELED.
*
*         CALLS  CCB, HTR.
 
 
 EOV2     AOD    PB          SKIP *EOV2* SEQUENCE
          AOD    PB          SKIP *UTL* SEQUENCE
          LDN    0           INDICATE NO WRITE
 
 EOV      SUBR               ENTRY/EXIT
          LDD    LT
          SHN    21-12
          MJN    EOV1        IF LABELED
          LDD    FM
          SHN    -6
          SBN    /MTX/TFSI+1
          MJN    EOV1        IF I OR SI FORMAT
          SBN    /MTX/TFLI-/MTX/TFSI-1
          NJN    EOV2        IF NOT LI FORMAT
 EOV1     LDN    1           SET POSITION IN LABEL BUFFER
          STD    T6
          LDC    =H*EOV1*+40000  SET *EOV1*
          RJM    CCB
          RJM    HTR
          UJN    EOVX        RETURN
 EVO      SPACE  4,10
**        EVO - END OF VOLUME - 2.
*
*         USES   T6.
*
*         CALLS  CCB, SFL.
 
 
 EVO1     LDN    0           INDICATE NO WRITE
 
 EVO      SUBR               ENTRY/EXIT
          LDM    IVSN
          ZJN    EVO1        IF NEXT VSN NOT KNOWN
          LDM    EVSN+4
          SHN    21-5
          MJN    EVO1        IF NEXT VSN IS SCRATCH
          LDN    1           SET POSITION IN LABEL BUFFER
          STD    T6
          LDC    =H*EOV2*+40000  SET EOV2
          RJM    CCB
          LDC    IVSN+60000  COPY VSN
          RJM    CCB
          LDC    70D         SPACE FILL REMAINDER
          RJM    SFL
          LDN    1           INDICATE WRITE REQUIRED
          UJN    EVOX        RETURN
 EOF      SPACE  4,10
**        EOF - WRITE END OF FILE LABEL.
*
*         USES   T6.
*
*         CALLS  CCB, HTR.
 
 
 EOF2     LDN    0           INDICATE NO WRITE
 
 EOF      SUBR               ENTRY/EXIT
          LDD    LT
          SHN    21-12
          MJN    EOF1        IF LABELED
          LDD    FM
          SHN    -6
          SBN    /MTX/TFSI+1
          MJN    EOF1        IF I OR SI FORMAT
          SBN    /MTX/TFLI-/MTX/TFSI-1
          NJN    EOF2        IF NOT LI FORMAT
 EOF1     LDN    1           SET POSITION IN LABEL BUFFER
          STD    T6
          LDC    =H*EOF1*+40000  SET *EOF1*
          RJM    CCB
          RJM    HTR
          UJN    EOFX        RETURN
 EFO      SPACE  4,10
**        EFO - PROCESS EOF2 - EOF9.
*
*         CALLS  PSL.
 
 
 EFO      SUBR               ENTRY/EXIT
          LDC    3REOF
          RJM    PSL
          UJN    EFOX        RETURN
 HDR      SPACE  4,10
**        HDR - *HDR1* PROCESSOR.
*
*         CALLS  CCB, HTR.
 
 
 HDR      SUBR               ENTRY/EXIT
          LDN    1           SET POSITION IN LABEL BUFFER
          STD    T6
          LDC    =H*HDR1*+40000    SET *HDR1*
          RJM    CCB
          RJM    HTR
          RJM    WUC         WRITE UNIT DESCRIPTOR TABLE CONDITIONALLY
          UJN    HDRX        RETURN
 OHD      SPACE  4,10
**        OHD - PROCESS HDR2-HDR9.
*
*         CALLS  PSL.
 
 
 OHD      SUBR               ENTRY/EXIT
          LDC    3RHDR
          RJM    PSL
          UJN    OHDX        RETURN
 UHL      SPACE  4,10
**        UHL - USER FILE HEADER LABEL.
*
*         CALLS  PUL.
 
 
 UHL      SUBR               ENTRY/EXIT
          LDC    3RUHL
          RJM    PUL
          UJN    UHLX        RETURN
 UTL      SPACE  4,10
**        UTL - USER TRAILER LABELS.
*
*         CALLS  PUL.
 
 
 UTL      SUBR               ENTRY/EXIT
          LDC    3RUTL
          RJM    PUL
          UJN    UTLX        RETURN
 UVL      SPACE  4,10
**        UVL - USER VOLUME HEADER LABEL.
*
*         CALLS  PSL.
 
 
 UVL2     LDN    1R2         RESET SEARCH TO BEGIN AT XXX2
          STM    PSLA
          SOM    PSLB
          LDN    0
          STD    PA
 
 UVL      SUBR               ENTRY/EXIT
          LDD    PA
          NJN    UVL1        IF NOT FIRST ENTRY
          LDN    1R1         SET SEARCH TO BEGIN AT UVL1
          STM    PSLA
          AOM    PSLB
 UVL1     LDC    3RUVL       SET LABEL TO SEARCH FOR
          RJM    PSL
          ZJN    UVL2        IF NO UVL LABELS
          UJN    UVLX        RETURN
 VOL      SPACE  4,10
**        VOL - VOLUME HEADER LABEL.
*
*         USES   T6, T7, CM - CM+4, CN - CN+4.
*
*         CALLS  CCB, CLF, GUD, SFL, SLC.
 
 
 VOL1     AOD    PB          ADVANCE SECTION
          LDN    0           SET LAST GOOD BLOCK TAPE MARK
          STD    LG
          STD    LG+1
 
 VOL      SUBR               ENTRY/EXIT
          LDD    UP          SET LAST OPERATION WRITE FLAG
          SCN    20
          LMN    20
          STD    UP
          LDD    EI
          NJN    VOL2        IF ERROR RECOVERY IN PROGRESS
          LDD    DS
          LPN    4
          ZJN    VOL1        IF NOT LOAD POINT
 VOL2     LDN    1           SET POSITION IN LABEL BUFFER
          STD    T6
          LDC    =H*VOL1*+40000  SET *VOL1*
          RJM    CCB
          LDN    11D         COPY VSN
          STD    T7
          LDN    6
          RJM    CLF
          LDN    55D         COPY VOLUME ACCESSIBILITY FROM *UGNU*
          STD    T7
          LDN    1
          RJM    CLF
          LDN    20D         SPACE FILL LABEL
          RJM    SFL
          LDN    6           SPACE FILL LABEL
          RJM    SFL
          LDN    8D          GET FAMILY ORDINAL
          STD    T7
          RJM    GUD
          NJN    VOL3        IF NOT NULL FAMILY
          LDN    1           SUBSTITUTE DEFAULT FAMILY
 VOL3     STD    CN          SAVE FAMILY ORDINAL
          LDK    FOTP        READ FOT POINTERS
          CRD    CM
          LDD    CM          CALCULATE FOT ENTRY ADDRESS
          SHN    14
          ADD    CM+1
          ADD    CN
          CRD    CN
          LDC    70000+CN
          RJM    CCB
          LDN    1           COPY USER NAME
          STD    T7
          LDN    7
          RJM    CLF
          LDN    28D         SPACE FILL
          RJM    SFL
          LDN    1R1         SET LABELS ARE ANSI STANDARD
          RJM    SLC
          LDN    1           SET TO WRITE BLOCK
          LJM    VOLX        RETURN
 CWS      SPACE  4,10
**        CWS - CLEAR WRITE STATUS.
 
 
 CWS      SUBR               ENTRY/EXIT
          LDD    UP
          SCN    30          CLEAR WRITE OPERATION AND EOR/EOF FLAGS
          STD    UP
          LDN    0
          UJN    CWSX        RETURN
          ERRNZ  /MTX/WLTM
          TITLE  CHARACTER PROCESSING SUBROUTINES.
          SPACE  4,10
**        DIRECT CELL USAGE IN FOLLOWING ROUTINES.
*
*         (T5)   NUMBER OF CHARACTERS.
*         (T6)   CHARACTER POSITON IN *BUF*.
*         (T7)   CHARACTER POSITON IN *UDT*.
*
*         ALL CHARACTER POSITIONS ARE REFERENCED STARTING WITH *1*.
*         THUS, THE CHARACTER POSITION VALUES BEING USED TO ACCESS
*         *BUF* MAY BE REFERENCED DIRECTLY TO THE LABEL STANDARD.
 CCB      SPACE  4,10
**        CCB - COPY CHARACTER BUFFER.
*         COPYS THE SPECIFIED NUMBER OF CHARACTERS FROM THE SPECIFIED
*         FIELD TO THE LABEL BUFFER.  TRAILING ZEROS ARE BLANK FILLED.
*
*         ENTRY  (A, 21 - 14) = NUMBER OF CHARACTERS.
*                (A, 13 - 0) = ADDRESS OF BUFFER TO MOVE FROM.
*                (T6) = CHARACTER POSITION IN *BUF*.
*
*         CALLS  SFL, SLC.
 
 
 CCB2     LDD    T5          SPACE FILL LABEL
          RJM    SFL
 
 CCB      SUBR               ENTRY/EXIT
          STD    T4          SAVE BUFFER ADDRESS
          SHN    -14
          STD    T5          SAVE CHARACTER COUNT
 CCB1     LDI    T4          MOVE CHARACTER
          SHN    -6
          ZJN    CCB2        IF 00 CHARACTER
          RJM    SLC         STORE CHARACTER
          SOD    T5
          ZJN    CCBX        IF ALL CHARACTERS MOVED
          LDI    T4          MOVE CHARACTER
          LPN    77
          ZJN    CCB2        IF 00 CHARACTER
          RJM    SLC
          SOD    T5
          ZJN    CCBX        IF ALL CHARACTERS MOVED
          AOD    T4
          UJN    CCB1        LOOP
 CLF      SPACE  4,10
**        CLF - COPY LABEL FIELD FROM UDT.
*         IF FIRST CHARACTER FIELD IS ZERO, FIELD IS SPACE FILLED.
*
*         ENTRY  (A) = NUMBER OF CHARACTERS TO MOVE.
*                (T6) = CHARACTER POSITION IN *BUF*.
*                (T7) = CHARACTER POSITION IN *UDT*.
*
*         CALLS  GUD, SFL, SLC.
 
 
 CLF      SUBR               ENTRY/EXIT
          STD    T5
          RJM    GUD
          NJN    CLF2        IF SPACE FILL NOT NEEDED
          LDD    T5          ADVANCE CHARACTER POSITION IN *UDT*
          RAD    T7
          LDD    T5          SPACE FILL
          RJM    SFL
          UJN    CLFX        RETURN
 
 CLF1     RJM    GUD         GET UNIT DESCRIPTOR CHARACTER
 CLF2     RJM    SLC         STORE LABEL CHARACTER
          SOD    T5
          NJN    CLF1        IF STILL MORE CHARACTERS TO MOVE
          UJN    CLFX        RETURN
 DCV      SPACE  4,10
**        DCV - DECIMAL CONVERT TO A 6 DIGIT NUMBER.
*
*         ENTRY  (CM+3 - CM+4) = QUANITY TO BE CONVERTED.
*
*         EXIT   (DCB+2 - DCB+4) = DISPLAY CODE DECIMAL NUMBER.
*
*         MACROS MONITOR.
 
 
 DCV      SUBR               ENTRY/EXIT
          LDN    0           PRESET TO CONVERT NUMBER
          STD    CM+1
          STD    CM+2
          LDD    MA
          CWD    CM
          MONITOR RDCM       REQUEST DATA CONVERSION
          LDD    MA
          CRD    CM
          LDD    CM+4        REMOVE *.* FROM DATA
          STM    DCB+4
          LDD    CM+3
          LPN    77
          SHN    14
          LMD    CM+2
          SHN    6
          STM    DCB+3
          LPC    770000
          LMD    CM+1
          SHN    6
          STM    DCB+2
          LDC    DCB+1       REMOVE SPACES
          STD    T1
 DCV1     AOD    T1          ADVANCE TO NEXT BYTE
          LMC    DCB+5
          ZJN    DCV3        IF ALL SPACES
          LDI    T1
          ZJN    DCV2        IF ZERO
          LMC    2R
          NJN    DCV3        IF NOT *  *
 DCV2     LDC    2R00
          STI    T1
          UJN    DCV1        LOOP
 
 DCV3     SHN    -6
          NJN    DCV4        IF NOT * *
          LCN    -1R0+1R
          SHN    6
          RAI    T1
 DCV4     LJM    DCVX        RETURN
 GUD      SPACE  4,10
**        GUD - GET UNIT DESCRIPTOR CHARACTER.
*
*         ENTRY  (T7) = CHARACTER POSITION OF NEXT CHARACTER.
*
*         EXIT   (A) = CHARACTER.
*                (T7) = INCREMENTED.
*
*         USES   T1.
 
 
 GUD1     LDM    UDTB-1,T1
          LPN    77
 
 GUD      SUBR               ENTRY/EXIT
          AOD    T7
          SBN    1
          SHN    21
          STD    T1
          SHN    -21
          ZJN    GUD1        IF EVEN CHARACTER POSITION
          LDM    UDTB,T1
          SHN    -6
          UJN    GUDX        RETURN
 HTR      SPACE  4,10
**        HTR - GENERATE HEADER/TRAILER LABEL INFORMATION.
*
*         EXIT   (A) = 1. (INDICATE BLOCK WRITE)
*
*         CALLS  CLF, C2D, DCV, SFL.
 
 
 HTR      SUBR               ENTRY/EXIT
          LDN    5           GENERATE FILE IDENTIFIER
          STD    T6
          LDN    21D
          STD    T7
          LDN    17D
          RJM    CLF
          LDN    41D         COPY SET IDENTIFCATION
          STD    T7
          LDN    6
          RJM    CLF
          LDM    UDTB+22     CONVERT SECTION NUMBER
          LPN    77
          STD    CM+3
          LDM    UDTB+23
          STD    CM+4
          RJM    DCV
          LDC    /MTX/UUDTL*10D+7
          STD    T7
          LDN    4
          RJM    CLF
          LDM    UDTB+27     CONVERT SEQUENCE NUMBER
          LPN    77
          STD    CM+3
          LDM    UDTB+30
          STD    CM+4
          RJM    DCV
          LDC    /MTX/UUDTL*10D+7
          STD    T7
          LDN    4
          RJM    CLF
          LDM    UDTB+34     CONVERT GENERATION NUMBER
          LPN    77
          STD    CM+3
          LDM    UDTB+35
          STD    CM+4
          RJM    DCV
          LDC    /MTX/UUDTL*10D+7
          STD    T7
          LDN    4
          RJM    CLF
          LDM    UDTB+33     CONVERT GENERATION VERSION NUMBER
          LPN    77
          SHN    14
          LMM    UDTB+34
          SHN    -6
          STD    CM+4
          LDN    0
          STD    CM+3
          RJM    DCV
          LDC    /MTX/UUDTL*10D+9D
          STD    T7
          LDN    2
          RJM    CLF
          LDN    JDAL        SET CREATION DATE
          CRM    DCB,ON
          LDC    /MTX/UUDTL*10D+6
          STD    T7
          RJM    SCL         SET CREATION DATE CENTURY
          LDN    5
          RJM    CLF
          LDC    66D         SET EXPIRATION DATE
          STD    T7
          RJM    SCL         SET EXPIRATION DATE CENTURY
          LDN    5
          RJM    CLF
          LDN    47D         SET ACCESSIBILITY CODE
          STD    T7
          LDN    1
          RJM    CLF
          LDD    BL          CONVERT BLOCK COUNT
          STD    CM+3
          LDD    BL+1
          STD    CM+4
          RJM    DCV
          LDC    /MTX/UUDTL*10D+5
          STD    T7
          LDN    6
          RJM    CLF
          LDD    MA          SET OPERATING SYSTEM NAME
          CWM    HTRA,ON
          SBN    1
          CRM    DCB,ON
          LDC    /MTX/UUDTL*10D+1
          STD    T7
          LDN    10D
          RJM    CLF
          LDD    EO          SET EST ORDINAL WRITTEN ON
          SHN    -3          POSITION UPPER DIGITS
          RJM    C2D
          STM    DCB
          LDD    EO          PROCESS LOWER DIGIT
          LPN    7
          ADN    1R0
          SHN    6
          STM    DCB+1
          LDC    /MTX/UUDTL*10D+1
          STD    T7
          LDN    3
          RJM    CLF
          LDN    7           SPACE FILL
          RJM    SFL
          LDN    1           INDICATE TO WRITE BLOCK
          LJM    HTRX        RETURN
 
 
 HTRA     DATA   10HNOS   "VERNUM"-
 PSL      SPACE  4,10
**        PSL - PROCESS SEQUENTIAL TYPE OPTIONAL LABELS.
*                (HDR2 - HDR9, EOF2 - EOF9, UVL1 - UVL9)
*
*         ENTRY  (A) = 3 CHARACTER LABEL NAME TO SEARCH FOR.
*                (PA) = FOURTH CHARACTER OF LABEL - 2.
*
*         EXIT   (A) = (PA) = 0 IF NO LABEL.
*
*         CALLS  ELA.
 
 
 PSL4     STD    PA
 
 PSL      SUBR               ENTRY/EXIT
          SHN    14
          STM    PSLC
          SHN    -6
          SCN    77
          LMC    1R2
 PSLA     EQU    *-1
*         LMC    1R1         (UVL LABELS)
          ADD    PA
          STM    PSLD
          LDN    ZERL        SET TO START AT BEGINNING OF BUFFER
          CRD    T5
          LDD    PA
 PSLB     LMN    9D-1
*         LMN    9D          (UVL LABELS)
          ZJN    PSL4        IF MAXIMUM LABELS
 PSL1     RJM    ELA
          ZJN    PSL4        IF NO EXTENDED LABEL OR END OF BUFFER
          CRD    CN
          ADN    1
          CRD    CM
          LDD    CN+4
          ZJN    PSL4        IF END OF LABELS IN BUFFER
          LMC    80D
          NJN    PSL3        IF NOT CORRECT LENGTH
          LDD    CM
          LMC    *
 PSLC     EQU    *-1
          NJN    PSL2        IF NOT CORRECT LABEL
          LDD    CM+1
          LMC    *
 PSLD     EQU    *-1
          NJN    PSL2        IF NOT CORRECT LABEL
          LDN    10          READ LABEL
          STD    T5
          RJM    ELA
          ADN    1
          CRM    BUF,T5
          LCN    1           SET WRITE LABEL
          LJM    PSLX        RETURN
 
 PSL2     LDN    11          INCREMENT TO NEXT LABEL BLOCK
          RAD    T7
          SHN    -14
          RAD    T6
          LJM    PSL1        LOOP FOR NEXT LABEL
 
 PSL3     LDN    /MTX/IXL    INCORRECT CHARACTER COUNT IN HEADER
          LJM    RET3        RETURN ERROR CODE
 PUL      SPACE  4,10
**        PUL - PROCESS USER LABELS.
*
*         ENTRY  (A) = 3 CHARACTER LABEL NAME TO SEARCH FOR.
*                (PA) = PARTICULAR LABEL OF TYPE TO TAKE.
*
*         EXIT   (PA) = (A) = 0, IF NO LABEL.
*
*         CALLS  ELA.
 
 
 PUL4     STD    PA
 
 PUL      SUBR               ENTRY/EXIT
          SHN    14
          STM    PULA
          SHN    -14
          STM    PULB
          LDN    ZERL
          CRD    T5
          LDD    PA
          LMD    HN
          ZJN    PUL4        IF MAXIMUM NUMBER OF USER LABELS
 PUL1     RJM    ELA
          ZJN    PUL4        IF NO EXTENDED LABELS OR END OF BUFFER
          CRD    CN
          ADN    1
          CRD    CM
          LDD    CN+4
          ZJN    PUL4        IF END OF LABELS IN BUFFER
          LMC    80D
          NJN    PUL3        IF NOT CORRECT LENGTH
          LDD    CM
          LMC    *
 PULA     EQU    *-1
          NJN    PUL2        IF NOT CORRECT LABEL
          LDD    CM+1
          SHN    -6
          LMC    *
 PULB     EQU    *-1
          NJN    PUL2        IF NOT CORRECT LABEL
          AOD    T5
          SBN    1
          LMD    PA
          NJN    PUL2        IF NOT CORRECT LABEL BLOCK
          LDN    10          READ LABEL
          STD    T5
          RJM    ELA
          ADN    1
          CRM    BUF,T5
          LCN    1
          LJM    PULX        RETURN
 
 PUL2     LDN    11          INCREMENT TO NEXT BLOCK
          RAD    T7
          SHN    -14
          RAD    T6
          LJM    PUL1        LOOP
 
 PUL3     LDN    /MTX/IXL    INCORRECT CHARACTER COUNT IN HEADER
          LJM    RET3        RETURN ERROR CODE
 RUD      SPACE  4,10
**        RUD - READ UDT VSN AND LABEL INFORMATION.
*
*         EXIT   (A) = 0 IF NOT AT MAGNET CP.
*                UDT INFORMATION READ IF AT MAGNET CP.
*
*         CALLS  UDA.
 
 
 RUD      SUBR               ENTRY/EXIT
          RJM    UDA
          ZJN    RUDX        IF NOT AT MAGNET CP
          CRM    EVSN,T1     READ VSN AND LABEL INFORMATION
          UJN    RUDX        RETURN
 UDA      SPACE  4,10
**        UDA - SET UDT ADDRESS OF VSN AND LABEL PARAMETERS.
*
*         EXIT   (A) = ADDRESS OF *UESN*.
*                (T1) = NUMBER OF UDT WORDS IN BLOCK.
*
*         CALLS  UAD.
 
 
 UDA1     LDN    0
 
 UDA      SUBR               ENTRY/EXIT
          LDM    CECB
          LPN    77
          NJN    UDA1        IF NOT AT MAGNET CP
          LDN    /MTX/UUDTL+2
          STD    T1
          RJM    UAD
          ADK    /MTX/UESN
          ERRNZ  /MTX/UISN-/MTX/UESN-1
          ERRNZ  /MTX/UUFN-/MTX/UISN-1
          UJN    UDAX        RETURN
 WUC      SPACE  4,15
**        WUC - WRITE UNIT DESCRIPTOR TABLE CONDITIONALLY.
*         UPDATE UDT CREATION DATE FOR SYMBOLIC ACCESS TMS TAPES.
*
*         EXIT   CREATION DATE FROM LABEL WRITTEN INTO *UDT* IF TAPE IS
*                SYMBOLIC ACCESS.
*
*         NOTE   (A) IS PRESERVED.
*
*         USES   CM - CM+4.
*
*         CALLS  UAD, WUD.
 
 
 WUC      SUBR               ENTRY/EXIT
          STM    WUCA+1      SAVE (A)
          SHN    -14
          ADC    LDCI
          STM    WUCA
          LDM    CECB        CHECK CONTROL POINT
          LPN    77
          NJN    WUC1        IF NOT AT MAGNET CP
          RJM    UAD         GET UDT ADDRESS
          ADN    /MTX/UTMS
          CRD    CM          CHECK FOR TMS TAPE, SYMBOLIC ACCESS
          LDD    CM+4
          SHN    21-10
          PJN    WUC1        IF NOT SYMBOLIC ACCESS
          LDM    WUCB+0      SET CREATION DATE
          STM    WUCC+0
          LDM    WUCB+1
          STM    WUCC+1
          LDM    WUCC+2
          LPN    77
          STM    WUCC+2
          LDM    WUCB+2
          SCN    77
          RAM    WUCC+2
          RJM    WUD         WRITE UNIT DESCRIPTOR TABLE
 WUC1     BSS    0
 WUCA     LDC    *           RESTORE (A)
          LJM    WUCX        RETURN
 
 WUCB     EQU    BUF+42D/2   CREATION DATE IN LABEL BUFFER
*WUCC     EQU    UDTB+/MTX/UDAT*5-/MTX/UUFN*5  CREATION DATE IN UDT
 WUD      SPACE  4,10
**        WUD - WRITE UDT VSN AND LABEL INFORMATION.
*
*         CALLS  UDA.
 
 
 WUD      SUBR               ENTRY/EXIT
          RJM    UDA         GET UDT LABEL ADDRESS ADDRESS
          ZJN    WUDX        IF NOT AT MAGNET CP
          CWM    EVSN,T1
          UJN    WUDX        RETURN
 SCL      SPACE  4,10
**        SCL - SET CENTURY IN LABEL.
*         GENERATES THE *ISO* STANDARD CENTURY CHARACTER, BASED ON THE
*         YEAR IN THE *UDT*, AND PLACES IT IN THE OUTPUT BUFFER.
*
*         ENTRY  (T7) = CHARACTER POSITION OF YEAR IN *UDT*.
*                (T6) = CHARACTER POSITION IN OUTPUT BUFFER.
*
*         EXIT   FILL CHARACTER PLACED IN OUTPUT BUFFER,
*                (* * FOR 19XX YEARS, *0* FOR 20XX YEARS).
*                (T7) = (A) = ORIGINAL (T7).
*                (T6) INCREMENTED.
*
*         CALLS  GUD, SLC.
*
*         USES   T7.
 
 
 SCL1     LDN    1R          SPACE FILL
 SCL2     RJM    SLC         STORE LABEL CHARACTER
          SOD    T7
 
 SCL      SUBR               ENTRY/EXIT
          RJM    GUD         GET TENS DIGIT OF YEAR
          SBN    1R7
          PJN    SCL1        IF YEAR .LE. 1999
          LDN    1R0         ZERO FILL FOR NEXT CENTURY
          UJN    SCL2        STORE CHARACTER AND RETURN
 SLC      SPACE  4,10
**        SLC - STORE LABEL CHARACTER.
*
*         ENTRY  (T6) = CHARACTER POSITION IN *BUF*.
*                (A) = CHARACTER.
*
*         EXIT   (T6) = INCREMENTED.
*
*         USES   T1.
 
 
 SLC1     LDM    BUF-1,T1
          SCN    77
          LMD    T0
 SLC2     STM    BUF-1,T1
 
 SLC      SUBR               ENTRY/EXIT
          STD    T0          SAVE CHARACTER
          AOD    T6          INCREMENT POSITION
          SHN    21
          STD    T1
          SHN    -21
          NJN    SLC1        IF EVEN CHARACTER
          LDM    BUF-1,T1
          LPN    77
          SHN    14
          LMD    T0
          SHN    6
          UJN    SLC2        STORE CHARACTER
 SFL      SPACE  4,10
**        SFL - SPACE FILL LABEL.
*
*         (A) = NUMBER OF SPACES.
*         (T6) = FIRST CHARACTER OF LABEL FIELD.
*
*         CALLS  SLC.
 
 
 SFL      SUBR               ENTRY/EXIT
          STD    T5
 SFL1     LDN    1R
          RJM    SLC         STORE LABEL CHARACTER
          SOD    T5
          NJN    SFL1        IF STILL MORE CHARACTERS TO FILL
          UJN    SFLX        RETURN
          SPACE  4,10
**        COMMON DECKS.
 
 
*CALL     COMPC2D
          TITLE  HARDWARE PROCESSING SUBROUTINES.
 WTM      SPACE  4,10
**        WTM - WRITE TAPE MARKS.
*
*         CALLS  FCN, STW, WTE.
 
 
 WTM      SUBR               ENTRY/EXIT
 WTM0     LDN    2           WAIT NOT BUSY
          RJM    STW
 WTMA     EQU    *-1
*         RJM    /PRESET/GPS (IF CTS)
 WTMB     PSN
*         MJN    WTM2        IF COMMAND RETRY (CTS)
*         LDD    DS          CHECK FOR READY AND WRITE ENABLE
          LPC    201
          LMC    201
          NJN    WTM1        IF NOT READY OR NO WRITE ENABLE
 
*         WRITE TAPE MARK.
 
          LDN    F0051
          RJM    FCN
*         LDN    0
 WTM1     RJM    WTE         CHECK AND PROCESS ERRORS
          UJN    WTMX        RETURN
 
 WTM2     LDN    F0002
          RJM    /PRESET/ICF ISSUE CONTINUE FUNCTION
          UJP    WTM0        WAIT FOR END OF OPERATION
          SPACE  4,10
 TADD     TSAD               ADDRESS RELOCATION TABLE
 
          USE    BUFFERS
 
          ERROVL
 
 EVSN     EQU    *           *UESN*
 IVSN     EQU    EVSN+5      *UISN*
 UDTB     EQU    IVSN+5      UDT LABEL PARAMETERS (*UUFN* - *UDAT*)
 DCB      EQU    UDTB+/MTX/UUDTL*5  DATA CONVERSION BUFFER
 
 WUCC     EQU    UDTB+/MTX/UDAT*5-/MTX/UUFN*5  CREATION DATE IN UDT
          TITLE  PRESET.
 PRS      SPACE  4,10
**        PRS - PRESET.
*
*         CALLS  MCH.
 
 
 PRS      LDC    PRSA        MODIFY CHANNELS
          RJM    MCH
          LDD    HP
          SHN    21-7
          PJP    PRS2        IF NOT CTS
          LDC    LDNI+CCW/10000
          STM    /WRITE/WCTA DO CODE CONVERSION
          LDN    CLBL
          STM    LTYP+1      LENGTH OF LABEL
          LDC    LDNI+0
          STM    /WRITE/WCTD
          STM    /WRITE/WCTD+1
          ISTORE /WRITE/WCTE,(UJN /WRITE/WCT5)
          LDC    6321        BITS IN GENERAL STATUS TO CHECK
          STM    /PRESET/WFEA
          LDC    /PRESET/GPS
          STM    WTMA
          ISTORE WTMB,(MJN WTM2)
          LDK    CPEL-1
          STD    T1
 PRS1     LDM    .CPE,T1     REPLACE *WTE* WITH *CPE*
          STM    WTEX,T1
          SOD    T1
          PJN    PRS1        IF MORE CODE TO MOVE
          ISTORE ERAA,(UJN ERA1)  SKIP ERASE GAP
          ISTORE /WRITE/WCTJ,(UJN /WRITE/WRT7)  SKIP READ CM BUFFER
          LDC    /WRITE/WCT2 SKIP CODE CONVERSION
          STM    /WRITE/WCTI
          ISTORE /WRITE/WCTG,(UJN /WRITE/WCT7)  SKIP READ OF CM BUFFER
          ISTORE /WRITE/WCTM,(UJN /WRITE/WRT7)  SKIP BLOCK COUNT UPDATE
          UJN    PRS3        SET SRU INCREMENT
 
 PRS2     LDC    LDNI+0
          STM    /WRITE/WRTC
          STM    /WRITE/WRTC+1
          LDM    PRSC
          STM    /WRITE/WRTD
          LDM    PRSD
          STM    /WRITE/WRTG
          LDC    4625
          STM    //WEOA
 PRS3     LDC    /SRU/ITCL*100  SET SRU INCREMENT
          STM    //CECA
          LDM    PRSB
          STM    /WRITE/WRTH
          LJM    PRSX        RETURN
 
 
 PRSA     CHTB               CHANNEL TABLE
 
 PRSB     BSS    0
          LOC    /WRITE/WRTH
          UJN    /WRITE/WRT7 CALCULATE DATA CHECKSUM
          LOC    *O
 
 PRSC     BSS    0
          LOC    /WRITE/WRTD
          UJN    /WRITE/WRT3.1  WRITE LABELS
          LOC    *O
 
 PRSD     BSS    0
          LOC    /WRITE/WRTG
          UJN    /WRITE/WRT5 WRITE LABELS
          LOC    *O
          TITLE  CTS-SPECIFIC ROUTINES.
 CPE      SPACE  4,15
**        CPE - CHECK AND PROCESS WRITE TAPE MARK ERRORS.
*
*         THIS ROUTINE OVERLAYS *WTE* FOR CTS.
*
*         ENTRY  (A) .EQ. 0 IF STATUS SHOULD BE CHECKED.
*                (A) .NE. 0 IF NOT READY OR NO WRITE ENABLE.
*
*         CALLS  *CEM*, *CWP*.
*
*         MACROS CALL.
 
 
 .CPE     BSS    0
          LOC    WTEX
 CPE      SUBR               ENTRY/EXIT
          ZJN    CPE2        IF CHECK STATUS
          LPN    1
          NJN    CPE1        IF NOT READY
          LDN    3
          STD    EP          SET SUB ERROR CODE
          LDN    /MTX/NWE
          UJN    CPE1.1      RETURN
 
 CPE1     LDN    /MTX/RDR    NOT READY
          STD    EC
          CALL   CEM         CALL ERROR HANDLER
          LDD    EC
 CPE1.1   LJM    RET3        RETURN
 
 CPE2     STD    EC
 CPE3     RJM    /PRESET/WFE WAIT FOR END OF OPERATION
          MJN    CPE5        IF COMMAND RETRY
          LMN    20          EXPECT TAPE MARK STATUS
          ZJN    CPE4        IF NO ERROR
          LDN    /MTX/STE    STATUS ERROR
 CPE4     ADD    EI
          ZJN    CPEX        IF NO ERROR OR PREVIOUS ERROR
          CALL   CWP         WRITE ERROR PROCESSOR
          UJP    CPEX        RETURN
 
 CPE5     LDN    F0002
          RJM    /PRESET/ICF ISSUE CONTINUE FUNCTION
          UJN    CPE3        WAIT FOR END OF OPERATION
 
 CPEL     EQU    *-CPEX      LENGTH OF *CPE*
          ERRNG  WTEB-*      *CPE* LARGER THAN *WTE*
 
          LOC    *O
          OVERLAY (CODE CONVERT LABEL TO WRITE.),(ERLB+5),P
 CCW      SPACE  4,10
**        CCW - CODE CONVERT LABEL TO WRITE TO CTS.
*
*         ENTRY  (MD) = MODE FUNCTION.
*                (DNCV) = CONVERSION MODE.
*                (CF) = 63/64 CHARACTER SET FLAG.
*
*         USES   T1, T2, T3.
*
*         CALLS  GCC, SCC.
 
 
          ENTRY  CCW
 CCW      SUBR               ENTRY/EXIT
          LDD    MD
          SHN    21-6
          PJN    CCW1        IF NOT CODED
          LDM    DNCV
          LPN    7
          LMN    /MTX/ANS
          ZJN    CCW1        IF ASCII CONVERSION MODE
          LDC    EBCI
          STM    GCCA        CODE MODIFICATION FOR EBCDIC
 CCW1     LDD    CF
          LPN    1
          NJN    CCW2        IF 64 CHARACTER SET
          LDK    0#20
          STM    ANSI+ANSIA  MODIFY TABLES FOR 63 CHARACTER SET
          LDK    0#3A
          STM    ANSI+ANSIB
          LDN    0
          STM    EBCI+EBCIA
          LDK    0#7A
          STM    EBCI+EBCIB
 CCW2     LDC    79D
          STD    T1          POINTER TO CHARACTER TO CONVERT
          LDC    64
          STD    T2          POINTER TO STORE CONVERTED CHARACTER
          LDN    1
          STD    T3          1 OF 3 POSITIONS OF 8-BIT BYTE
          LDN    0
          STM    BUF+1,T2
 CCW3     RJM    GCC         GET CONVERTED CHARACTER
          RJM    SCC         STORE CONVERTED CHARACTER
          SOD    T1
          PJN    CCW3        IF MORE CHARACTERS TO CONVERT
          LJM    CCWX        RETURN
 GCC      SPACE  4,15
**        GCC - GET CONVERTED CHARACTER.
*
*         ENTRY  (T1) = POINTER TO CHARACTER TO CONVERT.
*                (T5) = CHARACTER TO CONVERT IF (T1) HAS EVEN VALUE.
*
*         EXIT   (T6) = CONVERTED CHARACTER.
*                (T5) = NEXT CHARACTER TO CONVERT IF (T1) HAS ODD VALUE.
 
 
 GCC      SUBR               ENTRY/EXIT
          LDD    T1
          SHN    21-0
          STD    T6
          PJN    GCC1        IF LEFT MOST CHARACTER OF WORD
          LDM    BUF,T6
          STD    T5
          LPN    77
          UJN    GCC2        SAVE CHARACTER TO CONVERT
 
 GCC1     LDD    T5
          SHN    -6
 GCC2     STD    T6          CHARACTER TO CONVERT
          LDM    ANSI,T6
 GCCA     EQU    *-1
*         LDM    EBCI,T6     (EBCDIC)
          STD    T6
          UJN    GCCX        RETURN
 SCC      SPACE  4,15
**        SCC - STORE CONVERTED CHARACTER.
*
*         THIS ROUTINE CONVERTS ONE OF THE 80 CHARACTERS OF THE
*         LABEL FROM DISPLAY CODE TO ASCII OR EBCDIC AND STORES
*         IT IN THE LABEL BUFFER.
*
*         ENTRY  (T6) = CONVERTED CHARACTER.
*                (T2) = POINTER TO STORE CHARACTER.
*                (T3) = 1 0F 3 POSITIONS TO STORE 8-BIT BYTE.
 
 
 SCC3     SOD    T3
 
 SCC      SUBR               ENTRY/EXIT
          LDD    T3
          NJN    SCC1        IF NOT BYTE 1 OF 3
          LDD    T6
          SHN    4
          RAM    BUF,T2
          LDN    2
          STD    T3
          LCN    2
          RAD    T2
          UJN    SCCX        RETURN
 
 SCC1     SBN    1
          NJN    SCC2        IF NOT BYTE 2 OF 3
          LDD    T6
          SHN    10
          RAM    BUF+1,T2
          SHN    -14
          STM    BUF,T2
          UJN    SCC3        UPDATE POINTER
 
 SCC2     LDD    T6
          STM    BUF+1,T2
          UJP    SCC3        UPDATE POINTER
 ANSI     SPACE  4,10
**        ATANS - TABLE TO CONVERT DISPLAY TO ASCII.
 
 
 ANSI     BSS    0
          LOC    0
          CON    0#3A        COLON
 ANSIA    EQU    *-1
*         CON    0#20        (63 CHARACTER SET - SPACE)
          CON    0#41        A
          CON    0#42        B
          CON    0#43        C
          CON    0#44        D
          CON    0#45        E
          CON    0#46        F
          CON    0#47        G
          CON    0#48        H
          CON    0#49        I
          CON    0#4A        J
          CON    0#4B        K
          CON    0#4C        L
          CON    0#4D        M
          CON    0#4E        N
          CON    0#4F        O
          CON    0#50        P
          CON    0#51        Q
          CON    0#52        R
          CON    0#53        S
          CON    0#54        T
          CON    0#55        U
          CON    0#56        V
          CON    0#57        W
          CON    0#58        X
          CON    0#59        Y
          CON    0#5A        Z
          CON    0#30        0
          CON    0#31        1
          CON    0#32        2
          CON    0#33        3
          CON    0#34        4
          CON    0#35        5
          CON    0#36        6
          CON    0#37        7
          CON    0#38        8
          CON    0#39        9
          CON    0#2B        PLUS
          CON    0#2D        HYPHEN
          CON    0#2A        ASTERISK
          CON    0#2F        SLANT
          CON    0#28        OPENING PAREN
          CON    0#29        CLOSING PAREN
          CON    0#24        DOLLAR SIGN
          CON    0#3D        EQUALS
          CON    0#20        SPACE
          CON    0#2C        PERIOD
          CON    0#2E        COMMA
          CON    0#23        NUMBER SIGN
          CON    0#5B        OPEN BRACKET
          CON    0#5D        CLOSING BRACKET
          CON    0#25        PERCENT
 ANSIB    EQU    *-1
*         CON    0#3A        (63 CHARACTER SET - PERCENT)
          CON    0#22        QUOTATION MARKS
          CON    0#5F        UNDERLINE
          CON    0#21        EXCLAMATION POINT
          CON    0#26        AMPERSAND
          CON    0#27        APOSTROPHE
          CON    0#3F        QUESTION MARK
          CON    0#3C        LESS THAN
          CON    0#3E        GREATER THAN
          CON    0#40        COMMERCIAL AT
          CON    0#5C        REVERSE SLANT
          CON    0#5E        CIRCUMFLEX
          CON    0#3B        SEMICOLON
          LOC    *O
 EBCI     SPACE  4,10
**        EBCI - TABLE TO CONVERT DISPLAY TO EBCDIC.
 
 
 EBCI     BSS    0
          LOC    0
 
          CON    0#7A        COLON
 EBCIA    EQU    *-1
*         CON    0           (63 CHARACTER SET - COLON)
          CON    0#C1        A
          CON    0#C2        B
          CON    0#C3        C
          CON    0#C4        D
          CON    0#C5        E
          CON    0#C6        F
          CON    0#C7        G
          CON    0#C8        H
          CON    0#C9        I
          CON    0#D1        J
          CON    0#D2        K
          CON    0#D3        L
          CON    0#D4        M
          CON    0#D5        N
          CON    0#D6        O
          CON    0#D7        P
          CON    0#D8        Q
          CON    0#D9        R
          CON    0#E2        S
          CON    0#E3        T
          CON    0#E4        U
          CON    0#E5        V
          CON    0#E6        W
          CON    0#E7        X
          CON    0#E8        Y
          CON    0#E9        Z
          CON    0#F0        0
          CON    0#F1        1
          CON    0#F2        2
          CON    0#F3        3
          CON    0#F4        4
          CON    0#F5        5
          CON    0#F6        6
          CON    0#F7        7
          CON    0#F8        8
          CON    0#F9        9
          CON    0#4E        PLUS
          CON    0#60        HYPHEN
          CON    0#5C        ASTERISK
          CON    0#61        SLANT
          CON    0#4D        OPENING PAREN
          CON    0#5D        CLOSING PAREN
          CON    0#5B        DOLLAR SIGN
          CON    0#7E        EQUALS
          CON    0#40        SPACE
          CON    0#6B        PERIOD
          CON    0#4B        COMMA
          CON    0#7B        NUMBER SIGN
          CON    0#4A        OPEN BRACKET
          CON    0#5A        CLOSING BRACKET
          CON    0#6C        PERCENT
 EBCIB    EQU    *-1
*         CON    0#7A        (63 CHARACTER SET - COLON)
          CON    0#7F        QUOTATION MARKS
          CON    0#6D        UNDERLINE
          CON    0#4F        EXCLAMATION POINT
          CON    0#50        AMPERSAND
          CON    0#7D        APOSTROPHE
          CON    0#6F        QUESTION MARK
          CON    0#4C        LESS THAN
          CON    0#6E        GREATER THAN
          CON    0#7C        COMMERCIAL AT
          CON    0#E0        REVERSE SLANT
          CON    0#5F        CIRCUMFLEX
          CON    0#5E        SEMICOLON
          LOC    *O
          ERRNG  473+ERLB+5-*  IF OVERLAY LONGER THAN ONE PRU
          OVERLAY (MTS/ATS WRITE ERROR PROCESSOR.),(BUFB+10),P
 WEM      SPACE  4,10
**        WEM - WRITE ERROR PROCESSOR.
*
*         ENTRY  (EP, 11) = VERIFY IN PROGRESS.
*                (EP, 10) = ERASE ERROR HAS OCCURRED.
*                (EP, 9) = LOAD POINT ERROR FLAG.
*                (EP, 8) = LOAD POINT RECOVERY FLAG.
*                (EP+1, 5 - 0) = NUMBER OF ERASES.
*
*         CALLS  /CPP/CAL, CFC, /WRITE/CNW, *CPP*, EBW, *EMM*, EOT,
*                /CPP/INM, MCH, POT, PRS, RCI, /CPP/SFP, WLP.
*
*         MACROS CALL.
 
 
          ENTRY  WEM
 WEM      SUBR               ENTRY
          LDM    //LOV       SAVE CALLERS EXIT ADDRESS
          STM    WEMH
          LDC    WEM1        SET ADDRESS TO ENTER AT
          STM    //LOV
          UJN    WEMX        RETURN
 
 WEM1     LDD    MA          SAVE OUT POINTER
          CWD    CN
          CRM    WEMI,ON
          LDC    CTAB        MODIFY CHANNELS
          RJM    MCH
          RJM    PRS
          RJM    EBW         EVALUATE BID WINDOW
          RJM    CFC         RECONNECT UNIT
          LDM    //STER      RESTORE STATUS
          STD    DS
          LPN    1
          NJN    WEM2        IF READY
          LDN    /MTX/RDR
          STD    EC
          UJN    WEM2.1      NO LOAD POINT RECOVERY IF NOT READY
 
 WEM2     RJM    WLP         CHECK FOR LOAD POINT RECOVERY
*         UJN    WEM2.1      (NOT ATS CONTROLLER)
 WEML     EQU    *-2
          MJN    WEM2.1      IF NO LOAD POINT ERROR OR ERROR RECOVERED
          CALL   EMM         ISSUE MESSAGE
          LDN    0
          STD    EC
          AOD    EI
          LJM    RET2        RETRY ON *BFW* ERROR
 
 WEM2.1   LDD    FN          LOAD MAGNET FUNCTION CODE
          LMN    /MTX/WLA
          NJN    WEM3        IF NOT WRITE LABELS
          LDC    RET2        FORCE REQUEUE AFTER WRITE IS GOOD
          STM    /WLA/WLAG
          AOM    POTD
 WEM3     LDM    /WRITE/WTFE CHECK IF EOF REQUEST DETECTED AHEAD
 WEMK     EQU    *-1
*         LDM    /WLI/WLIA   (LI FORMAT)
          LMN    1
          NJN    WEM4        IF NOT EOF REQUEST
          LDD    MD
          SCN    14
          STD    MD
 WEM4     LDD    EC
          ZJN    WEM6        IF VERIFY OPERATION
          LMN    /MTX/STE
          NJN    WEM7        IF NOT STATUS ERROR
          LDD    DS
          SHN    21-3
          PJN    WEM7        IF NOT EOT
          SHN    12
          PJN    WEM5        IF NO OTHER ERRORS
          LDM    MTDS
          LPC    7077
 WEMA     EQU    *-1
*         LPC    7777        (ATS UNIT)
          NJN    WEM7        IF OTHER ERRORS
 WEM5     RJM    EOT
 WEM6     LJM    WEM10       POSITION TAPE
 
 WEM7     LDD    DS          CHECK FOR NON-FATAL ERRORS
          SHN    21-13
          PJN    WEM8        IF OTHER ERRORS
          LDM    MTDS
          LPC    7077
 WEMB     EQU    *-1
*         LPC    7777        (ATS UNIT)
          NJN    WEM8        IF FATAL ERRORS
          STD    EC
          AOM    WEME        SET ACCEPT DATA FLAG
 WEMC     UJN    WEM8        PROCESS MTS DATA
*         LDM    MTDS+1      (ATS UNIT)
          CON    MTDS+1
          SHN    -11
          LPN    3
          ZJN    WEM7.1      IF NOT ON-THE-FLY
          LDN    /MTX/OTF
          STD    EC
          UJN    WEM8        PROCESS CORRECTED BLOCK
 
 WEM7.1   LDD    HN
          RAM    ECNT+1      INCREMENT LATE DATA COUNTER
          SHN    -14
          RAM    ECNT
 WEM8     LDD    SP
          LPN    4
          RAM    WEME        SET ACCEPT WRITE FLAG
          LDD    SP
          LPN    4
          NJN    WEM9        IF ERROR PROCESSING INHIBITED
          LDM    /WRITE/BYWR SET BYTE COUNT
          STD    BY
          LDC    -0          RESTORE BID
 WEMD     EQU    *-1
          STM    UBWB
          CALL   EMM         DIAGNOSE ERROR
          RJM    CFC         RECONNECT UNIT
 WEM9     LDD    EC
          SBN    /MTX/BFAT
          MJN    WEM10       IF NOT FATAL ERROR
          SBN    /MTX/MFAT-/MTX/BFAT
          PJN    WEM10       IF NOT FATAL ERROR
          LJM    RET4        RETURN FATAL ERROR
 
 WEM10    LDC    0           ACCEPT DATA FLAG
 WEME     EQU    *-1
          NJN    WEM11       IF ACCEPT DATA
          RJM    POT         POSITION TAPE
 WEMF     EQU    *-2
*         UJN    *+2         (DISCARD BLOCK AT EOT)
 WEM11    LDN    0           CLEAR ERROR CODE
          STD    EC
 WEMJ     LDN    1
*         LDN    0           (FORMAT CHANGE)
          NJN    WEM11.1     IF FORMAT PARAMETERS NOT CHANGED
          STM    //RELA
 WEM11.1  CALL   CPP         RELOAD ADDRESS RELOCATOR
          LDM    WEMD        RESTORE BLOCK ID
          STM    UBWB
          LDM    /WRITE/BYWR RESET BYTE COUNT
          STD    BY
          LDD    FN
          LMN    /MTX/WLA
          NJN    WEM12       IF NOT WRITE LABELS
          LJM    WEM15       EXIT
 
 WEM12    RJM    RCI         READ UDT
          RJM    /CPP/CAL    CALCULATE PARAMETERS
          LDC    ADDR        MODIFY INSTRUCTIONS
          RJM    /CPP/INM
          LDM    WEME
          ZJN    WEM13       IF REREAD DATA
          LDN    0           CLEAR ERROR PARAMATERS
          STD    EP
          STD    EP+1
          STD    EI
          LDD    MA          RESTORE OUT POINTER
          CWM    WEMI,ON
          SBN    1
          CRD    CN
          LDM    /WRITE/WTFE CHECK IF EOF REQUEST DETECTED AHEAD
 WEMM     EQU    *-1
*         LDM    /WLI/WLIA   (LI FORMAT)
          LMN    1
          NJN    WEM14       IF NOT EOF REQUEST
          LDN    14          SET EOF STATUS
          RAD    MD
          UJN    WEM15       EXIT
 
 WEM13    LDN    3           READ OUT POINTER
          RJM    /CPP/SFP
 WEM14    RJM    /WRITE/CNW
 WEMG     EQU    *-2
*         UJN    *+2         (DISCARD BLOCK AT EOT)
*         RJM    /WLI/CNW    (LI FORMAT)
 WEM15    LJM    *           EXIT
 WEMH     EQU    *-1
 
 
 WEMI     EQU    WEM
 TBDW     EQU    WEMI+5      TEMPORARY BID WINDOW
          ERRNG  WEM1-TBDW   BUFFER OVERFLOW
 EOT      SPACE  4,10
**        EOT - END OF TAPE PROCESSOR.
 
 
 EOT3     LDC    EOTEXIT     SET TO RETURN HERE AFTER POINTER UPDATE
          STM    /WRITE/WRTK
 EOTA     EQU    *-1
*         STM    /WLI/WRTK   (LI FORMAT)
          LDD    EI
          ZJN    EOTX        IF RECOVERY NOT IN PROGRESS
          LDN    0           SET TO VERIFY REWRITE AND ISSUE MESSAGE
          STM    WEME
          STD    EC
 
 EOT      SUBR               ENTRY/EXIT
          AOM    WEME        SET ACCEPT DATA FLAG
          LDD    SP
          SHN    -12
          ZJN    EOT3        IF TERMINATE WITH TAPE MARK
          LMN    1
          NJN    EOT1        IF NOT ACCEPT BLOCK AT EOT
          LDM    /WRITE/STAT
          SHN    21-3
          PJN    EOTX        IF TAPE MARK ENCOUNTERED THIS BLOCK
          UJN    EOT2        CLEAR ACCEPT DATA FLAG
 
 EOT1     LMN    2&1
          NJN    EOTX        IF NOT DISCARD BLOCK AT EOT
          LDD    UP          CLEAR EOR FLAG
          SCN    10
          STD    UP
          LDD    MD          CLEAR EOR/EOF THIS OPERATION
          LPC    7377
          STD    MD
 EOT2     LDN    0
          STM    WEME
          LDC    UJNI+2
          STM    WEMF
          STM    WEMG
          LJM    EOT3        SET RETURN ADDRESS
 POT      SPACE  4,10
**        POT - POSITION AND VERIFY TAPE AFTER ERROR.
*
*         USES   CM - CM+4.
*
*         CALLS  BKS, CID, CKR, FCN, IRC, ISC, POS, RDA, STW, WEO.
 
 
 POT      SUBR               ENTRY/EXIT
          LDD    EC
          NJN    POT1        IF ERROR
          RJM    DTS         GET DETAIL STATUS
          LJM    POT12       VERIFY BLOCK REWRITE
 
*         BACKSPACE OVER THE ERROR BLOCK.
 
 POT1     AOD    EI
          RJM    BKS         BACKSPACE OVER BAD BLOCK
          LDD    EI          LOAD ERROR COUNTER
          LPN    77          ERROR ITERATION
          SBN    2
          PJN    POT3        IF SECOND ITERATION
 POT2     RJM    POS         POSITION TO LAST GOOD RECORD
 
*         TAPE IS POSITIONED TO LGB.
 
          LDD    EP
          SHN    21-13
          PJN    POT3        IF NOT VERIFY
          LJM    POT12       VERIFY BLOCK REWRITE
 
*         ERASE TAPE.
 
 POT3     AOD    EP+1        COUNT ERASE
          LPN    77
          SBN    ERAL
          MJN    POT4        IF NOT MAXIMUM ERASES
          LDN    /MTX/ERA    ERASE LIMIT ERROR
          STD    EC
          LJM    POT17       FATAL ERROR
 
 POT4     LDN    1           NUMBER OF ERASES TO PERFORM
          STM    POTK
          LDN    2           WAIT NOT BUSY
          RJM    STW
          LDD    CP          CHECK ERROR FLAG
          ADN    STSW
          CRD    CM
          LDD    CM+1
          LPN    37
          SBN    SPET
          MJN    POT5        IF NO ERROR *SPET* OR ABOVE
          LDN    /MTX/EFT    SET ERROR FLAG TERMINATION
          STD    EC
          LJM    POT17       RETURN ERROR
 
 POT5     LDN    52          SKIP BAD SPOT (ERASE)
          RJM    FCN
          LDN    2           WAIT NOT BUSY
          RJM    STW
          SHN    21-3
          PJN    POT6        IF NOT EOT
          LJM    POT19       SET ERASE AT EOT FLAG
 
 POT6     RJM    WEO         WAIT END OF OPERATION
          SCN    10          IGNORE EOT
          NJN    POT7        IF ERASE ERROR
          SOM    POTK
          NJN    POT5        IF MORE ERASES TO PERFORM
          LJM    POT9        SET UP TO REWRITE BLOCK
 
 POT7     LDN    /MTX/STE    DIAGNOSE ERASE ERROR
          STD    EC
          LDD    DS          SET STATUS FOR MESSAGE
          STM    //STER
          RJM    ISC         ISSUE MESSAGE AND RECONNECT UNIT
          AOD    EI          INCREMENT ERROR ITERATION COUNT
          LDM    DNCV
          LPN    70
          LMN    /MTX/D16*10
          ZJN    POT8        IF 1600 BPI CONTINUE ERASE
          LMN    /MTX/D62*10&/MTX/D16*10
          ZJN    POT8        IF 6250 CPI CONTINUE ERASE
          LJM    POT2        REPOSITION TO LAST GOOD RECORD
 
 POT8     RJM    CKR         CHECK FOR UNIT READY
          LJM    POT3        REISSUE THE ERASE
 
*         REWRITE THE BLOCK.
 
 POT9     LDD    LG+1
          ZJN    POT11       IF TAPE MARK WRITE
          LDD    UP          CLEAR EOR FLAG
          SCN    10
          STD    UP
          LDD    MD          CLEAR EOR/EOF THIS OPERATION FLAG
          LPC    7377
          STD    MD
          LDD    EI
          LPN    7
          ZJN    POT11       IF TIME TO REQUEUE
          LDC    0
 POTD     EQU    *-1         ADD ONE TO *POTD*
          ZJN    POT10       IF NOT WRITE LABELS
          LDC    /WLA/WLA8-/WRITE/WTF
 POT10    ADC    /WRITE/WTF
          ERRNZ  /WRITE/WTF-/WLI/WLI  ENTRY POINTS MUST BE THE SAME
          STM    WEMH
          LJM    POTX        RETURN
 
 POT11    LJM    RET2        REQUEUE
 
*         WRITE VERIFY OPERATION.
 
 POT12    RJM    BKS         BACKSPACE OVER CURRENT BLOCK
          LDD    EP          CHECK FOR LOAD POINT RECOVERY FLAG
          SHN    21-10
          MJN    POT13       IF NOT LOAD POINT RECOVERY
          LDD    EP          SET VERIFY IN PROGRESS
          LPC    3777
          LMC    4000
          STD    EP
          RJM    POS         INSURE CORRECT TAPE POSITION
 
*         VERIFY THE ENTIRE SEQUENCE.
 
 POT13    RJM    RDA         READ BLOCK
          LDD    T4
          NJN    POT14       IF ERROR
          RJM    CID         CHECK I FORMAT TRAILER INFORMATION
          ZJN    POT15       IF NO ERROR
          LCN    0           SET BLOCK ID TO IMPOSSIBLE
          STM    WEMD
          LJM    POS6        ISSUE POSITION LOST MESSAGE, NO RETURN
 
 POT14    LDN    /MTX/WVF
          STD    EC
          RJM    ISC         ISSUE POSITION LOST MESSAGE
          UJN    POT17       RETURN FATAL ERROR
 
 POT15    AOM    WEME        SET TO ACCEPT WRITE
          RJM    ISC         ISSUE RECOVERED MESSAGE AND CONNECT UNIT
          RJM    IRC         INCREASE RECOVERED ERROR COUNTER
          LDD    FN
          LMN    /MTX/WLA
          NJN    POT16       IF NOT WRITE LABELS
          STD    EP+1        CLEAR ERROR PARAMETERS
          STD    EP
          STD    EI
 POT16    LJM    POTX        RETURN
 
*         CANNOT RECOVER ERROR.
 
 POT17    LDD    FN
          LMN    /MTX/WLA
          NJN    POT18       IF NOT WRITE LABELS
          LDD    UP
          SCN    30          CLEAR WRITE OPERATION AND EOR/EOF FLAGS
          STD    UP
 POT18    LJM    RET4        RETURN FATAL ERROR
 
*         ERASE AT EOT.
 
 POT19    LDD    EP
          SHN    21-12
          MJN    POT17       IF IRRECOVERABLE ERROR
          LDC    2000        SET ERASE OCCURRED AT EOT FLAG
          RAD    EP
          LJM    POT6        RETRY
 
 POTK     CON    0           NUMBER OF ERASES TO PERFORM
          TITLE  SUBROUTINES.
 ABC      SPACE  4,15
**        ABC - ADJUST BYTE COUNT FOR 9 TRACK TAPES.
*
*         ENTRY  (BY) = BYTE COUNT.
*                (T4) = BUFFER SIZE.
*                (DS) = DEVICE STATUS.
*
*         EXIT   (A) = 0 IF NO BYTE ADJUSTMENT.
*                (ES) = 40 IF FILL STATUS.
*                     = 0 IF NO FILL STATUS.
*
*         USES   T2, T4.
 
 
 ABC      SUBR               ENTRY/EXIT
          LDD    HP
          LPN    1
          ZJN    ABCX        IF 7 TRACK
 
*         SET FILL STATUS.
 
          LDD    DS
 ABCA     SHN    0-5
*         UJN    ABC2        (ATS UNIT)
          LPN    1
          ADD    BY
          LPN    3
          ZJN    ABC1        IF NO FILL STATUS
          LDN    40
*         LPN    40          (ATS UNIT)
 ABCB     EQU    *-1
 ABC1     STD    ES
 
*         CORRECT 9 TRACK BYTE COUNT.
 
          LDD    DS
          LPN    40
          ZJN    ABC2        IF NO ODD COUNT
          LDD    BY
          LPN    2
          ZJN    ABC2        IF NOT MODULO 4, 2 OR 3
          SOD    BY
          SOD    T4
 
*         ADJUST BUFFER LENGTH FOR I FORMAT.
 
 ABC2     LDD    FM
          SHN    -6
          LMN    /MTX/TFI
          ZJN    ABC3        IF I FORMAT
          LDN    0
          UJN    ABC4        RETURN
 
 ABC3     LDD    BY
          ZJN    ABC4        IF NO DATA READ
          SBN    1
          ZJN    ABC4        IF POSSIBLE TAPE MARK
          STD    T2          CALCULATE WORD COUNT
          SHN    1           13*BYTES
          ADD    T2
          SHN    2
          ADD    T2
          SHN    14  (-6)    (13*BYTES)/64
          STD    T0
          SHN    6+2         4*13*BYTES  (52*BYTES)
          SBD    T2          51*BYTES
          ADD    T0          (51*BYTES)+((13*BYTES)/64)
          SHN    -8D         WORDS = ((51*BYTES)+((13*BYTES)/64))/256
          LPN    1
 ABC4     STM    ABCC
          LJM    ABCX        RETURN
 
 
 ABCC     CON    0
 BKS      SPACE  4,10
**        BKS - BACKSPACE TAPE.
*
*         EXIT   (A) = NEGATIVE IF BOT.
*                (DS) = GENERAL STATUS.
*
*         CALLS  CKR, FCN, STW, WFC.
 
 
 BKS      SUBR               ENTRY/EXIT
          RJM    CKR         CHECK READY
          LDN    2           WAIT NOT BUSY
          RJM    STW
          LDC    F0113       BACKSPACE
          RJM    FCN
          RJM    WFC         WAIT FUNCTION COMPLETE
          LDD    DS          RETURN LOAD POINT STATUS
          SHN    21-2
          UJN    BKSX        RETURN
 BTW      SPACE  4,10
**        BTW - BUILD TEMPORARY WINDOW.
*
*         ENTRY  (A) = NUMBER OF BLOCKS TO MOVE BACK.
*
*         EXIT   (TBDW) = TEMPORARY BLOCK ID WINDOW IF FIRST BKSP NOT
*                         AT LOAD POINT.
*
*         USES   T8, T9.
*
*         CALLS  BKS, DTS, ISC, SOB.
 
 
 BTW      SUBR               ENTRY/EXIT
          STD    T8
          LDN    4           SETUP FIRST BID BYTE
          STM    TBDW
 BTW1     RJM    BKS         BACKSPACE
          MJN    BTW2        IF BOT
          SOD    T8
          NJN    BTW1        LOOP FOR NEXT BLOCK
 BTW2     LDM    POSB        SET BID POINTER
          STD    T9
          LDM    POSA        CHECK FOR LOAD POINT ON FIRST BKSP
          SBD    T8
          ZJN    BTWX        IF FIRST BKSP AT LOAD POINT
          LDN    0           CLEAR PRU COUNTER
          STD    T8
 BTW3     RJM    SOB         SET UP AND READ ONE BLOCK
          LDM    UBWB
          STM    TBDW+1,T8
          AOD    T9          INCREMENT POINTER
          LPN    7           RESET POINTER FOR POSSIBLE WRAP AROUND
          STD    T9
          AOD    T8
          LMM    POSA
          NJN    BTW4        IF LOOP FOR NEXT BLOCK
          LJM    BTWX        RETURN
 
 BTW4     RJM    DTS         GET DETAILED STATUS
 BTWA     UJN    BTW3        MTS
*         LDM    MTDS+1      (ATS) LOAD ERROR CORRECTION FLAGS
          CON    MTDS+1
          SHN    -11
          LPN    3           SINGLE/DOUBLE TRACK CORRECTED FLAGS
          ZJN    BTW3        IF NO CORRECTABLE ERRORS
          LDD    DS          CHECK FOR ALERT
          SHN    21-13
          MJN    BTW3        IF ALERT STATUS SET
          LDD    T8          SAVE TEMPORARIES
          STM    BTWB
          LDD    T9
          STM    BTWC
          LDN    /MTX/RCE    ISSUE REPOSITION CORRECTION MESSAGE
          STD    EC
          LDD    DS          SAVE STATUS
          STM    //STER
          RJM    ISC         ISSUE MESSAGE AND RECONNECT
          LDN    0           CLEAR ERROR CODE
          STD    EC
          AOD    EI
          LDM    BTWB        RESTORE TEMPORARIES
          STD    T8
          LDM    BTWC
          STD    T9
          LJM    BTW3        CONTINUE FORESPACES
 
 
 BTWB     CON    0           SAVE T8
 BTWC     CON    0           SAVE T9
 CFC      SPACE  4,10
**        CFC - CHECK FOR CONNECT.
*
*         ENTRY  (RELA) = CONNECT FLAG.
*                (DS) = DEVICE STATUS.
*
*         USES   T1.
*
*         CALLS  CUI.
 
 
 CFC      SUBR               ENTRY/EXIT
          LDM    MTSF+2      SAVE CURRENT ERROR CORRECTION CODE
          STM    CFCB
          LPC    2000
          ZJN    CFC0        IF ERROR CORRECTION ENABLED
          LDC    4000        ENABLE ERROR CORRECTION FOR RECOVERY
          STM    MTSF+2
          LDN    0
          STM    //RELA      CLEAR CONNECTED FLAG
          LDC    LDNI+0      SET FORMAT ALTERED FLAG
          STM    WEMJ
 CFC0     LDM    //RELA
          ZJN    CFC1        IF UNIT NOT CONNECTED
          LDD    DS
          SHN    21-11
          PJN    CFCX        RETURN IF UNIT CONNECTED
          LDN    0
          STM    //RELA
 CFC1     STD    T1
 CFC2     LDM    MTDS,T1     SAVE DETAILED STATUS
          STM    CFCA,T1
          AOD    T1
          LMN    10
          NJN    CFC2        IF MORE TO SAVE
          RJM    CUI         CONNECT UNIT
          LDN    0
          STD    T1
 CFC3     LDM    CFCA,T1     RESTORE DETAILED STATUS
          STM    MTDS,T1
          AOD    T1
          LMN    10
          NJN    CFC3        IF MORE TO MOVE
          LDM    CFCB        RESET ORIGINAL ERROR CORRECTION CODE
          STM    MTSF+2
          LJM    CFCX        RETURN
 
 
 CFCA     BSS    10          SAVE AREA FOR DETAILED STATUS
 CFCB     BSS    1           ORIGINAL ERROR CORRECTION CODE
 CBW      SPACE  4,15
**        CBW - COMPARE BID WINDOWS.
*
*         COMPARE THE PERMANENT WINDOW (BIDW) TO THE TEMPORARY
*         WINDOW (TBDW).
*
*         ENTRY  (T1) = FIRST BYTE IN BIDW TO COMPARE.
*                (T2) = FIRST BYTE IN TBDW TO COMPARE.
*
*         EXIT   (A) = 0 IF MATCH OR NOT BLOCK ID EQUIPMENT.
*                (A, 13-6) = NUMBER OF INVALID BLOCK ID-S.
*                (A, 5-0)  = NUMBER OF VALID BLOCK ID MISMATCHES.
*
*         USES   T1 - T4.
 
 
 CBW      SUBR               ENTRY/EXIT
          LDD    CF          CHECK IF BLOCK ID EQUIPMENT
          LPC    300
          LMC    300
          ZJN    CBWX        IF NO BLOCK ID
          LDN    0
          STD    T4
          STD    T3
          LDD    T1          SAVE (T1)
          STM    CBWA
 CBW1     LDM    BIDW,T1     LOAD HISTORY BLOCK ID
          LMN    4
          ZJN    CBW3        IF INVALID BID IN HISTORY
          LDM    TBDW,T2     LOAD BID FROM TEMP WINDOW
          LMN    4           INVALID CHECK
          NJN    CBW2        IF NOT INVALID BID IN TEMP WINDOW
          AOD    T3          CHECK NEXT BID
          UJN    CBW3        CONTINUE
 
 CBW2     LDM    BIDW,T1     LOAD BID FROM HISTORY
          LMM    TBDW,T2
          ZJN    CBW3        IF NO ERROR
          AOD    T4
 CBW3     LDD    WP
          SBM    CBWA
          ZJN    CBW4        IF ONLY ONE BLOCK ID
          AOD    T2
          AOD    T1          INCREMENT POINTER
          LPN    7           RESET POINTER FOR POSSIBLE WRAP AROUND
          STD    T1
          LMD    WP
          NJN    CBW1        IF NOT END OF COMPARE
 CBW4     LDD    T3          FORM BID COMPARE RESULTS AND EXIT
          SHN    6
          ADD    T4
          LJM    CBWX        RETURN
 
 
 CBWA     CON    0           STORAGE FOR (T1)
 CKR      SPACE  4,10
**        CKR - CHECK READY.
*         IF UNIT NOT READY, A TIME OUT WILL BE PERFORMED WAITING FOR
*         UNIT TO BECOME READY BEFORE GIVING A FATAL ERROR.  THIS
*         SHOULD ALLOW RECOVERY FROM MOMENTARY NOT READY CONDITIONS.
*
*         CALLS  CUI, FCN.
 
 
 CKR      SUBR               ENTRY/EXIT
          LCN    0           PRESET TIME OUT
          STM    CKRA
 CKR1     LDN    12          STATUS UNIT
          RJM    FCN
          ACN    CH
          LDC    SBNI+1      RETRY FOR TWO MS
 CKR2     EQU    *-1
          FJM    CKR3,CH     IF DATA
          NJN    CKR2        IF RETRY NOT COMPLETE
          DCN    CH+40
          UJN    CKR5        EXIT WITH ERROR
 
 CKR3     IAN    CH
          DCN    CH+40
          LPC    1001
          LMN    1
          ZJN    CKRX        IF READY
          SHN    21-11
          PJN    CKR4        IF UNIT CONNECTED
          LDN    0
          STM    RELA        CLEAR CONNECTED FLAG
          RJM    CUI         CONNECT UNIT
 CKR4     SOM    CKRA
          NJN    CKR1        IF TIME OUT
 CKR5     LDN    /MTX/RDR    READY DROP
          LJM    RET3        RETURN ERROR CODE
 
 
 CKRA     CON    7777        TIME OUT COUNTER
 CID      SPACE  4,15
**        CID - CHECK I FORMAT TRAILER BYTES.
*         IF LI FORMAT, CHECK THE BLOCK NUMBER IN THE PREFIX.
*
*         ENTRY  (A) = AMOUNT TO ADJUST BLOCK NUMBER BY.
*                (BY) = BYTES IN BLOCK LAST READ.
*                (EBUF - EBUF+3) = I FORMAT TRAILER BYTES.
*                (EBUF-1 - EBUF+3) = LI FORMAT PREFIX.
*
*         EXIT   (A) = 0, GOOD BLOCK.
*
*         USES   T1.
 
 
 CID3     LDN    0           INDICATE GOOD COMPARE
 
 CID      SUBR               ENTRY/EXIT
          STD    T1          SAVE BLOCK NUMBER ADJUSTMENT
          LDD    FM
          SHN    -6
          LMN    /MTX/TFI
          NJN    CID3        IF NOT I FORMAT
 CIDA     EQU    *-1
*         UJN    CID1        (LI FORMAT)
          LDD    FN
          LMN    /MTX/WTF
          NJN    CID3        IF NOT WRITE DATA
 CID1     LDD    BY
          SBN    4
          MJN    CID3        IF TAPE MARK OR SNB BLOCK
          LDD    BY
          LMN    40D
          ZJN    CIDX        IF LABEL BLOCK
          LDM    EBUF+1      STORE DATA FOR MESSAGE
          SHN    14
          LMM    EBUF+2
          ADD    T1
          STM    //BNEI+2
          SHN    -14
          STM    //BNEI+1
          LDM    EBUF
          STM    //BNEI
          LMD    BY
          NJN    CID2        IF LENGTHS DON,T COMPARE
 CIDB     EQU    *-1
*         PSN                (LI FORMAT)
          LDM    EBUF+1      COMPARE BLOCK NUMBERS
          SBD    BL
          SHN    14
          ADM    EBUF+2
          SBD    BL+1
          ADD    T1
 CID2     LJM    CIDX        RETURN
 IRC      SPACE  4,10
***       IRC - INCREASE RECOVERED ERROR COUNTER.
*         RECOVERED ERROR COUNT IN UDT INCREASED.
*
*         ENTRY  NONE.
*
*         EXIT   RECOVERED ERROR COUNTER INCREASED.
*
*         USES   CM - CM+4, CN - CN+4.
*
*         MACROS DELAY, MONITOR, PAUSE.
 
 
 IRC      SUBR               ENTRY/EXIT
          LDN    /MTX/UTMS
          STD    T1
 IRC1     LDM    UADA
          ADD    T1
          STD    CM+4
          LDD    HN          REQUEST 1 WORD
          STD    CM+3
          LDN    0           REQUEST READ FROM MAGNET
          STD    CM+1
          LCN    7777-/SSD/MTSI  SET MAGNET SUBSYSTEM IDENTIFICATION
          STD    CM+2
          MONITOR TDAM
          LDD    CM+1
          LMN    1
          NJN    IRC2        IF MOVE NOT IN PROGRESS
          PAUSE  NE
          DELAY
          UJN    IRC1        REISSUE REQUEST
 
 IRC2     LDD    MA
          CRD    CN
          LDD    CN+1        CHECK RECOVERED ERROR COUNTER
          LMC    7777
          NJN    IRC4        IF NOT MATCH MAX THRESHOLD
 IRC3     LJM    IRCX        IF MATCH MAX THRESHOLD
 
 IRC4     AOD    CN+1
 IRC5     LDN    /MTX/RUU    SET MAGNET FUNCTION
          STD    CM
          LDN    /MTX/UTMS   SET UDT WORD
          STD    CM+2
          LDD    HN          SET WORD COUNT
          STD    CM+3
          LDM    UADA        SET UDT ADDRESS
          STD    CM+4
          LDD    MA          WRITE MAGNET REQUEST
          CWD    CM
          ADN    1           WRITE NEW UDT WORD
          CWD    CN
          LDK    /MTX/RCAL   SET MAGNET REQUEST WORD
          STD    CM+4
          LDC    200         SET WORD COUNT
          STD    CM+3
          LCN    7777-/SSD/MTSI  SET *MAGNET* SUBSYSTEM IDENTIFICATION
          STD    CM+2
          LDN    1           SET WRITE
          STD    CM+1
          MONITOR TDAM
          LDD    CM+1
          ZJN    IRC3        IF REQUEST COMPLETE
          SBN    4
          PJN    IRC6        IF NOT REJECT
          PAUSE  NE
          DELAY
          LJM    IRC5        REISSUE REQUEST
 
 IRC6     LJM    //PNR5      DROP PP
          SPACE  4,10
**        END OF TAPE RETURN FOR EXIT.
*
*         NOTE - THIS CODE MUST BE BEFORE BUFFERS.
 
 
 EOTEXIT  LDN    /MTX/BEI    RETURN END OF TAPE
          LJM    RET3        RETURN ERROR CODE
          SPACE  4,10
 ISC      SPACE  4,10
**        ISC - ISSUE MESSAGE AND RECONNECT UNIT.
*
*         ENTRY  (EC) = ERROR CODE.
*
*         CALLS  CFC, *EMM*.
*
*         MACROS CALL.
 
 
 ISC      SUBR               ENTRY/EXIT
          LDM    WEMD        RESTORE BID FOR MESSAGE
          STM    UBWB
          CALL   EMM         ISSUE MESSAGE
          RJM    CFC         RECONNECT UNIT IF NEEDED
          UJN    ISCX        RETURN
 POS      SPACE  4,15
**        POS - POSITION TAPE.
*
*         ENTRY  (POSA) = NUMBER OF BLOCKS TO BACKUP.
*                TAPE POSITIONED BEFORE BAD BLOCK.
*
*         EXIT   POSITION VERIFIED.
*                SINGLE BLOCK MISPOSTION MESSAGES ISSUED AS NEEDED.
*
*         USES   T1, T2.
*
*         CALLS  BKS, BTW, CBW, ISC, SOB.
 
 
 POS11    SHN    14
          LMD    EC
          STM    POSC        SAVE EC
          SHN    -14
          STD    EC
          RJM    ISC         ISSUE MESSAGE AND RECONNECT UNIT
          LDC    *           RESTORE EC
 POSC     EQU    *-1
          STD    EC
 
 POS      SUBR               ENTRY/EXIT
          LDD    WP
          SBM    POSA
          ADN    1
          PJN    POS1        IF NO WRAP AROUND
          ADN    10
 POS1     STM    POSB        STORE STARTING POINTER
          LDC    0
 POSA     EQU    *-1
          RJM    BTW         BUILD TEMPORARY WINDOW
          LDN    1
          STD    T2
          LDC    *
 POSB     EQU    *-1
          STD    T1
          RJM    CBW         COMPARE WINDOWS
          ZJN    POSX        RETURN IF GOOD COMPARE
          SHN    -6          CHECK FOR INVALID BID IN TEMP WINDOW
          ZJN    POS2        IF NO INVALID BLOCK ID-S
          LJM    POS8        INVALID BLOCK ID-S EXIST
 
 POS2     LDD    WP          CHECK FOR LAST GOOD RECORD VALID BID
          STD    T3
          LDM    BIDW,T3
          STD    T4
          LMN    4
          ZJN    POS4        IF CANNOT TRY REPOSITION
          SOD    T3          CHECK LRG-1 NOT SAME
          PJN    POS3        IF NO OVERFLOW
          LDN    7
          STD    T3
 POS3     LDM    BIDW,T3
          LMD    T4
          NJN    POS5        IF LAST TWO BID-S NOT THE SAME
 POS4     LJM    POS6        CANNOT TRY REPOSITION
 
 POS5     LDN    2           CHECK FOR TOO FAR BACKWARD
          STD    T2
          RAM    POSA        INCREASE REPOSITION COUNT BY TWO
          LDM    POSB
          STD    T1
          LDM    BIDW,T1
          SBM    TBDW,T2
          NJN    POS9        IF NOT TOO FAR BACKWARD
          LDD    WP
          STD    T9
          RJM    SOB         SET UP AND READ ONE BLOCK
          LDM    POSA
          RJM    BTW         REBUILD BLOCK ID WINDOW
          LDN    1
          STD    T2
          LDM    POSB
          STD    T1
          RJM    CBW         RECOMPARE THE BID WINDOWS
          NJN    POS6        IF POSITION LOST
          LDN    /MTX/SMB    ISSUE SINGLE BLOCK MISPOSITION MESSAGE
          LJM    POS11       ISSUE ERROR MESSAGE
 
 POS6     LDN    /MTX/PLO    ISSUE POSITION LOST MESSAGE
 POS7     STD    EC          SAVE ERROR CODE
          RJM    ISC         ISSUE MESSAGE AND RECONNECT UNIT
          LJM    RET4        RETURN FATAL ERROR
 
 POS8     LDN    /MTX/MWT
          UJN    POS7        ISSUE MARGINALLY WRITTEN TAPE
 
 POS9     LDN    0           CHECK FOR TOO FAR FORWARD
          STD    T2
          LDM    POSB
          STD    T1
          LDM    BIDW,T1
          SBM    TBDW,T2
          NJN    POS6        IF POSITION LOST
          RJM    BKS         CORRECT FOR TOO FAR FORWARD AND RETRY
          LDM    POSA
          RJM    BTW
          LDN    1
          STD    T2
          LDM    POSB
          STD    T1
          RJM    CBW
          ZJN    POS10       IF POSITION NOT LOST
          LJM    POS6        POSITION LOST
 
 POS10    LDN    /MTX/SMF    ISSUE SINGLE BLOCK MISPOSITION MESSAGE
          LJM    POS11       ISSUE ERROR MESSAGE
 RCI      SPACE  4,10
**        RCI - READ *CIO* INFORMATION FROM *MAGNET,S FL.
*
*         EXIT   (T6 - T7) = FET ADDRESS.
*                (T1 - T5) = UCIC WORD.
*
*         USES   CM - CM+4.
*
*         CALLS  HNG.
*
*         MACROS DELAY, MONITOR, PAUSE.
 
 
 RCI3     LDD    MA          READ WORDS
          CRD    T6-3
          ADN    2
          CRD    T1
 
 RCI      SUBR               ENTRY/EXIT
 RCI1     LDM    UADA        SET FWA OF DESIRED UDT WORDS
          ADN    /MTX/UCIA
          STD    CM+4
          LDC    300         REQUEST THREE WORDS
          STD    CM+3
          LDN    0           REQUEST READ FROM *MAGNET*
          STD    CM+1
          LCN    7777-/SSD/MTSI  SET *MAGNET* SUBSYSTEM IDENTIFICATION
          STD    CM+2
          MONITOR TDAM
          LDD    CM+1
          ZJN    RCI3        IF DONE
          SBN    2
          PJN    RCI2        IF MOVE NOT IN PROGRESS
          PAUSE  NE
          DELAY
          UJN    RCI1        REISSUE REQUEST
 
 RCI2     RJM    HNG         HANG PP
 RDA      SPACE  4,15
**        RDA - READ DATA.
*
*         EXIT   (A) = (T4) = 0, NO ERROR.
*                (BY) = BYTE COUNT OF BLOCK.
*                (EBUF - EBUF+3) = TRAILER BYTES FOR I FORMAT.
*                (EBUF-1 - EBUF+3) = PREFIX BYTES FOR LI FORMAT.
*                (UBWB) SET TO 1 IF TAPE MARK.
*
*         USES   T3, T4.
*
*         CALLS  ABC, CKR, FCN, WEO.
 
 
 RDA      SUBR               ENTRY/EXIT
          RJM    CKR         CHECK READY
          LDN    F0040       ISSUE READ FUNCTION
          RJM    FCN
          ACN    CH
 RDA1     LDN    0
          STD    T3          CLEAR LOOP COUNTER
          STD    BY
 
*         FLUSH DATA, COUNT BYTES, SAVE TRAILER (I FORMAT), SAVE
*         PREFIX (LI FORMAT).
 
 RDA2     LDC    500         INPUT DATA IN 500B WORD CHUNKS
          IAM    EBUF,CH
 RDAD     EQU    *-1
*         IAM    EBUF-1,CH   (LI FORMAT)
          NJN    RDA3        IF END OF DATA
 RDA2.1   AOD    T3          INCREMENT LOOP COUNTER
          UJN    RDA2        LOOP UNTIL END OF DATA
 RDAE     EQU    *-1
*         LDC    500         (LI FORMAT)
          DATA   500
          IAM    EBUF+4,CH
          ZJN    RDA2.1      IF ALL WORDS TRANSFERRED
 RDA3     STD    T4          SAVE REMAINDER
          LDC    500
          SBD    T4
          STD    T4
          LDD    T3          LOAD LOOP COUNT
          ZJN    RDA5        IF NOT GREATER THAN 500 WORDS
 RDA4     LDC    500
          RAD    BY
          SHN    -12D
          NJN    RDA6        IF GREATER THAN 7777 WORDS
          SOD    T3          DECREMENT LOOP COUNT
          NJN    RDA4        IF NOT LAST CHUNK
 RDA5     LDD    T4          LOAD REMAINDER
          NJN    RDA5.1      IF NOT EVEN CHUNK
          LDC    500         SET TO LAST ADDRESS OF CHUNK
          STD    T4
          UJN    RDA7        EXIT
 
 RDA5.1   RAD    BY
          SHN    -12D
          ZJN    RDA7        IF NO BORROW
 RDA6     LCN    0
          STD    BY          SET BYTE COUNT TO 7777
 RDA7     RJM    WEO         WAIT END OF OPERATION
          SCN    74
          ZJN    RDA9        IF NO ERRORS
          SHN    21-10
 RDAA     PJN    RDA8        IF NOT NOISE
*         UJN    RDA8        (ATS UNIT)
          LDN    42          ISSUE REPEAT READ
          RJM    FCN
          ACN    CH
          LJM    RDA1        REINITIATE READ
 
 RDA8     LDM    MTDS
          LPC    7077
 RDAB     EQU    *-1
*         LPC    7777        (ATS UNIT)
          ZJN    RDA9        IF ONLY WARNING STATUS
          LCN    0
 RDA9     STM    RDAC
          RJM    ABC
          ZJN    RDA10       IF NO BYTE ADJUSTMENT
          SOD    T4
 
*         MOVE I FORMAT TRAILOR INFORMATION.
 
 RDA10    LDN    3
 RDAF     EQU    *-1
*         UJN    RDA15       (LI FORMAT)
          STD    T5
 RDA11    LDM    EBUF-1,T4
          STM    EBUF,T5
          SOD    T4
          SOD    T5
          PJN    RDA11       IF MORE DATA TO MOVE
          LDM    ABCC
          ZJN    RDA15       IF NO ADJUSTMENT
          SOD    BY
 RDA15    LDD    DS          CHECK FOR TAPE MARK
          LPN    20
          LMN    20
          NJN    RDA17       IF NOT TAPE MARK
          STD    BY
          LDN    1           SET TAPE MARK INDICATION
          STM    UBWB
          LDD    HP
          LPN    1
          NJN    RDA17       IF 9 TRACK
          LDD    MD
          SHN    21-6
          MJN    RDA17       IF 7 TRACK CODED
          LDN    0           CLEAR ERROR INDICATION
          STM    RDAC
 RDA17    LDM    RDAC        LOAD EXIT FLAG
          STD    T4
          LJM    RDAX        RETURN
 
 
 RDAC     CON    0           EXIT FLAG
 SOB      SPACE  4,10
**        SOB - SET UP AND READ ONE BLOCK.
*
*         ENTRY  (T9) = POINTER TO BID WINDOW.
*
*         EXIT   (UBWB) = BID OF READ CORRECTED FOR CLIPPING LEVEL AND
*                READ ERRORS.
*
*         USES   T0.
*
*         CALLS  FCN, RDA.
 
 
 SOB2     RJM    RDA         READ BLOCK
          ZJN    SOBX        IF GOOD READ
 SOB3     LDN    4           SET UNUSABLE BID
          STM    UBWB
 
 SOB      SUBR               ENTRY/EXIT
          LDD    MD          CHECK IF PARITY CHANGE NEEDED
          SHN    -5
          LMM    BIDW,T9
          LPN    2
          ZJN    SOB1        IF NO CHANGE NEEDED
          LDD    HP
          LPN    1
          NJN    SOB1        IF 9 TRACK
          LDN    5           TOGGLE TO OPPOSITE PARITY
          RJM    FCN
 SOB1     LDM    BIDW,T9     CHECK IF CHANGE IN CLIPPING LEVEL NEEDED
          SHN    21-2
          PJN    SOB2        IF NO CHANGE NEEDED
          LPN    7           SET CLIPPING LEVEL
          SHN    6
          ADN    6
          RJM    FCN
          RJM    RDA         READ BLOCK
          NJN    SOB3        IF ERROR
          LDM    BIDW,T9     ADD CLIPPING LEVEL TO LAST BID
          LPN    74
          STD    T0
          LDM    UBWB
          SCN    74
          LMD    T0
          STM    UBWB
          LJM    SOBX        RETURN
 WFC      SPACE  4,10
**        WFC - WAIT BACKSPACE FUNCTION COMPLETE.
*         TIMES OUT APPROXIMATELY 25 FEET OF TAPE.
*
*         EXIT   (DS) = UNIT STATUS.
*
*         USES   T2.
*
*         CALLS  //STW.
 
 
 WFC2     CON    0           ENTERED VIA *RJM* FROM //STW
          SOD    T2
          NJN    WFC1        IF NOT TIMEOUT
          LDC    //ERR       RESET ERROR EXIT
          STM    //STWC
          UJN    WFC1        ATTEMPT 1 MORE WAIT
 
 WFC      SUBR               ENTRY/EXIT
          LDC    2000        SET TIME OUT
          STD    T2
          LDC    WFC2        SET RETURN ON TIMEOUT IN //STW
          STM    //STWC
 WFC1     LDN    2           WAIT NOT BUSY
          RJM    //STW
          LDC    //ERR       RESET ERROR EXIT
          STM    //STWC
          UJN    WFCX        RETURN
 WNB      SPACE  4,10
**        WNB - WAIT NOT BUSY ON *CMTS* OR *FSC* CONTROLLER.
*
*         USES   T2, CM - CM+4.
*
*         CALLS  ERR, FCN, STW.
*
*         MACROS SFA.
 
 
 WNB      SUBR               ENTRY/EXIT
          LDC    2000
          STD    T2
 WNB1     LDN    0
          RJM    //STW       WAIT FOR END OF OPERATION
          LPN    2
          ZJN    WNBX        IF UNIT NOT BUSY
          SOD    T2
          ZJN    WNB2        IF TIMEOUT
          LDN    1
          RJM    FCN         RELEASE UNIT
          SFA    EST,EO
          ADK    EQDE
          CRD    CM
          LDD    CM+4
          LPN    17          GET UNIT NUMBER
          LMN    20
          RJM    FCN         CONNECT UNIT
          UJN    WNB1        CONTINUE WAITING
 
 WNB2     LDN    /MTX/WEO
          RJM    ERR         ISSUE ERROR MESSAGE
          SPACE  4,10
 ADDR     TSAD   SMER
          SPACE  4,10
**        BUFFERS FOR READING DURING WRITE RECOVERY.
 
 
 EBUF     BSS    0
          ERRNG  7777-EBUF-4-510  BUFFER DOES NOT FIT WITHIN PP
 WLP      SPACE  4,15
**        WLP - LOAD POINT RECOVERY.
*
*         ENTRY  DETAIL STATUS BUFFERS SET UP.
*
*         EXIT   (A) .LT. 0 IF NOT *TCF* OR *BFW* ERROR OR
*                           IF *TCF* OR *BFW* ERROR WAS RECOVERED.
*                (A) = 0 IF RETRY ON *BFW* ERROR.
*
*         ERROR  TO *RET4* IF LOAD POINT PROBLEM.
*                (EC) = *TCF* OR *BFW*.
*
*         USES   T1.
*
*         CALLS  DTS, *EMM*, FCN, WFC, WNB.
*
*         MACROS CALL.
 
 
 WLP      SUBR               ENTRY/EXIT
          LDD    EC
          NJN    WLP0        IF ERROR
          RJM    DTS         GET DETAILED STATUS
 
*         SAVE CURRENT EQUIPMENT STATUS.
 
 WLP0     LDD    DS          SAVE GENERAL STATUS
          STM    WLPA
          LDM    UBWB        SAVE BLOCK ID
          STM    WLPB
          LDN    0           SAVE DETAIL STATUS
          STD    T1
 WLP1     LDM    MTDS,T1     MOVE ALL DETAIL STATUS WORDS
          STM    WLPC,T1
          AOD    T1          INCREMENT STATUS WORD COUNTER
          SBN    16
          NJN    WLP1        IF NOT ALL STATUS WORDS MOVED
          LDM    ATUS+2      GET DETAIL STATUS WORD 13
          SHN    21-2        POSITION CLEANER ACTIVE BIT
          PJN    WLP2        IF CLEANER PARKED
          LDD    EP          SET LOAD POINT ERROR FLAG
          LPC    6777
          ADC    1000
          STD    EP
          LDN    /MTX/TCF    CLEANER ACTIVE
          LJM    WLP10       ISSUE ERROR MESSAGE AND UNLOAD TAPE
 
 WLP2     LDM    MTDS        LOAD DETAIL STATUS WORD 3
          LPC    177         MASK ERROR CODES
          SBN    7
          ZJN    WLP8        IF ERROR CODE 7
          SBN    3
          ZJN    WLP8        IF ERROR CODE 12
          SBN    1
          ZJN    WLP8        IF ERROR CODE 13
          SBN    3
          ZJN    WLP8        IF ERROR CODE 16
          LDD    EC
          NJN    WLP6        IF NON-LOAD POINT ERROR
          LDD    EP
          SHN    21-11
          PJN    WLP6        IF NO PREVIOUS LOAD POINT ERROR
          LDN    0           CLEAR ERROR CODE
          STD    EC
          LDD    EP          CLEAR LOAD POINT ERROR FLAG
          LPC    6777
          STD    EP
 WLP6     LDD    EP          CLEAR LOAD POINT RECOVERY FLAG
          LPC    7377
          STD    EP
          LCN    0
          LJM    WLPX        RETURN NO LOAD POINT ERROR OR RECOVERED
 
 WLP8     LDD    EP          SET LOAD POINT ERROR AND RECOVERY FLAGS
          LPC    6377
          LMC    1400
          STD    EP
          LDD    EI
          LPN    77          ERROR ITERATION
          ZJN    WLP11       IF FIRST TRY ON BAD HEADER
          LPN    7
          ZJN    WLP9        IF ITERATION IS A MULTIPLE OF 4
          SBN    4
          NJN    WLP11       IF NOT A MULTIPLE OF 4
 WLP9     LDN    /MTX/BFW    BAD PHASE/GCR HEADERS
 WLP10    STD    EC
          CALL   EMM         ISSUE MESSAGE TO ERROR LOG
          AOD    EI
          LDC    110         UNLOAD THE TAPE
          RJM    FCN
          LDD    HP
          SHN    21-6
          MJN    WLP10.2     IF *CMTS* OR *FSC* CONTROLLER
          RJM    WFC         WAIT END OF OPERATION
 WLP10.1  LJM    RET4        RETURN ERROR CODE
 
 WLP10.2  RJM    WNB         WAIT END OF OPERATION
          UJN    WLP10.1     RETURN ERROR CODE
 
*         REWIND TO LOAD POINT AND ATTEMPT REWRITE.
 
 WLP11    LDN    F0010       REWIND TAPE TO LOAD POINT
          RJM    FCN
          RJM    WFC
 
*         RESTORE EQUIPMENT ERROR STATUS BEFORE EXIT.
 
          LDN    0
          STD    T1
          LDM    WLPA        RESTORE GENERAL STATUS
          STD    DS
          LDM    WLPB        RESTORE BLOCK ID
          STM    UBWB
 WLP12    LDM    WLPC,T1     RESTORE ERROR STATUS
          STM    MTDS,T1
          AOD    T1          INCREMENT COUNTER
          SBN    16
          NJN    WLP12       IF NOT ALL STATUS WORDS MOVED
*         LDN    0
          LJM    WLPX        TRY TO REWRITE FROM LOAD POINT
 
 
 WLPA     CON    0           GENERAL STATUS
 WLPB     CON    0           BLOCK ID
 WLPC     BSSZ   16          DETAILED STATUS
          SPACE  4,10
**        CTAB - CHANNEL TABLE.
 
 
 CTAB     CHTB
          TITLE  OVERLAYABLE SUBROUTINES.
          SPACE  4,10
**        NOTE - CODE AFTER THIS POINT WILL BE DESTROYED WHEN
*         CALLING THE ERROR PROCESSOR *EMM*.  ALL CALLS TO CODE
*         LOCATED AFTER THIS POINT MUST BE DONE PRIOR TO CALLING
*         *EMM*.
 
 
          ERROVL
 EBW      SPACE  4,15
**        EBW - EVALUATE BID WINDOW.
*
*         ENTRY  (BIDW) = BID WINDOW.
*
*         EXIT   (POSA) = NUMBER OF BLOCKS TO BACKSPACE.
*                NUMBER OF BLOCKS TO BACKSPACE = 2 IF
*                   1) NO BID PRESENT.
*                   2) INVALID HISTORY BLOCK ID ENCOUNTERED.
*                   3) .GT. 5 BLOCK ID-S ENCOUNTERED.
*                   4) END OF BLOCK ID WINDOW ENCOUNTERED.
*                (WEMD) = BID FROM LAST WRITE.
*                (T2) = NUMBER OF DIFFERENT BLOCK ID-S.
*                (T4) = NUMBER OF SAME BLOCK ID-S.
*
*         USES   T1 - T4.
 
 
 EBW      SUBR               ENTRY/EXIT
          LDD    CF          CHECK IF BID PRESENT
          LPC    300
          LMC    300
          NJN    EBW2        IF BID PRESENT
 EBW1     LJM    EBW9        FORCE BACKSPACE OF TWO BLOCKS
 
 EBW2     LDM    UBWB        SAVE CURRENT BID
          STM    WEMD
          LDD    WP          SET UP DIRECTS
          STD    T1
          LDN    0
          STD    T2
          STD    T4
          LCN    0
          STD    T3
 EBW3     LDD    T2          CHECK FOR MAX COUNT OF 5
          ADD    T4
          SBN    5
          PJN    EBW1        IF MAX COUNT REACHED, FORCE SET 2
          LDM    BIDW,T1
          LMN    4
          ZJN    EBW10       IF INVALID, STOP SCAN
          LPN    1
          ZJN    EBW5        IF NOT TAPE MARK
          AOD    T2          FORCE BACKSPACE OVER TAPE MARK
 EBW4     STM    POSA        SET BACKSPACE COUNT
          LJM    EBWX        RETURN
 
 EBW5     LDM    BIDW,T1
          SBD    T3
          NJN    EBW6        IF NOT SAME
          AOD    T4          INCREMENT SAME BID COUNT
          UJN    EBW7        CONTINUE BID SCAN
 
 EBW6     AOD    T2          INCREMENT DIFFERENT COUNT
          SBN    2
          MJN    EBW7        IF NOT TWO DIFFERENT BID-S
          LDD    T2
          ADD    T4
          UJN    EBW4        STORE BACKSPACE COUNT AND EXIT
 
 EBW7     LDM    BIDW,T1
          STD    T3          SAVE LAST BID
          SOD    T1          REDUCE POINTER
          PJN    EBW8        IF NO OVERFLOW
          LPN    7
          STD    T1
 EBW8     LMD    WP          CHECK FOR END OF WINDOW
          NJN    EBW11       IF NOT END OF WINDOW
 EBW9     LDN    2           FORCE BACKSPACE OF TWO BLOCKS
          UJN    EBW4        STORE BACKSPACE COUNT AND EXIT
 
 EBW10    LDD    T2
          ADD    T4
          ZJN    EBW9        IF END OF WINDOW
          UJN    EBW4        STORE BACKSPACE COUNT AND EXIT
 
 EBW11    LJM    EBW3        CHECK NEXT BID
 PRS      SPACE  4,10
**        PRS - PRESET.
*
*         CALLS  DME.
 
 
 
 PRS      SUBR               ENTRY/EXIT
          LDD    HP
          LPN    20
          NJN    PRS1        IF ATS-TYPE CONTROLLER
          LDM    PRSF        DISABLE LOAD POINT RECOVERY
          STM    WEML
          UJN    PRSX        EXIT PRESET
 
*         MODIFY INSTRUCTIONS FOR ATS-TYPE CONTROLLER.
 
 PRS1     LDM    PRSA
          STM    ABCA
          LDC    LPNI-LDNI
          RAM    ABCB
          LDC    5000        FUNCTION CODE FOR *LDM*
          STM    BTWA
          LCN    0
          STM    WEMA
          STM    WEMB
          STM    RDAB
          LDC    UJNI-PJNI
          RAM    RDAA
          LDC    LDMI
          STM    WEMC
          LDD    FN
          LMN    /MTX/WTF
          NJP    PRS2        IF NOT WRITE FUNCTION
          LDD    FM
          SHN    -6
          LMN    /MTX/TFLI
          NJP    PRS2        IF NOT LI FORMAT
*         LDN    0
          STM    ADDR        NO INSTRUCTION MODIFICATION
          STM    CIDB        NO BLOCK LENGTH CHECK
          ISTORE CIDA,(UJN CID1)
          LDC    /WLI/WLIA
          STM    WEMK        DROP OUT FLAG
          STM    WEMM
          LDC    /WLI/CNW
          STM    WEMG+1      SET ADDRESS OF *CNW*
          LDC    /WLI/WRTK
          STM    EOTA        END OF TAPE EXIT ADDRESS
          SOM    RDAD        LOCATION FOR PREFIX
          LDC    LDCI
          STM    RDAE
          ISTORE RDAF,(UJN RDA15)
 PRS2     LJM    PRSX        EXIT PRESET
 
 
 PRSA     BSS    0
          LOC    ABCA
          UJN    ABC2        ADJUST BUFFER LENGTH
          LOC    *O
 
 PRSE     BSS    0           BACKSPACE DELAYS FOR FSC, CMTS OR ISMT
          LOC    0
          CON    LDNI+27     75 IPS UNIT (FSC)
          CON    LDNI+17     125 IPS UNIT (FSC)
          CON    LDNI+10     200 IPS UNIT (FSC OR CMTS)
          CON    LDNI+34     25 IPS UNIT (ISMT)
          LOC    *O
 
 PRSF     BSS    0
          LOC    WEML
          UJN    WEM2.1      DISABLE LOAD POINT RECOVERY
          LOC    *O
          OVERLAY (CTS WRITE ERROR PROCESSOR.),(BUFB+10),P,CWP
 CWP      SPACE  4,15
**        CWP - CTS WRITE ERROR PROCESSOR.
*
*         EXIT   TO CALLER IF EOT, RECOVERED ERROR OR ERROR PROCESSING
*                          INHIBITED.
*                TO *WRA* IF ERROR.
*                (CN+3, CN+4) = OUT POINTER IF WRITE.
*
*         USES   CN - CN+4.
*
*         CALLS  /WLI/CNW, /WRITE/CNW, *CEM*, EOT, MCH, PRS, WRA.
*
*         MACROS CALL.
 
 
          ENTRY  CWP
 CWP      SUBR               ENTRY/EXIT
 
*         THE FOLLOWING CODE IS OVERLAYED BY THE OUT POINTER.
 
 CWPA     EQU    *
 CWPB     EQU    *+5
          LDM    //LOV       SAVE CALLERS EXIT ADDRESS
          STM    CWP
          LDD    MA          SAVE OUT POINTER
          CWD    CN
          CRM    CWPA,ON
          LDC    CTAB        MODIFY CHANNELS
          RJM    MCH
          RJM    PRS         PRESET
          LDD    DS
          LPN    1
          NJN    CWP1        IF READY
          LDN    /MTX/RDR
          STD    EC
 CWP1     LDD    FN          LOAD MAGNET FUNCTION CODE
          LMN    /MTX/WLA
          NJN    CWP2        IF NOT WRITE LABELS
          LDC    RET2        FORCE REQUEUE AFTER WRITE IS GOOD
          STM    /WLA/WLAG
 CWP2     LDM    /WRITE/WTFE CHECK IF EOF REQUEST DETECTED AHEAD
 CWPC     EQU    *-1
*         LDM    /WLI/WLIA   (LI FORMAT)
          LMN    1
          NJN    CWP3        IF NOT EOF REQUEST
          LDD    MD
          SCN    14
          STD    MD
 CWP3     LDD    EC
          NJN    CWP4        IF NOT RECOVERED ERROR
          CALL   CEM         ISSUE RECOVERED MESSAGE
          LDD    FN
          LMN    /MTX/WLA
          NJN    CWP6        IF NOT WRITE LABELS
          STD    EP          CLEAR ERROR PARAMETERS
          STD    EI          CLEAR RETRY COUNT
          UJN    CWP6        CLEAR ERROR CODE
 
 CWP4     LMN    /MTX/STE
          NJN    CWP5        IF NOT STATUS ERROR
          LDD    DS
          SHN    21-3
          PJN    CWP5        IF NOT EOT
          SHN    21-13-21+3+22
          MJN    CWP5        IF OTHER ERRORS
          RJM    EOT
          UJN    CWP6        CLEAR ERROR CODE
 
 CWP5     LDD    SP
          LPN    4
          NJN    CWP6        IF ERROR PROCESSING INHIBITED
          RJM    WRA         WRITE RECOVERY ALGORITHM (NO RETURN)
 
 CWP6     LDN    0           CLEAR ERROR CODE
          STD    EC
          LDD    FN
          LMN    /MTX/WLA
          ZJN    CWP8        IF WRITE LABELS
          LDN    0           CLEAR ERROR PARAMATERS
          STD    EP
          STD    EI
          LDD    MA          RESTORE OUT POINTER
          CWM    CWPA,ON
          SBN    1
          CRD    CN
          LDM    /WRITE/WTFE CHECK IF EOF REQUEST DETECTED AHEAD
 CWPD     EQU    *-1
*         LDM    /WLI/WLIA   (LI FORMAT)
          LMN    1
          NJN    CWP7        IF NOT EOF REQUEST
          LDN    14          SET EOF STATUS
          RAD    MD
          UJN    CWP8        RESTORE MA BACK TO OLD OUT POINTER
 
 CWP7     RJM    /WRITE/CNW
 CWPE     EQU    *-1
*         RJM    /WLI/CNW    (LI FORMAT)
 CWP8     LJM    CWPX        RETURN
 EOT      SPACE  4,10
**        EOT - END OF TAPE PROCESSOR.
 
 
 EOT      SUBR               ENTRY/EXIT
          LDC    EOT1        SET TO RETURN HERE AFTER POINTER UPDATE
          STM    /WRITE/WRTK
 EOTA     EQU    *-1
*         STM    /WLI/WRTK   (LI FORMAT)
          UJN    EOTX        RETURN
 
 EOT1     LDN    /MTX/BEI    RETURN END OF TAPE
          LJM    RET3        RETURN ERROR CODE
 POS      SPACE  4,15
**        POS - POSITION TAPE.
*         THIS ROUTINE USES THE LOCATE BLOCK COMMAND TO POSITION
*         THE TAPE TO THE EXPECTED BLOCK POSITION.
*
*         ENTRY  (BL, BL+1) = NOS BLOCK POSITION.
*                (WP, EP+1) = PHYSICAL BLOCK ID WHEN (BL,BL+1) = 0.
*
*         EXIT   (A) = 0 IF NO ERROR.
*                TO *ERR* IF CHANNEL MALFUNCTION.
*
*         USES   T3.
*
*         CALLS  /PRESET/GPS, /PRESET/ICF, /PRESET/RBI.
 
 
 POS      SUBR               ENTRY/EXIT
          RJM    /PRESET/RBI READ BLOCK ID
          LDM    BIDW
          STM    POSA
          SBN    20
          ZJN    POS1        IF FIRST SEGMENT
          STM    POSA        SET PHYSICAL REFERENCE BLOCK ID
 POS1     LDD    BL+1
          SHN    4
          ADD    EP+1
          STM    POSA+2      MOVE BLOCK NUMBER TO PARAMETERS
          SHN    -14
          STM    POSA+1
          LDD    BL
          SHN    4
          ADD    WP
          RAM    POSA+1
          LDN    F0016       LOCATE BLOCK
          RJM    /PRESET/ICF ISSUE FUNCTION
          ACN    CH
          LDN    3
          OAM    POSA,CH     OUTPUT THE 3 PARAMETER WORDS
          STD    T3          WORDS NOT TRANSFERRED
          FJM    *,CH        WAIT FOR DATA TO BE TAKEN
 POS2     LDN    0           WAIT FOR END OF OPERATION
          RJM    /PRESET/GPS GET AND PROCESS GENERAL STATUS
          MJN    POS2        IF COMMAND RETRY
          SHN    21-13
          MJN    POS3        IF ERROR
          LDD    T3
          ZJN    POS4        IF ALL WORDS TRANSFERRED
          LDN    /MTX/CMF    CHANNEL MALFUNCTION
          RJM    ERR         REPORT ERROR (NO RETURN)
 
 POS3     LDN    /MTX/STE    STATUS ERROR
          STD    EC
 POS4     LJM    POSX        RETURN
 
 
 POSA     DATA   0           LOCATE BLOCK PARAMETERS
          DATA   0           UPPER 12 BITS OF BLOCK NUMBER
          DATA   0           8/LOWER BITS OF BLOCK NUMBER / 4 UNUSED
 WFC      SPACE  4,10
**        WFC - WAIT FOR COMPLETION.
*
*         CALLS  /PRESET/GPS.
 
 
 WFC      SUBR               ENTRY/EXIT
 WFC1     LDN    0           WAIT FOR END OF OPERATION
          RJM    /PRESET/GPS
          MJN    WFC1        IF COMMAND RETRY
          UJN    WFCX        RETURN
 WRA      SPACE  4,20
**        WRA - WRITE RECOVERY ALGORITHM.
*
*         ENTRY  (EI) = RETRY COUNT.
*
*         EXIT   TO *RET2* TO REQUEUE.
*                TO *RET4* TO RETURN A FATAL ERROR.
*                TO *ERR* IF MICROCODE LOAD FAILED.
*                (EI) = (EI) + 1.
*
*         USES   CN, CN+1, EC, HP, MD.
*
*         CALLS  *CEM*, /PRESET/ICF, POS, /PRESET/RCU, WFC, *0CT*.
*
*         MACROS CALL, EXECUTE.
 
 
*         THIS ROUTINE DOES ERROR RECOVERY AS FOLLOWS -
*
*         IF (EI) = 0 LOG ERROR, POSITION TAPE, AND REQUEUE.
*         IF (EI) = 1 LOG ERROR, LOAD CCC MICROCODE, POSITION TAPE,
*                     AND REQUEUE.
*         IF (EI) = 2 LOG UNRECOVERED ERROR, POSITION TAPE, RETURN
*                     FATAL CODE.
*
 
 WRA      CON    0           ENTRY
          LDC    LDNI+F0002
          STM    /PRESET/GPSC  SEND CONTINUE IF COMMAND RETRY
 WRA1     CALL   CEM         LOG ERROR
          LDC    LDNI
          STM    //PNRC      FORCE DROP OUT
          AOD    EI          INCREMENT RETRY COUNT
          SBN    1
          ZJP    WRA4        IF FIRST ERROR
          SBN    1
          NJP    WRA5        IF RETRIES FAILED
          CHTE   *
          LDN    CH          SET CHANNEL NUMBER
          STD    CN
          LDC    ERLB        SET BUFFER ADDRESS
          STD    CN+1
          EXECUTE  0CT,ERLA+5  LOAD CTS/CCC MICROCODE
          LDD    CN
          ZJN    WRA3        IF MICROCODE LOADED
          STD    EC
          SHN    0-13
          PJN    WRA2        IF ERROR CODE ALREADY SAVED
          LDN    /MTX/CMF
          STD    EC
 WRA2     LDM    CN+1        SAVE FUNCTION
          STM    /PRESET/ICFA
          RJM    ERR         REPORT ERROR (NO RETURN)
 
 WRA3     RJM    /PRESET/RCU RECONNECT UNIT
 WRA4     RJM    POS         POSITION TAPE
          NJP    WRA1        IF LOCATE BLOCK FAILED
          STD    EC          CLEAR ERROR CODE
          LDD    HP          CLEAR EOR FLAG
          LPC    5777
          STD    HP
          LDD    MD          CLEAR EOR/EOF THIS OPERATION FLAG
          LPC    7377
          STD    MD
          LJM    RET2        REQUEUE THE REQUEST
 
 WRA5     LDD    FN
          LMN    /MTX/WLA
          NJN    WRA7        IF NOT WRITE LABELS
          LDD    EC
          LMN    /MTX/STE
          NJN    WRA7        IF NOT STATUS ERROR
          LDM    CTGS
          LPC    177
          SBN    CE007
          ZJN    WRA6        IF LOAD POINT ERROR
          SBN    CE012-CE007
          NJN    WRA7        IF NOT LOAD POINT ERROR
 WRA6     LDN    /MTX/BFW    LOAD POINT ERROR
          STD    EC
          CALL   CEM         LOG THE ERROR
          LDC    F0110       UNLOAD TAPE
          RJM    /PRESET/ICF ISSUE CTS FUNCTION
          RJM    WFC         WAIT FOR COMPLETION
          UJN    WRA8        RETURN FATAL ERROR
 
 WRA7     LDD    FN
          LMN    /MTX/WLA
          NJN    WRA8        IF NOT WRITE LABELS
          LDD    UP
          SCN    30          CLEAR WRITE OPERATION AND EOR/EOF FLAGS
          STD    UP
 WRA8     LJM    RET4        RETURN FATAL ERROR
          SPACE  4,10
          ERRNG  ERLA-*      CODE OVERFLOWS HELPER OVERLAY
          ERRPL  ERLA+5+ZCTL-ERLB  *0CT* OVERFLOWS INTO BUFFER
          SPACE  4,10
**        CTAB - CHANNEL TABLE.
 
 
 CTAB     CHTB
 PRS      SPACE  4,10
**        PRS - PRESET.
 
 
 PRS      SUBR               ENTRY/EXIT
          LDD    FN
          LMN    /MTX/WTF
          NJN    PRSX        IF NOT WRITE FUNCTION
          LDD    FM
          SHN    -6
          LMN    /MTX/TFLI
          NJN    PRSX        IF NOT LI FORMAT
          LDC    /WLI/WLIA
          STM    CWPC        DROP OUT FLAG
          STM    CWPD
          LDC    /WLI/CNW
          STM    CWPE        SET ADDRESS OF *CNW*
          LDC    /WLI/WRTK
          STM    EOTA        END OF TAPE EXIT ADDRESS
          LJM    PRSX        EXIT PRESET
          SPACE  4,10
          OVERFLOW  BUFB+10,/WLA/WTMX  OVERFLOW INTO CALLING ROUTINE
          OVERLAY (CTS ERPA CODES.),(ERLB+5),P,ERP
**        ERP - ERROR RECOVERY PROCEDURE ACTION TEXT MESSAGES.
 
 
          ENTRY  ERP
 ERP      SUBR               ENTRY/EXIT
          UJN    ERPX        RETURN
 
*         THE FOLLOWING TABLE CONTAINS POINTERS TO TEXT MESSAGES
*         FOR ERPA CODES 21 THROUGH 4C.
 
 ERPA     CON    ERP21
          CON    ERP22
          CON    ERP23
          CON    ERP24
          CON    ERP23
          CON    ERP23
          CON    ERP27
          CON    ERP28
          CON    0,0,0
          CON    ERP2C
          CON    0
          CON    ERP2E
          CON    0
          CON    ERP30
          CON    ERP31
          CON    ERP32
          CON    ERP33
          CON    ERP34
          CON    ERP35
          CON    0
          CON    ERP37
          CON    ERP38
          CON    ERP39
          CON    ERP3A
          CON    ERP3B
          CON    0,0,0,0,0
          CON    ERP41
          CON    ERP42
          CON    ERP3A
          CON    ERP44
          CON    ERP45
          CON    ERP46
          CON    ERP47
          CON    0
          CON    ERP49
          CON    ERP4A
          CON    0
          CON    ERP4C
 
*         THE FOLLOWING ARE ERPA TEXT MESSAGES.
 
 ERP21    DATA   C*DATA STREAMING ERROR.*
 ERP22    DATA   C*PATH EQUIPMENT CHECK.*
 ERP23    DATA   C*DATA CHECK.*
 ERP24    DATA   C*LOAD DISPLAY CHECK.*
 ERP27    DATA   C*COMMAND REJECT.*
 ERP28    DATA   C*WRITE ID CHECK.*
 ERP2C    DATA   C*CU EQUIPMENT CHECK.*
 ERP2E    DATA   C*NOT CAPABLE.*
 ERP30    DATA   C*FILE PROTECTED.*
 ERP31    DATA   C*TAPE VOID.*
 ERP32    DATA   C*TENSION LOSS.*
 ERP33    DATA   C*LOAD FAILURE.*
 ERP34    DATA   C*UNLOAD FAILURE.*
 ERP35    DATA   C*DRIVE EQUIPMENT CHECK.*
 ERP37    DATA   C*TAPE LENGTH ERROR.*
 ERP38    DATA   C*PHYSICAL END OF TAPE.*
 ERP39    DATA   C*BACKWARD AT BOT.*
 ERP3A    DATA   C*DRIVE NOT READY.*
 ERP3B    DATA   C*UNLOAD ERROR.*
 ERP41    DATA   C*BLOCK ID SEQUENCE ERROR.*
 ERP42    DATA   C*DEGRADED MODE.*
 ERP44    DATA   C*LOCATE BLOCK UNSUCCESSFUL.*
 ERP45    DATA   C*DRIVE ASSIGNED ELSEWHERE*
 ERP46    DATA   C*DRIVE OFFLINE.*
 ERP47    DATA   C*CU ERROR*
 ERP49    DATA   C*BUS OUT PARITY*
 ERP4A    DATA   C*CU ERP FAILED.*
 ERP4C    DATA   C*CU CHECK ONE ERROR*
          ERRNG  1*473+ERLB+5-*
          QUAL   1LT
 .QNAM    MICRO  1,, 1LT
 .IM      SET    0
          TTL    1MT/1LT - LONG BLOCK PROCESSOR.
          TITLE
          IDENT  1LT,LTP     LONG BLOCK HELPER PROCESSOR.
*COMMENT  1MT - LONG BLOCK HELPER PROCESSOR.
          SPACE  4,10
**        *1LT* CALL FORMAT.
*
*         INPUT REGISTER -
*
*T,       18/  1LT,6/ CP,6/ HP,6/ FUNC,2/ CF,10/ CH,12/ PPIA
*
*         MESSAGE BUFFER + 1 (*1MT*) -
*
*T,       12/  -0,24/  FIRST,24/  LIMIT
*
*         CP     CONTROL POINT NUMBER.
*         HP     UNIT HARDWARE PARAMETERS (UPPER 6 BITS ONLY).
*         FUNC   FUNCTION (0 = READ, 1 = WRITE, 2 = WRITE *LI* FORMAT).
*         CF     MTS/ATS CONTROLLER FLAG.
*         CH     TAPE CHANNEL.
*         PPIA   *1MT* PP INPUT REGISTER ADDRESS.
*         FIRST  *FIRST* POINTER FROM FET.
*         LIMIT  *LIMIT* POINTER FROM FET.
          SPACE  4,10
**        *1LT* REQUEST/REPLY FORMAT.
*
*         REQUESTS AND REPLYS ARE PASSED IN THE MESSAGE BUFFER OF *1LT*.
*
*         REQUEST (*1MT*) -
*
*T,       12/ CC,12/ WC,12/ OV,24/ PT
*
*         CC     COMMAND CODE (1 = START OF BLOCK, 3 = READ SKIP).
*         WC     NUMBER OF WORDS IN LAST CHUNK (READ).
*         WC     NUMBER OF BYTES IN LAST CHUNK (WRITE).
*         OV     OVERFLOW CHUNK COUNT.
*         PT     POINTER TO START TRANSFER AT.
*
*         REPLY (*1LT*) -
*
*T,       12/ CR,12/ BT,12/ WT,24/ 0
*
*         CR     COMMAND RESPONSE CODE (0 = ACKNOWLEDGE, 2 = COMPLETE).
*         BT     BYTES TRANSFERRED.
*         WT     WORDS TRANSFERRED.
          SPACE  4,15
**        *1MT*/*1LT* INTERLOCK (CYBER 180 ONLY).
*
*         FOR CYBER 180 MAINFRAMES, AN INTERLOCK IS MAINTAINED
*         IN MESSAGE BUFFER + 1 (*1LT*).  THIS INTERLOCK IS USED
*         TOGETHER WITH THE CHANNEL FLAG TO ENSURE THAT CHUNKS
*         ARE SEQUENCED CORRECTLY.
*
*T,       12/ IN,48/ RESERVED
*
*         IN     INTERLOCK
*                (0 = *1MT* MAY TRY TO SET THE CHANNEL FLAG,
*                 1 = *1LT* MAY TRY TO SET THE CHANNEL FLAG).
          SPACE  4,10
**        DIRECT CELL DEFINITIONS.
 
 
          LOC    20
 CC       BSS    1           COMMAND CODE
 WC       BSS    1           NUMBER WORDS IN LAST CHUNK (READ)
*                            NUMBER BYTES IN LAST CHUNK (WRITE)
 OV       BSS    1           OVERFLOW CHUNK COUNT
 PT       BSS    2           POINTER TO START TRANSFER AT
 CR       BSS    1           COMMAND RESPONSE CODE
 BT       BSS    1           BYTES TRANSFERRED
 WT       BSS    1           WORDS TRANSFERRED
 ZR       BSS    5           (5 BYTES OF ZEROES)
 BI       BSS    1           BYTES TO INPUT/OUTPUT
 RS       BSS    2           AMOUNT OF SPACE IN BUFFER - READ SKIP
          LOC    *O
 LTP      SPACE  4,10
**        LTP - LONG BLOCK PROCESSOR.
*
*         ENTRY  (IR+2) = 6/X, 6/Y WHERE
*                         X = UPPER 6 BITS OF (HP).
*                         Y = 2  IF WRITE LI FORMAT.
*                         Y = 1  IF WRITE AND NOT LI FORMAT.
*                         Y = 0  IF READ.
*
*         CALLS  PRS.
*
*         MACROS MONITOR.
 
 
          ORG    PPFW
 LTP      RJM    PRS         PRESET
          LDD    IR+2
          LPN    77
          NJN    LTP1        IF WRITE
          LJM    RED         PROCESS READ
 
 LTP1     SBN    2
          ZJN    LTP2        IF WRITE LI FORMAT
          LDC    UJNI+WRT8.1-WRTE
          STM    WRTE        DO NOT ADJUST BYTE COUNT
 LTP2     LJM    WRT         PROCESS WRITE
 
 DPP      MONITOR DPPM       DROP PPU
          LJM    PPR         EXIT TO PP RESIDENT
 RED      SPACE  4,10
**        RED - READ DATA FROM TAPE.
*         THIS ROUTINE TRANSFERS CHUNKS 2, 4, 6, ... OF A LONG BLOCK.
*         IT EXITS TO *WSB* AND RETURNS WITH TRANSFER INFORMATION
*         IN *OV* AND *WC* IF IT IS NEEDED TO HELP TRANSFER A BLOCK.
*
*         CALLS  ADP, WDA, WSB.
 
 
 RED      RJM    WSB         WAIT FOR *1MT* TO START BLOCK
 
*         INSURE *1MT* GETS FIRST PORTION OF DATA.
 
          LDC    UJNI+RED10-REDE  SET START OF BLOCK
*         LDC    NJNI+.RED8-.REDB  (ATS NON-CYBER 180)
*         LDC    NJNI+RED8.-REDB.  (CYBER 180 IOU)
 REDA     EQU    *-1
          STM    REDE
*         STM    .REDB       (ATS NON-CYBER 180)
*         STM    REDB.       (CYBER 180 IOU)
 REDF     EQU    *-1
 RED1     IJM    RED12,CH    IF *1MT* COMPLETE
*         UJN    RED3        (ATS NON-CYBER 180)
*         UJN    RED3        (CYBER 180 IOU)
 REDB     EQU    *-2
          FJM    RED2,CH     IF DATA TRANSFER STARTED
          EJM    RED1,CH     IF *1MT* NOT STARTED
 RED2     LDN    40          DELAY TO INSURE *1MT* INTO BLOCK TRANSFER
*         LDN    77          (2X PPU SPEED)
 REDC     EQU    *-1
          SBN    1
          NJN    *-1
 RED3     LCN    2
          RAD    OV
          PJN    RED5        IF INPUT FULL BLOCK
          ADN    1
          PJN    RED4        IF NOT DONE
          LJM    RED12       SEND RESPONSE TO *1MT*
 
 RED4     LDC    NJNI+RED10-REDE
*         LDC    UJNI+.RED8-.REDB  (ATS CONTROLLER)
*         LDC    UJNI+RED8.-REDB.  (CYBER 180)
 REDD     EQU    *-1
          STM    REDE
*         STM    .REDB       (ATS NON-CYBER 180)
*         STM    REDB.       (CYBER 180)
 REDG     EQU    *-1
          LDD    WC
          SHN    2
          ADD    WC
          ADN    1
          UJN    RED6        SET UP TO INPUT DATA
          ERRNZ  RED6-.RED6  IF TAGS OUT OF SYNC
 
 RED5     LDC    LBBY
 
*         THE FOLLOWING CODE IS OVERLAID BY THE ATS INPUT LOOP IF ATS
*         ON A NON-CYBER 180, OR BY THE IOU INPUT LOOP ON A CYBER 180.
 
 .REDA    EQU    *           BEGINNING OF OVERLAID CODE
 
 RED6     STD    BI
          STD    T1          PRESET BYTES REMAINING
 RED7     IJM    RED10,CH    IF *1MT* FINISHED INPUT
 RED8     EJM    RED7,CH     IF *1MT* TAKING DATA
          EJM    RED7,CH     IF *1MT* TAKING DATA
          EJM    RED7,CH     IF *1MT* TAKING DATA
          EJM    RED7,CH     IF *1MT* TAKING DATA
          FJM    RED9,CH     IF TIME FOR *1LT* TO TAKE DATA
          UJN    RED8        LOOP
 
 RED9     IAM    BUFB,CH     INPUT THIS PP,S DATA
          STD    T1
          UJN    RED10       NOT LAST PARTIAL BLOCK
*         NJN    RED10       (IF NOT BLOCK TOO LARGE)
 REDE     EQU    *-1
          DCN    CH+40       TERMINATE TRANSFER
 
 .REDAL   EQU    *-.REDA     LENGTH OF OVERLAID AREA
 
 RED10    LDD    BI          CALCULATE BYTES INPUT
          SBD    T1
          STD    BT
          ADN    4
          STD    T2
          SHN    1           13*BYTES
          ADD    T2
          SHN    2
          ADD    T2
          SHN    14  (-6)    (13*BYTES)/64
          STD    T0
          SHN    6+2         4*13*BYTES  (52*BYTES)
          SBD    T2          51*BYTES
          ADD    T0          (51*BYTES)+((13*BYTES)/64)
          SHN    -8D         WORDS = ((51*BYTES)+((13*BYTES)/64))/256
          STD    WT          WORDS TO TRANSFER
          LDC    /MTX/LBWD   ADVANCE POINTER OVER DATA *1MT* PUT IN
          RJM    ADP
          LDD    WT          ADVANCE POINTER FOR THIS TRANSFER
          RJM    ADP
          RJM    WDA         WRITE DATA
          LDD    BT
          LMC    LBBY
          NJN    RED12       IF NOT FULL BLOCK
          LJM    RED3        LOOP
 
 RED11    LDN    0           SET NO DATA READ
          STD    BT
          STD    WT
 RED12    LDD    MA          SEND RESPONSE TO *1MT*
          CWD    CR
          LJM    RED         WAIT FOR *1MT* TO INDICATE WHAT TO DO
 WRT      SPACE  4,10
**        WRT - WRITE TAPE.
*         THIS ROUTINE TRANSFERS CHUNKS 2, 4, 6, ... OF THE BLOCK.
*         IT EXITS TO *WSB* AND RETURNS WITH TRANSFER INFORMATION
*         IN *OV* AND *WC* IF IT IS NEEDED TO HELP TRANSFER A BLOCK.
*
*         CALLS  ADP, OPA, OPD, OPE, OPI, OPL, RDA, WSB.
 
 
 WRT      RJM    WSB         WAIT FOR *1MT* START INDICATION
          LDD    WC          SET BYTES IN LAST BLOCK
          STD    BI
          ADN    4
          STD    T2
          SHN    1           13*BYTES
          ADD    T2
          SHN    2
          ADD    T2
          SHN    14  (-6)    (13*BYTES)/64
          STD    T0
          SHN    6+2         4*13*BYTES  (52*BYTES)
          SBD    T2          51*BYTES
          ADD    T0          (51*BYTES)+((13*BYTES)/64)
          SHN    -8D         WORDS = ((51*BYTES)+((13*BYTES)/64))/256
          STD    WC
          LDN    0
 WRT1     IJM    WRT9,CH     IF ERROR
          EJM    WRT1,CH     IF DATA TRANSFER NOT STARTED
*         UJN    WRT2        (CYBER 180)
 WRTA     EQU    *-2
 
*         PREPARE TO OUTPUT NEXT CHUNK.
 
 WRT2     LDC    /MTX/LBWD   SKIP CHUNK WRITTEN BY *1MT*
          RJM    ADP
          LDD    OV
          ZJN    WRT5        IF 1LT WILL FINISH
          LCN    2           DECREMENT CHUNK COUNT
          RAD    OV
          NJN    WRT3        IF NOT EVEN MULTIPLE OR NOT DONE
          LDD    BI
          NJN    WRT6        IF NOT FULL CHUNK
          LJM    WRT7        FULL CHUNK WITH TERMINATION
 
 WRT3     SBN    1
          PJN    WRT6        IF NOT COMPLETE
          ADN    1
          MJN    WRT4        IF POSSIBLE PARTIAL BLOCK
          LDD    BI
          ZJN    WRT7        IF TERMINATION BLOCK
          UJN    WRT6        SET UP POINTERS
 
 WRT4     LDD    WC
          NJN    WRT8        IF *1LT* WILL FINISH WRITE
 WRT5     LJM    WRT9        SEND RESPONSE TO *1MT*
 
 WRT6     LDC    /MTX/LBWD   SET UP POINTERS
          RJM    ADP
          RJM    RDA         READ DATA
          LDC    LBBY        OUTPUT DATA
          STD    BT
          RJM    OPD         OUTPUT DATA
*         RJM    OPA         (ATS NON-CYBER 180)
*         RJM    OPI         (CYBER 180)
 WRTB     EQU    *-1
          NJN    WRT9        IF TRANSFER INCOMPLETE
          LJM    WRT2        SET UP TO OUTPUT NEXT CHUNK
 
 WRT7     LDC    LBBY
          STD    BI
          LDC    /MTX/LBWD
 WRT8     RJM    ADP
          RJM    RDA         READ DATA
          LDD    BI
          LPC    7776        WRITE EVEN BYTE COUNT
 WRTE     EQU    *-2
*         UJN    WRT8.1      (NOT LI FORMAT)
          ADN    1
 WRT8.1   RJM    OPD         OUTPUT DATA
*         RJM    OPL         (ATS NON-CYBER 180 - OUTPUT LAST CHUNK)
*         RJM    OPE         (CYBER 180 - OUTPUT LAST CHUNK
 WRTC     EQU    *-1
          FJM    *,CH
          NJN    WRT9        IF INCOMPLETE TRANSFER
          UJN    WRT8.2
 WRTD     EQU    *-1
 
*         DELAY 10 MICROSECONDS TO PREVENT A HARDWARE ERROR IN THE
*         CCC.  THE DISCONNECT WOULD SOMETIMES CAUSE THE LAST BYTE TO
*         BE LOST.
 
*         LDN    20          (CTS)
          SBN    1
          NJN    *-1
 WRT8.2   DCN    CH+40
 WRT9     STD    BT          SAVE BYTES REMAINING
          LDD    MA          SEND RESPONSE TO *1MT*
          CWD    CR
          LJM    WRT         LOOP FOR NEXT BLOCK
          TITLE  SUBROUTINES.
 ADP      SPACE  4,10
**        ADP - ADVANCE POINTER.
*
*         ENTRY  (PT - PT+1) = IN POINTER.
*                (A) = WORDS TO INCREMENT IN POINTER BY.
*
*         EXIT   (T4 - T5) = STARTING IN POINTER.
*                (PT - PT+1) = UPDATED IN POINTER.
*                (T6) = FIRST PART WORD COUNT.
*
*         MACROS SADT.
 
 
 ADP      SUBR               ENTRY/EXIT
          STD    T6
 ADPA     UJN    ADP2        NOT READ SKIP
*         PSN                (READ SKIP)
          LDD    RS
          SHN    14
          LMD    RS+1
          SBD    T6
          PJN    ADP1        IF STILL ROOM FOR ENTIRE BLOCK
          RAD    T6          ADJUST WORD COUNT
          LDN    0           SET BUFFER FULL
 ADP1     STD    RS+1
          SHN    -14
          STD    RS
 ADP2     LDD    PT          SAVE IN
          STD    T4
          LDD    PT+1
          STD    T5
          LDN    0           PRESET SECOND PART WORD COUNT
          STD    T7
          LDD    T6          UPDATE IN
          RAD    PT+1
          SHN    -14
          RAD    PT
          SHN    14
          LMD    PT+1
          SADT   .LM,C
          ADC    -*          (-LIMIT)
          MJN    ADPX        IF NO WRAP AROUND
          STD    T7          SET SECOND PART WORD COUNT
          SADT   .FT
          ADC    *           (FIRST)
          STD    PT+1
          SHN    -14
          STD    PT
          LDD    T6          RESET FIRST PART WORD COUNT
          SBD    T7
          STD    T6
          LJM    ADPX        RETURN
 CPD      SPACE  4,10
**        CPD - CHECK PP DROP OUT.
*
*         ENTRY  (IR+4) = *1MT* INPUT REGISTER ADDRESS.
*
*         EXIT   EXIT TO DPP IF *1MT* GONE.
*
*         USES   CM - CM+4.
 
 
 CPD      SUBR               ENTRY/EXIT
 CPDA     LDC    0           (*ACPP* ADDRESS)
          CRD    CM          GET CP ASSIGNMENT
          LDD    CM+2
          LMD    CP
          NJN    CPD1        IF NOT CORRECT CP ASSIGNMENT
          LDD    IR+4        GET INPUT REGISTER
          CRD    CM
          LDD    CM+1
          SCN    77
          SHN    6
          LMD    CM
          LMC    3RT1M
          NJN    CPD1        IF NOT *1MT*
          LDD    CM+3
          LMD    IR+3
          LPN    37
          ZJN    CPDX        IF CORRECT CHANNEL
 CPD1     LJM    DPP         DROP PPU
 INM      SPACE  4,10
**        INM - INSTRUCTION MODIFICATION.
*
*         ENTRY  (A) = FWA OF INSTRUCTION MODIFICATION LIST.
*
*         NOTE   FET ADDRESS AND BLOCK SIZE ARE NOT AVAILABLE IN *1LT*.
*
*         USES   SC, CM+4, CM+5, T2 - CM+3.
 
 
 INM      SUBR               ENTRY/EXIT
          ZJN    INMX        IF NO MODIFICATIONS
          STD    SC
 INMA     LDC    *           SET FIRST
          STD    .FT+1
          SHN    -14
          STD    .FT
 INMB     LDC    *           SET LIMIT
          STD    .LM+1
          SHN    -14
          STD    .LM
          SBD    .FT
          SHN    14
          ADD    .LM+1
          SBD    .FT+1
          STD    .LF+1
          SHN    -14
          STD    .LF
 INM1     LDI    SC
          ZJN    INMX        IF END OF LIST
          SHN    21-0
          STD    T1          SAVE INSTRUCTION ADDRESS
          SHN    -21
          SHN    1           COMPLEMENT FLAG * 2
          LMC    UJNI+3
          STM    INMC
          LDI    T1          PRESERVE INSTRUCTION OP CODE
          SCN    77
          STI    T1
          LDM    1,SC        EXTRACT DIRECT CELL TO REFERENCE
          SHN    14
          STD    CM+4
          SCN    77          CLEAR DIRECT CELL ADDRESS
          SHN    3           EXTRACT BIAS
          STD    CM+5
          SCN    7           CLEAR BIAS
          ADI    CM+4        ADD UPPER PORTION OF VALUE
          PJN    INM2        IF RELATIVE VALUE DESIRED
          SHN    6
          SCN    40          CLEAR ABSOLUTE FLAG
          ADD    RA
          SHN    14
 INM2     SHN    14
          ADM    1,CM+4      ADD LOWER PORTION OF VALUE
          ADD    CM+5        ADD BIAS
 
*         NOTE CODE SHOULD NOT BE ADDED IN NEXT THREE LINES.
 
 INMC     UJN    3           COMPLEMENT NOT NEEDED
*         UJN    1           COMPLEMENT NEEDED
          LMC    -0
          STM    1,T1        MODIFY INSTRUCTION
          SHN    -14
          RAI    T1
          LDN    2           INCREMENT TO NEXT ITEM IN LIST
          RAD    SC
          LJM    INM1        LOOP
 ITS      SPACE  4,10
**        ITS - INDICATE *1LT* TRANSFER STARTED.
*
*         ENTRY  (A) = BYTE COUNT.
*
*         EXIT   (A) = BYTE COUNT.
 
 
 ITS      SUBR               ENTRY/EXIT
          STD    T0          SAVE BYTE COUNT
          LDD    MA          INDICATE *1LT* TRANSFER STARTED
          ADN    1
          CWD    ZR
          LDD    T0          RESTORE (A)
          UJN    ITSX        RETURN
 OPA      SPACE  4,10
**        OPA - OUTPUT DATA TO ATS UNIT (NON-CYBER 180).
*
*         ENTRY  (A) = NUMBER OF BYTES TO OUTPUT.
*
*         EXIT   (A) = BYTES REMAINING IF INCOMPLETE TRANSFER.
 
 
 OPA      SUBR               ENTRY/EXIT
          AJM    *,CH        WAIT FOR *1MT* TO OUTPUT CHUNK
          PSN                DELAY TO ALLOW *1MT* TO REACTIVE CHANNEL
          PSN
          OAM    BUFB,CH     OUTPUT DATA
          FJM    *,CH
          DCN    CH+40       INDICATE TO *1MT* TO RESUME OUTPUT
          NJN    OPAX        IF INCOMPLETE TRANSFER
          ACN    CH
          UJN    OPAX        RETURN
 OPD      SPACE  4,10
**        OPD - OUTPUT DATA TO MTS UNIT (NON-CYBER 180).
*
*         ENTRY  (A) = NUMBER OF BYTES TO OUTPUT.
*
*         EXIT   (A) = BYTES REMAINING IF INCOMPLETE TRANSFER.
 
 
 OPD2     FJM    OPD1,CH     IF *1MT* OUTPUTTING DATA
          FJM    OPD1,CH     IF *1MT* OUTPUTTING DATA
          FJM    OPD1,CH     IF *1MT* OUTPUTTING DATA
          OAM    BUFB,CH     OUTPUT DATA
 
 OPD      SUBR               ENTRY/EXIT
 OPD1     FJM    OPD1,CH     IF *1MT* OUTPUTTING DATA
          FJM    OPD1,CH     IF *1MT* OUTPUTTING DATA
          UJN    OPD2
 OPI      SPACE  4,10
**        OPI - OUTPUT DATA FROM CYBER 180 IOU.
*
*         ENTRY  (A) = NUMBER OF BYTES TO OUTPUT.
*
*         EXIT   (A) = BYTES REMAINING IF INCOMPLETE TRANSFER.
*
*         CALLS  ITS, WTS.
 
 
 OPI      SUBR               ENTRY/EXIT
          RJM    WTS         WAIT FOR *1MT* TRANSFER TO START
 OPI1     IJM    OPIX,CH     IF *1MT* OUTPUT SHORT CHUNK
          SCF    OPI1,CH     WAIT FOR *1MT* TO CLEAR CHANNEL FLAG
          RJM    ITS         INDICATE *1LT* TRANSFER STARTED
          OAM    BUFB,CH
          NJN    OPIX        IF INCOMPLETE TRANSFER
          CCF    *,CH        SIGNAL *1MT* TO START OUTPUT
          UJN    OPIX        RETURN
 OPE      SPACE  4,10
**        OPE - OUTPUT ENDING CHUNK FROM CYBER 180 IOU.
*
*         ENTRY  (A) = NUMBER OF BYTES TO OUTPUT.
*
*         EXIT   (A) = BYTES REMAINING IF INCOMPLETE TRANSFER.
*
*         CALLS  ITS, WTS.
 
 
 OPE      SUBR               ENTRY/EXIT
          RJM    WTS         WAIT FOR *1MT* TRANSFER TO START
 OPE1     IJM    OPE2,CH     IF *1MT* OUTPUT SHORT CHUNK
          SCF    OPE1,CH     WAIT FOR *1MT* TO CLEAR CHANNEL FLAG
          RJM    ITS         INDICATE *1LT* TRANSFER STARTED
          OAM    BUFB,CH
 OPE2     CCF    *,CH        CLEAR CHANNEL FLAG
          UJN    OPEX        RETURN
 OPL      SPACE  4,10
**        OPL - OUTPUT LAST PARTIAL CHUNK TO ATS UNIT (NON-CYBER 180).
*
*         ENTRY  (A) = NUMBER OF BYTES TO OUTPUT.
*
*         EXIT   (A) = BYTES REMAINING IF INCOMPLETE TRANSFER.
 
 
 OPL      SUBR               ENTRY/EXIT
          AJM    *,CH        WAIT FOR *1MT* TO OUTPUT CHUNK
          PSN                DELAY TO ALLOW *1MT* TO REACTIVATE CHANNEL
          PSN
          OAM    BUFB,CH     OUTPUT LAST PARTIAL CHUNK
          UJN    OPLX        RETURN
 RDA      SPACE  4,10
**        RDA - READ DATA FROM CENTRAL.
*
*         ENTRY  (T4 - T5) = IN POINTER.
*                (T6) = FIRST PART WORD COUNT.
*                (T7) = SECOND PART WORD COUNT.
*
*         MACROS SADT.
 
 
 RDA      SUBR               ENTRY/EXIT
          LDD    T6
          ZJN    RDAX        IF NO FIRST PART
          SHN    2
          ADD    T6
          ADC    BUFB
          STM    RDAA
          LDD    T4          READ FIRST PART
          SHN    6
          ADD    RA
          SHN    6
          ADD    T5
          CRM    BUFB,T6
          LDD    T7
          ZJN    RDAX        IF NO SECOND PART
          SADT   .FT,,,A
          LDC    *           READ SECOND PART
          CRM    *,T7
 RDAA     EQU    *-1
          UJN    RDAX        RETURN
 WDA      SPACE  4,10
**        WDA - WRITE DATA TO CENTRAL.
*
*         ENTRY  (T4 - T5) = IN POINTER.
*                (T6) = FIRST PART WORD COUNT.
*                (T7) = SECOND PART WORD COUNT.
*
*         MACROS SADT.
 
 
 WDA      SUBR               ENTRY/EXIT
          LDD    T6
          ZJN    WDAX        IF NO FIRST PART
          SHN    2
          ADD    T6
          ADC    BUFB
          STM    WDAA
          LDD    T4          TRANSFER FIRST PART
          SHN    6
          ADD    RA
          SHN    6
          ADD    T5
          CWM    BUFB,T6
          LDD    T7
          ZJN    WDAX        IF NO SECOND PART
          SADT   .FT,,,A
          LDC    *           TRANSFER SECOND PART
          CWM    *,T7
 WDAA     EQU    *-1
          UJN    WDAX        RETURN
 WSB      SPACE  4,10
**        WSB - WAIT START OF BLOCK FROM *1MT*.
*
*         USES   CM - CM+4.
*
*         CALLS  CPD, INM.
*
*         MACROS PAUSE.
 
 
 WSB      SUBR               ENTRY/EXIT
 WSB1     LDN    CMCL
          CRD    CM
          LDD    CP
          SHN    -7
          LMD    CM
          NJN    WSB3        IF MOVE FLAG NOT SET FOR THIS CP
          LDD    IR+4        CHECK IF *1MT* PAUSED
          ADN    1
          CRD    CM
          LDD    CM
          ZJN    WSB3        IF NO FUNCTION
          SHN    21-10       CHECK STORAGE MOVE ALLOWED (BIT 56)
          MJN    WSB2        IF STORAGE MOVE ALLOWED
          SHN    10-21       RESTORE BYTE TO ORIGINAL POSITION
          SBN    SMAM
          MJN    WSB3        IF STORAGE MOVE NOT ALLOWED
          SBN    CPUM-SMAM
          PJN    WSB3        IF STORAGE MOVE NOT ALLOWED
 WSB2     PAUSE  NE
          LDC    ADDR        MODIFY INSTRUCTIONS
          RJM    INM
 WSB3     RJM    CPD         CHECK IF *1MT* STILL AROUND
          LDD    MA
          CRD    CC
          LDD    CC
          LMN    1
          NJN    WSB4        IF NOT START OF BLOCK
          STD    CC          ACKNOWLEDGE BLOCK START UP
          LDD    MA
          CWD    CC
          LJM    WSBX        RETURN
 
 WSB4     LMN    3&1
          NJN    WSB5        IF NOT READ SKIP OPERATION
          STD    CC
          STM    ADPA        ENABLE READ SKIP
          LDD    MA          ACKNOWLEDGE TRANSFER
          CWD    CC
          LDD    CC+3        SET AMOUNT OF SPACE IN BUFFER
          STD    RS
          LDD    CC+4
          STD    RS+1
 WSB5     LJM    WSB1        LOOP
 
 ADDR     TSAD               ADDRESS RELOCATION INFORMATION
 WTS      SPACE  4,10
**        WTS - WAIT FOR *1MT* TRANSFER TO START.
*
*         ENTRY  (A) = BYTE COUNT.
*
*         EXIT   (A) = BYTE COUNT.
*
*         USES   CM - CM+4.
*
*         CALLS  CPD.
 
 
 WTS3     LDC    *           (BYTE COUNT)
 WTSA     EQU    *-1
 
 WTS      SUBR               ENTRY/EXIT
          STM    WTSA        SAVE BYTE COUNT
 WTS1     LDD    MA          CHECK *1MT*/*1LT* INTERLOCK
          ADN    1
          CRD    CM
          LDD    CM
          NJN    WTS3        IF *1MT* TRANSFER STARTED
          RJM    CPD         CHECK IF *1MT* PP DROPPED OUT
          LDN    24          DELAY 10 MICROSECONDS
 WTS2     SBN    1
          NJN    WTS2        IF NOT DONE
          UJN    WTS1        CHECK INTERLOCK
          SPACE  4,10
          BUFFER BUFB
          TITLE  PRESET.
 PRS      SPACE  4,10
**        PRS - PRESET.
*
*         CALLS  CPD, INM, MCH.
*
*         MACROS CHTL.
 
 
 PRS      SUBR               ENTRY/EXIT
          LDK    PPCP
          CRD    CM
          LDD    IR+4
          SBD    CM+4
          SHN    PPXES-PPCES SET EXTENDED PP COMMUNICATION BLOCK OFFSET
          STD    T1
          LDD    CM          SET *ACPP* ADDRESS
          SHN    14
          ADD    CM+1
          ADD    T1
          ADK    ACPP
          STM    CPDA+1
          SHN    -14
          RAM    CPDA
          RJM    CPD         CHECK FOR DROP OUT OF *1MT*
          LDD    IR+4        READ PARAMETERS
          ADN    3
          CRD    CM
          LDD    CM+1        SET FIRST
          RAM    INMA
          LDD    CM+2
          STM    INMA+1
          LDD    CM+3        SET LIMIT
          RAM    INMB
          LDD    CM+4
          STM    INMB+1
          LDN    ZERL        SET ACKNOWLEDGE TO *1MT*
          CRD    ZR
          LDD    MA          SET UP FOR REQUESTS FOR *1MT*
          CWD    ZR
          ADN    1           PRESET *1MT*/*1LT* INTERLOCK
          CWD    ZR
          LDN    2
          STD    CR
          LDD    IR+4        TELL *1MT* THAT *1LT* IS LOADED
          ADN    3
          CWD    ZR
          LDD    IR+3        SET MTS/ATS CONTROLLER FLAG
          SHN    14
          STM    PRSA
          STM    PRSB
          SHN    6
          LPN    37
          STD    IR+3
          LDC    TCHS        MODIFY CHANNELS
          STD    T1
          UJN    PRS2        ENTER LOOP TO MODIFY INSTRUCTIONS
 
 PRS1     RAI    T2
          AOD    T1
 PRS2     LDI    T1          MODIFY CHANNEL INSTRUCTIONS
          STD    T2
          LDD    IR+3
          CHTL   *
          SBN    CH
          NJN    PRS1        IF MORE CHANNELS TO MODIFY
          LDC    ADDR        MODIFY INSTRUCTIONS
          RJM    INM
          LDD    IR+2
          SHN    21-7
          PJN    PRS2.1      IF NOT CTS
          LDC    LDNI+20     DELAY BEFORE DISCONNECT
          STM    WRTD
 PRS2.1   LDK    MABL
          CRD    CM
          LDD    CM+1
          SHN    -6
          LPN    41
          LMN    1
          ZJN    PRS3        IF CYBER 180 IOU
          LDD    IR+2
          LPN    77
          NJN    PRS4        IF WRITE
          LJM    PRS6        PRESET FOR READ
 
 PRS3     LJM    PRS9        PRESET FOR CYBER 180
 
 PRS4     LDC    0
 PRSA     EQU    *-1
          SHN    21-4
          PJN    PRS5        IF MTS CONTROLLER
          LDC    OPA         SET ATS OUTPUT ROUTINE
          STM    WRTB
          LDC    OPL
          STM    WRTC
 PRS5     LJM    PRSX        RETURN
 
 PRS6     LDM    DLYA
          LPN    10
          ZJN    PRS7        IF 1X PPU SPEED
          LDC    LDNI+77     RESET DELAY FOR 2X PPU SPEED
          STM    REDC
 PRS7     LDC    0           CHECK CONTROLLER TYPE
 PRSB     EQU    *-1
          SHN    21-4
          PJN    PRS5        IF MTS CONTROLLER
          LDC    NJNI+.RED8-.REDB  MODIFY INSTRUCTIONS
          STM    REDA
          LDC    UJNI+.RED8-.REDB
          STM    REDD
          LDC    UJNI+RED3-REDB
          STM    REDB
          LDC    .REDB
          STM    REDF
          STM    REDG
          LDN    .REDRL-1    MOVE ATS INPUT LOOP
          STD    T1
 PRS8     LDM    .REDR,T1
          STM    .REDA,T1
          SOD    T1
          PJN    PRS8        IF MOVE NOT DONE
          LDC    .REDC       MODIFY CHANNELS
          RJM    MCH
          LJM    PRSX        RETURN
 
*         PRESET FOR CYBER 180.
 
 PRS9     LDC    OPI         MODIFY INSTRUCTIONS
          STM    WRTB
          LDC    OPE
          STM    WRTC
          LDC    NJNI+RED8.-REDB.
          STM    REDA
          LDC    UJNI+RED8.-REDB.
          STM    REDD
          LDC    UJNI+RED3-REDB
          STM    REDB
          LDC    REDB.
          STM    REDF
          STM    REDG
          LDN    REDRL.-1    MOVE IOU LOOP
          STD    T1
 PRS10    LDM    REDR.,T1
          STM    .REDA,T1
          SOD    T1
          PJN    PRS10       IF MOVE NOT COMPLETE
          LDC    REDC.       MODIFY CHANNELS
          RJM    MCH
          LDC    UJNI+WRT2-WRTA  MODIFY *WRTA*
          STM    WRTA
          LJM    PRSX        RETURN
          SPACE  4,10
 TCHS     CHTB               CHANNEL TABLE
          TITLE  PRESET SUBROUTINES.
 RED      SPACE  4,10
**        ATS INPUT LOOP (NON-CYBER 180).
 
 
 .REDR    BSS    0
          LOC    .REDA
 
 .RED6    AJM    *,CH        WAIT FOR *1MT* TO DCN CHANNEL
          STD    BI          SAVE BYTES TO INPUT
          STD    T1
 .RED7    IJM    RED11,CH    IF *1MT* FINISHED INPUT
          EJM    .RED7,CH    IF DATA NOT AVAILABLE
          IAM    BUFB,CH
          DCN    CH+40       INDICATE TO *1MT* TO CONTINUE READ
 .REDB    NJN    .RED8       IF END OF BLOCK
*         UJN    .RED8       (LAST PARTIAL BLOCK BEING READ)
          ACN    CH
 .RED8    STD    T1          SAVE BYTES REMAINING
 .RED9    IJM    RED10,CH    IF *1LT* FINISHED INPUT
          EJM    .RED9,CH    IF *1MT* NOT TAKING DATA YET
          UJN    RED10       COMPUTE WORD COUNT
 
          LOC    *O
 .REDRL   EQU    *-.REDR     LENGTH OF ATS INPUT LOOP
 
          ERRMI  .REDAL-.REDRL  OVERLAID CODE OVERFLOWED
 MCH      SPACE  4,10
**        MCH - MODIFY CHANNELS.
*
*         ENTRY  (A) = ADDRESS OF CHANNEL TABLE
*
*         USES   T1, T2.
*
*         MACROS CHTL.
 
 
 MCH1     RAI    T2
          AOD    T1
 MCH2     LDI    T1
          STD    T2
          LDD    IR+3
          CHTL   *
 MCHA     SBN    CH
          NJN    MCH1        IF MORE CHANNEL TO MODIFY
 
 MCH      SUBR               ENTRY/EXIT
          STD    T1          SAVE ADDRESS
          UJN    MCH2        ENTER LOOP TO MODIFY CHANNELS
 
 .REDC    CHTB               CHANNEL TABLE FOR ATS INPUT LOOP
 RED      SPACE  4,10
**        IOU INPUT LOOP (CYBER 180).
 
 REDR.    BSS    0
          LOC    .REDA
 RED6.    STD    BI          SAVE BYTES TO INPUT
          STD    T1
          RJM    WTS         WAIT FOR *1MT* TRANSFER TO START
 RED7.    IJM    RED11,CH    IF *1MT* FINISHED INPUT
          SCF    RED7.,CH    WAIT FOR *1MT* TO READ ITS CHUNK
          RJM    ITS         INDICATE *1LT* TRANSFER STARTED
          IAM    BUFB,CH
          NJN    RED8.       IF INCOMPLETE TRANSFER
*         UJN    RED8.       LAST TRANSFER
 REDB.    EQU    *-1
          CCF    *,CH        SIGNAL *1MT* TO CONTINUE INPUT
 RED8.    STD    T1
          UJN    RED10       COMPUTE WORD COUNT
 
          LOC    *O
 REDRL.   EQU    *-REDR.     LENGTH OF IOU INPUT LOOP
 
          ERRMI  .REDAL-REDRL.         OVERLAID CODE OVERFLOWED
 
          CHTL   MCHA
 REDC.    CHTB               CHANNEL TABLE FOR IOU INPUT LOOP
          SPACE  4,10
          TTL    1MT - PPU MAGNETIC TAPE EXECUTIVE.
          END