1MT 
          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 
