0002           CTL  641111
0003           ORG  087                DEFINE INDEX REGISTERS
0004 INDEX1    DCW  @000@
0005           ORG  092
0006 INDEX2    DCW  @000@
0007           ORG  097
0008 INDEX3    DCW  @000@
0009           ORG  83
0010 BL        DCW  @   @              BLOCK LENGTH
0011 CNOP      DCW  @ @                NUMBER OF MOVES TO OUTPUT AREA
0012 *                                  NEEDED IN ADDITION TO NCF
0013           ORG  90
0014 DESCND    DCW  @ @                COLLATING SEQUENCE OF OUTPUT
0015 FLR            @ @                RECORD FORMAT INDICATOR
0016           ORG  95
0017 NCF       DCW  @  @               NUMBER OF CONTROL FIELDS
0018           ORG  183
0019 BO        DCW  @   @              OUTPUT BLOCKING FACTOR
0020 URPI      DCW  @ @                UNREADABLE RECORD PROCEDURE
0021 LDI            @ @                DENSITY INDICATOR
0022 ITLI           @ @                INPUT TAPE LABEL INDICATOR
0023 OTLI      DCW  @ @                OUTPUT TAPE LABEL INDICATOR
0024 HTMO      DCW  @ @                TAPE MARK AFTER OUTPT HDR LBL
0025 TL             @ @                INPUT TRAILER LABEL INDICATOR
0026 TLO            @ @                TRAILER LABEL OPTION
0027 PI        DCW  @ @                PADDING INDICATOR
0028 RCDIST    DCW  @000@              3 DIGIT POS OF RCC
0029 B              @   @              SORT BLOCKING FACTOR
0030           ORG  335
0031 CFIRE     DCW  @001@              RIGHT EDGE OF CF1
0032 I1TUN     DCW  @ @                WORK TAPE UNIT NUMBERS
0033 I2TUN          @ @                2ND INPUT TAPE UNIT
0034 I3TUN          @ @                3RD INPUT TAPE UNIT
0035 MI1TUN         @ @                1ST WORK TAPE UNIT
0036 MI2TUN         @ @                2ND WORK TAPE UNIT
0037 MI3TUN         @ @                3RD WORK TAPE UNIT
0038 MS             @ @                MACHINE SIZE
0039 L              @   @              RECORD LENGTH
0040 GPMARK         @I9Y@              GROUPMARK-WORDMARK LOCATION
0041 CF1SL          @   @              CONTROL FIELD STARTING LOCNS
0042 CF2SL          @   @              3 CHAR HIGH ORDER POSITIONS
0043 CF3SL          @   @              TAKEN FROM CONTROL CARDS
0044 CF4SL          @   @
0045 CF5SL          @   @
0046 CF6SL          @   @
0047 CF7SL          @   @
0048 CF8SL          @   @
0049 CF9SL          @   @
0050 CF0SL          @   @
0051 IF1F2          @   @              DISTANCE BETWEEN CONTROL FIELDS
0052 IF2F3          @   @
0053 IF3F4          @   @
0054 IF4F5          @   @
0055 IF5F6          @   @
0056 IF6F7          @   @
0057 IF7F8          @   @
0058 IF8F9          @   @
0059 IF9F0          @   @
0060 TPAVLM         @     @            USER AREA ADDRESS PHASE 2
0061 LABELS    DCW  @ @                WORKTAPE LABEL INDICATOR
0062 LBBUCK    DCW  @ @
0063 CENSIG    DCW  @ @
0064 UNLOAD    DCW  @ @                REWIND AND UNLOAD OPTION
0065 WLBKT     DCW  @ @                WORK TAPE HEADER LABEL INDICATOR
0066 THLTMO    DCW  @ @                TAPEMARK INDICATOR -WORK TAPES
0067 OHLOP     DCW  @ @                OUTPUT HEADER CHECKING INDICATOR
0068 FLSROP    DCW  @ @                FILE SERIAL INDICATOR
0069 RLSQOP    DCW  @ @                REEL SEQUENCE UPDATE INDICATOR
0070 TPSROP    DCW  @ @                TAPE SERIAL ASSGMNT INDICATOR
0071 HDRTAG    DCW  @1HDR @            HEADER TAG OF OUTPUT HDR CARD
0072 TPSERL    DCW  #5                 NEW TAPE SERIAL NO.
0073 FLSERL    DCW  #5                 OUTPUT HEADER FILE SERIAL NO.
0074           DC   @-@
0075 REELSQ    DCW  #3                 OUTPUT HDR REEL SEQUENCE NO.
0076           DC   @ @
0077 FLNAME    DC   #10                OUTPUT HEADER FILE NAME
0078 OHDATE    DC   @     @            OUTPUT HEADER DATE
0079           DC   @-@
0080 RTCYCL    DC   #3                 RETENTION CYCLE BUCKET
0081           DC   @ @
0082           DCW  #1
0083 LBLBKT    DCW  #33                INPUT HEADER LABEL BUCKET
0084 DATE      DCW  #5                 CURRENT DATE- YEAR AND DAY
0085           DCW  #25
0086 RCMKPI    DCW  @ @                RECORD MARK IN PADDING RECORDS
0087 CNSQ           @      @           SEQUENCE COUNT
0088 CTNR      DCW  @      @           RECORD COUNT
0089 CNOS1          @      @           TAPE SWITCH COUNT
0090 PDCPUT    DCW  000                PAD COUNT
0091 OUTMOD    DCW  @M@                OUTPUT MODE
0092 CSTCNS    DCW  @I7V@              PH2 3 POS. USER AREA
0093 STRTMP    ORG  *
0094 RTAIN     DCW  @ @                RETAIN RCC OPTION
0095 COMET     DCW  @   @
0096 COMETF    DCW  #3
0097 RLIIND    DCW  @ @
0098 KRUNCH    DCW  @ @                VLR LOAD MODE INPUT IND IF RLI
0099 *                               NOT IN FIRST RCD POS AND NOT CF
0100 STPH2     ORG  *
0101 INMODE    DCW  @M@                INPUT MODE-M- UNLESS SPECIFIED
0102 LRG2G1    DCW  @   @
0103 TPV1      DCW  #3                 PH1 3 POS USER AREA
0104 INTOUT    DCW  000
0105 LBLSAM    DCW  @ @                IF 1 - INP HDR IS OPT HDR
0106 CCB       DCW  @   @              16K COMPLEMENT OF SORT BL FAC
0107 C16000         16000
0108 K16000         16000
0109 TCOMET    DCW  @12100@
0110 TCOMTF    DCW  @12100@
0111 KLTD           5520000
0112 KTD            15350000
0113 KHTD      DCW  @22080000@
0114 KKK3      DCW  #1
0115 EXPAND    SBR  CZONE&10            CONVERT THREE DIGIT ADDRESS
0116           MLC  CONVRT,CONSTX       TO FIVE DIGIT NUMBER
0117           MLC  @00   @,HOLD
0118           MLNS CONVRT,HOLD
0119           MLNS
0120           MLNS
0121 CZONE     C    HOLD,CONSTX
0122           BE   0
0123           MA   @?0?@,CONSTX
0124           A    @1@,HOLD-3
0125           B    CZONE
0126 CONSTX    DCW  #3
0127           LTORG*
0128 HOLD      DCW  #5
0129 CONVRT    DCW  #5
0130           ORG  3975
0131 MFS       DCW  @       @          MAXIMUM FILE SIZE
0132 NOINTP    DCW  @  @               NUMBER OF INPUT TAPES
0133 BI             @   @              INPUT BLOCKING FACTOR
0134 TLCF           #3                 TOTAL LENGTH OF ALL CONTROL FLDS
0135 MINREC         @   @              MINIMUM RECORD LENGTH
0136 MAXBLK         @   @              MAXIMUM BLOCKING FACTOR
0137 EFS            @       @          ESTIMATED FILE SIZE
0138 COMPL          @   @              COMP OF L
0139 CMNREC         @   @              COMP OF MIN RECORD
0140 CMXBLK         @   @              COMP OF MX BLK SIZE
0141 CF1RE          @   @              UNITS LOCATION OF CONTROL FIELD
0142 CF2RE          @   @
0143 CF3RE          @   @
0144 CF4RE     DCW  @   @
0145 CF5RE          @   @
0146 CF6RE          @   @
0147 CF7RE          @   @
0148 CF8RE          @   @
0149 CF9RE          @   @
0150 CF0RE          @   @
0151 CCCFRE         @   @
0152 FSLST     DCW  CF2SL               ADD 3 TO THIS FOR EACH CTL FIELD
0153 K5TOK3    SBR  CMBCK&3             CONVERT FIVE DIGIT NUMBER
0154           MLZS @1@,CONVRT          TO THREE DIGIT ADDRESS
0155 SUBBB     S    @1@,CONVRT-3
0156 CMBCK     BM   0,CONVRT-3
0157           MA   @|00@,CONVRT
0158           B    SUBBB
0159 PRMSX     DCW  @OVERSIZE INPUT BLOCKING-RESTART@
0160 DELEXC    DCW  @ @
0161 PRMDIN    DCW  @ @                INPUT MODE
0162 PRMDOT    DCW  @ @                OUTPUT MODE
0163 SLRCC     DCW  #3
0164 UAPHZ1    DCW  #5                 USER AREA PHASE 1
0165           LTORG*
0166           ORG  700
0167 READCC    CS   80
0168           R                       READ CONTROL CARD #1
0169           CS   332
0170           CS
0171           SW   201
0172           MLC  080,280
0173           W                       PRINT CONTENTS OF CONTROL CARD
0174           CC   K
0175           BCE  NEXTST,027,4       CLEAR STORAGE ABOVE 8K
0176           BCE  NEXTST,27,
0177           BCE  CLR12,027,5
0178 CLR       CS   15999
0179           SBR  CLR&3
0180           BWZ  NEXTST,CLR&3,S
0181           B    CLR
0182 CLR12     SBR  CLR&3,11999
0183           B    CLR
0184 *                                 PLACE CONTROL CARD CONSTANTS
0185 *                                 IN DEFINED AREAS
0186 NEXTST    MLC  57,FLR             FIXED OR VARIABLE LENGTH RECORDS
0187           MLC  75                 COLLATING SEQUENCE
0188           MLC  29,NCF             TOTAL NUMBER OF CONTROL FIELDS
0189           MLC  26,PI              PADDING INDICATOR CHARACTER
0190           MLC                     OUTPUT TR LAB INDICATOR
0191           MLC                     INPUT TRAILER LABEL BUCKET
0192           MLC                     TAPEMARK ON OUTPUT HDR LAB
0193           MLC                     OUTPUT HEADER LAB INDICATOR
0194           MLC                     INPUT TAPE HEADER LABEL INDICATOR
0195           MLC                     DENSITY INDICATOR
0196           MLC                     UNREADABLE RECORD PROCEDURE
0197           MLC                     OUTPUT BLOCKING FACTOR
0198           SW   58,30
0199           MLC  61,CONVRT          CONVERT RCC TO 3 DIGIT
0200           B    K5TOK3
0201 IRENE     MLC  CONVRT,RCDIST
0202           MLC  27,MS              MACHINE SIZE
0203           MLC  6                  INITIALIZE TAPE BUCKETS
0204           MLC                     6 TO MI3TUN,5 TO MI2TUN
0205           MLC                     4 TO MI1TUN, 3 TO I3TUN
0206           MLC                     2 TO I2TUN, 1 TO I1TUN
0207           MLC
0208           MLC
0209           MLC  12,L4              RECORD LENGTH
0210           MLC  32,TLCF            TOTAL LENGTH OF CONTROL FIELDS
0211           MLC  15                 INPUT BLOCKING FACTOR
0212           MLC  8                  NUMBER OF INPUT TAPES
0213           CW   58,30
0214           MLC  69,MXBLK4          LARGEST INPUT BLOCK-VARIABLE
0215           MLC                     SMALLEST INPUT RECORD
0216           MLC  46,EFS             ESTIMATED FILE SIZE
0217           MLC  51,UAPHZ1          USER AREA PH1 STARTING ADDRESS
0218           BCE  *&30,UAPHZ1,
0219           B    *&8                THIS ROUTINE IS INITIALIZED FOR
0220           NOP  0,0                THE TAPE LOADABLE VERSION
0221           MLC  UAPHZ1,CONVRT
0222           B    K5TOK3
0223           MLC  CONVRT,TPV1
0224           MLC  56,TPAVLM          STARTING ADDR USER AREA PH2
0225           MLC  39,NC1CF           FIRST CONTROL FIELD SPECIFIC.
0226           MLC                     STARTING LOCATION OF CF1
0227           MLC  74,RCMKPI          RECORD MARK IN PADDING RECORDS
0228           MLC  73,MAXBLO          LARGEST OUTPUT BLOCK
0229           MLC  61,RCC4#4          RECORD COUNT LOW ORDER
0230           BCE  NXTINA,FLR,        BLANK-FIXED  1-VARIABLE
0231           C    015,@001@          001 IF UNBLOCKED VARIABLE INPUT
0232           BU   SPCRLI             IF BLOCKED CHECK FOR RCC
0233           BCE  *&5,MXBLK4,        IF 66-69 BLANK  L4 LOADED
0234           B    *&8                INTO MXBLK4
0235           MLC  L4,MXBLK4
0236 CKOT      C    018,@001@          001 IF UNBLOCKED OUTPUT
0237           BU   NXTINA
0238           BCE  *&5,MAXBLO,        IF 70-73 BLANK   L4 LOADED
0239           B    *&8                INTO MAXBLO
0240           MLC  L4,MAXBLO
0241 NXTINA    C    25,BLNK5           BLANK IF NO HEADER OR TRAILER
0242           BE   *&8                LABELS SPECIFIED ON CC1
0243           MLC  @1@,LABELS         SET LABEL INDICATOR
0244           BCE  WDMKST,24,4
0245           BCE  WDMKST,24,3        CHECK FOR 120 CHARAC
0246           BCE  WDMKST,22,4
0247           BCE
0248           BCE  WDMKST,22,3
0249           BCE
0250           B    *&30
0251 WDMKST    CW   REELSQ-2,FLSERL-4
0252           CW   HDRTAG&1
0253           MLC  @1@,LBBUCK
0254           SW   FILNAM&1,FILESE&1
0255           SW   SYSCRE&1
0256           SW   6,3
0257           SW
0258           SW
0259 *                               SCAN CONTROL CARD ONE FOR INVALID
0260 *                               CHARACTERS
0261           C    36,@0000@          CHECK COLUMNS 33-36
0262           BL   *&5                CF1 LOCATION CANNOT BE ZERO OR AN
0263           B    ERMCD              ALPHABETICAL CHARACTER
0264           SBR  INDEX1,0
0265           SBR  INDEX2,1
0266           SBR  INDEX3,12
0267           MLC  @13-18@,ZQST
0268           C    BI,@000@           CHECK COLUMNS 13-18
0269           BE   ERMCD
0270           C    BO,@000@
0271           BE   ERMCD
0272           BCE  RTOUR,FLR,
0273           C    15,@   @           BLANK IF BLOCKED VARIABLE INPUT
0274           BE   CM18TB
0275           C    15,@001@           UNBLOCKED VARIABLE RECORDS
0276           BU   ERMCD
0277 CM18TB    MLC  @000@,215
0278           C    18,@   @           BLANK IF BLOCKED VARIABLE OUTPUT
0279           BE   RTOUR
0280           C    18,@001@           UNBLOCKED VARIABLE OUTPUT
0281           BU   ERMCD
0282 RTOUR     MLC  @000@,218
0283           MLC  @0@,203
0284           MLC  @0@,206
0285           MLC  @0@,27
0286           MLC  @01-06@,ZQST
0287           BCE  ERMTP,2,           CHECK COLUMNS 1-6
0288           BCE                     COL 1,2,4,5 MUST BE SPECIFIED
0289           BCE  ERMTP,5,           COL 3 MUST BE SPECIFIED IF 6
0290           BCE                     IS SPECIFIED.6 IS SPECIFIED FOR
0291           BCE  ABZX,6,            3-WAY MERGE
0292           BCE  ERMTP,3,
0293           B    BRXQ
0294 ABZX      BCE  *&5,3,
0295           B    ERMTP
0296           MLC  @8@,3
0297           MLC  @9@,6
0298 BRXQ      C    1&X1,1&X2          CHECK FOR MULTIPLE USE
0299           BE   ERMTP              OF A TAPE DRIVE
0300           C    1&X1,2&X2
0301           BE   ERMTP
0302           C    1&X1,3&X2
0303           BE   ERMTP
0304           C    1&X1,4&X2
0305           BE   ERMTP
0306 CBC       C    1&X1,5&X2
0307           BE   ERMTP
0308           MA   @001@,INDEX1
0309           MA   @001@,INDEX2
0310           MA   @I8H@,INDEX3
0311           MLC  @N@,CBC&X3
0312           A    @1@,CNTER1#1
0313           C    CNTER1,@5@
0314           BH   BRXQ
0315           MLC  @000@,INDEX1
0316           MLC  I3TUN,3
0317           MLC  MI3TUN,6
0318 RRDC      C    1&X1,@6@           CHECK FOR ANY DRIVE NUMBER
0319           BL   ERMTP              HIGHER THAN 6
0320           MA   @001@,INDEX1
0321           C    INDEX1,@6@
0322           BH   RRDC
0323           MLC  @ 19  @,ZQST
0324           BCE  CQZ,19,C           CHECK COLUMN 19
0325           BCE  CQZ,19,P
0326           C    19,@0@
0327           BL   *&8
0328           MLC  @1@,SWP#1
0329           C    19,@7@
0330           BH   *&8
0331           MLC  @1@,SWP
0332           BCE  CQZ,URPI,
0333           SBR  INDEX1,0
0334 INDXUR    C    URPI,1&X1
0335           BU   ZZRQ               CK URPI WITH I/O TP UNITS
0336           MLC  @1@,ERM6SW#1
0337 ZZRQ      MA   @001@,INDEX1
0338           C    INDEX1,@6@
0339           BH   INDXUR
0340 CQZ       MLC  @0@,219
0341           MLC  @58-73@,ZQST
0342           MLC  @000@,INDEX1       CHECK COLUMNS 58-73
0343           MLC  @0@,227
0344           SW   BLNK5-3
0345 CMBLN     C    61&X1,BLNK5
0346           BU   *&8
0347           MLC  TSERO,261&X1
0348           MA   @004@,INDEX1
0349           C    INDEX1,@16@
0350           BH   CMBLN
0351           CW   BLNK5-3
0352           MLC  @001@,INDEX1
0353           MLC  @ 21  @,ZQST
0354           B    OKIND              CHECK COLUMNS 21-25
0355           MLC  @22@,ZQST-2
0356           B    OKIND
0357           MLC  @23@,ZQST-2
0358           MLC  @N@,BRNON4
0359           MLC  @N@,BRNON3
0360           MLC  @N@,BRNON2
0361           B    OKIND
0362           MLC  @24@,ZQST-2
0363           MLC  @B@,BRNON2
0364           MLC  @B@,BRNON3
0365           MLC  @B@,BRNON4
0366           B    OKIND
0367           MLC  @25@,ZQST-2
0368           MLC  @N@,BRNON3
0369           MLC  @N@,BRNON4
0370           B    OKIND
0371           MLC  @26@,ZQST-2
0372           MLC  @9@,BRNON2&7       CHECK COLUMN 26
0373           MLC  @N@,BRNON1
0374           B    OKIND
0375           MLC  @57@,ZQST-2
0376           MLC  @B@,BRNON1         CHECK COLUMN 57
0377           MLC  @N@,BRNON2
0378           MA   @030@,INDEX1
0379           B    OKIND
0380           MLC  @74@,ZQST-2
0381           MA   @016@,INDEX1
0382           B    OKIND              CHECK COLUMNS 74,75, AND 20
0383           MLC  @75@,ZQST-2
0384           B    OKIND
0385           MLC  @20@,ZQST-2
0386           MA   @I4D@,INDEX1
0387           MLC  @0@,BRNON&7
0388           MLC  @2@,BRNON2&7
0389           MLC  @B@,BRNON2
0390           B    OKIND
0391           MLC  @28-29@,ZQST
0392           C    NCF,@10@           CHECK COLUMNS 28-29
0393           BL   ERMCF
0394           C    NCF,@00@
0395           BE   ERMCF
0396           BCE  ERMCF,NCF,
0397           BCE  ERMCF,NCF-1,
0398           MLC  @07-08@,ZQST
0399           C    NOINTP,@00@        CHECK COLUMNS 7-8
0400           BE   ERMRL
0401           BCE  ERMRL,NOINTP,
0402           BCE  ERMRL,NOINTP-1,
0403           C    46,@       @       IS EXPECTED FL SZ KNOWN
0404           BU   *&8
0405           MLC  @0000000@,246
0406           MLC  @000@,INDEX1
0407 CMUSAR    C    51&X1,BLNK5
0408           BU   *&8
0409           MLC  TSERO,251&X1
0410           MA   @005@,INDEX1
0411           C    INDEX1,@2@
0412           BL   CMUSAR
0413           MLC  @000@,INDEX1
0414           MLC  @N@,QZWRT
0415           B    CSCAN
0416           BCE  ERMDP,SWP,1
0417 ZZGX      BCE  ERMS6,ERM6SW,1
0418 *                               ESTABLISH AVAILABLE PHASE 2 AREA
0419 BTPVLM    BCE  DUMMY,TPAVLM,      BRANCH IF NO PH2 USER AREA
0420           MLC  TPAVLM,CONVRT
0421           B    K5TOK3
0422           MLC  CONVRT,CSTCNS
0423           MA   @I9I@,CSTCNS
0424           B    REWND1
0425 DUMMY     BCE  REWND1,MS,
0426           BCE  REWND1,MS,4
0427           MA   @00|@,CSTCNS
0428           BCE  REWND1,MS,5
0429           MA   @00|@,CSTCNS
0430 REWND1    MLC  I1TUN,*&4          REWIND TAPES
0431           RWD  0
0432           MLC  I2TUN,*&4
0433           RWD  0
0434           BSS  PLYIN1,C
0435           BCE  RWD2WY,MI3TUN,
0436           MLC  I3TUN,*&4
0437           RWD  0
0438           MLC  MI3TUN,*&4
0439           RWD  0
0440 RWD2WY    MLC  MI1TUN,*&4
0441           RWD  0
0442           MLC  MI2TUN,*&4
0443           RWD  0
0444           BCE  ONECF,NCF,1        BRANCH IF ONE CONTROL FIELD
0445 *
0446 *                   READ THE SECOND CONTROL CARD
0447 *
0448           CS   80                 ONLY READ IF MORE THAN 1 CF
0449           R
0450           SW   1
0451           CS   332
0452           CS
0453           MLC  080,280
0454           W
0455           CC   K
0456           MLC  63,70              SHIFT CONTROL CARD 7 POSITIONS
0457           MLC  NC1CF,7            MOVE FIRST CONTROL FIELD
0458           MLC                     CONSTANTS TO READ AREA
0459           SW   5                  WORD MARKS SET FOR CONTROL
0460           SW   8,12               FIELD POSITIONS AND LENGTHS
0461           SW   15,19
0462           SW   22,26
0463           SW   29,33
0464           SW   36,40
0465           SW   43,47
0466           SW   50,54
0467           SW   57,61
0468           SW   64,68
0469           SBR  INDEX1,0
0470           MLC  @2@,QRS
0471 ADDNCF    A    @1@,NCFCT          TEST FOR VALID NUMBER OF CFS
0472           A    @7@,CDLNG
0473           C    NCF,NCFCT
0474           BL   ADDNCF
0475           MLC  @NCF INVALIDLY SPECIFIED@,PRMCD
0476           B    CSCAN
0477           MLC  @OUT OF SEQUENCE        @,PRMCD
0478 CHKCFL    C    NCF,CNTNCF         COMPUTE TOTAL LENGTH OF CON FIELD
0479           BE   CCTLCF
0480 ANCCF     A    7,CTLCF
0481           MA   @007@,ANCCF&3
0482           A    @1@,CNTNCF
0483           B    CHKCFL
0484 CCTLCF    C    TLCF,CTLCF          COMPARE TOT LNGH OF CON FIELD
0485           BE   CLTLCF              WITH COMPUTED VALUE
0486 ERRMS4    CS   332
0487           CS
0488           MLC  PRMS4,244
0489           W
0490           CC   1
0491           H    *&1                PRESS START TO ACCEPT COMPUTED
0492           B    CLTLCF             VALUE
0493 CNOP1     MLC  @1@,CNOP
0494           B    CRE
0495 ONECF     C    TLCF,NC1CF
0496           BU   ERRMS4
0497 CLTLCF    MLC  CTLCF,CTLCF4
0498           C    CTLCF4,L4
0499           BL   ERRMS5
0500           MLC  @  @,COUNT2
0501 CKURPI    BCE  SNGLCF,NCF,1
0502           SBR  INDEX1,0
0503           SBR  INDEX2,0
0504 CCFXSL    ZA   4&X2,CONVRT         CONVERT STARTING LOCATION OF
0505           B    K5TOK3              CONTROL FIELDS TO 3 DIGITS
0506           MLC  CONVRT,CF1SL&X1
0507           C    CONVRT,@001@        SEE IF A CTL FLD STARTS IN COL 1
0508           BE   CNOP1
0509 CRE       MLC  CONVRT,CF1RE&X1     COMPUTE RIGHT EDGE
0510           MA   7&X2,CF1RE&X1       OF CONTROL FIELDS
0511           MA   @I9H@,CF1RE&X1
0512           MLC  CF1RE&X1,CONVRT     EXPAND RIGHT EDGE TO 4 DIGITS
0513           B    EXPAND
0514           MLC  HOLD,CF1REX
0515           MA   @004@,*-7
0516           MA   @003@,FSLST
0517           MA   @007@,INDEX2
0518           MA   @003@,INDEX1
0519           A    @1@,COUNT2
0520           C    NCF,COUNT2
0521           BL   CCFXSL
0522           MA   CF1RE,CFIRE
0523           MLC  C16000,CONVRT
0524           S    CF1REX,CONVRT
0525           B    K5TOK3
0526           MLC  CONVRT,CCCFRE
0527           SW   LBLBKT-32,LBLBKT-30
0528           SW
0529 *
0530 *                     READ THIRD CONTROL CARD
0531 *
0532           B    *&8                CC3 MAY BE OMITTED IF BLANK
0533 READC3    MLC  @1@,SW13
0534           CS   080
0535           R
0536           SBR  INDEX1,0
0537 VRE       BCE  RUTN,1,,           BRANCH IF BOOTSTRAP CARD READ
0538           SW   1
0539           MLCWA80,280
0540           W
0541           CC   K
0542           BCE  BRZAQ,SW13,1       TEST TO DETERMINE IF CONTROL
0543           C    TSINK,223          CARD IS 3,4, OR 5
0544           BU   CARYON
0545           SW   221
0546           C    TSINK,250
0547           CW   221
0548           BE   READC3
0549 CARYON    SW   224
0550           C    TSINK,250
0551           CW   224
0552           BE   LBBQ               BRANCH IF CC3
0553 BRZAQ     C    TSINK,250
0554           BE   ERRCC
0555           BCE  *&17,SW14,1
0556           BCE  RDIH,ITLI,2        BRANCH IF CONTROL CARD
0557           BCE  RDIH,ITLI,4        #4 IS TO BE READ
0558           BCE  *&17,SW15,1
0559           BCE  RDOH,OTLI,2        BRANCH IF CONTROL CARD
0560           BCE  RDOH,OTLI,4        #5 SHOULD BE PRESENT
0561           B    ERRCC
0562 LBBQ      MLC  @3@,QRS            BEGIN CC3 ROUTINE HERE
0563           MLC  @23@,CDLNG
0564 LBBWZ     BWZ  *&5,201&X1,2
0565           B    ERMCD
0566           MA   @001@,INDEX1
0567           C    INDEX1,CDLNG
0568           BH   LBBWZ
0569           BCE  *&23,4,            BRANCH IF WORK TAPES DO NOT
0570           MLC  @1@,LABELS         CONTAIN HEADER LABELS
0571           BCE  *&8,4,1            CHECK FOR 120 CHARACTER LABELS
0572           MLC  @1@,LBBUCK         ON INPUT TAPE
0573           MLC  3,PRMDOT           MOVE CONSTANTS FROM CC#3
0574           MLC                     TO RESPECTIVE BUCKETS
0575           BCE  MVCN2,PRMDIN,      BRANCH IF INPUT IN MOVE MODE
0576           MLC  @L@,INMODE
0577           BCE  MVCN2,FLR,         BRANCH IF FLR
0578           BCE  MVCN2,RCC4,        BRANCH IF NO RLI
0579           MLC  1,KKK3
0580           BCE  MVCN2,KKK3,3       RECORD CHARACTER COUNT MUST BE
0581           BCE  MVCN2,KKK3,4       EITHER 3 OR 4 CHARACTERS
0582           B    ERRLI
0583 MVCN2     BCE  *&8,PRMDOT,        BRANCH OUTPUT IN MOVE MODE
0584           MLC  @L@,OUTMOD
0585 TCD3      MLC  18,TPSROP          OUTPUT TAPE SERIAL OPTION
0586           MLC                     OUTPT HEADER REEL INCREMENT
0587           MLC                     OUTPT HEADER FILE SERIAL
0588           MLC                     OUTPT HEADER CHECKING
0589           MLC  5                  WK TAPE HEADER LABEL TAPEMARK
0590           MLC  4                  WORK TAPE HEADER LABEL
0591           MLC  11                 UNLOAD OPTION
0592           MLC  10,DATE            RUN DATE INDICATED IN CC3
0593           MLC  12,RTAIN           RETENTION CYCLE FROM CC
0594           MLC  14,LBLBKT-30       REEL SEQUENCE INCREMENT OPTION
0595           MLC                     HEADER CHECK-ALL OPTION
0596           BCE  *&12,LBBUCK,
0597           MLC  22,SYSCRE
0598           B    READC3
0599           MLC  23,TPSERL          NEW TAPE SERIAL NUMBERS
0600           B    READC3             READ NEXT CARD
0601 CTLCF4    DCW  @0000@
0602 TEMP      DCW  @                     @
0603                0
0604 DVR            @                    @
0605 DVD            @                     @
0606 QUOT      EQU  DVD
0607 NEW       DCW  @0@
0608 QSS            @ @
0609 RMDRSN         1
0610 INDEX          0?
0611 LOC       DSA  DVD-31
0612 RUTN      BCE  *&17,SW11,1        CHECK TO SEE IF ALL CONTROL CARDS
0613           BCE  ERRLBL,ITLI,2      NEEDED HAVE BEEN READ PRIOR TO
0614           BCE  ERRLBL,ITLI,4      BOOTSTRAP CARD
0615           BCE  *&17,SW12,1
0616           BCE  ERRLBL,OTLI,2
0617           BCE  ERRLBL,OTLI,4
0618           MLC  @B@,LDXQ
0619           MLC  @N@,SETWM
0620           BCE  LAB120,LBBUCK,1
0621           BCE  *&8,DATE,          BRANCH IF NO DATE SPEC ON CC3
0622 DATE80    MLC  DATE,OHDATE
0623           BCE  MVOHDT,ITLI,
0624           C    OTLI,@1@
0625           BU   *&8
0626           MLC  @1@,LBLSAM
0627           C    OTLI,@3@           CONTROL PORTION OF 120 CHAR LABEL
0628           BU   *&8
0629           MLC  @1@,LBLSAM
0630 MVOHDT    MLC  @-@,OHDATE&1
0631           MLC  @-@,LBLBKT-24
0632           MLC  @-@,LBLBKT-4
0633           BCE  ADD4,FLR,
0634           BCE  AD4RLI,RCDIST,
0635 ADD4      ZA   L4,CONVRT          CONVERT L, MAXBLK, MINREC TO
0636           B    K5TOK3             THREE DIGIT NUMBER
0637           MLC  CONVRT,L
0638           BCE  CMPLMT,FLR,        BRANCH IF FIXED LENGTH RECORDS
0639           BCE  TESTMX,MNREC4,
0640           MLC  MNREC4,CONVRT
0641           B    K5TOK3
0642           MLC  CONVRT,MINREC
0643 TESTMX    BCE  CMPLMT,MXBLK4,
0644           MLC  MXBLK4,CONVRT
0645           B    K5TOK3
0646           MLC  CONVRT,MAXBLK
0647 CMPLMT    MLC  C16000,CONVRT       COMPUTE THREE DIGIT COMPLEMENT
0648           S    L4,CONVRT           OF L, MAXBLK, MINREC
0649           B    K5TOK3
0650 ADD       MLC  CONVRT,COMPL
0651           BCE  CMPTUP,FLR,        BRANCH IF FIXED LENGTH RECORDS
0652 MODAD     MA   @004@,CMPLMT&10
0653           MA   @003@,ADD&6
0654           A    @1@,COUNT
0655 PAIN      BCE  NOPPN,MNREC4,
0656           BCE  CMPTUP,COUNT,3
0657           B    CMPLMT
0658 AD4RLI    A    @4@,L4
0659           B    ADD4
0660 NOPPN     MLC  @N@,PAIN
0661           B    MODAD
0662 CMPTUP    BCE  MS4,MS,4           DETERMINE MACHINE SIZE
0663           BCE  MS5,MS,5
0664           BCE  MS6,MS,6
0665           CS   332
0666           CS
0667           MLC  PRMS1,238
0668           W
0669           CC   1
0670           MLC  @4@,MS
0671           H                       MACHINE SIZE ERROR
0672 MS4       ZA   @8000@,WKAREA
0673           ZA   @4775@,DVD
0674           B    NUMRTR-8
0675 MS5       ZA   @12000@,WKAREA
0676           ZA   @8775@,DVD
0677           MLC  @I9Q@,GPMARK
0678           B    NUMRTR-8
0679 MS6       ZA   C16000,WKAREA
0680           ZA   @12775@,DVD
0681           MLC  @I9H@,GPMARK
0682           BCE  *&27,TPAVLM,       COMPUTE THE UPPER LIMIT
0683 NUMRTR    C    TPAVLM,WKAREA
0684           BL   ERRTPV
0685           S    TPAVLM,WKAREA
0686           S    WKAREA,DVD
0687           BCE  *&8,LABELS,
0688           S    @700@,DVD
0689           C    I3TUN,@0@
0690           BU   XYZ
0691           A    @410@,DVD
0692           BCE  *&8,LABELS,
0693           A    @300@,DVD
0694 XYZ       MLC  @3@,DVR
0695           MZ   @0@,DVD
0696           BCE  INIT,I3TUN,        BRANCH IF NOT 3-WAY MERGE
0697           MLC  @4@,DVR
0698 INIT      ZA   @03@,INDEX
0699           S    @12@,DVD
0700           B    ED OP              BRANCH TO DIVISION SUBROUTINE
0701           MLC  QUOT,UPLMT
0702           BCE  CHECKQ,FLR,1       BRANCH IF VARIABLE LENGTH REC
0703           B    CNITQ
0704 CHECKQ    BCE  K3400,DESCND,1     BRANCH IF DESCENDING SEQUENCE
0705           BCE  CNITQ,NCF,1
0706 K3400     C    @3401@,UPLMT
0707           BL   CMPRLL-8
0708           MLC  @3400@,UPLMT
0709           B    CMPRLL-8
0710 CNITQ     C    @4000@,UPLMT
0711           BL   CMPRLL-8
0712           MLC  @3999@,UPLMT
0713           BCE  LFTOUT,FLR,1
0714 CMPRLL    C    BI,@001@           CHECK RECORD LENGTH SPEC FOR
0715           BU   CRLBCK             FIXED LENGTH RECORDS
0716           C    L4,@0013@
0717           BH   ERRMS3             RECORD SIZE TOO SMALL
0718           B    CMPRLU
0719           ORG  4135
0720 CRLBCK    C    L4,@0010@
0721           BH   ERRMS3
0722           B    CMPRLU
0723 LFTOUT    C    MXBLK4,UPLMT       CHECK RECORD LENGTH SPEC FOR
0724           BL   NOSOAP             VARIABLE LENGTH RECORDS
0725           C    MNREC4,@    @
0726           BE   CMPRLL
0727           C    MNREC4,@0013@
0728           BH   ERRMS3
0729           B    CMPRLL
0730 NOSOAP    CS   332
0731           CS
0732           MLC  PRMS2A-1,223
0733           W
0734           CC   1
0735           H    *-3                OVERSIZE INPUT BLOCK-VLR
0736 ERRMS2    CS   332
0737           CS
0738           MLC  PRMS2,0230
0739           W
0740           CC   1
0741           H    *-3                OVERSIZED RECORD LENGTH
0742 ERRMS3    CS   332
0743           CS
0744           MLC  PRMS3,0229
0745           W
0746           CC   1
0747           H    *-3                UNDERSIZED RECORD LENGTH
0748 CMPRLU    C    L4,UPLMT
0749           BL   ERRMS2
0750 CMPTBT    ZA   UPLMT,DVD          COMPUTE THEORETICAL B
0751           ZA   L4,DVR
0752           ZA   @02@,INDEX
0753           B    ED OP
0754           MZ   @0@,QUOT
0755           MLC  QUOT,BT
0756           BCE  VARBL,FLR,1
0757 CBIBT     C    BI,BT              TEST FOR OVERSIZE BI
0758           BL   ERRMSX
0759 ADDBI     A    BI,B               COMPUTE B
0760           C    B,BT
0761           BH   ADDBI
0762           BE   *&8
0763           S    BI,B
0764           MZ   @0@,B
0765           MLC  C16000,CONVRT
0766           S    B,CONVRT
0767           B    K5TOK3
0768           MLC  CONVRT,CCB
0769           B    CMPTBL
0770 ERRMSX    CS   332
0771           CS
0772           MLC  BT,PRMSX1-8
0773           MLC  PRMSX1,258
0774           W
0775           CC   1
0776           H    *-3                OVERSIZE INPUT BLOCKING-FLR
0777 ERRMSQ    CS   332
0778           CS
0779           MLC  PRMSQ,0220
0780           W
0781           CC   1
0782           H    *-3                OVERSIZE OUTPUT BLOCK-VLR
0783 CMPTBL    A    L4,BL4             COMPUTE BLOCK LENGTH
0784           A    @1@,COUNT3
0785           C    COUNT3,B
0786           BH   CMPTBL
0787           ZA   BL4,CONVRT
0788           B    K5TOK3
0789           MLC  CONVRT,BL
0790           B    DNSTY
0791 VARBL     ZA   UPLMT,CONVRT
0792           B    K5TOK3
0793           MLC  CONVRT,BL
0794 ART       MLC  UPLMT,BL4
0795           BCE  *&22,LABELS,1
0796           A    @700@,TCOMET
0797           MLZS @ @,TCOMET
0798           MLC  TCOMET,TCOMTF
0799           A    @100@,TCOMET
0800           MZ   BLNK1,TCOMET
0801           S    UPLMT,TCOMET
0802           A    L4,TCOMET
0803           MZ   BLNK1,TCOMET
0804           MLC  TCOMET,CONVRT
0805           B    K5TOK3
0806           MLC  CONVRT,COMET
0807           MLC  COMET,COMETF
0808           BCE  XXX,MAXBLO,
0809           S    MAXBLO,TCOMTF
0810           A    L4,TCOMTF
0811           MLC  TCOMTF,CONVRT
0812           B    K5TOK3
0813           MLC  CONVRT,COMETF
0814 XXX       C    BI,@ @
0815           BU   CCC3BI
0816           MLC  @10@,THIRTN
0817           BCE  DVD10,MNREC4,
0818           ZA   MXBLK4,DVD
0819           ZA   MNREC4,DVR
0820           ZA   @02@,INDEX
0821           B    ED OP
0822           MLNS QUOT,BI
0823           MLC
0824           B    CCC3BI
0825 DVD10     A    @9@,MXBLK4
0826           MLC  MXBLK4-1,BI
0827 CCC3BI    S    BI,K16000
0828           S    BI,K16000
0829           S    BI,K16000
0830           MLC  K16000,CONVRT
0831           B    K5TOK3
0832           MLC  CONVRT,LRG2G1
0833           BCE  VARMFS,BO,
0834           SBR  COUNT3,0
0835 CBOL      A    L4,BOLMAX          DETERMINE OUTPUT BLOCK LENGTH-VLR
0836           A    @1@,COUNT3
0837           C    BO,COUNT3
0838           BL   CBOL
0839           C    UPLMT,BOLMAX
0840           BH   ERRMSQ
0841 VARMFS    SBR  CMPMFS&27,BT
0842           ZA   NCF,DVR
0843           A    DVR
0844           MLC  @A@,CHNGOP
0845 DNSTY     BCE  CMPMFS,LDI,1
0846           BCE  HIDNSY,LDI,2
0847           MLC  KLTD,KTD
0848           MLC  LDIRG,KIRG
0849           B    CMPMFS
0850 HIDNSY    MLC  KHTD,KTD
0851           MLC  HDIRG,KIRG
0852 CMPMFS    MLC  @000@,COUNT3       COMPUTE MAXIMUM FILE SIZE
0853           A    KTD,MFSDVD
0854           A    @1@,COUNT3
0855           C    COUNT3,B
0856           BH   CMPMFS&7
0857           ZA   MFSDVD,DVD
0858 CHNGOP    ZA   BL4,DVR
0859           A    KIRG,DVR
0860           ZA   @07@,INDEX
0861           B    ED OP
0862           MLNS QUOT,MFS
0863           MLC
0864           BCE  *&5,I3TUN,
0865 PLY111    A    MFS
0866           C    EFS,MFS
0867           BL   MFSEXH
0868           BCE  HUH,FLR,1
0869           C    BO,B               CHECK BO SPECIFIED
0870           BL   ERRMSY
0871           BE   HUH
0872           MLC  BO,BOSUBB
0873 TM SHK    A    BO,BOSUBB
0874           C    BOSUBB,B
0875           BH   TM SHK
0876           BE   HUH
0877           CS   332
0878           CS
0879           MLC  B,HLMN&4
0880           S    BO,BOSUBB
0881           MLZS @ @,BOSUBB
0882 AUGBI     A    BI,BISUBB#3
0883           C    BISUBB,BOSUBB
0884           BH   AUGBI
0885           MLC  @000@,BISUBB
0886           BE   WRITEA-7
0887           MLC  PRMSZ1,302
0888           B    WRITEA
0889           MLC  PRMSZ,332
0890 WRITEA    W                       BO NOT SUBMULTIPLE OF B
0891           CC   1
0892           H    HUH-14
0893           MLC  BOSUBB,B           MAKE B A MULTIPLE OF BO
0894           MLC  @000@,COUNT3       RECOMPUTE SORT BLOCK LENGTH AND
0895           MLC  @0000@,BL4         MAXIMUM FILE SIZE
0896           S    MFSDVD
0897           MLZS @ @,MFSDVD
0898           B    CMPTBL
0899 ERRMSY    CS   332
0900           CS
0901           MLC  B,PRMSY-53
0902           MLC  PRMSY,288
0903           W                       BO GREATER THAN B
0904           CC   1
0905           H    HUH-14
0906 *
0907 *                    READ THE INPUT HEADER CARD
0908 *
0909 RDIH      MLC  50,LBLBKT
0910           MLC  @1@,SW11
0911           MLC  @1@,SW14
0912           SW   LBLBKT-4,LBLBKT-9
0913           SW   LBLBKT-19,LBLBKT-23
0914           MLC  @1@,LBLBKT-32
0915           MLC  @1@,ITLI
0916           B    READC3
0917 *
0918 *                    READ THE OUTPUT HEADER CARD
0919 *
0920 RDOH      BCE  RDO120,LBBUCK,1
0921           MLC  50,REELSQ&21
0922           MLC  @1@,SW12
0923           MLC  @1@,SW15
0924           MLC  25,FLSERL
0925           B    READC3
0926 RDO120    MLC  25,FILESE
0927           SW   31,41
0928           SW   47
0929           MLC  49,RETPER
0930           MLC  45,CREATD
0931           MLC  29,RESEQE
0932           MLC  40,FILNAM
0933           CW   31,41
0934           CW   47
0935           MLC  @1@,SW12
0936           MLC  @1@,SW15
0937           MLC  @N@,MVOHDT
0938           MLC  @N@,MVOHDT&7
0939           MLC  @N@,MVOHDT&14
0940           B    READC3
0941 LAB120    BCE  *&8,DATE,
0942           MLC  DATE,CREATD
0943           B    DATE80&7
0944 ED OP     SBR  RETADD&3           DIVISION ROUTINE
0945           S    TEMP
0946           MLC  @3@,TEMP-19
0947           S    INDEX,TEMP-18
0948           A    LOC,TEMP-18
0949           MLNS TEMP-18,SIGN&6
0950           MLC
0951           A    @1@,TEMP-18
0952           MLNS TEMP-18,SUBTCT&6
0953           MLC
0954           MLNS TEMP-18,OUT&6
0955           MLC
0956           MLNS TEMP-18,GOPOS&6
0957           MLC
0958 SUBTCT    S    DVR,000
0959 OUT       BWZ  GOPOS,000,K
0960           BAV  *&1
0961           A    @1@,NEW
0962           BAV  OVER
0963           B    SUBTCT
0964 OVER      MLC  @9@,QSS
0965           A    QSS
0966           B    RETADD
0967 GOPOS     A    DVR,000
0968           MLC  NEW,TEMP
0969           ZA
0970           MLC  TEMP&1,NEW
0971           ZA
0972           S    @1@,INDEX
0973           BWZ  SUBTCT,INDEX,B
0974           MLZS QSS,DVD
0975 SIGN      MLZS RMDRSN,0
0976 RETADD    B    000
0977 ONETWO    BIN  SHINE,
0978 ADDRSS    DSA  MAXBLK-3
0979 CF1REX    DCW  @    @
0980 CF2REX         @    @
0981 CF3REX         @    @
0982 CF4REX         @    @
0983 CF5REX         @    @
0984 CF6REX         @    @
0985 CF7REX         @    @
0986 CF8REX         @    @
0987 CF9REX         @    @
0988 CF0REX         @    @
0989 WKAREA         @08000@
0990 CF1SLX         @    @
0991 NC1CF          @   @
0992 CTLCF          @   @
0993 CNTNCF         @  @
0994 COUNT2         @  @
0995 COUNT          @ @
0996 NOOFCF         00
0997 BT             @000@              THEORETICAL SORT BLOCKING FACTOR
0998 COUNT3         @000@
0999 BOSUBB         000
1000 BOLMAX         0000
1001 BL4            0000               BLOCK LENGTH
1002 L4             @0000@
1003 MNREC4         0000
1004 MXBLK4         0000
1005 UPLMT          0000
1006 MFSDVD         00000000000
1007 MAXBLO    DCW  @    @
1008 LDIRG          150
1009 KIRG           417
1010 HDIRG     DCW  @600@
1011 PRMS1     DCW  @MACHINE SIZE ERROR-FOR 8K,PRESS START@
1012 PRMS2          @OVERSIZE RECORD LENGTH-RESTART@
1013 PRMS3          @RECORD SIZE TOO SMALL-RESTART@
1014 PRMS4     DCW  @CF LNGH ERROR-FOR COMPUTED TLCF,PRESS START@
1015 PRMS5          @TLCF GREATER THAN L@
1016 PRMS6     DCW  @TAPE UNIT NOT AVAILABLE-@
1017 MFSEXH    CS   332
1018           CS
1019           MLC  EFSMES,277
1020           W
1021           CC   1
1022           H    PLY111&16
1023           DCW  @EFFECTIVE FILE SIZE GREATER THAN @
1024           DC   @MAXIMUM FILE SIZE.  PRESS START TO @
1025 EFSMES    DC   @CONTINUE.@
1026 ERRMS5    CS   0332
1027           CS
1028           MLC  PRMS5,0219
1029           W
1030           CC   1
1031           H    *-3                CF LENGTH GREATER THAN RECORD
1032           MLC  B,BO
1033           MLC  BL4,BOLMAX
1034 HUH       MLC  @01@,COUNT2
1035 CIFXFY    ZA   CF2REX,CONVRT       COMPUTE DISTANCE BETWEEN
1036           S    CF1REX,CONVRT      CONTROL FIELDS
1037           BWZ  NEGIFD,CONVRT,K
1038           MZ   @ @,CONVRT
1039 BRANCH    B    K5TOK3
1040           MLC  CONVRT,IF1F2
1041           A    @1@,COUNT2
1042           MA   @004@,CIFXFY&3
1043           MA   @004@,CIFXFY&10
1044           MA   @003@,BRANCH&10
1045           C    NCF,COUNT2
1046           BL   CIFXFY
1047           B    DECBY1
1048 NEGIFD    A    C16000,CONVRT
1049           MZ   @ @,CONVRT
1050           B    BRANCH
1051 SNGLCF    ZA   CF1SLX,CONVRT       ROUTN FOR 1 CONTROL FIELD
1052           B    K5TOK3
1053           MLC  CONVRT,CF1SL
1054           A    CF1SL,CF1RE
1055           MA   NC1CF,CF1RE
1056           MLCWAONETWO&4,HUH&4
1057           SBR  INDEX1,0
1058           B    CRE&14
1059 SHINE     C    CF1SLX,@0001@
1060           BU   DECBY1
1061           MLC  @1@,CNOP
1062 DECBY1    MA   @I9I@,CF1SL
1063           A    @1@,NOOFCF
1064           C    NCF,NOOFCF
1065           BE   *&12
1066           MA   @003@,DECBY1&6
1067           B    DECBY1
1068 SETWM     CS   80
1069           BSS  PLYIN2,C
1070           SW   24,56
1071           SW   63,67
1072 LDXQ      R    56
1073 PLYIN1    MLC  @0@,MI3TUN         MULTIPHASE INITIALIZATION
1074           MLC  @0@,I3TUN
1075           MLC  @N@,PLY111
1076           B    RWD2WY
1077 PLYIN2    MLC  @ @,MI3TUN
1078           MLC  @ @,I3TUN
1079           B    SETWM&9
1080 *
1081 *                   PROCESS THE INPUT HEADER CARD
1082 *
1083 HLMN      DCW  @BO NOT SUBMULTIPLE OF B, TO SET BO EQUAL TO@
1084 PRMSZ1    DC   @     PRESS START. @
1085           DC   @TO MAKE B A MULTIPLE OF BO, PRESS START/RESET @
1086 PRMSZ     DC   @AND START@
1087 PRMSQ     DCW  @BOL TOO LARGE-RESTART@
1088 PRMS2A    DCW  @OVERSIZE INPUT BLOCKING,@
1089 PRMSX1    DC   @ GREATEST POSSIBLE B     -RESTART@
1090           DCW  @BO GREATER THAN B, BO MAY EQUAL @
1091           DC   @    OR ANY SUBMULTIPLE OF IT.@
1092 PRMSY     DC   @ PRESS START FOR BO EQUAL B@
1093 ERMCD     CS   299
1094           MLC  PRMCD,299
1095           W
1096           CS   299
1097           MLC  PRMZQ,270
1098 QZWRT     W
1099           CC   1
1100           H    *-3
1101 PRMTPV    DCW  @USER AREA SPECIFIED ABOVE CORE SIZE-RESTART@
1102 ERRTPV    CS   299
1103           MLC  PRMTPV,299
1104           W
1105           CC   1
1106           H    *-3                USER AREA ABOVE CORE SIZE
1107 CSCAN     SBR  RTEND&3            CONTROL CARD SCAN ROUTINE
1108           MLC  @000@,INDEX1
1109 CM201     C    201&X1,@0@
1110           BH   ERMCD
1111           MA   @001@,INDEX1
1112           C    INDEX1,CDLNG
1113           BH   CM201
1114           MLC  @00@,CDLNG
1115 RTEND     B    000
1116 OKIND     SBR  RTFINI&3
1117 BRNON     BCE  RTOK,20&X1,
1118 BRNON1    BCE  RTOK,20&X1,1       CHECK FOR PROPER INFORMATION
1119 BRNON2    BCE  RTOK,20&X1,2       1,2,3,4, OR BLANK IN CC
1120 BRNON3    BCE  RTOK,20&X1,3
1121 BRNON4    BCE  RTOK,20&X1,4
1122           B    ERMCD
1123 RTOK      MLC  TSERO-4,220&X1
1124           MA   @001@,INDEX1
1125 RTFINI    B    000
1126 ERMTP     CS   299
1127           MLC  PRMTP,299
1128 QZWRIT    W                       TAPE UNIT INVALIDLY SPECIFIED
1129           CC   L
1130           B    ERMCD
1131 ERMDP     CS   299
1132           MLC  PRMDP,299
1133           W
1134           CC   1
1135           MLC  @P@,URPI
1136           H    ZZGX               UNREADABLE RECORD PROCEDURE ERROR
1137 ERMCF     CS   299
1138           MLC  PRMCF,299
1139           B    QZWRIT
1140 ERMRL     CS   299
1141           MLC  PRMRL,299
1142           B    QZWRIT
1143 ERRCC     CS   299
1144           MLC  PRMCDX,299
1145           W
1146           CC   1
1147           H    *-3                INVALID CONTROL CARD
1148 THIRTN    DCW  0013
1149 ERRLBL    CS   299
1150           MLC  PRMLBL,299
1151           W
1152           CC   1
1153           H    *-3                CONTROL CARD 4 AND/OR 5 MISSING
1154 PRMLBL    DCW  @CONTROL CARD#4 AND/OR #5 ARE MISSING@
1155 ERMS6     CS   299
1156           SW   225
1157           MLC  PRMDP,252
1158           MLC  PRMS6
1159           W
1160           CC   1
1161           MLC  @P@,URPI
1162           H    BTPVLM             DUMP TAPE NOT AVAILABLE
1163 SPCRLI    BCE  *&5,RCC4,          DETERMINE IF RLI IS SPECIFIED FOR
1164           B    CKOT               VLR BLOCKED INPUT
1165           CS   299
1166           MLC  @58-61@,ZQST
1167           SW   201
1168           MLC  PRMRLI,233
1169           B    QZWRT-7
1170 ERRLI     CS   299
1171           MLC  PRMRLI,280
1172           W
1173           CC   1                  RLI LENGTH NOT SPECIFIED FOR
1174           H    *-3                VLR LOAD MODE INPUT
1175 PRMTP     DCW  @TAPE UNIT IS INVALIDLY SPECIFIED@
1176           DCW  @URPI IS INVALIDLY SPECIFIED-@
1177 PRMDP     DC   @PRESS START FOR PUNCH OPTION@
1178 PRMCF     DCW  @NO. OF CONTROL FIELDS IS INVALIDLY SPECIFIED@
1179 PRMRL     DCW  @NO. OF INPUT REELS IS INVALIDLY SPECIFIED@
1180 PRMRLI    DCW  @THE LENGTH OF RCC IS NOT SPECIFIED FOR VARIABLE@
1181 QRS       EQU  *&14
1182           DCW  @CONTROL CARD#1 INVALIDLY PUNCHED@
1183 PRMCDX    DCW  @AN INVALID CONTROL CARD IS PRESENT@
1184 PRMCD     DC   @ OR OUT OF SEQUENCE        @
1185 ZQST      EQU  *&18
1186 PRMZQ     DCW  @CHECK COLUMN 33-36@
1187 NCFCT     DCW  @01@               CONTROL FIELD COUNTER
1188 CDLNG     DCW  @75@
1189 CSCNT     DCW  @00@
1190 TSERO     DCW  @00000@
1191 BLNK5     DCW  @     @
1192 QZSW1     DCW  @ @
1193 SW11      DCW  #1
1194 SW12      DCW  #1
1195 SW13      DCW  #1
1196 SW14      DCW  #1
1197 SW15      DCW  #1
1198 TSINK     DCW  #50
1199 BLNK1     DCW  @ @
1200 HERTAG    EQU  HDRTAG
1201 RETPER    EQU  TPSERL             RETENTION PERIOD
1202 CREATD    EQU  FLSERL             CREATION DATE
1203 FILNAM    EQU  FLNAME-5           FILE NAME BUCKET
1204 FILESE    EQU  FLNAME              FILE SERIAL NUMBER
1205 SYSCRE    EQU  OHDATE             CREATING SUSTEMS
1206 RESEQE    EQU  RTCYCL             REEL SEQUENCE NUMBER
1207           EX   READCC
1208           JOB  ** IBM 1401 SORT 7 VERSION 2  ASSIGNMENT PHASE         60  2
1209           ORG  700
1210 ENDAPH    BCE  CHECLA,LBBUCK,1
1211           BCE  ENDMSG,FLR,1
1212           MLC  L4,PRMS8-27        PRINT VALUES TO BE USED FOR
1213           MLC  B,PRMS8-19         FIXED LENGTH RECORD SORT
1214           MLC  BI,PRMS8-10
1215           MLC  BO,PRMS8-1
1216           MLC  BL4,PRMS8&9
1217           MLC  MFS,PRMS8&23
1218           CS   332
1219           CS
1220           MLC  PRMS8&23,0256
1221           W
1222           B    MESS9
1223 ENDMSG    C    MNREC4,L4
1224           BL   VLRER
1225           BCE  AINT,RCDIST,
1226           BCE  CST322,INMODE,M
1227           MLC  @000@,INDEX1
1228 TSARNA    C    RCC4,CF1REX&X1
1229           BE   CST322
1230           MA   @004@,INDEX1
1231           A    @1@,KRCNT#2
1232           C    KRCNT,NCF
1233           BH   TSARNA
1234           S    KKK3,RCC4
1235           MLZS @ @,RCC4
1236           C    RCC4,@0000@
1237           BE   CST322
1238           MLC  @1@,KRUNCH
1239           ZA   RCC4,CONVRT
1240           B    K5TOK3
1241           MLC  CONVRT,SLRCC
1242 CST322    CS   332                PRINT VALUES TO BE USED FOR
1243           CS                      VARIABLE LENGTH RECORD SORT
1244           MLC  L4,PRMSU-28
1245           MLC  BL4,PRMSU-14
1246           MLC  MFS,PRMSU
1247           MLC  PRMSU,0238
1248           W
1249 MESS9     CS   322
1250           CS
1251           MLC  PRMS9,0223
1252           CC   L
1253           W                       PRINT END OF ASSIGNMENT PHASE
1254           CC   1
1255           SW   OHDATE-4
1256           BCE  EXITAP,URPI,P
1257           BCE  EXITAP,URPI,C
1258           MLC  URPI,*&4
1259           RWD  0
1260 EXITAP    NOP  0                  USERS EXIT
1261           MLZS *-6,CENSIG
1262           CS   80
1263           SW   24,56
1264           SW   63,67
1265           R    56                 LOAD PHASE ONE
1266 VLRER     CS   332
1267           CS
1268           MLC  VLRERM,253
1269           W
1270           CC   1
1271           H    *-3
1272 AINT      MLC  @1@,RLIIND
1273           MLC  @ @,CNOP
1274           MLC  @004@,RCDIST
1275           MA   @004@,CFIRE
1276           MLC  @  @,COUNT2
1277 ISSO      MA   @004@,CF1RE
1278           A    @1@,COUNT2
1279           C    COUNT2,NCF
1280 NOMO      BE   SOS
1281           MA   @003@,ISSO&6
1282           B    ISSO
1283 SOS       SBR  ISSO&6,CF1SL
1284           SBR  NOMO&3,UPDT
1285           B    ISSO-7
1286 UPDT      MA   @I9F@,CCCFRE
1287           B    CST322
1288           DCW  @RECORD LENGTH ERROR-@
1289 CHECLA    BCE  ERLAEL,TL,2
1290           BCE  ERLAEL,TL,1
1291           BCE  ERLAEL,OTLI,2
1292           BCE
1293           BCE  ERLAEL,OTLI,1
1294           BCE  *&8,ITLI,
1295           MLC  @1@,ITLI
1296           B    ENDAPH&8
1297 ERLAEL    CS   332
1298           CS
1299           MLC  @INVALID LABEL SPECIFICATION@,228
1300           W
1301           CC   1
1302           H    HTMGHT
1303           C    TL,@3@
1304           BL   *&8
1305           MLC  @3@,TL
1306           C    OTLI,@3@
1307           BL   *&8
1308           MLC  @3@,OTLI
1309           BCE  *&8,ITLI,
1310           MLC  @1@,ITLI
1311           B    ENDAPH&8
1312 HTMGHT    C    TL,@2@
1313           BH   OTLGHT
1314           BE   OTLGHT
1315           MLC  @1@,TL
1316 OTLGHT    C    OTLI,@2@
1317           BH   ITLGHT
1318           BE   ITLGHT
1319           MLC  @1@,OTLI
1320 ITLGHT    C    ITLI,@2@
1321           BH   LBBGHT
1322           MLC  @1@,ITLI
1323 LBBGHT    MLC  @ @,LBBUCK
1324           B    ENDAPH&8
1325 VLRERM    DC   @MAXIMUM LESS THAN MINIMUM-RESTART@
1326 PRMS8     DCW  @L        B       BI       BO     @
1327           DC   @  BL        MFS        @
1328 PRMS9     DCW  @END OF ASSIGNMENT PHASE@
1329 PRMSU     DCW  @L MAX        BL MAX        MFS        @
1330           EX   ENDAPH
1331           JOB  ** IBM 1401 SORT 7 VERSION 2  PHASE 1                  60  2
1332           ORG  87
1333 X1        DCW  @000@
1334           ORG  92
1335 X2        DCW  @000@
1336           ORG  97
1337 X3        DCW  @000@
1338           ORG  7998
1339 GM        DCW  @}@                                                    B1401
1340           ORG  CCB&1
1341           ORG  *&124
1342 HERE      ORG  *                  BEGINNING OF REDUNDANT REC RTN
1343           ORG  *&135
1344 *
1345 PLYIN3    MLC  @|@,000
1346           B    NOSWCH
1347 K2FLD     DCW  00
1348 BFRST3    DCW  @0|0@
1349 PCOMPL    DCW  000
1350 K1BLNK    DCW  @ @                BLANK TO REMOVE GM AFTER READ
1351 G         DCW  000
1352           DC   0
1353 P15999    DCW  @I9I@
1354 LBMI3T    DSA  MI3TUN
1355 LBI3T     DSA  I3TUN
1356 CPLITP    DCW  @99@
1357 THREEB    DCW  0
1358 NINE      DCW  @9@
1359 NINTNN    DCW  @99@
1360 TWO       DCW  @002@
1361 K2BLNK         @00@
1362 MFSIZE    DCW  0000000            MAXIMUM FILE SIZE
1363 NOTAPS    DCW  @4@
1364 THREE     DCW  @003@
1365 O1        DCW  000                                                    B1401
1366 G1        DCW  000
1367 ONE       DCW  @001@
1368 BLKCT1    DCW  @00000@
1369 ONERM     DCW  @|@
1370 *
1371 CLRTN     SW   000                CLEAR WORDMARK ROUTINE
1372           MLC  CDTO,X3
1373 CLR1      S    0&X3               SUBTRACT TO WORDMARK
1374           SBR  X3                 SAVE ADDRESS
1375           MA   ONE,X3
1376           CW   0&X3               CLEAR WORDMARK
1377           C    ONPTAR,X3          INPUT AREA ALL CLEARED
1378           BU   CLR1
1379           B    VLRGET             YES
1380 CDTO      DCW  #3
1381           ORG  *&34
1382 *                  SET WORDMARK ROUTINE FOR VARIABLE
1383 *                  LENGTH RECORDS
1384 VARLNT    SW   0&X2
1385           SW   0&X2,0&X2
1386           SW   0&X2,0&X2
1387           SW   0&X2,0&X2
1388           SW   0&X2,0&X2
1389 STWMVL    SW   0&X2,0&X2
1390           SW   0&X2
1391 CNVRSN    ZA   15998&X2,X3
1392           ZA   X3-2,X3
1393           MLZS K1BLNK,X3
1394 CNVRS1    MLZS TBLE&X3,15997&X2
1395 B011TA    A    ONE,CTNR
1396           S    ONE,MFSIZE
1397 B011T     MLC  X2,0
1398 B011TH    NOP  0,0
1399 B011TB    MA   15999&X2,X2
1400           MLC  LRG2G1,CMPLRG
1401           MA   B011T&6,CMPLRG
1402           BWZ  SETG1H,CMPLRG,2
1403 STMRWM    MA   THREE,B011T&6
1404 STG1J     C    X2,X1
1405 SETG1J    BU   STWMVL
1406 CLWMVL    B    B013R
1407 SETG12    MA   @I9G@,B011T&6
1408 SETG1     MLC  B011T&6,G1
1409           MLC  K1BLNK,0&X1
1410           B    B4SS5
1411 SETG1H    MLC  @N@,CLWMVL
1412           B    STMRWM
1413 LSTBLK    MLC  @N@,CLWMVL
1414 LSTBK1    B    STWMVL
1415 CMPLRG    DCW  000
1416 CMPCOW    DCW  000
1417 CMPCOU    DCW  000
1418 TBLE      DC   @9@
1419           DC   @Z@
1420           DC   @R@
1421           DC   @I@
1422           DC   @9@
1423 *
1424 *    S T E P   D O W N   R O U T I N E                                B1401
1425 *
1426 *
1427 STPDNR    MLC  O1FA-3,X1
1428 LOADGM    MLCWAGM,0
1429           MLC  HOLDND,X3
1430           A    ONE,CNSQ           SEQUENCE COUNT
1431 *                  COMPARE LOWEST RECORD IN NEW G TO HIGHEST
1432 *                  RECORD IN PREVIOUS G
1433 STPCMP    C    0,0
1434 STPCM1    BL   NEXTTP             IF LOW-SWITCH OUTPUT TAPES
1435 STPCM2    BE   EQUALS             IF EQUAL-TEST SECONDARY CFS
1436 *                  IF ALL CONTROL FIELDS ARE EQUAL OR IF
1437 *                  RECORD IS HIGH-KEEP OUTPUT BLOCKS OF NEW G ON
1438 *                  SAME OUTPUT TAPE UNIT AS WAS USED FOR
1439 *                  PREVIOUS G
1440           B    NOSWCH
1441 EQUALS    MA   ONE,X3
1442           SBR  B04EQ&3,STPCM2&5
1443           SBR  B03EQ&3
1444           B    EQLRTN
1445 NEXTTP    MLC  MI2TUN,TPBKT
1446 NXTTP1    C    NEXTTP&3,&MI2TUN
1447           BE   CYCLE
1448           MA   ONE,NEXTTP&3
1449           B    CYCLE1
1450 CYCLE     SBR  NEXTTP&3,MI1TUN
1451 CYCLE1    MLC  TPBKT,B201W&3
1452           MLC  TPBKT,TAPERW&3                                         B1401
1453           MLC  TPBKT,B203W&3                                          B1401
1454           A    ONE,CNOS1          SWITCH TAPE COUNT
1455           BSS  PLYIN3,C
1456 NOSWCH    B    BP000
1457 HOLDND    DCW  000
1458 TPBKT     DCW  0                  OUTPUT TAPE NUMBER
1459 *
1460 *                  PUT ROUTINE
1461 *
1462 BP000     SBR  B212W&3,BP2200
1463 B2200     MLC  O1FA-3,B2000&3     GET ADDR OF 1ST REC FROM ADDR
1464 BP2200    MLC  0,B2001&6          TABLE
1465 B2201V    B    B2000
1466           DC   @   @
1467 B220VL    MLC  0,X1
1468           MA   P15999,X1
1469 B2201     MA   L,B2001&6
1470 B2000     MLC  0,X1               ADDR OF RECORD TO BE MOVED TO X1
1471 PUTEXT    NOP  0                  USERS EXIT
1472 B2001     MLCWA15999&X1,0         CHAIN MOVE RECORD TO OUTPUT AREA
1473           NOP                     THESE NOPS ARE CHANGED TO L
1474           NOP                     ACCORDING TO THE NUMBER OF
1475           NOP                     CONTROL FIELDS SPECIFIED BY THE
1476           NOP                     USER IN CC1 &2
1477           NOP
1478           NOP
1479           NOP
1480           NOP
1481           NOP
1482           NOP
1483           NOP
1484 B2211D    NOP  0,0
1485 B2211B    C    B2000&3,G1         HAVE G RECORDS BEEN MOVED TO
1486 B2202     MA   THREE,B2000&3      OUTPUT AREA
1487 B2202A    BU   B2211              NO-IS WRITE REQUIRED
1488 B2211C    B    BP001              YES-WRITE FINAL BLK OF G RECS
1489 B2211     C    B2001&6,COUNTR     TEST-IS WRITE REQUIRED
1490 B2212     BU   B2201              NO-BR TO MOVE NEXT REC TO OUTPUT
1491           B    BP002
1492           DC   @      @
1493           B    B2201V
1494 N         DCW  @N@                                                    B1401
1495 *      E  Q  U  A  L       R  O  U  T  I  N  E
1496 EQUAL     SBR  B04EQ&3            STORE THE B REGISTER TO RETURN
1497           SBR  B03EQ&3            TO THE COMPARE LOOP MAINLINE
1498 EQLRTN    SBR  B00EQ&3,BSCBSC     MOVE ADDRESS OF 2ND-3RD-ETC CF
1499 B00EQ     MLC  0,B01EQ&6          TO COMPARE INSTRUCTION
1500 B01EQ     C    0,0                COMPARE SECONDARY CONT FLDS
1501           BE   B07EQ              BRANCH TO ALTER COMPARE
1502           MA   @I9?@,B03EQ&3
1503 B03EQ     BL   0                  BR LOW TO MAINLINE BR LOW INSTR
1504 B04EQ     B    0000               BR HI TO MAINLINE BR HI INSTR
1505 B07EQ     C    B00EQ&3,LAST       TEST FOR OTHER CF IF EQ COMPARE
1506           BE   B04EQ              ALL CF HAVE BEEN COMPARED
1507           MA   @006@,B00EQ&3      ALTER COMPARE INSTRUCTION
1508           B    B00EQ              BR TO COMPARE NEXT CF
1509 BSCBSC    DCW  000000             THESE 6 CHARACTER BUCKETS
1510           DCW  000000             CONTAIN THE POSITION WITHIN
1511           DCW  000000             THE RECORD OF THE SECOND THRU
1512           DCW  000000             TENTH CONTROL FIELD IF MULTIPLE
1513           DCW  000000             CONTROL FIELDS ARE PRESENT
1514           DCW  000000
1515           DCW  000000
1516           DCW  000000
1517           DCW  000000
1518 LAST      DCW  000                ADDR OF LAST 6 CHAR DCW
1519 *
1520 *                    WRITE ROUTINE
1521 *
1522 BP001     SBR  B212W&3,B010R
1523 BP002     S    B,MFSIZE
1524           BWZ  MAXFS,MFSIZE,K
1525 WRTFL1    A    B,CTNR
1526 WRITFL    MLC  @80@,CNTR50
1527 B211W     MLC  @N@,B202W
1528 RITEXT    NOP  0                  USERS EXIT
1529 B201W     WT   %U4,0
1530           BAV  *&1
1531           BER  TAPERW
1532           BEF  EOFW
1533 PLYIN4    NOP  K1BLNK,000
1534 B212W     B    B2201
1535 EOFW      SBR  OLGA&3
1536 EOFW2     NOP  EOFWND
1537           MLC  @B@,EOFW2
1538           SBR  NOSWCH&3,NORSIF
1539           B    NEXTTP
1540 EOFWND    MLC  @B@,CNTR
1541           B    TSTFPD
1542 NORSIF    MLC  @ @,STPCMP&4
1543           MLC  &BP000
1544           MLC  @B@
1545 OLGA      B    0
1546 TAPERW    BSP  %U4                                                    B1401
1547 B202W     B    ERSRTN
1548           MLC  @B@,B202W
1549           B    B201W                                                  B1401
1550 ERSRTN    A    ONE,CNTR50
1551           BAV  HLTWTR                                                 B1401
1552 B203W     SKP  %U4                                                    B1401
1553           B    B211W                                                  B1401
1554 HLTWTR    H    WRITFL
1555 MAXFS     MLC  NOP,BP002&7
1556           H    WRTFL1
1557 NOP       DCW  @N@
1558 CNTR50    DCW  00
1559 COUNTR    DCW  000
1560 *                                  16000 - SIZE OF B - 1  IF VLR
1561 *
1562 *                   GET ROUTINE
1563 *
1564 VLRGET    MLC  @B@,CLWMVL
1565           MLC  O1FA-3,B011T&6
1566           MLC  ONPTAR,X2
1567 B010RI    NOP  K4,X1
1568 B010R     MLC  ONPTAR,X1          MOVE BEGINNING OF INPUT TO X1
1569 B013R     MLC  X1,X3
1570 B000R     MLC  ONE,CNTR           INITIALIZE ERROR COUNTER
1571           A    ONE,BLKCT1         ADD 1 TO # OF BLOCKS READ
1572           MLC  CENSIG,13&X1       MOVE CENT SIGN TO 14TH POSITION
1573 *                                 OF INPUT AREA FOR NOISE TEST
1574 B011R     MLC  K1BLNK,0&X1        BLANK GROUPMARK AT END OF RECORD
1575 B001R     RT   %U1,0&X1           READ INPUT BLOCK
1576           SBR  X1                                                     B1401
1577           MA   P15999,X1
1578           BEF  EOFRD              TEST-END OF FILE ON READ            B1401
1579 CKNOIS    BCE  NOISRT,13&X3,      BRANCH IF CENT SIGN STILL PRESENT
1580           BER  TAPERD             TEST-TAPE TRANSMISSION ERROR
1581 GETEXT    NOP  0                  USERS EXIT
1582 *              AT THIS POINT USER MAY BRANCH TO HIS OWN ROUTINE
1583 *              IF ADDITIONAL MANIPULATION OF RECORDS IS
1584 *              DESIRED--CONTENTS OF INDEX REGISTERS MUST BE SAVED
1585 *              AND RESTORED BEFORE RETURNING TO SORT PROGRAM.
1586 ***
1587 RNGLNQ    BCE  ACCEPT-7,0&X3,}      CHECK RECORD LENGTH OF FIXED
1588 *                                   LENGTH RECORDS
1589 RNGL1Q    H
1590 RNGL2Q    B    HERE
1591           MLC  K1BLNK,0&X1        THE GROUPMARK IS REMOVED FROM THE
1592 ACCEPT    C    X1,COWNTR          IS INPUT AREA FILLED
1593           BU   B013R              RETURN TO READ ANOTHER BLOCK
1594 B002R     B    B4SS5              BRANCH TO SEQUENCE RECORDS
1595           DC   @     @
1596 RLINO     B    RLIYES
1597           DC   @   @
1598           MLC  X1,CONVRT          DETERMINE LENGTH OF VARIABLE LNG
1599           B    EXPAND             RECORDS WITH NO RLI SPECIFIED
1600           MLCWAHOLD,RLI
1601           MLC  X3,CONVRT
1602           B    EXPAND
1603           S    HOLD,RLI
1604           MLZS K1BLNK,RLI
1605           SW   RLI-3
1606           MLCWARLI,3&X2
1607 RLIYES    BWZ  LSTBLK,CMPCOW,2
1608 B002RA    B    STWMVL
1609 RLI       DCW  00000
1610 NOISRT    MLC  K1BLNK,13&X3       CLEAR NOISE RECORD
1611           MLC
1612           MLC
1613           MLC
1614           MLC
1615           MLC
1616           MLC
1617           MLC
1618           MLC
1619           MLC
1620           MLC
1621           MLC
1622           MLC
1623           MLC
1624           MLC  X3,X1              RESTORE INDEX REGISTERS
1625           B    B011R-7
1626 EOFRD     BAV  *&1
1627           S    ONE,BLKCT1
1628           MLZS K2BLNK,BLKCT1
1629           BCE  *&5,TL,            TEST FOR TRAILER LABEL
1630 LSTCHK    B    TRLENT             BR TO PROC TRAILER LABEL
1631           S    BLKCT1             ZERO BLOCK COUNT
1632           MLZS K2BLNK,BLKCT1
1633           BSS  EOFRWD,D
1634           MLC  @R@,EOFRWD&4
1635 EOFRWD    RWU  0
1636           A    ONE,CPLITP         ADD 1 TO NO OF REELS PROC
1637           BAV  TSTFPD             TEST-MORE REELS TO PROC
1638 SWCTAP    MLC  K1BLNK,0&X1
1639           SBR  X1
1640           BSS  TAPRD1,B
1641 SWCHTP    MLC  I1TUN,ITPBKT      SWITCH TAPES
1642 SCHTP1    C    SWCHTP&3,&I2TUN
1643           BE   CICLE
1644           MA   ONE,SWCHTP&3
1645           B    CICLE1
1646 CICLE     SBR  SWCHTP&3,I1TUN
1647 CICLE1    MLC  ITPBKT,B001R&3
1648           MLC  ITPBKT,EOFRWD&3
1649           MLC  ITPBKT,TAPRD2&3
1650 TSTLBL    BCE  HDRENT,ITLI,1      TEST FOR HEADER LABEL
1651           B    CHKPNT
1652 TAPRD1    H    SWCHTP             HALT BEFORE SWITCHING INPUT TPS
1653 TAPERD    BAV  *&1
1654           A    ONE,CNTR
1655           BAV  HERE
1656 TAPRD2    BSP  1
1657           MLC  X3,X1
1658           B    B001R-14
1659 *                       80 CHARACTER HEADER-TRAILER ROUTINE
1660 *
1661 HDRENT    SBR  HDREXT&3           INITIALIZE LABEL ROUTINE
1662           MLC  ITPBKT,RDHDRL&3
1663           MLC  ITPBKT,RDTPMK&3
1664           MLC  ITPBKT,BGET1&3
1665           MLC  K2BLNK-1,CNTR
1666           MLC  ITPBKT,*&4
1667 BCKHDR    RWD  %U0                REWIND UNIT
1668 RDHD1     MLCWAGM,281             LOAD GROUPMARK
1669           MLC  CENSIG,214
1670 RDHDRL    RTW  0,201              READ HEADER LABEL IN LOAD MODE
1671           SW   201
1672 LABNOS    BCE  NOISEL,214,        CHECK FOR NOISE RECORD
1673           BER  REREAD             TAPE ERROR CHECK
1674           BCE  *&8,LBLSAM,
1675           MLCWA240,RTCYCL&1       SAVE FIRST 40 POSITIONS OF LABEL
1676           MLC  @N@,*-13
1677           NOP  000,000
1678           NOP  000,000
1679           BEF  *&1                RESET INDICATOR
1680           W
1681           CC   L
1682           BCE  EXIT7,LBLBKT-32,   IS LABEL TO BE CHECKED
1683           BCE  FNAME,LBLBKT-31,   YES-ALL VALUES OR FILE NAME ONLY
1684           C    215,LBLBKT-25      COMPARE FILE SERIAL NUMBER
1685           BU   ERRHDR
1686           C    235,LBLBKT-5       COMPARE CREATION DATE
1687           BU   ERRHDR
1688           C    210,LBLBKT-20      COMPARE REEL SEQUENCE NUMBER
1689           BU   ERRHDR
1690 FNAME     C    230,LBLBKT-10      COMPARE FILE NAMES
1691           BU   ERRHDR
1692           BCE  EXIT7-7,LBLBKT-30,
1693           A    ONE,LBLBKT-21      UPDATE REEL SEQ NO
1694           MLCWAGM,281
1695 EXIT7     NOP  000                USERS EXIT
1696 RDTPMK    RTW  0,240              READ TAPEMARK
1697           CS   299
1698           BEF  HDREXT
1699 BGET1     BSP  %U0                NO TAPE MARK PRESENT
1700 HDREXT    B    000
1701 REREAD    A    ONE,CNTR
1702           BAV  STOPH
1703           B    BCKHDR
1704 NOISEL    CS   220
1705           B    RDHDRL-7
1706 ERRHDR    CS   332
1707           CS
1708           MLC  UCMSG,215
1709           MLC  LBLBKT,255         MOVE CONTROL CARD CONSTANTS TO
1710           MLC                     PRINT AREA
1711           MLC
1712           MLC
1713           MLC
1714           W
1715           CC   1
1716 STOPH     H    EXIT7-22
1717           B    BCKHDR-14
1718 UCMSG     DCW  @ERROR-SHOULD BE@
1719 TRLENT    SBR  TRLEXT&3
1720           MLC  ITPBKT,RDTRLL&3
1721           MLC  ITPBKT,BCKTRL&3
1722           MLC  K2BLNK-1,CNTR
1723 RDTL1     MLCWAGM,281             LOAD GROUPMARK
1724 RDTRLL    RTW  0,201              READ TRAILER LABEL
1725           BEF  *&1                RESET INDICATOR
1726           BER  RERD               TAPE ERROR CHECK
1727           W
1728           CC   L
1729           BCE  EXIT6,TL,1         IS LABEL TO BE CHECKED
1730           C    210,BLKCT1
1731           BU   ERRTRL
1732           C    220,CNTR
1733           BE   EXIT6
1734           SBR  EREINE&3,CNTR      PLACE RECORD COUNT IN MESSAGE
1735           B    ERRTRL
1736 EXIT6     NOP  000                USERS EXIT
1737 TRLEXT    B    000
1738 RERD      A    ONE,CNTR
1739           BAV  STOPT
1740 BCKTRL    BSP  %U0
1741           B    RDTRLL
1742 ERRTRL    CS   332                PRINT UNEQUAL COMPARE MESSAGE
1743           CS
1744           MLC  UCMSG,215
1745 EREINE    MLC  BLKCT1,230
1746           W
1747           CC   1
1748           H    EXIT6
1749 STOPT     H    TRLEXT
1750 ONPTAR    DCW  000                FIRST POSITION OF G AREA
1751 CNTR      DCW  00
1752 COWNTR    DCW  000
1753 *                                  16K - LAST POS G & MXBLKSIZ--VLR
1754 ITPBKT    DCW  0
1755 K4        DCW  @004@
1756 *
1757 *      B I N A R Y      S E A R C H
1758 *
1759 ZERO      DCW  &000                                                   B1401
1760 HALF      DCW  &5                                                     B1401
1761 D         DCW  000
1762 E         DCW  0000
1763 O1FA      DCW  000000
1764 G/4       DCW  000
1765           DC   00
1766 LORCRD    DCW  @ @
1767 SONED     DCW  @SXXXXXX@                                              B1401
1768 *
1769 HLTMFS    MLC  @N@,CNTR
1770 TSTFPD    CS   080
1771           SW   24,56
1772           SW   63,67
1773           R    056
1774 Z         DCW  000
1775           LTORG*
1776 *
1777 HPNDPM    DCW  000
1778 TPCNPM    DCW  @D99@
1779 CLEARS    NOP  0,0
1780 STRTCL    CS   15999              CLEAR CORE
1781           SBR  STRTCL&3
1782           C    STRTCL&3,TPCNPM
1783           BU   STRTCL
1784 LOADTB    SW   0
1785 LODTB1    MLC  ADRLRD,0
1786 LODTB2    MLC  0,0
1787 LODTB3    CW   0
1788           NOP  @|@,000
1789 MAX       MLC  GM,0
1790           BCE  NITTAP,FLR,1
1791           MLC  TPCNPM,X1
1792           MLC  K1BLNK,1&X1
1793 LDBKPM    MLC  K1BLNK,0&X1        CLEAR BY MOVING BLANKS
1794           SBR  X1
1795           CW   1&X1
1796           C    X1,HPNDPM          IS THE INPUT AREA CLEARED
1797           BU   LDBKPM
1798           MA   ONPTAR,SETWMK&3    SET WORD MARKS
1799 STWMK1    MLC  NCF,K2FLD
1800           MLC  @000@,X3
1801 SETWMK    SW   0&X3
1802 INSWIN    MLC  CF1SL,X3
1803           MA   THREE,INSWIN&3
1804           A    NINTNN,K2FLD
1805           BAV  SETWMK
1806           SBR  INSWIN&3,CF1SL
1807           MA   L,SETWMK&3
1808           A    K999,GCNTR
1809           BAV  STWMK1
1810           C    G,ONE                G EQUALS ONE
1811           BU   SETWM1
1812           SBR  B002R&3,STPDNR
1813 SETWM1    MLC  O1,X3                                                  B1401
1814           MLC  ONPTAR,ONPTRI                                          B1401
1815 ADRTBL    MLC  ONPTRI,0&X3    SET UP TABLE OF ADDRESSES
1816           MA   L,ONPTRI                                               B1401
1817           C    X3,G1                                                  B1401
1818           MA   THREE,X3
1819           BU   ADRTBL
1820 NITTAP    B    056
1821 ADRLRD    DSA  LORCRD
1822 ONPTRI    DCW  000
1823 GCNTR     DCW  000
1824 K999      DCW  @999@
1825           LTORG*
1826           ORG  *&1
1827 B002B     MLC  3&X2,X3            ENTER SORT LOOP HERE WHEN
1828           C    0&X3,0&X1          SORTING 2ND RECORD
1829           BL   B4S07
1830           BE   EQUAL
1831 B700B     MA   B002B&3,X2
1832 P003      B    B4S07
1833 B004B     MLC  6&X2,X3            ENTER SORT LOOP HERE WHEN
1834           C    0&X3,0&X1          SORTING 3RD OR 4TH RECORD
1835           BL   B002B
1836           BE   EQUAL                                                  B1401
1837 B701B     MLC  9&X2,X3
1838           C    0&X3,0&X1
1839           BL   B712B
1840           BE   EQUAL                                                  B1401
1841 B702B     MA   B701B&3,X2
1842           B    B4S07                                                  B1401
1843 B712B     MA   B004B&3,X2
1844 P009      B    B4S07
1845 B008B     MLC  12&X2,X3           ENTER SORT LOOP HERE WHEN
1846           C    0&X3,0&X1          SORTING RECORDS 5 THRU 8
1847           BL   B004B
1848           BE   EQUAL                                                  B1401
1849 B703B     MLC  18&X2,X3
1850           C    0&X3,0&X1
1851           BL   B715B
1852           BE   EQUAL                                                  B1401
1853 B705B     MLC  21&X2,X3
1854           C    0&X3,0&X1
1855           BL   B716B
1856           BE   EQUAL                                                  B1401
1857 B706B     MA   B705B&3,X2
1858           B    B4S07                                                  B1401
1859 B716B     MA   B703B&3,X2
1860           B    B4S07                                                  B1401
1861 B715B     MLC  15&X2,X3
1862           C    0&X3,0&X1
1863           BL   B714B
1864           BE   EQUAL                                                  B1401
1865 B704B     MA   B715B&3,X2
1866           B    B4S07                                                  B1401
1867 B714B     MA   B008B&3,X2
1868 P021      B    B4S07
1869 B016B     MLC  24&X2,X3           ENTER SORT LOOP HERE WHEN
1870           C    0&X3,0&X1          SORTING RECORDS 9 THRU 16
1871           BL   B008B
1872           BE   EQUAL
1873 B600B     MA   B016B&3,X2
1874 P024      B    B008B
1875 B032B     MLC  48&X2,X3           ENTER SORT LOOP HERE WHEN
1876           C    0&X3,0&X1          SORTING RECORDS 17 THRU 32
1877           BL   B016B
1878           BE   EQUAL                                                  B1401
1879 B601B     MLC  72&X2,X3
1880           C    0&X3,0&X1
1881           BL   B612B
1882           BE   EQUAL                                                  B1401
1883 B602B     MA   B601B&3,X2
1884           B    B008B                                                  B1401
1885 B612B     MA   B032B&3,X2
1886 P072      B    B008B
1887 B064B     MLC  96&X2,X3           ENTER SORT LOOP HERE WHEN
1888           C    0&X3,0&X1          SORTING RECORDS 33 THRU 64
1889           BL   B032B
1890           BE   EQUAL                                                  B1401
1891 B603B     MLC  144&X2,X3
1892           C    0&X3,0&X1
1893           BL   B615B
1894           BE   EQUAL                                                  B1401
1895 B605B     MLC  168&X2,X3
1896           C    0&X3,0&X1
1897           BL   B616B
1898           BE   EQUAL                                                  B1401
1899 B606B     MA   B605B&3,X2
1900           B    B008B                                                  B1401
1901 B616B     MA   B603B&3,X2
1902           B    B008B                                                  B1401
1903 B615B     MLC  120&X2,X3
1904           C    0&X3,0&X1
1905           BL   B614B
1906           BE   EQUAL                                                  B1401
1907 B604B     MA   B615B&3,X2
1908           B    B008B                                                  B1401
1909 B614B     MA   B064B&3,X2
1910 P144      B    B008B
1911 B128B     MLC  192&X2,X3          ENTER SORT LOOP HERE WHEN
1912           C    0&X3,0&X1          SORTING RECORDS 65 THRU 128
1913           BL   B064B
1914           BE   EQUAL
1915 B500B     MA   B128B&3,X2
1916 P192      B    B064B
1917 B256B     MLC  384&X2,X3          ENTER SORT LOOP HERE WHEN
1918           C    0&X3,0&X1          SORTING RECORDS 129 THRU 256
1919           BL   B128B
1920           BE   EQUAL                                                  B1401
1921 B501B     MLC  576&X2,X3
1922           C    0&X3,0&X1
1923           BL   B522B
1924           BE   EQUAL                                                  B1401
1925 B502B     MA   B501B&3,X2
1926           B    B064B                                                  B1401
1927 B522B     MA   B256B&3,X2
1928 P576      B    B064B
1929 B512B     MLC  768&X2,X3          ENTER SORT LOOP HERE WHEN
1930           C    0&X3,0&X1          SORTING RECORDS 257 THRU 512
1931           BL   B256B
1932           BE   EQUAL                                                  B1401
1933 B503B     MLC  1152&X2,X3
1934           C    0&X3,0&X1
1935           BL   B515B
1936           BE   EQUAL                                                  B1401
1937 B505B     MLC  1344&X2,X3
1938           C    0&X3,0&X1
1939           BL   B516B
1940           BE   EQUAL                                                  B1401
1941 B506B     MA   B505B&3,X2
1942           B    B064B                                                  B1401
1943 B516B     MA   B503B&3,X2
1944           B    B064B                                                  B1401
1945 B515B     MLC  960&X2,X3
1946           C    0&X3,0&X1
1947           BL   B514B
1948           BE   EQUAL                                                  B1401
1949 B504B     MA   B515B&3,X2
1950           B    B064B                                                  B1401
1951 B514B     MA   B512B&3,X2
1952 P1344     B    B064B
1953           DCW  @ @
1954           JOB  ** IBM 1401 SORT 7 VERSION 2  PHASE 1                  60  2
1955 *
1956 *
1957 *
1958           LTORG*
1959 *
1960 *
1961 *                       80 CHARACTER WORK LABEL ROUTINE
1962 *
1963           ORG  4175
1964 WLAREA    DCW  @1HDR 00000SORT7LABEL          @
1965           DC   #50
1966 WLGM      DCW  @  @
1967 INTIAL    BCE  TWLABL,MS,4
1968           MLC  GPMARK,INTAL1&6
1969 INTAL1    MLCWAGM,0
1970           CW   GM
1971           MLC  GPMARK,RDHD1&3
1972           MLC  GPMARK,RDTL1&3
1973           MLC  GPMARK,EXIT7-4
1974           MLC  GPMARK,LOADGM&3
1975 TWLABL    BCE  NXTINT,LBBUCK,1    CHECK FOR 120 CHARACTER LABELS
1976           MLC  CENSIG,LABNOS&7    PRIME NOISE TEST WITH CENT SIGN
1977           BCE  NXBYPS,LABELS,
1978 EXIT0     NOP  0                  USER EXIT BEFORE READING WORK LBL
1979 SWKLB     MLC  MI1TUN,TPWKBK      MOVE 1ST WORK TP NO TO BUCKET
1980           MLC  TPWKBK,WLAREA-20
1981           MLC  CENSIG,WKENOI&7    PRIME NOISE RECORD TEST
1982           MLC  @00@,CRYBU1
1983           MA   ONE,SWKLB&3
1984           MLC  GPMARK,*&4
1985           MLCWAGM,WLGM-1
1986           BCE  NOWL,WLBKT,        NO LABEL-CREATE TEMP LABEL
1987           MLC  K1BLNK,CNTR        RESET COUNTER
1988           MLC  TPWKBK,*&4         INITIALIZE REWIND INSTRUCTION
1989           RWD  %U0                REWIND UNIT
1990 RDWL      MLC  CENSIG,WLAREA-16   LOAD CENT SIGN FOR NOISE TEST
1991           MLC  TPWKBK,*&4
1992           RTW  %U0,WLAREA-29      READ WORK LABEL
1993           SBR  HDRBKT
1994 WKENOI    BCE  NOISEW,WLAREA-16,    IS CENT SIGN STILL PRESENT
1995           BER  RERDWL             CHECK TAPE TRANS ERROR
1996           BEF  *&1                RESET INDICATOR
1997           A    ONE,TBC
1998           BCE  EXIT5-12,WLBKT,0   0 IF HDR BUT NO CHK CC3COL4
1999 *                  RETENTION CYCLE CHECK
2000           ZA   WLAREA&9,CRTCYL    MOVE TAPE INFORMATION TO CHECK
2001           MLC                     BUCKET
2002           MLC
2003           SW   OHDATE-2
2004 CLWL      C    OHDATE-3,CRTCYL-7  COMPARE YEAR
2005           BU   MODYR
2006           A    CRTCYL-4,CRTCYL    ADD TAPE DAYS TO RT CYL
2007           S    OHDATE,CRTCYL      SUB CONT DAYS FROM RT CYL
2008           CW   OHDATE-2
2009           BWZ  EXIT5-12,CRTCYL,K  CAN WE WRITE ON TAPE
2010           CS   332                NO-PRINT MESSAGE INDICATING
2011           CS                      DAYS TAPE IS TO BE RETAINED
2012           MLC  SAVMSG,226
2013           MLNS CRTCYL,221
2014           MLNS
2015           MLNS
2016           MLC  SAVMS1
2017           MLC  TPWKBK
2018           MLC  SAVMS2
2019           W
2020           CC   1
2021           H    EXIT5-12           HIT START TO ACCEPT TAPE
2022           B    RDWL-5             START RESET-START TO RECHECK
2023 MODYR     S    TSF,CRTCYL         SUBTRACT 365 FROM RT CYL
2024           A                       AND ADD 1 TO TAPE YEARS
2025           A
2026           A    @1@,CRYBU1
2027           BCE  HLCRY1,CRYBU1-1,3
2028           B    CLWL
2029 HLCRY1    H    EXIT5-12
2030           MLC  @00@,CRYBU1
2031           B    CLWL
2032 CRYBU1    DCW  @  @
2033           DCW  @1@
2034           DCW  @0@
2035 TSF       DCW  @365@
2036 SAVMS2    DCW  @RETAIN TAPE @
2037 SAVMS1    DCW  @ FOR @
2038 SAVMSG    DCW  @ DAYS@
2039           DCW  #2
2040           DCW  #3
2041 CRTCYL    DCW  #4
2042           MLC  TPWKBK,*&4
2043           RWD  %U0                REWIND UNIT
2044 EXIT5     NOP  000                USER EXIT AFTER READING LABEL
2045 *                                 OR BEFORE WRITING NEW WORK TAPE
2046 *                                 LABEL
2047           MLC  TPWKBK,*&4
2048 WTWL      WT   %U0,WLAREA-29      WRITE WORK HEADER LABEL
2049           BER  EWWKL
2050           BEF  *&1
2051           BCE  EXIT9,THLTMO,      TP MARK AFTER HEADER LABEL
2052           MLC  TPWKBK,*&4         YES
2053           WTM  %U0                WRITE TAPE MARK
2054 EXIT9     NOP  000                USER EXIT AFT WRITING WKLBL
2055           BCE  TOOWA,MI3TUN,      3 WAY MERGE
2056           C    TBC,@3@            YES
2057           BU   SWKLB
2058           B    NXBYPS
2059 TOOWA     C    TBC,@2@            2 WAY MERGE
2060           BU   SWKLB
2061           BCE  NXBYPS,URPI,P
2062           BCE  NXBYPS,URPI,C
2063           SBR  EXIT9&7,NXBYPS
2064           MLC  URPI,TPWKBK
2065           B    SWKLB&7
2066 NXBYPS    R
2067           BCE  NXTINT,68,B
2068           B    NXBYPS
2069 NXTINT    CS   080
2070           SW   24,56
2071           SW   63,67
2072           R    056
2073 NOISEW    MLC  HDRBKT,X3
2074           MLC  K2BLNK,0&X3
2075           CHAIN12
2076           B    RDWL
2077 RERDWL    A    ONE,CNTR
2078           BAV  STOPW
2079           B    RDWL-5
2080 STOPW     H    ACPLB              ERR ON READING WK LABEL
2081           B    RDWL-5             HIT START TO ACCEPT AS READ
2082 *                                 HIT START RESET-START-TO REREAD
2083 ACPLB     BEF  *&1
2084           A    ONE,TBC
2085           B    EXIT5-12
2086 NOWL      A    ONE,TBC            NO WORK LABEL-CREATE TEMP
2087           B    EXIT5
2088 EWWKL     A    ONE,CFIFTY         WRITE ERROR ROUTINE
2089           MLC  TPWKBK,*&4
2090           BSP  %U0
2091           BAV  H50
2092           MLC  TPWKBK,*&4
2093           WT   %U0,WLAREA-29
2094           BER  *&5
2095           B    WTWL&13
2096           MLC  TPWKBK,*&4
2097           BSP  %U0
2098           MLC  TPWKBK,*&4
2099           SKP  %U0
2100           B    WTWL
2101 H50       MLC  @80@,CFIFTY
2102           H    WTWL-7             TRIED TO WRITE WORK LABEL 20
2103 *                                 TIMES-HIT START TO TRY AGAIN
2104 TPWKBK    DCW  @ @
2105 TBC       DCW  @0@
2106 CFIFTY    DCW  @80@
2107 HDRBKT    DCW  @000@
2108           LTORG*
2109           EX   INTIAL
2110           JOB  ** IBM 1401 SORT 7 VERSION 2 PHASE 1                   60  2
2111 *
2112 *
2113 *
2114 *              120 CHARACTER HEADER TRAILER ROUTINE                   61  2
2115 *                                                                     61  2
2116           ORG  HDRENT
2117 HDRANT    SBR  HDRAXT&3            INITIALIZE LABEL ROUTINE           61  2
2118           MLC  ITPBKT,REHDRL&3    PRIME TAPE READ INSTRUCTION
2119           MLC  ITPBKT,RETPMK&3    PRIME READ TAPEMARK ROUTINE
2120           MLC  ITPBKT,CGET1&3     PRIME BACKSPACE COMMAND
2121           MLC  ITPBKT,*&4         PRIME REWIND INSTRUCTION
2122 BCKHER    RWD  0                  REWIND TAPE UNIT PRIOR TO READ
2123           MLC  K1BLNK,CNTR        PRIME ERROR COUNTER
2124 REHD2     MLCWAGM,321             LOAD GROUPMARK INTO LABEL AREA
2125           MLC  CENSIG,214         PRIME NOISE RECORD TEST
2126 REHDRL    RTW  0,201              READ HEADER LABEL IN LOAD MODE
2127           SW   201                SET A WODRMARK TO LOAD RECORD
2128 ANOSCK    BCE  NOISBL,214,        CHECK FOR NOISE RECORD
2129           BER  REDOLB             REDUNDANT RECORD ON TAPE READ
2130           BCE  *&29,LBLSAM,       BRANCH IF LABEL IS NOT TO BE
2131 *                                 SAVED
2132           MLC  240,RESEQE&1       ONLY THE LABEL IS SAVED
2133           MLCWA230,FILESE
2134           SBR  *-18,2500
2135           SBR  *-18,2500
2136           BEF  *&1                RESET END OF FILE INDICATOR
2137           W                                                           61  2
2138           CC   L
2139           BCE  USEXT7,LBLBKT-32,     IS LABEL TO BE CHECKED
2140           BCE  NAMFIL,LBLBKT-31,    ALL VALUES OR FILE NAME ONLY
2141           C    230,LBLBKT-25      COMPARE FILE SERIAL NUMBER
2142           BU   FRRHDR             UNEQUAL-BRANCH TO ERROR MESSAGE
2143           C    215,LBLBKT-5       COMPARE CREATION DATE
2144           BU   FRRHDR             UNEQUAL-BRANCH TO ERROR ROUTINE
2145           C    240,LBLBKT-20      COMPARE REEL SEQUENCE NUMBER
2146           BU   FRRHDR             UNEQUAL-BRANCH TO ERROR ROUTINE
2147 NAMFIL    C    225,LBLBKT-10      COMPARE RREL NAMES
2148           BU   FRRHDR
2149           BCE  USEXT7-7,LBLBKT-30,
2150           A    ONE,LBLBKT-21
2151           MLCWAGM,321
2152 USEXT7    NOP  000                USER EXIT FOR FURTHER CHECKING
2153 *                                 OF INPUT HEADER LABELS.LABEL WILL
2154 *                                 BE NOW FOUND IN RLAREA&80
2155 RETPMK    RTW  0,319              READ TAPEMARK
2156           CS   332
2157           BEF  HDRAXT
2158 CGET1     BSP  0                  NO TAPE MARK IS PRESENT
2159 HDRAXT    B    0
2160 REDOLB    A    ONE,CNTR           REDUNDANT LABEL DETECTED
2161           BAV  STOPIH
2162           B    BCKHER             REATTEMPT READ OPERATION
2163 NOISBL    CS   220                CLEAR NOISE RECORD
2164           B    REHDRL-7
2165 FRRHDR    CS   332
2166           CS
2167           MLC  UCMESG,215
2168           MLC  LBLBKT,255         MOVE CONSTANTS FROM CONTROL CARD
2169           MLC                     TO PRINT AREA
2170           MLC
2171           MLC
2172           MLC
2173           MLC
2174           W
2175           CC   1
2176 STOPIH    H    USEXT7-22
2177           B    BCKHER-14
2178 UCMESG    DCW  @ERROR-SHOULD BE@
2179 *                                 TRAILER LABEL ROUTINE
2180 TRLANT    SBR  TRLAXT&3
2181           MLC  ITPBKT,RDTRAL&3
2182           MLC  ITPBKT,BAKTRL&3
2183           MLC  K2BLNK-1,CNTR
2184 RDTL2     MLCWAGM,321             LOAD GROUPMARK
2185 RDTRAL    RTW  0,201              READ TRAILER INTO LABEL AREA
2186           BEF  *&1
2187           BER  RAREAT
2188           W
2189           CC   L
2190           BCE  USEXT6,TL,3
2191           C    272,BLKCT1         CHECK BLOCK COUNT
2192           BU   ERETRL
2193 USEXT6    NOP  0        USER EXIT AFTER TRAILER READ
2194 TRLAXT    B    000
2195 RAREAT    A    ONE,CNTR
2196           BAV  STOPIT
2197 BAKTRL    BSP  0
2198           B    RDTRAL             TRY TO REREAD LABEL
2199 ERETRL    CS   332                PRINT UNEQUAL BLOCK COUNT MESSAGE
2200           CS
2201           MLC  UCMESG,215
2202           MLC  BLKCT1,230
2203           W
2204           CC   1
2205           H    USEXT6
2206 STOPIT    H    TRLAXT             BYPASS TRAILER READ
2207 *
2208 *                120 CHARACTER WORK LABEL ROUTINE
2209           ORG  4175
2210           DCW  @1HDR           SORT7LABEL     @
2211           DC   @00000@
2212           DC   #45
2213           DC   #40
2214 MAGMWL    DCW  @  @
2215 WORTEN    MLC  MI1TUN,TPWRBK
2216           MLC  CENSIG,ANOSCK&7
2217           MLC  GPMARK,USEXT7-4
2218           MLC  CENSIG,OTWNOI&7
2219           MLC  GPMARK,REHD2&3
2220           SBR  LSTCHK&3,TRLANT
2221           MLC  GPMARK,RDTL2&3
2222           MLC  @00@,CRYBU2
2223           MLC  TPWRBK,WLAREA&5
2224           MA   ONE,WORTEN&3
2225           MLC  GPMARK,*&4
2226           MLCWAGM,MAGMWL-1        LOAD GROUPMARK FOR TAPE OPERATION
2227 USEXT0    NOP  000      USERS EXIT PRIOR TO READ LABEL
2228           BCE  NYETWL,WLBKT,      NO LABEL CREAT TEMP LABEL
2229           MLC  TPWRBK,DARAWL&3
2230           MLC  K1BLNK,CNTR        RESET COUNTER
2231           MLC  TPWRBK,*&4
2232           RWD  0                  REWIND TAPE UNIT
2233           MLC  CENSIG,WLAREA-16   PRIME NOISE ROUTINE TEST
2234 DARAWL    RTW  0,WLAREA-29        READ WORK TAPE LABEL
2235           SBR  HERBKT
2236 OTWNOI    BCE  NOISOW,WLAREA-16,    CHECK NOISE RECORD
2237           BER  OERDWL
2238           BEF  *&1
2239           A    ONE,OTW0BC
2240           BCE  USEXT5-12,WLBKT,0  00 IF HEADER BUT NO CHECK CC3COL4
2241 *                  RETENTION CYCLE CHECKING
2242           MLC  WLAREA-15,YEACHK
2243           MLC
2244           MLC
2245           SW   CREATD-2
2246 CULLES    C    CREATD-3,YEACHK-3  COMPARE YEAR
2247           BU   CHNGYR
2248           A    YEACHK,YEACHK-5    ADD TAPE DAYS TO RETENTION CYCLE
2249           S    CREATD,YEACHK-5    SUBTRACT CONT DAS FROM RET CYL
2250           CW   CREATD-2
2251           BWZ  USEXT5-12,YEACHK-5,K  CAN WE WRITE ON TAPE
2252           CS   332                N/ PRINT MESSAGE INDICATING NUM
2253           CS                      OF DAYS TAPE IS TO BE RETAINED
2254           MLC  SAVMES,226
2255           MLNS YEACHK-5,221
2256           MLNS
2257           MLNS
2258           MLC  SVMES1
2259           MLC  TPWRBK
2260           MLC  SVMES2
2261           W
2262           CC   1
2263           H    USEXT5-12          HIT START TO ACCEPT TAPE
2264           B    USEXT0-7
2265 CHNGYR    A    REOYRE,YEACHK-5    SUBTRACT 365 FROM RETENTION CYL
2266           A                       AND ADD 1 TO TAPE YEARS
2267           S
2268           A    @1@,CRYBU2
2269           BCE  HLCRY2,CRYBU2-1,3
2270           B    CULLES
2271 HLCRY2    H    USEXT5-12
2272           MLC  @00@,CRYBU2
2273           B    CULLES
2274 CRYBU2    DCW  @  @
2275           DCW  @365@
2276           DCW  @1@
2277 REOYRE    DCW  @0@
2278 SVMES2    DCW  @RETAIN TAPE @
2279 SVMES1    DCW  @ FOR @
2280 SAVMES    DCW  @ DAYS@
2281           DCW  #4                 RETENTION CYCLE BUCKET
2282           DCW  #2                 YEAR
2283 YEACHK    DCW  #3                 DAY
2284           MLC  TPWRBK,*&4
2285           RWD  0                  REWIND UNIT
2286 USEXT5    NOP  0                  USER EXIT PRIOR TO WRITING
2287 *                                 HEADER LABEL ON WORK TAPE
2288           MLC  TPWRBK,*&4
2289 WETWIL    WT   0,WLAREA-29        WRITE WORK HEADER LABEL
2290           BER  EEWWKL
2291           BEF  *&1
2292           BCE  USEXT9,THLTMO,     TAPEMARK AFTER HDR LABEL CHECK
2293           MLC  TPWRBK,*&4         YES
2294           WTM  0                  WRITE TAPEMARK
2295 USEXT9    NOP  0                  USER EXIT AFTER WRITNIG HEADER
2296 *                                 LABEL ON WORK TAPE
2297           BCE  ZWEWAY,MI3TUN,      THREEWAY MERGE
2298           C    OTW0BC,@3@         YES
2299           BU   WORTEN
2300           B    LEVWLR
2301 ZWEWAY    C    OTW0BC,@2@         TWOWAY MERGE
2302           BU   WORTEN
2303           BCE  LEVWLR,URPI,P
2304           BCE  LEVWLR,URPI,C
2305           SBR  USEXT9&7,LEVWLR
2306           MLC  URPI,TPWRBK
2307           B    WORTEN&7
2308 LEVWLR    CS   80
2309           SW   24,56
2310           SW   63,67
2311           R    56
2312 NOISOW    MLC  HERBKT,X3
2313           MLC  K2BLNK,0&X3
2314           CHAIN12
2315           B    DARAWL
2316 OERDWL    A    ONE,CNTR
2317           BAV  OSTOPW
2318           B    DARAWL-12
2319 OSTOPW    H    OACPLB             ERROR ON READING WORK LABEL
2320           B    DARAWL-12          HIT START TO ACCEPT AS READ
2321 *                                 HIT START RESET&START TO REREAD
2322 OACPLB    BEF  *&1
2323           A    ONE,OTW0BC
2324           B    USEXT5-12
2325 NYETWL    A    ONE,OTW0BC         NO WORK LABEL CREATE TEMPORARY
2326           B    USEXT5
2327 EEWWKL    A    ONE,YFIFTY         WRITE ERROR ROUTINE
2328           MLC  TPWRBK,*&4
2329           BSP  0
2330           BAV  OTW050
2331           MLC  TPWRBK,*&4
2332           WT   0,WLAREA-29
2333           BER  *&5
2334           B    WETWIL&13          RETURN TO NORMAL ROUTINE
2335           MLC  TPWRBK,*&4
2336           BSP  0
2337           MLC  TPWRBK,*&4
2338           SKP  0
2339           B    WETWIL
2340 OTW050    MLC  @80@,YFIFTY        TRIED TO WRITE WORK LABEL 20
2341           H    WETWIL-7           TIMES HIT START TO TRY AGAIN
2342 TPWRBK    DCW  @ @
2343 HERBKT    DCW  @000@
2344 OTW0BC    DCW  @ @
2345 YFIFTY    DCW  @  @
2346           LTORG*
2347           DCW  @3@
2348           EX   WORTEN
2349           JOB  ** IBM 1401 SORT 7 VERSION 2  PHASE 1                  60  2
2350 *
2351 *           I N I T I A L I Z A T I O N   P H A S E                   B1401
2352 *
2353           ORG  4175
2354 *                               MULTIPHASE INITIALIZATION
2355 PLYIN5    MLC  ONPTAR,B201W&6
2356           MA   @001@,ONPTAR
2357           MLC  ONPTAR,INTOUT
2358           SW   B201W&4
2359           MLC  B201W&6,PLYIN4&6
2360           MLC  PLYIN5,PLYIN4
2361           MLC  B201W&6,PLYIN3&6
2362           MLC  B201W&6,LODTB3&10
2363           MLC  @M@,LODTB3&4
2364           CW   B201W&4
2365           B    INSRT5&19
2366 ATEK      MLC  &INTOUT,BP2200&3
2367           MLC  CENSIG,CKNOIS&7    INITIALIZE NOISE ROUTINE
2368           MLC  GPMARK,LDGM&3
2369           MA   CF1RE,BFRST3
2370           BCE  *&15,UNLOAD,
2371           MLC  @N@,EOFRWD-7
2372           MLC  @U@,EOFRWD&4
2373           BCE  PTCHB1,MI3TUN,
2374           MLC  &LBMI3T,NXTTP1&6
2375           MLC  &LBI3T,SCHTP1&6
2376           MLC  @6@,NOTAPS
2377 PTCHB1    MLC  NOTAPS,NOTAPG
2378 PTCHBR    BCE  VLTHRU,FLR,1
2379 *                               DETERMINE G BASED ON B FOR FLR
2380           MLC  @B@,L10
2381           MLC  @B@,L102
2382           A    B,G
2383 G2TMS     A    G
2384 SETMXG    C    G,@512@
2385           BH   SETG
2386           BE   SETG
2387           MLC  @N@,DUBLGL
2388 L10       B    L103
2389 VLTHRU    BCE  VLTHR2,MINREC,
2390           MLC  BL,CONVRT
2391           B    EXPAND
2392           MLC  HOLD,HOLDGL
2393 DBLVLG    A    HOLDGL
2394           BCE  VLTHR3,MI3TUN,
2395 GL3VL     A    HOLD,HOLDGL
2396 VLTHR3    MLC  MINREC,CONVRT
2397           B    EXPAND
2398 VLTHR1    S    HOLD,HOLDGL
2399           A    ONE,G
2400           BWZ  VLTHR1,HOLDGL,B
2401           MA   @I9I@,G
2402           C    G,@512@
2403           BH   THRU
2404 VLTHR2    MLC  @512@,G
2405           B    THRU
2406 HOLDGL    DCW  00000
2407 VLBL      DCW  000
2408           MLC  @N@,GL3NXT
2409 L103      MLC  @N@,L10
2410           S    B,G
2411           MLZS K1BLNK,G
2412           B    SETMXG
2413 SETG      MLC  G,FIRSTG
2414           BCE  THRU,NOTAPS,4
2415 G3TMS     A    B,G
2416 SETMG2    C    G,@512@
2417           BH   SETGFR
2418           BE   SETGFR
2419           MLC  @N@,GL3NXT
2420 L102      B    L104
2421           MLC  @N@,DUBLGL
2422 L104      MLC  @N@,L102
2423           S    B,G
2424           MLZS K1BLNK,G
2425           B    SETMG2
2426 SETGFR    MLC  G,FIRSTG
2427           BCE  THRU,EFS,        DETERMINE G FOR EXPECTED FILE SIZE
2428           MLC  EFS,EFSTRT
2429 LOG3      MLC  EFSTRT,EFSCPT
2430           A    EFSCPT
2431           A    EFSTRT,EFSCPT
2432           MLC  @6@,BUCKET
2433 DIVTHR    A    EFSCPT,EFSTPT
2434           MA   P15999,DIVTHR&6
2435           A    NINE,BUCKET
2436           BAV  DIVTHR
2437           ZA   EFSTPT-7,EFSTRT
2438           MLZS K1BLNK,EFSTRT
2439           A    ONE,EFSTRT
2440           C    EFSTRT,G
2441           S    EFSTPT
2442           MA   @007@,DIVTHR&6
2443           BL   LOG3
2444           S    B,G
2445           MLZS K1BLNK,G
2446           C    EFSTRT,G
2447           BL   ADDBLF
2448           BE   ADDBLF
2449           MLC  @N@,GL3NXT
2450           B    THRU
2451 ADDBLF    A    B,G
2452 THRU      A    INTGLG
2453 CMTGLG    C    INTGLG,G
2454           BH   THRU
2455           MLC  MFS,MFSIZE
2456 DETPRM    MA   @I9C@,DTPRM1&3
2457 DTPRM1    C    PRGMSZ&7,INTGLG
2458           SAR  MVNDPM&3
2459           BU   DETPRM
2460 MVNDPM    MLC  0,NDFPGM
2461           MLC  NDFPGM,HPNDPM
2462           BCE  CMPT52,DESCND,1
2463           MA   @I9I@,HPNDPM
2464           BCE  CMPT5G,NCF,1
2465 CMPT52    MA   L,HPNDPM
2466 CMPT5G    A    INTGLG,HLD3G
2467           MA   G,THREEG
2468           A    NINE,HOLD2
2469           BAV  CMPT5G
2470           MLC  HLD3G,HLD34G
2471           A    HLD34G
2472           A    HLD34G
2473           A    HLD3G,HLD34G
2474           MLC  HLD34G-1,TREQRG&1
2475           A    TREQRG&1
2476           A    TREQRG&1
2477           A    HLD34G-1,TREQRG&1
2478           MLC  INTGLG,G/4INT
2479           MA   ONE,HPNDPM
2480           MLC  HPNDPM,ONPTAR
2481           MA   ONE,ONPTAR
2482 INSRT5    BSS  PLYIN5,C
2483 *                               DETERMINE ADDRESSES OF I/O AREAS
2484           MLC  ONPTAR,INTOUT
2485           MLC  ONPTAR,B201W&6
2486           MA   BL,ONPTAR
2487           MLC  ONPTAR,HOLDND
2488           MA   COMPL,HOLDND
2489           MLC  ONPTAR,LOADGM&6
2490           MLC  ONPTAR,COUNTR
2491           MA   @I9I@,COUNTR
2492 LDGM      MLCWAGM,333
2493           MLC  ONPTAR,X
2494           MA   ONE,X
2495           MLC  X,Y
2496           MA   TREQRG,Y
2497           MA   @I9I@,Y
2498           MLC  Y,O1
2499           MA   THREE,O1
2500           MLC  O1,G1
2501           MA   THREEG,G1
2502           MA   @I9G@,G1
2503           MLC  O1,O1FA
2504           MLC  O1
2505           MA   @003@,O1FA
2506           MLC  O1,STPDNR&3
2507           MLC  G1,ONPTAR
2508           MA   ONE,ONPTAR
2509           MLC  ONPTAR,Z
2510           MLC  BL,GL
2511 DUBLGL    MA   GL
2512           MA   GL,Z
2513 GL3       BCE  *&8,NOTAPS,4
2514 GL3NXT    MA   BL,Z
2515 GL1111    BWZ  SBTRCB,Z,2         DETERMINE IF INPUT AREA
2516 GL1112    MLC  Z,CONVRT           ALLOCATED IS SUFFICIENT
2517           B    EXPAND
2518           MLC  HOLD,Z5DIGT
2519           BCE  TPPSBL,UAPHZ1,
2520 CTPAVL    C    Z5DIGT,UAPHZ1
2521           BH   DUBLG
2522 SBTRCB    A    @7@,NOTAPG
2523           MLC  @16000@,SXTNTH
2524           BAV  RPCHBR
2525           CS   332
2526           CS
2527           MLC  PRMSG7,250
2528           W
2529           CC   1
2530           H    *&1
2531           MLC  GPMARK,TPV1
2532           MLC  @#@,GL3NXT
2533           MLC  @#@,DUBLGL
2534           MLC  @A@,DBLVLG
2535           MLC  @A@,GL3VL
2536           MLC  @#@,G3TMS
2537           MLC  @#@,G2TMS
2538           MLC  GPMARK,CONVRT
2539           B    EXPAND
2540           MLC  HOLD,UAPHZ1
2541           MLC  FIRSTG,G
2542           B    INRPCH
2543 TPPSBL    MLC  GPMARK,CONVRT
2544           B    EXPAND
2545           MLC  HOLD,UAPHZ1
2546           B    CTPAVL
2547 RPCHBR    MLC  @N@,DUBLGL
2548           MLC  @N@,DBLVLG
2549           MLC  @N@,G2TMS
2550           NOP
2551 BCLWMK    B    CLWMK
2552           MLC  @N@,GL3NXT
2553           MLC  @N@,GL3VL
2554           MLC  @N@,G3TMS
2555 CLWMK     CW   BCLWMK
2556 INRPCH    MLC  @0002@,INTGLG
2557           S    EFSTRT
2558           MLC  @0000@,G&1
2559           MLC  &PRGMSZ&7,DTPRM1&3
2560           S    HLD3G
2561           MLC  @000@,THREEG
2562           MLC  TWO,HOLD2
2563           S    HLD34G
2564           S    TREQRG&1
2565           B    PTCHBR
2566           DCW  &P1344&4
2567           DC   0512
2568           DCW  &P576&4
2569           DC   0256
2570           DCW  &P192&4
2571           DC   0128
2572           DCW  &P144&4
2573           DC   0064
2574           DCW  &P072&4
2575           DC   0032
2576           DCW  &P024&4
2577           DC   0016
2578           DCW  &P021&4
2579           DC   0008
2580           DCW  &P009&4
2581           DC   0004
2582           DCW  &P003&4
2583 PRGMSZ    DC   0002
2584 KTWO      DCW  @ @
2585 TWO2      DCW  @002@
2586 CMPRNS    DCW  000000
2587 G/4INT    DCW  000
2588 SEVEN     DCW  @7@
2589 ISONED    S    ONE,D
2590 THRWSZ    DCW  @109@
2591 BTRUTN    DCW  @998@
2592 TPRUTN    DCW  @|98@
2593 EQRTSZ    DCW  @127@
2594 MODADR    DSA  15001
2595 PRMSG7    DCW  @PATCH PROGRAM TOO LARGE PRESS START - IGNORE PATCH@
2596 CMPLBL    DCW  000
2597 NOTAPG    DCW  0
2598 Z5DIGT    DCW  00000
2599 NOEQL     MLC  @N@,STPCM2
2600           B    STCMP4
2601 BILRGM    CS   332
2602           CS
2603           MLC  PRMSX,231
2604           W
2605           CS   231
2606           MLC  @G@,201
2607           MLC  G,205
2608           W
2609           CC   1
2610           H    *-3
2611 DUBLG     MLC  Z,COWNTR
2612           C    G,BI
2613           BH   BILRGM
2614 DUBLG2    MLC  Y,H13H10-3
2615           MA   @I9G@,Y
2616           MLC  Y,H13H10
2617           MLC  X,LOADTB&3
2618           MLC  Y,LODTB3&3
2619           MLC  H13H10,LODTB2&6
2620           MLC  H13H10-3,LODTB1&6
2621 DUBLG1    MA   CCCFRE,ADRLRD
2622           BCE  DUBLG3,DESCND,     DESCENDING
2623           MLC  @5@,ASCNDN&6       YES-INITIALIZE COMPARE BUCKETS
2624           MLC  @2@,ASCNDN&13      FOR DESCENDING
2625           MA   @003@,ASCNDG&6
2626 DUBLG3    BCE  NOEQL,NCF,1        TEST FOR NUM OF CONTROL FIELDS
2627           MLC  NDFPGM,ADRLRD
2628           MA   ONE,ADRLRD
2629           MLC  NCF,POT
2630           S    TWO,POT
2631           MLC  &CF2RE,X1          INITIALIZE EQUAL ROUTINE
2632           MLC  &BSCBSC-6,X2       CONSTANTS IF SECONDARY CONTROL
2633 STNEQL    MLC  0&X1,6&X2          FIELDS ARE PRESENT
2634           MLC  0&X1
2635 ASCNDN    MLZS @A@,2&X2
2636           MLZS @Z@,5&X2
2637           MA   @006@,X2
2638           MA   @003@,X1
2639           BAV  *&1
2640           A    NINTNN,POT
2641           BAV  STNEQL
2642           MA   X2,LAST
2643           MLC  @6@,BKET
2644 MVNEQL    MLC  @N@,STCMPR&7
2645           MA   @014@,MVNEQL&6
2646           A    NINE,BKET
2647           BAV  MVNEQL
2648 STCMP4    MLC  BFRST3,CMPRNS
2649           MLC  BFRST3
2650 ASCNDG    MLZS @A@,CMPRNS-4
2651           MLC  @013@,X1
2652 STCMPR    MLC  CMPRNS,B002B&X1    INITIALIZE COMPARE INSTRUCTIONS
2653           MLC  @N@,B002B&6&X1     IN MAINLINE WITH RIGHT EDGE OF
2654           MLC  CMPRNS,B004B&X1    MAJOR CONTROL FIELD
2655           MLC  @N@,B004B&6&X1
2656           MLC  CMPRNS,B701B&X1
2657           MLC  @N@,B701B&6&X1
2658           MLC  CMPRNS,B008B&X1
2659           MLC  @N@,B008B&6&X1
2660           MLC  CMPRNS,B703B&X1
2661           MLC  @N@,B703B&6&X1
2662           MLC  CMPRNS,B705B&X1
2663           MLC  @N@,B705B&6&X1
2664           MLC  CMPRNS,B715B&X1
2665           MLC  @N@,B715B&6&X1
2666 STCMP5    MA   @245@,X1
2667           C    KTWO,@2@
2668           A    ONE,KTWO
2669           BU   STCMPR
2670 CMPTGC    MLC  G,GCNTR
2671           S    ONE,GCNTR
2672           S    NOINTP,CPLITP
2673           A    ONE,CPLITP
2674 CMPTG4    MLC  G/4INT,G/4&2
2675           A    G/4&2
2676           A    G/4INT,G/4&1
2677           A    G/4&2
2678           A    G/4INT,G/4&2
2679           MLC  B008B&13,STPCMP&6
2680           MLC  ISONED&6,SONED
2681           CS   80
2682           SW   24,56
2683           SW   63,67
2684           R    56
2685           DCW  @ @
2686           ORG  6200
2687 PRMSG9    DCW  @PHASE 1 INP       OUT      @
2688 GCMPLT    DCW  @999@                                                  B1401
2689 POT       DCW  00
2690 FIRSTG    DCW  000
2691 EFSTRT    DCW  00000000
2692 BLCMPT    DCW  000
2693 BKET      DCW  0
2694 SXTNTH    DCW  @16000@
2695 VLRRTN    DCW  000
2696 EFSCPT    DCW  00000000
2697 BUCKET    DCW  0
2698 EFSTPT    DCW  00000000000000
2699 INTGLG    DCW  @0002@
2700 THREEG    DCW  0000
2701 HLD3G     DCW  0000
2702 HOLDG     DCW  000
2703 MOVPUT    MLC  X2,HOLDND
2704 HLD34G    DCW  00000
2705 TREQRG    DCW  00000
2706           DC   0
2707 HOLD2     DCW  @2@
2708 NDFPGM    DCW  @?00@
2709 X         DCW  000
2710 Y         DCW  000
2711 NINEG     DCW  @009@
2712 CMPGLG    DCW  @XXX@
2713 GL        DCW  00000
2714 NTOTVL    DCW  000
2715 H13H10    DCW  000000
2716 PHZ1MG    DCW  @PHASE 1  INTERNAL SORT@
2717 CHKPRT    DCW  @CHECKPOINT ON TAPE UNIT #@
2718           LTORG*
2719           EX   ATEK
2720           JOB  ** IBM 1401 SORT 7 VERSION 2  PHASE 1                  60  2
2721           ORG  4175
2722 FXCHEK    BCE  FLRRTN,FLR,        FIXED LENGTH RECORDS BRANCH
2723           MLC  @ @,RNGLNQ&4       INITIALIZE MAINLINE ROUTINES FOR
2724           MLC  &B2211B,BTOHAS&3   VARIABLE LENGTH RECORDS
2725           MA   BFRST3,B011TH&3
2726           MA   RCDIST,CNVRSN&3
2727           MA   RCDIST,CNVRS1&6
2728           MA   RCDIST,B011TB&3
2729           MLC  @N@,BP002
2730           MLC  @N@,B2211D
2731           MLC  &VLRGET,BP001&6
2732           BCE  CNTVL1,DESCND,1
2733           MA   ONE,STPCMP&3
2734           B    CNTVLR
2735 NORLIN    MLC  @M@,B010RI
2736           MLC  @#@,B010R
2737           MLC  @N@,STG1J
2738           MLC  @N@,SETG1J
2739           MLC  @N@,SETG1&7
2740           MLCWARLINO2&6,RLINO&6
2741           MLCWARLINO1&6
2742           B    CNTVL3
2743 CON16T    DCW  @16000@
2744 RLINO2    MA   K4,X1
2745 RLINO1    MLC  K1BLNK,0&X1
2746 MLTIBL    MA   K4,X2
2747 CNTVL1    MA   ONE,STPCMP&6
2748 CNTVLR    CW   B2212&5
2749           CW   B002R
2750           MLCWAMLTIBL&6,B002R&8
2751           MLC  &CMPCOW
2752           MLC  @089@
2753           MLC  @#@
2754           MLC  &CMPCOW
2755           MLC  &COWNTR
2756           MLC  @M@
2757           MLC  @0!1@,WRTFL1&6
2758           MLC  GPMARK
2759           MLC  @L@
2760           MLC  @2@,B2212&14
2761           MLC  &CMPCOU
2762           MLC  &BP002
2763           MLCWA@V@
2764           MLC  &CMPCOU
2765           MLC  @094@
2766           MLC  @#@
2767           MLC  &CMPCOU
2768           MLC  &COUNTR
2769           MLC  @M@
2770           C    BI,@001@           CHECK FOR UNBLOCKED INPUT
2771           BU   CNTVL3
2772           BCE  NORLIN,RLIIND,1
2773           MLCWARLINO&6,RLINO-1
2774 CNTVL3    MLC  &B220VL&3,B2200&6
2775           MLC  &B220VL&3,B2202&6
2776           MLC  &B220VL&3,B2211B&3
2777           MLC  @0!0@,B2001&6
2778           MLC  @0|0@
2779           MLC  RCDIST,B2000&3
2780           MLCWA@#@
2781           MLZS @S@,B2000&2
2782           MLC  @094@,B2201&6
2783           MLC  RCDIST
2784           MLC  @#@
2785           MLZS @S@,B2201&2
2786           MLCWAMOVPUT&6,B2201V&6
2787           MLC  @094@
2788           MLC  @L@,B201W
2789           MLC  @L@,B001R
2790           MLC  L,CONVRT
2791           B    EXPAND
2792           C    @00999@,HOLD       CHECK RECORD LENGTH
2793           BH   BRMAX
2794           MLCWABRMAXL&4,CNVRSN&4
2795 BRMAX     MA   G1,LRG2G1
2796           MLC  LRG2G1,CONVRT
2797           B    EXPAND
2798           MLC  CON16T,CONVRT
2799           S    HOLD,CONVRT
2800           MLZS K1BLNK,CONVRT
2801           B    K5TOK3
2802           MLC  CONVRT,LRG2G1
2803           MLC  UAPHZ1,CONVRT
2804           S    @004@,CONVRT
2805           MLZS K1BLNK,CONVRT
2806           B    K5TOK3
2807           MLC  CONVRT,COWNTR
2808           MA   CMXBLK,COWNTR
2809           MLC  COWNTR,CONVRT
2810           B    EXPAND
2811           MLC  CON16T,CONVRT
2812           S    HOLD,CONVRT
2813           MLZS K1BLNK,CONVRT
2814           B    K5TOK3
2815           MLC  CONVRT,COWNTR
2816           MA   COMPL,COUNTR
2817           MA   ONE,COUNTR
2818           MLC  COUNTR,CONVRT
2819           B    EXPAND
2820           MLC  CON16T,CONVRT
2821           S    HOLD,CONVRT
2822           MLZS K1BLNK,CONVRT
2823           B    K5TOK3
2824           MLC  CONVRT,COUNTR
2825           BCE  *&8,KRUNCH,        DETERMINE IF RLI REQUIRES THE
2826           MA   SLRCC,STWMVL&10    SETTING OF A WORDMARK
2827           MLC  @000@,X1
2828           BCE  INVLWM,CNOP,1
2829           MA   @003@,INVLWM&3
2830 INVLWM    MLC  INVLST&X1,X3       INITIALIZE SET WORDMARK ROUTINE
2831           MA   CF1SL&X1,0&X3      FOR VARIABLE LENGTH RECORDS
2832           MA   @003@,X1
2833           C    X1,@030@
2834           BU   INVLWM
2835           MLC  NCF,NCFTOP
2836           MLC  &STWMVL,X2
2837           BCE  INVLW1,CNOP,1
2838           A    ONE,NCFTOP
2839 INVLW1    C    NCFTOP,KTHREE
2840           BH   INVLW2
2841           MA   @I9C@,X2
2842           A    @02@,KTHREE
2843           B    INVLW1
2844 INVLW2    C    NCFTOP,@11@
2845           BU   INVLW3
2846           MLC  &STWMVL-32,X2
2847 INVLW3    MLC  X2,SETG1J&3
2848           MLC  X2,B002RA&3
2849           MLC  X2,LSTBK1&3
2850           B    INSTP
2851 BRMAXL    B    B011TA
2852           DC   @ @
2853 KTHREE    DCW  @03@
2854 INVLST    DC   &STWMVL&3
2855                &STWMVL&6
2856                &STWMVL-1
2857                &STWMVL-4
2858                &STWMVL-8
2859                &STWMVL-11
2860                &STWMVL-15
2861                &STWMVL-18
2862                &STWMVL-22
2863                &STWMVL-25
2864                &STWMVL-29
2865 NCFTOP    DCW  @   @
2866 NCFPUT    DCW  00
2867 EMM       DCW  @L@
2868 QOUNTR    DCW  000
2869 BTOHAS    B    B2211D
2870 FLRRTN    MA   L,INTOUT
2871           MA   L,B2001&3
2872           MLC  &EQUAL,STPCM2&3
2873 QBACK     MA   L,RNGLNQ&6
2874           A    @1@,QOUNTR
2875           C    QOUNTR,BI
2876           BU   QBACK
2877           MLC  @N@,VLRGET
2878           MLC  @N@,VLRGET&7
2879           MLC  @N@,VLRGET&14
2880           MLC  &B4SS5,B002R&3
2881           MLC  BFRST3,B2211D&3
2882 INSTP     MA   @I9I@,INTOUT
2883           MLC  MI1TUN,B201W&3
2884           MLC  MI1TUN,B203W&3
2885           MLC  MI1TUN,TAPERW&3
2886           BCE  ANNENC,CNOP,1
2887 CTOL      S    CNOP,NCF
2888           S    ONE,NCF
2889           MLZS K1BLNK,NCF
2890           MLC  NCF,NCFPUT
2891           BCE  *&8,KRUNCH,
2892           A    @1@,NCFPUT
2893           MLC  @001@,X1
2894 SETPUT    MLCWAEMM,B2001&6&X1     INITIALIZE CHAINED MOVE IN
2895           A    @1@,X1             PUT ROUTINE BASED ON THE NUMBER
2896           A    NINTNN,NCFPUT      OF CONTROL FIELDS
2897           BAV  SETPUT
2898           C    NCF,@05@
2899           BL   SBCNOP
2900           MLCWABTOHAS&3,B2001&9&X1
2901 SBCNOP    A    CNOP,NCF
2902           A    ONE,NCF
2903 CTLAGN    MLC  COMPL,PCOMPL
2904           MA   @I9I@,HPNDPM
2905           MA   @I9I@,NDFPGM
2906           MLC  HPNDPM-2,TPCNPM-2
2907           MLZS HPNDPM,TPCNPM
2908           MLC  G,HOLDG
2909           C    HPNDPM,TPCNPM
2910           BU   *&8
2911           MLC  BR&4,MAX&19
2912 CKPTCR    BCE  GPMRK,UAPHZ1,
2913           MLC  UAPHZ1,CONVRT
2914           B    K5TOK3
2915           MA   CONVRT,STRTCL&3
2916           B    CHECK
2917 GPMRK     MA   GPMARK,STRTCL&3
2918 CHECK     CS   332
2919           CS
2920           C    HPNDPM,TPCNPM
2921           BU   DETS
2922           MLC  BR&4,MAX&19
2923           B    DETS
2924 BR        BIN  STWMK1-7,
2925 DETS      BCE  REVRS5,DESCND,1
2926           BCE  SWCHTP,NCF,1
2927           B    CMPTNC
2928 REVRS5    MA   NDFPGM,REVRS3&3
2929 REVRS3    SW   1
2930           MLC  HPNDPM,X1
2931           MLCWANINE,1&X1
2932 REVRS4    MLC  1&X1,0&X1
2933           SBR  X1
2934           CW   1&X1
2935           C    X1,NDFPGM
2936           BU   REVRS4
2937           MLC  K1BLNK,1&X1
2938           MLC  NDFPGM,ADRLRD
2939           MA   TWO,ADRLRD
2940           B    SWCHTP
2941 CMPTNC    MA   NDFPGM,*&4
2942           SW   1
2943           MLC  HPNDPM,X1
2944 LDNINE    MLCWAK1BLNK,1&X1
2945 LDBLNK    MLCWA1&X1,0&X1
2946           SBR  X1
2947           BCE  *&5,DESCND,
2948           CW   3&X1
2949           C    X1,NDFPGM
2950           BU   LDBLNK
2951           B    SWCHTP
2952 ANNENC    BCE  *&5,NCF,1
2953           B    CTOL
2954           BCE  CTLAG6,KRUNCH,
2955           MLC  EMM,B2001&7
2956           MLCWABTOHAS&3,B2001&11
2957           B    CTLAG6&7
2958 CTLAG6    MLCWABTOHAS&3,B2001&10
2959           B    CTLAGN
2960 CHKPNT    CS   80
2961           SW   24,56
2962           SW   63,67
2963           R    056
2964           EX   FXCHEK
2965           JOB  ** IBM 1401 SORT 7 VERSION 2  PHASE 1                  60  2
2966 *
2967 *                  BYPASS OR LOAD IN ROUTINE TO HANDLE FIXED
2968 *                  LENGTH RECORDS READ IN THE LOAD MODE
2969 *
2970           ORG  5000
2971 TESTML    BCE  TML,FLR,1
2972           BCE  BPSS,INMODE,M
2973 LCRD      CS   80
2974           SW   24,56
2975           SW   63,67
2976           R    056
2977           MLC  @L@,B001R
2978 BPSS      R
2979           BCE  LCRD,68,B
2980           B    BPSS
2981 TML       BCE  BPSS-7,INMODE,L
2982           BCE  *&12,TPV1,
2983           MLC  TPV1,CDTO
2984           B    *&8
2985           MLC  GPMARK,CDTO
2986           MA   @I9I@,CDTO
2987           MLC  ONPTAR,CLRTN&3
2988           MLC  @M@,B001R
2989           MLC  &CLRTN,BP001&6
2990           B    BPSS
2991           DCW  #1
2992           EX   TESTML
2993           JOB  ** IBM 1401 SORT 7 VERSION 2  PHASE 1                  60  2
2994 *
2995 *              SET WORD MARK ROUTINE FOR FIXED LENGTH
2996 *                  RECORDS READ IN THE LOAD MODE
2997 *
2998           ORG  VARLNT
2999           MLC  G,GCNT7
3000           MA   P15999,GCNT7
3001           MLC  @0?0@,SET7&3
3002           MA   ONPTAR,SET7&3
3003 SET71     MLC  NCF,NCF7
3004           MLC  @000@,X3
3005 SET7      SW   0&X3
3006 INSWN7    MLC  CF1SL,X3
3007           MA   THREE,INSWN7&3
3008           BAV  *&1
3009           A    NINTNN,NCF7
3010           BAV  SET7
3011           SBR  INSWN7&3,CF1SL
3012           MA   L,SET7&3
3013           A    @999@,GCNT7
3014           BAV  SET71
3015           B    B4SS5
3016 INSWF     MLC  @L@,B001R
3017           MLC  &VARLNT,B002R&3
3018           CS   80
3019           SW   24,56
3020           SW   63,67
3021           R    056
3022 GCNT7     DCW  #3
3023 NCF7      DCW  #2
3024           LTORG*
3025           EX   INSWF
3026           JOB  ** IBM 1401 SORT 7 VERSION 2  PHASE 1                  60  2
3027 *
3028 *                  WRITE CHECKPOINT ROUTINE
3029 *
3030           ORG  5000
3031 CHKPT1    CW   333                WRITE CHECKPOINT
3032           SW   1,5
3033           MLC  &RESTRT
3034           MLC  @B@
3035           MLC  MI1TUN,WRTCHK&3
3036           MLC  @80@,CNTR50
3037 RTCHK1    MLC  @N@,BRNCHK
3038 WRTCHK    WTW  0,1
3039           BER  ERRCHK
3040           BEF  EOFCHK
3041 RTCHK2    MLC  Z,MAX&6
3042           MLC  GPMARK
3043           MLC  GPMARK,LDG333&3
3044 LDG333    MLCWAGM,333
3045           MLC  &B013R,TSTLBL&11
3046           B    MPZ1
3047 ERRCHK    MN   WRTCHK&3,ERCHK1&3
3048 ERCHK1    BSP  0
3049 BRNCHK    B    ERSCHK
3050           MLC  @B@,BRNCHK
3051           B    WRTCHK
3052 ERSCHK    A    ONE,CNTR50
3053           BAV  HLTCHK
3054           MLNS WRTCHK&3,ERSHK1&3
3055 ERSHK1    SKP  0
3056           B    RTCHK1
3057 HLTCHK    H    CHKPNT
3058 EOFCHK    H    RTCHK2
3059 RESTRT    MLC  GPMARK,X1           RESTART
3060           RWD  1
3061           CS   332
3062           CS
3063           SW   0&X1
3064           MLC  @,@,PRMSG9-1
3065           MLC  MI2TUN
3066           MLC  @,@
3067           MLC  MI1TUN
3068           BCE  TOWYMG,NOTAPS,4
3069           MLC  MI3TUN,PRMSG9
3070           MLC  I3TUN,PRMSG9-10
3071           MLZS *-6,CENSIG
3072 TOWYMG    MLC  @,@,PRMSG9-11
3073           MLC  I2TUN
3074           MLC  @,@
3075           MLC  I1TUN
3076           RWD  1
3077           MLC  PRMSG9,227
3078           W
3079           CC   1
3080 NDRSTT    H    CHKPT1
3081 MPZ1      CS   299
3082           MLC  PHZ1MG,222
3083           W
3084           CS   299
3085           MLC  MI1TUN,226
3086           MLC  CHKPRT
3087           W
3088           BCE  ENDPRT,FLR,1
3089 CMPT3B    A    ONE,THREEB
3090           S    B,HOLDG
3091           BWZ  CMPT3B,HOLDG,B
3092           S    ONE,THREEB
3093           CS   226
3094           MLC  @G@,201
3095           MLC  G,205
3096           W
3097 ENDPRT    CC   1
3098 RDURLD    CS   080
3099           SW   24,56
3100           SW   63,67
3101 WHICH     BCE  STURPI,URPI,P
3102           BCE  STURPI,URPI,C
3103           MLC  @T@,DECIDE&7
3104           B    DECIDE-1
3105 STURPI    MLC  URPI,DECIDE&7      DETERMINE REDUNDANCY ROUTINE
3106           R                       REQUESTED BY USER
3107 DECIDE    BCE  056,079,           LOAD IT AND BYPASS OTHERS
3108           R    DECIDE
3109 FRED      CS   080
3110           SW   24,56
3111           SW   63,67
3112           R
3113           BCE  CLEARS,079,
3114           R    *-11
3115           EX   CHKPT1
3116           JOB  ** IBM 1401 SORT 7 VERSION 2  PHASE 1  CORRECT URPI    60 C2
3117           ORG  HERE
3118           SBR  MOVUR&3,0&X3
3119           CS   332
3120           CS
3121           SBR  MOVUR&13,201
3122 MOVUR     MLC  0,CNTR1
3123           MLC  CNTR1,201
3124           MA   ONE,MOVUR&3
3125           MA   ONE,MOVUR&13
3126           C    MOVUR&3,X1
3127           BE   CRLNLR
3128           BCE  JDYLNR,MOVUR&11,3
3129           B    MOVUR
3130 JDYLNR    W    MOVUR-12           PRINT UNREADABLE INPUT BLOCK
3131 CRLNLR    W
3132           CC   1
3133 TSTSSG    H    WRLERT
3134           BSS  TAPRD2,G
3135           B    ACCEPT
3136 CNTR1     DCW  @ @
3137 WRLERT    MLC  K1BLNK,0&X1
3138           MLC  X3,X1
3139 WRGSET    MLCWAGM,0
3140           B    B000R
3141           DCW  @ @
3142           ORG  5000
3143 CORINI    MLC  GPMARK,WRGSET&3
3144           MLC  Z,WRGSET&6
3145           B    FRED
3146           DCW  @ @
3147           EX   CORINI
3148           JOB  ** IBM 1401 SORT 7 VERSION 2  PHASE 1  TAPE URPI       60 T2
3149           ORG  HERE
3150           BWZ  NOLNZG,0&X1,1
3151           MLC  CLR1&15,CLWMGM
3152           B    WTWTT-4
3153 NOLNZG    MLC  @N@,CLWMGM
3154           SW   0&X1
3155 WTWTT     WT   0,0&X3             WRITE UNREADABLE INPUT BLOCK ON
3156           BEF  HOUT               DUMP TAPE
3157           BER  ETND
3158 CLWMGM    CW   0&X1
3159           MLC  *-6,0&X1
3160           CS   332
3161           CS
3162           MLC  TURMSG,226
3163           W
3164           CC   1
3165           MLC  X3,X1
3166           B    B011R
3167 ETND      BSP  %U0
3168           SKP  %U0
3169           B    WTWTT
3170 HOUT      H    WTWTT
3171 TURMSG    DCW  @UNREAD BLK WRITTEN ON TU  @
3172           LTORG*
3173           ORG  5000
3174 INTTER    MLC  URPI,WTWTT&3       SET DUMP TAPE UNIT NUM
3175           MLC  URPI,ETND&3
3176           MLC  URPI,ETND&8
3177           MLC  URPI,TURMSG
3178           B    FRED
3179           DCW  @ @
3180           EX   INTTER
3181           JOB  ** IBM 1401 SORT 7 VERSION 2  PHASE 1  PUNCH URPI      60 P2
3182           ORG  HERE
3183           MLC  X3,CTBL
3184           MLC  @0?0@,PBDBK3&3
3185 PBDBK1    SBR  PBDBK3&13,100
3186           CS   180
3187 PBDBK2    MA   ONE,PBDBK3&13
3188 PBDBK3    MLC  0&X3,CNTR2
3189           MLC  CNTR2,0
3190           MA   ONE,CTBL
3191           MA   ONE,PBDBK3&3
3192           C    CTBL,X1
3193           BE   PBDBK4
3194           BCE  PBDBK5,PBDBK3&12,8
3195           B    PBDBK2
3196 PBDBK4    MLCWAGM,0
3197           MLC  K1BLNK,0&X1
3198           MLC  X3,X1
3199           P    B011R              PUNCH UNREADABLE INPUT BLOCK
3200 PBDBK5    P    PBDBK1
3201 CTBL      DCW  @000@
3202 CNTR2     DCW  @ @
3203           LTORG*
3204           ORG  5000
3205 PUNINI    MLC  GPMARK,PBDBK4&3
3206           MLC  Z,PBDBK4&6
3207           B    FRED
3208           DCW  @ @
3209           EX   PUNINI
3210           JOB  ** IBM 1401 SORT 7 VERSION 2  PHASE 1                  60  2
3211           ORG  HPNDPM-2
3212 B4S10     C    E-1,G/4
3213           MA   THREE,PLC1&3
3214           BH   B4S10A
3215           MLC  B4S10A&3,*&11
3216           MLCWAN,B4S18A&4
3217           MLC  0
3218           MLC  @B@,B4S18A
3219           B    B4S21
3220 B4S10A    MLC  BRNCH,BBS10&3
3221           SAR  B4S10A&3
3222           A    E
3223           ZA   E-1,D
3224           B    B4S21
3225 PLCFRF    DSA  15994
3226           DSA  15988
3227           DSA  15976
3228           DSA  15952
3229           DSA  15904
3230           DSA  15808
3231           DSA  15616
3232           DSA  15232
3233           DSA  14464
3234           DCW  &B512B
3235                &B256B
3236                &B128B
3237                &B064B
3238                &B032B
3239                &B016B
3240                &B008B
3241                &B004B
3242 BRNCH     DCW  &B002B
3243 *
3244 *                  THIS ROUTINE DETERMINES WHICH RECORD OF G
3245 *                  RECORDS IS BEING SORTED AND AT WHICH LOCATION
3246 *                  TO ENTER THE COMPARE LOOP
3247 *                  HAVING DETERMINED WHERE LAST RECORD SORTED
3248 *                  IS TO BE PLACED-INSERT ITS ADDRESS IN THE
3249 *                  TABLE OF ADDRESSES
3250 B4SS5     MLC  O1FA-3,O1
3251           MLC  O1FA,B4S08&6
3252           ZA   HALF,E                                                 B1401
3253           MLC
3254           SBR  B4S10A&3,BRNCH
3255           SBR  PLC1&3,PLCFRF-3
3256           MLCWASONED,B4S18A&6
3257           B    B4S19
3258 B4S07     SW   0&X2
3259 B4S08     MLC  0,0
3260           MA   THREE,B4S08&6
3261           MA   THREE,B4S08&3
3262           MLC  X1,3&X2
3263           CW
3264 B4S19     C    O1,G1
3265 B4S18     MA
3266 B4S20     BE   STPDNR
3267 B4S21     MLC  O1,X2
3268           MLC  0&X2,X1
3269 PLC1      MA   PLCFRF-3,X2
3270 B4S18A    S    ONE,D
3271 BBS10     BWZ  0000,D,B                                               B1401
3272 BBS100    B    B4S10
3273 *
3274           EX   VLRGET
3275           JOB  ** IBM 1401 SORT 7 VERSION 2  PHASE 1                  60  2
3276           ORG  VLRGET
3277 EOFMFS    BWZ  NOPMFS,CNTR,2
3278           BCE  EOFRIT,CNTR,B
3279 EOFRIT    CS   332
3280           CS                                                          B1401
3281           MLC  EOFPNT,221
3282           W                                                           B1401
3283           CC   1                                                      B1401
3284           H    *-3
3285 EOFPNT    DCW  @EOR ON 2 OUTPUT TAPES@
3286 NOPMFS    MLC  @N@,BP002&7
3287 PADVLR    MA   X1,PDCHCK          PADDING ROUTINE
3288           BCE  CPDON,FLR,
3289           BCE  *&5,RLIIND,1
3290           B    *&8
3291           MA   @I9F@,PDCHCK
3292 CPDON     C    PDCHCK,ONPTAR
3293           BE   OPNGRT
3294           BCE  VLRPAD,FLR,1
3295           SW   0&X3
3296           MA   @I9H@,Z
3297           MA   @I9I@,PDCHCK
3298           MLC  Z,X2
3299           MLC  PI,1&X2
3300 PDEXIT    NOP  0
3301 MVPADG    MLC  1&X2,0&X2
3302           SBR  X2
3303           C    X2,PDCHCK
3304           BU   PDEXIT
3305           MA   ONE,Z
3306 PADRTN    MA   PCOMPL,Z
3307           BCE  QNRCMK,RCMKPI,
3308           MA   L,X2
3309           MLC  ONERM,0&X2
3310 QNRCMK    A    ONE,PDCPUT
3311           C    Z,PDCHCK
3312           BU   PADRTN
3313           MLC  &NSHKFZ,B212W&3
3314           MLC  @N@,BP000
3315           MLC  @N@,BP001
3316           MLC  &PADBO1,B2200&3
3317           MLC  O1FA-3,PADBO1
3318           BCE  SHKFZ,DESCND,
3319           MLC  @ @,SHKFZD&7
3320 SHKFZ     S    B,PDCPUT
3321           BWZ  ADDB,PDCPUT,K
3322           S    ONE,THREEB
3323 SHKFZD    BCE  SHKFZ,PI,9
3324           MA   B,PADBO1
3325           MA   B,PADBO1
3326           MA   B,PADBO1
3327           B    SHKFZ
3328 ADDB      A    B,PDCPUT
3329           MLZS K1BLNK,PDCPUT
3330           BCE  ENDPAD,INMODE,M
3331           B    VARLNT
3332 ENDPAD    B    B4SS5
3333 VLRPAD    MLC  EOPNGT,BP001&6
3334           B    SETG12
3335 COPNGT    DCW  &EOPNGT
3336 EOPNGT    DCW  &OPNGRT
3337 NDFZ1     DCW  @END OF INTERNAL SORT@
3338 PADBO1    DCW  000
3339 PDCHCK    DCW  @I9I@
3340 PLZERO    DCW  &0
3341 NSHKFZ    S    ONE,THREEB
3342           C    PLZERO,THREEB
3343           BU   BP2200
3344 OPNGRT    MLC  MI1TUN,*&4
3345           WTM  1
3346           CW   333
3347           BCE  *&22,UNLOAD,
3348           MLC  @U@,URTAPE-24
3349           MLC  @U@,URTAPE-48
3350           MLC  @U@,URTAPE&36
3351 *                               REWIND OUTPUT TAPES
3352           MLC  MI1TUN,*&4
3353           RWD  1
3354           MLC  MI2TUN,*&4
3355           WTM  1
3356           MLC  MI2TUN,*&4
3357           RWD  1
3358           BCE  ENDE,URPI,P
3362 ENDE      BCE  RDCARD,NOTAPS,4
3363           MLC  MI3TUN,*&4
3364           WTM  1
3365           MLC  MI3TUN,*&4
3366           RWD  1
3367 RDCARD    CS   332
3368           CS
3369           MLC  NDFZ1,220
3370           W                       PRINT END OF INTERNAL SORT
3371           CC   1
3372           BCE  SKEIGT,LBBUCK,1     120 CHARACTER LABEL BYPASS
3373 TWNEXT    CS   80                  READ NEXT OVERLAY
3374           SW   24,56
3375           SW   63,67
3376           R    056
3377 SKEIGT    R                        BYPASS 80 CHARACTER ROUTINE
3378           BCE  TWNEXT,68,B         CHECK FOR EX CARD
3379           B    SKEIGT
3380           EX   EOFMFS
3381           JOB  ** IBM 1401 SORT 7 VERSION 2 WORK LABEL ROUTINE,80     60  2
3382 *
3383 *                  PROCESS HEADER LABELS ON ALL PHASE I WORK TAPES
3384 *                  PRIOR TO INITIATING PASS
3385 *                  THIS ROUTINE INCLUDES THE SENSE SWITCH D HALT
3386 *                  OPTION WHICH ALLOWS THE USER TO MOUNT WORK
3387 *                  TAPES ON THE PHASE 1 INPUT DRIVES
3388 *
3389 SWKLBA    EQU  700                RT-WT H.L.AREA
3390           ORG  780
3391           DCW  @}@
3392           ORG  600
3359           BCE  ENDE,URPI,C
3360           MLC  URPI,URTAPE&3
3361 URTAPE    WTM  1                  TAPE MARK DUMP TAPE
3393 *
3394 PREPH1    MLC  @99@,PREPC3
3395           H    PREOTX             BRANCH TO ACCEPT
3396           B    PREST2             BRANCH TO RETRY
3397 *                  READ REDUNDANCY WHILE READING LABEL ON PASS 1
3398 *                  OUTPUT TAPES  %SPECIFIED IN COL 1-3 CTL CD 1)
3399 *                 DEPRESS  - START -  TO ACCEPT THE LABEL AS READ
3400 *                            -BYPASS RETENTION CYCLE CHECK
3401 *                  DEPRESS  - START RESET -  THEN  - START -
3402 *                  TO REREAD 99 MORE TIMES . TO OPEN A NEW TAPE
3403 *                  LOAD IT IN PLACE OF THE ONE IN ERROR AND
3404 *                  DEPRESS  - START RESET -  AND  - START -
3405 *
3406 PREPH2    H    PREST2             BRANCH TO OPEN A NEW TAPE
3407           MLC  @10@,PREPC4        RESET ERROR COUNTER
3408           B    PAREXT-5           BRANCH TO RETRY WRITE
3409 *
3410 *                  A WRITE REDUNDANCY HAS OCCURRED WHILE TRYING
3411 *                  TO WRITE THE HEADER LABEL ON THE PASS 1 OUTPUT
3412 *                  TAPE.  9 SKIP CYCLES HAVE BEEN MADE .
3413 *                  DEPRESS  - START - TO OPEN NEW TAPE
3414 *                  DEPRESS START RESET THEN START TO RETRY
3415 *
3416 PREPH3    H    PREOTX             BRANCH TO ACCEPT
3417           B    PREST2             BRANCH TO OPEN NEW REEL
3418 *
3419 *                  RETENTION CYCLE ON OUTPUT TAPE INDICATES
3420 *                  TAPE SHOULD BE RETAINED
3421 *                  DEPRESS - START- TO ACCEPT TAPE AS WORK TAPE
3422 *                  DEPRESS -START RESET- THEN -START- IF A NEW
3423 *                  TAPE HAS BEEN MOUNTED
3424 *
3425 PREPH4    H    *-3                NO T/M AFTER H.L.-WITH
3426 *                                 A 1 IN COL.5 CC3
3427 *                                 RESTART PROG.
3428 *
3429 PREPH5    H    PREIPX             PRESS START TO BY PASS
3430 *                            UNREADABLE H.L.-INPUT
3431           B    PREST2             PRESS RESET START AND START
3432 *                          TO TRY READING UP TO 99 MORE TIMES
3433 *
3434           DCW  @ @
3435           ORG  800
3436 PREPC1    DCW  @B@                2-WAY CONST
3437 PREPC2    DCW  @B@                2-WAY CONST
3438 PREST0    BCE  *&15,I3TUN,        IF 2 WAY
3439           MLC  @C@,PREPC1         ALTER CONST.S FOR 3-WAY
3440           MLC  @C@,PREPC2
3441           MLC  &I1TUN,X1          ADDR OF PH2 OUTP TAPE NO.S
3442 EXDTAP    NOP  0                  DUMP TAPE H.L.EXIT
3443           BSS  *&5,D
3444           B    RWDINP
3445           CS   332
3446           CS
3447           MLC  PRMSF,228          TAPE SAVE MESSAGE
3448           W
3449           CC   1
3450           H    *&1
3451 RWDINP    MLNS MI1TUN,*&4          REWIND PH2 INPUT TAPES
3452           RWD  0
3453           MLNS MI2TUN,*&4
3454           RWD  0
3455           BCE  PREST1-16,MI3TUN,
3456           MLNS MI3TUN,*&4
3457           RWD  0
3458           BCE  PRERDR,LABELS,     NO LABELS BRANCH
3459           BCE  RETNOP,LBBUCK,1
3460 PREST1    S    &1,PREPC1
3461           BM   PREIRT,PREPC1      INIT FOR PH2 INPUT TAPES
3462           MLNS 0&X1,PREST2&21
3463           MN   0&X1,PRERTI&3
3464           MN   0&X1,PREOTX&7
3465           MN   0&X1,PREOTX&12
3466           MN   0&X1,PREPSW-2
3467           MN   0&X1,PAREXT-2
3468           MN   0&X1,PREIPX&15
3469           MN   0&X1,PREOTX&33
3470           MN   0&X1,SAVM2
3471           MA   @001@,X1           UP DATE FOR NEXT TAPE NO
3472           MLC  @00@,CRYBU4
3473 PREST2    MLC  @99@,PREPC3
3474           MLC  @10@,PREPC4
3475           CS   779
3476           RWD  0
3477           BCE  SORTWL,WLBKT,      IF FIRST PASS-PH2 OUTP
3478 *                                 TAPES HAVE SORT 7
3479 *                                 H.LABELS-COL.4 CC.3 IS
3480 *                                 A BLANK
3481           MLC  CENSIG,SWKLBA&13     MOVE CENT SIGN FOR NOISE TEST
3482           MLC  CENSIG,WLANOI&7
3483 PRERTI    RTW  0,SWKLBA
3484 WLANOI    BCE  PRENOS,SWKLBA&13,    CHECK FOR CENT SIGN
3485           BEF  *&1
3486           BER  PREPRT
3487           B    PRERCT
3488 PREIPX    NOP  0                  PH2 INPUT H.L. EXIT
3489           BCE  PREST1,THLTMO,     IF NO T/M AFTER H.L.
3490           RT   0,SWKLBA           READ T/M
3491           BEF  PREST1             IF SENSED A T/M
3492           B    PREPH4             T/M WAS NOT SENSED-ERROR
3493 PRENOS    CS   730
3494           B    PRERTI-14
3495 PRERCT    BCE  PRECT1,WLBKT,1
3496           B    PREOTX
3497           DCW  #2
3498           DCW  #3
3499 CRTCY     DCW  #4
3500 PRECT1    ZA   SWKLBA&39,CRTCY    MOVE TAPE INFO TO CHECK BUCKET
3501           MLC
3502           MLC
3503           SW   OHDATE-2
3504 CLW       C    OHDATE-3,CRTCY-7   COMPARE YEAR
3505           BU   MODY
3506           A    CRTCY-4,CRTCY      ADD TAPE DAYS TO RT CYCLE
3507           S    OHDATE,CRTCY       SUB CONT DAYS FROM RT CYCLE
3508           CW   OHDATE-2
3509           BWZ  PREOTX,CRTCY,K     CAN WE WRITE ON TAPE
3510           CS   332                NO-PRINT MESSAGE
3511           CS                      INDICATING DAYS TAPE
3512           MLC  SAVMS,227          IS TO BE RETAINED
3513           MLNS CRTCY,222
3514           MLNS
3515           MLNS
3516           MLC  SAVM1
3517           MLC  SAVM2
3518           W
3519           CC   1
3520           B    PREPH3
3521 MODY      S    TSF1,CRTCY         SUBTRACT 365 FROM
3522           A                       RT CYCLE AND ADD 1 TO
3523           A                       TAPE YEARS
3524           A    @1@,CRYBU4
3525           BCE  HLCRY4,CRYBU4-1,3
3526           B    CLW
3527 HLCRY4    H    PREOTX
3528           MLC  @00@,CRYBU4
3529           B    CLW
3530 CRYBU4    DCW  @  @
3531           DCW  @1@
3532           DCW  @0@
3533 TSF1      DCW  @365@
3534 SAVM2     DCW  @RETAIN TAPE  @
3535 SAVM1     DCW  @ FOR @
3536 SAVMS     DCW  @ DAYS@
3537 PREOTX    NOP  0                  WT. H.L.EXIT FOR OUTPUT
3538           RWD  0
3539           WT   0,SWKLBA
3540           BER  PREPWT
3541           BCE  PREST1,THLTMO,     IF T/M IS NOT TO BE WRITTEN
3542           WTM  0
3543           B    PREST1
3544 PREIRT    SBR  PREST1&10,PRERDR
3545           SBR  PREST1&13,PREPC2
3546           SBR  PREST1&6,PREPC2
3547           MLC  @N@,PRERTI-22
3548           MLC  @N@,PREIPX-4
3549           SBR  PREPRT&24,PREPH5
3550           MLC  &MI1TUN,X1
3551           B    PREST1
3552           DCW  @ @
3553 PRERDR    CS   1599
3554           CS   1299
3555           CS
3556           CS
3557           CS
3558           CS
3559           CS
3560           CS
3561 BYLAPS    R
3562           BCE  RETNOP,68,B
3563           B    BYLAPS
3564 RETNOP    CS   80
3565           SW   24,56
3566           SW   63,67
3567           R    056
3568           DCW  @ @
3569 SORTWL    MN   PRERTI&3,SORTRP&10  TAPE # INTO TAPE SERIAL #
3570           MLC  SORTLB,779
3571           B    PREOTX
3572 SORTRP    DCW  @ @
3573           DCW  @1HDR 00000SORT7LABEL          @
3574 SORTLB    DC   #50
3575 PRMSF     DCW  @INPUT TAPES MAY BE SAVED@
3576 *
3577 *    HEADER LABEL ERROR ROUTINE
3578 *
3579 PREPRT    SBR  PAREXT&3,PRERTI-14        READ ENTRANCE
3580           MLC  @B@,PREPSW
3581           S    &1,PREPC3#2
3582           BM   PREPH1,PREPC3      UNREADABLE BLK
3583           BSP  0
3584 PREPSW    B    PAREXT             NOP IF WRITE
3585           BCE  *&5,PREPC3,G       IF TIME TO SKIP
3586           B    PAREXT
3587           MLC  @9@,PREPC3
3588           S    &1,PREPC4#2
3589           BM   PREPH2,PREPC4      BAD TAPE
3590           SKP  0
3591 PAREXT    B    0
3592 PREPWT    SBR  PAREXT&3,PREOTX&9
3593           MLC  @N@,PREPSW
3594           B    PREPRT&14
3595           LTORG*
3596           EX   PREST0
3597           JOB  ** IBM 1401 SORT 7 VERSION 2 WORK LABEL ROUTINE 120    60  2
3598 *              PROCESS HEADER LABELS ON ALL PHASE I WORK TAPES        60  2
3599 *              PRIOR TO INITIALIZATION PASS                           60  2
3600 *              THIS ROUTINE INCLUDES THE SSW D HALT                   60  2
3601 *              OPTION WHICH ALLOWS THE USER TO MOUNT WORK             60  2
3602 *              TAPES ON PHASE 1 INPUT DRIVES                          60  2
3603 SWKLBB    EQU  700                 RT-WT HL AREA                      60  2
3604           ORG  820                                                    60  2
3605           DCW  @}@
3606           ORG  600                                                    60  2
3607 PRAPH1    MLC  @99@,PREPC3                                            60  2
3608           H    PRAOTX              BRANCH TO ACCEPT                   60  2
3609           B    PRAST2              BRANCH TO RETRY                    60  2
3610 *                                                                     60  2
3611 *              READ REDUNDANCY WHILE READING LABEL ON PASS 1          60  2
3612 *              OUTPUT TAPES SPECIFIED IN COL 1-3 CTL CD 1             60  2
3613 *              PRESS-START-TO ACCEPT THE LABEL AS READ                60  2
3614 *                         -BYPASS RETENTION CYCLE CHECK               60  2
3615 *              PRESS START RESET-THEN START-TO REREAD 99 MORE         60  2
3616 *              TIMES.TO OPEN A NEW TAPE LOAD IT IN PLACE OF THE       60  2
3617 *              ONE IN ERROR AND PRESS START RESET AND START
3618 PRAPH2    H    PRAST2              BRANCH TO OPEN A NEW TAPE          60  2
3619           MLC  @10@,PRAPC4         RESET ERROR COUNTER                60  2
3620           B    PARAXT-5            BRANCH TO RETRY WRITE              60  2
3621 *                                                                     60  2
3622 *              A WRITE REDUNDANCY HAS OCCURRED WHILE TRYING           60  2
3623 *              TO WRITE THE HEADER LABEL ON THE PASS 1 OUTPUT         60  2
3624 *              TAPE. 9 SKIP CYCLES HAVE BEEN MADE.PRESS START TO      60  2
3625 *              OPEN NEW TAPE PRESS START RESET & START TO RETRY       60  2
3626 PRAPH3    H    PRAOTX              BRANCH TO ACCEPT
3627           B    PRAST2              BRANCH TO OPEN NEW REEL
3628 *
3629 *              RETENTION CYCLE ON OUTPUT TAPE INDICATES TAPE SHOULD
3630 *              BE RETAINED.PRESS START TO ACCEPT TAPE AS WORK TAPE
3631 *              PRESS START RESET THEN START IF A NEW TAPE HAS BEEN
3632 *              MOUNTED
3633 *
3634 PRAPH4    H    *-3                 NO TAPEMARK AFTER HEADER LABEL
3635 *                                  WITH A -1- IN COLUMN 5 OF CC3
3636 *                                  RESTART THE PROGRAM
3637 *
3638 PRAPH5    H    PRAIPX              PRESS START TO BYPASS
3639 *                                  UNREADABLE HEADER LABEL-INPUT
3640           B    PRAST2              PRESS START RESET AND START
3641 *                             TO TRY READING UP TO 99 MORE TIMES
3642 *
3643           DCW  @ @
3644           ORG  821
3645 PRAPC1    DCW  @B@                 TWO WAY CONST
3646 PRAPC2    DCW  @B@                 TWO WAY CONST
3647 PRASTO    BCE  *&15,I3TUN,         BRANCH IF TWO WAY
3648           MLC  @C@,PRAPC1          ALTER CONST.S FOR 3-WAY
3649           MLC  @C@,PRAPC2
3650           MLC  &I1TUN,X1
3651 EXETAP    NOP  0                   DUMP TAPE HEADER LABEL EXIT
3652           BSS  *&5,D
3653           B    RWDJNP
3654           CS   332
3655           CS
3656           MLC  PRMSEF,228          TAPE SAVE MESSAGE
3657           W
3658           CC   1
3659           H    *&1
3660 RWDJNP    MLNS MI1TUN,*&4
3661           RWD  0
3662           MLNS MI2TUN,*&4
3663           RWD  0
3664           BCE  PRAST1-8,MI3TUN,
3665           MLNS MI3TUN,*&4
3666           RWD  0
3667           BCE  PRARDR,LABELS,      NO LABELS BRANCH
3668 PRAST1    S    &1,PRAPC1
3669           BM   PRAIRT,PRAPC1       INIT FOR PH2 INPUT TAPES
3670           MLNS 0&X1,PRARTI-24
3671           MLNS 0&X1,PRARTI&3
3672           MLNS 0&X1,PRAOTX&7
3673           MLNS 0&X1,PRAOTX&12
3674           MLNS 0&X1,PRAPSW-2
3675           MLNS 0&X1,PARAXT-2
3676           MLNS 0&X1,PRAIPX&15
3677           MLNS 0&X1,PRAOTX&33
3678           MLNS 0&X1,SAVMB2
3679           MA   @001@,X1           UPDATE FOR NEXT TAPE NO.
3680           MLC  @00@,CRYBU3
3681 PRAST2    MLC  @99@,PRAPC3
3682           MLC  @10@,PRAPC4
3683           CS   819
3684           CS
3685           RWD  0
3686           BCE  SRTWLB,WLBKT,       IF FIRST PASS PH2 OUTPUT TAPES
3687 *                                  HAVE SORT 7 120 CHARACTER HEADER
3688 *                                  LABELS-COLUMN 4 CC3 IS BLANK
3689           MLC  CENSIG,SWKLBB&13
3690           MLC  CENSIG,WLBNOI&7
3691 PRARTI    RTW  0,SWKLBB
3692 WLBNOI    BCE  PRANOS,SWKLBB&13,
3693           BEF  *&1
3694           BER  PRAPRT
3695           B    PRARCT
3696 PRAIPX    NOP  0                   PHASE 2 INPUT HEADER LABEL EXIT
3697           BCE  PRAST1,THLTMO,
3698           RT   0,SWKLBB            READ TAPEMARK
3699           BEF  PRAST1              BRANCH IF TAPEMARK IS SENSED
3700           B    PRAPH4              NO TM SENSED - ERROR
3701 PRANOS    CS   730
3702           B    PRARTI-14
3703 PRARCT    BCE  PRACT1,WLBKT,1
3704           B    PRAOTX
3705           DCW  #4
3706           DCW  #2
3707 CRTCYB    DCW  #3
3708 PRACT1    ZA   SWKLBB&14,CRTCYB    MOVE TAPE INFORMATION INTO
3709           MLC                      CHECK BUCKET
3710           MLC
3711           SW   CREATD-2
3712 CLWOTW    C    CREATD-3,CRTCYB-3    COMPARE YEAR
3713           BU   MODIFY
3714           S    CREATD,CRTCYB-5
3715           CW   CREATD-2
3716           BWZ  PRAOTX,CRTCYB-5,K   CAN WE WRITE ON TAPE
3717           CS   332                 NO-PRINT MESSAGE INDICATING DAYS
3718           CS                       TAPE IS TO BE RETAINED
3719           MLC  SAVMBS,227
3720           MLNS CRTCYB-5,222
3721           MLNS
3722           MLNS
3723           MLC  SAVMB1
3724           MLC  SAVMB2
3725           W
3726           CC   1
3727           B    PRAPH3
3728 MODIFY    S    TESFB1,CRTCYB-5    SUBTRACT 365 FROM RETENTION CYCLE
3729           A    TESFB1-3,CRTCYB-3    AND ADDD 1 TO TAPE YEARS
3730           A    @1@,CRYBU3
3731           BCE  HLCRY3,CRYBU3-1,3
3732           B    CLWOTW
3733 HLCRY3    H    PRAOTX
3734           MLC  @00@,CRYBU3
3735           B    CLWOTW
3736 CRYBU3    DCW  @  @
3737           DCW  @1@
3738 TESFB1    DCW  @365@
3739 SAVMB2    DCW  @RETAIN TAPE  @
3740 SAVMB1    DCW  @ FOR @
3741 SAVMBS    DCW  @ DAYS@
3742 PRAOTX    NOP  0                   WT HDR LBL EXIT FOR OUTPUT
3743           RWD  0
3744           WT   0,SWKLBB
3745           BER  PRAPWT
3746           BCE  PRAST1,THLTMO,      BRANCH IF NO TM IS TO BE WRITTEN
3747           WTM  0
3748           B    PRAST1
3749 PRAIRT    SBR  PRAST1&10,PRARDR
3750           SBR  PRAST1&13,PRAPC2
3751           SBR  PRAST1&6,PRAPC2
3752           MLC  @N@,PRARTI-22
3753           MLC  @N@,PRAIPX-4
3754           SBR  PRAPRT&24,PRAPH5
3755           MLC  &MI1TUN,X1
3756           B    PRAST1
3757           DCW  @ @
3758 PRARDR    CS   1599
3759           CS   1299
3760           CS
3761           CS
3762           CS
3763           CS
3764           CS
3765           CS
3766           CS   080
3767           SW   24,56
3768           SW   63,67
3769           R    56
3770           DCW  @ @
3771 SRTWLB    MLNS PRARTI&3,SBRTRP
3772           MLC  SBRTLB,819
3773           B    PRAOTX
3774           DCW  @1HDR           SORT7LABEL     @
3775 SBRTRP    DC   @00000@
3776           DC   #45
3777 SBRTLB    DC   #40
3778 PRMSEF    DCW  @INPUT TAPES MAY BE SAVED@
3779 *
3780 *              HEADER LABEL ERROR ROUTINE
3781 *
3782 PRAPRT    SBR  PARAXT&3,PRARTI-14     READ ENTRANCE
3783           MLC  @B@,PRAPSW
3784           S    &1,PRAPC3#2
3785           BM   PRAPH1,PRAPC3       UNREADABLE BLOCK
3786           BSP  0
3787 PRAPSW    B    PARAXT              NOP IF WRITE
3788           BCE  *&5,PRAPC3,G        IS IT TIME TO SKIP
3789           B    PARAXT
3790           MLC  @9@,PRAPC3
3791           S    &1,PRAPC4#2
3792           BM   PRAPH2,PRAPC4       BAD TAPE
3793           SKP  0
3794 PARAXT    B    0
3795 PRAPWT    SBR  PARAXT&3,PRAOTX&9
3796           MLC  @N@,PRAPSW
3797           B    PRAPRT&14
3798           LTORG*
3799           EX   PRASTO
3800           JOB  ** IBM 1401 SORT 7 VERSION 2  PHASE 2 ENTRY            60  2
3801           ORG  575
3802 TEST C    BSS  ENTMLT,C           TEST SENSE SWITCH C
3803           CS   80                 NOT ON  LOAD BALANCED MERGE
3804           SW   24,56
3805           SW   63,67
3806           R    56
3807 ENTMLT    R                       ON  BYPASS BALANCED MERGE AND
3808           C    10,CONMLT          LOAD MULTIPHASE MERGE
3809           BE   040
3810           B    ENTMLT
3811 CONMLT    DCW  @MULTIPHASE@
3812           EX   TEST C
3813           JOB  ** IBM 1401 SORT 7 VERSION 2  PHASE 2                  60  2
3814           ORG  STPH2
3815 REMTS     MLC  CSTCNS,CLPH1&3     CLEAR PHASE ONE
3816           CS   180
3817 CLPH1     CS   0
3818           SBR  CLPH1&3
3819           C    CLPH1&3,@699@
3820           BU   CLPH1
3821           CS   080
3822           SW   24,56
3823           SW   63,67
3824           R    056
3825           EX   REMTS
3826           JOB  ** IBM 1401 SORT 7 VERSION 2 PHASE 2                   60  2
3827           ORG  STPH2
3828 I1TUHA    DCW  @ @
3829 I2TUHA         @ @
3830 I3TUHA         @ @
3831 O1TUHA         @ @
3832 O2TUHA         @ @
3833 O3TUHA         @ @
3834 CNMP           @00@
3835 NMPL           @  @
3836 CNTRA          @ @
3837 CNTRB          @ @
3838 STREND    DCW  @000@              END OF CURRENT INPUT BLOCK
3839 PTCHP2    DA   1X100,C
3840 NXTPS     EQU  GMSET
3841 GMSET     LCA  0,0                SET GM FOR CHECK POINT
3842 RDCPT     RTW  0,1                READ CHECKPOINT
3843           BER  RREDCP-4
3844           BEF  EOFCP
3845           B    STPASS
3846           H    STPASS
3847 RREDCP    BSP  0
3848           B    RDCPT
3849 LGMEOA    LCA  0,0                SET GMKS IN I/O AREAS
3850           LCA  0,0
3851           LCA  0,0
3852           LCA  0,0
3853 READTP    B    READ1-14
3854 GO        SBR  READ1&15,EORA
3855           SBR  READ2&15,EORB
3856           SBR  READTP&2,2500
3857           SBR  FSTRD1&2
3858           SBR  FSTRD2&2
3859           SBR  FSTRD3&2
3860 RUNOUT    B    SKIP1              RUNOUT SWITCH                       SORT2
3861 SKIP1     B    COMPAB             BYPASS SWITCH                       SORT2
3862 COMPAB    C    0,0                COMPARE A&B
3863           BL   SKIP2              B LT A                              SORT2
3864           BH   SKIP3              A LT B                              SORT2
3865           B    EQU
3866 SKIP2     B    COMPBC             BYPASS SWITCH                       SORT2
3867 COMPBC    C    0,0                COMPARE B&C
3868           BL   CLOW-7
3869           BH   BLOW-7
3870           B    EQU
3871 SKIP3     B    COMPAC             BYPASS SWITCH                       SORT2
3872 COMPAC    C    0,0                COMPARE A&C
3873           BL   CLOW-7
3874           BH   ALOW-7
3875           B    EQU
3876           NOP  0,L
3877 ALOW      MZ   *-6,MTOA&2
3878           MA   L,MTOA&6
3879           NOP  0,0                REM ZONE IN VARY
3880           NOP  0&X1,BLKCT         GENERATE BLK COUNT
3881 INCR1     MA   L,IREG1
3882           B    IMOVE                                                  SORT2
3883           B    ISAMT                                                  SORT2
3884           NOP  0,L
3885 BLOW      MZ   WRITE,MTOA&2
3886           MA   L,MTOA&6
3887           NOP  0,0                REM ZONE IN VARY
3888           NOP  0&X2,BLKCT         GENERATE BLK COUNT
3889 INCR2     MA   L,IREG2
3890           B    IMOVE                                                  SORT2
3891           B    ISBMT                                                  SORT2
3892           NOP  0,L
3893 CLOW      MZ   RUNOUT,MTOA&2
3894           MA   L,MTOA&6
3895           NOP  0,0                REM ZONE IN VARY
3896           NOP  0&X3,BLKCT         GENERATE BLK COUNT
3897 INCR3     MA   L,IREG3
3898           B    IMOVE                                                  SORT2
3899           B    ISCMT                                                  SORT2
3900 IMOVE     SBR  RETURN#3           MOVE RECORD TO OUTPUT               SORT2
3901 MTOA      MLC  0,0                MOVE TO OUTPUT ROUTINE
3902           MLC
3903           MLC
3904           MLC
3905           MLC
3906           MLC
3907           MLC
3908           MLC
3909           MLC
3910           MLC
3911 LMV       MLC
3912           NOP
3913           MZ   *-6,SJA
3914 ADDTO     NOP  BLKCT,0            MOVE BLOCK COUNT TO OUTPUT AREA
3915 VARYCT    NOP  @1@,0
3916           MLC  SDCMPV,LSTSD       INCR STEPDOWN CHECK
3917           MA   L,SDCMPV
3918 CKOUT     C    0,ARELO
3919           BE   WRITE                                                  SORT2
3920 VARYSD    B    RTRN1-7
3921           DC   @      @
3922           MLC  RETURN,RTRN1&3                                         SORT2
3923 RTRN1     B    0                                                      SORT2
3924 WRITE     MLC  AREFO,MTOA&6       RESET MOVE TO OUTPUT                SORT2
3925           MLC  SDCOMP,SDCMPV      RESET SD COMPARE                    SORT2
3926           MZ   BLANK,SJA
3927           NOP  0                  SWITCH- WRITE TAPE
3928 KOWNT     A    B,0
3929 PDSW      B    WOBR-11
3930 BPADQ8    BCE  WOBR-11,0,1
3931 AWAY      C    0,PADCT#6
3932           BL   RTRN2-7
3933 REPL      BE   RTRN2-7
3934 BPADQ7    MLC  @N@,SPADQ6
3935 EXIT1     NOP  0                  USERS EXIT
3936           MLC  BLANK2,CNRR
3937 WOBR      WT   0,0                WRITE OUTPUT BLOCK
3938           SBR  RMVRGM&6
3939           BER  WORED                                                  SORT2
3940           NOP  @1@,TAPBLC#5
3941 SETBAK    NOP  @4@,0              RESET BLOCK COUNT
3942 RMVRGM    NOP  REKMKS,0
3943           BEF  EOFW1                                                  SORT2
3944           MLC  RETURN,RTRN2&3                                         SORT2
3945 RTRN2     B    0                                                      SORT2
3946 ISAMT     C    IREG1,ENDRA1       ARE WE READY TO READ A
3947           BU   RUNOUT
3948 OKRD1     MLC  INPUT1,IREG1
3949           MLC  BLANK2,CNRR
3950           MLC  CENSIG,13&X1
3951 READ1     RT   0,0                READ NEXT A BLOCK
3952           SBR  STREND
3953           BEF  EOF1
3954           MZ   *-6,SJA
3955           B    NOISE
3956           B    RIDGM1
3957           B    CLRGMP
3958           BER  RED
3959 EXIT2     NOP  0                  USERS EXIT
3960 FSTRD1    B    READ2-14
3961 *              STEPDOWN TEST FOR TAPE A
3962           MLC  LSTSD,STEPA&3
3963 STEPA     C    0,0                TEST SD OF A
3964           BL   EOSA               STEPDOWN EXISTS
3965           BH   RUNOUT             NO STEPDOWN
3966           B    EQU
3967 ISBMT     C    IREG2,ENDRA2       ARE WE READY TO READ B
3968           BU   RUNOUT
3969 OKRD2     MLC  INPUT2,IREG2
3970           MLC  BLANK2,CNRR
3971           MLC  CENSIG,13&X2
3972 READ2     RT   0,0                READ NEXT B BLOCK
3973           SBR  STREND
3974           BEF  EOF2
3975           MZ   @N@,SJA
3976           B    NOISE
3977           B    RIDGM2
3978           B    CLRGMP
3979           BER  RED
3980 EXIT3     NOP  0                  USERS EXIT
3981 FSTRD2    B    READ3-14
3982 *              STEPDOWN CHECK FOR TAPE B
3983           MLC  LSTSD,STEPB&3
3984 STEPB     C    0,0                TEST SD OF B
3985           BL   EOSB               STEPDOWN EXISTS
3986           BH   RUNOUT             NO STEPDOWN
3987           B    EQU
3988 ISCMT     C    IREG3,ENDRA3       ARE WE READY TO READ C
3989           BU   RUNOUT
3990 OKRD3     MLC  INPUT3,IREG3
3991           MLC  BLANK2,CNRR
3992           MLC  CENSIG,13&X3
3993 READ3     RT   0,0                READ NEXT C BLOCK
3994           SBR  STREND
3995           BEF  EORC
3996           MZ   COMPAB,SJA
3997           B    NOISE
3998           B    RIDGM3
3999           B    CLRGMP
4000           BER  RED
4001 EXIT4     NOP  0                  USERS EXIT
4002 FSTRD3    B    GO                 BR ON 1ST RD
4003 *              STEPDOWN CHECK FOR TAPE C
4004           MLC  LSTSD,STEPC&3
4005 STEPC     C    0,0                TEST SD OF C
4006           BL   EOSC               STEPDOWN EXISTS
4007           BH   RUNOUT             NO STEPDOWN
4008           B    EQU
4009 CLRGMP    SBR  RTN1&3
4010           MA   I99,STREND
4011           MLC  STREND,*&7
4012           MLC  REKMKS-1,0
4013 RTN1      B    0
4014 NOISE     SBR  NSE&3              CHECK FOR NOISE RECORDS
4015           SBR  NSERTN&3
4016           MZ   SJA,NSE&5
4017 NSE       BCE  0,13,}             BRANCH FOR NOISE RECORD
4018           MA   @004@,NSERTN&3
4019 NSERTN    B    0                  RETURN TO CLEAR GPMK
4020 RIDGM1    SBR  RTREAD&3,READ1-7     INITIALIZE RETURN
4021           B    RIDGM
4022 RIDGM2    SBR  RTREAD&3,READ2-7
4023           B    RIDGM
4024 RIDGM3    SBR  RTREAD&3,READ3-7
4025 RIDGM     MZ   SJA,*&6            MOVE IN ZONE FOR INDEXING
4026           MN   *,13               START CLEARING 13 POSITIONS
4027           MN
4028           MN
4029           MN
4030           MN
4031           MN
4032           MN
4033           MN
4034           MN
4035           MN
4036           MN
4037           MN
4038           MN
4039 RTREAD    B    0
4040 EOSA      A    @1@,CNTRB          END OF SEQ A
4041           B    EOSTST
4042 EOSB      A    @2@,CNTRB          END OF SEQ B
4043           B    EOSTST
4044 EOSC      A    @4@,CNTRB          END OF SEQ C
4045 EOSTST    BCE  GO,READTP,B
4046           BCE  SDALL,CNTRB,7      TEST EOS ON ALL TAPES
4047           BCE  SDAC,CNTRB,5       TEST EOS ON A&C
4048           BCE  SDAB,CNTRB,3       TEST EOS ON A&B
4049           BCE  SDBC,CNTRB,6       TEST EOS ON B&C
4050           BCE  SDA,CNTRB,1        TEST EOS ON A ALONE
4051           BCE  SDB,CNTRB,2        TEST EOS ON B ALONE
4052           BCE  SDC,CNTRB,4        TEST EOS ON C ALONE
4053           B    RUNOUT
4054 SDALL     SBR  RUNOUT&3,SKIP1
4055           MLC  BLANK,CNTRB
4056           BCE  SWOT,I3TUN,
4057           SBR  COMPAB&10,SKIP2
4058           SBR  COMPAB&15,SKIP3
4059           B    SWOT
4060 SDAC      BCE  SDALL,CNTRA,2           STEPDOWN ON A&C
4061           SBR  RUNOUT&3,BLOW-7
4062           B    RUNOUT
4063 SDAB      BCE  SDALL,CNTRA,4           STEPDOWN ON A&B
4064           SBR  RUNOUT&3,CLOW-7
4065           B    RUNOUT
4066 SDBC      BCE  SDALL,CNTRA,1           STEPDOWN ON B&C
4067           SBR  RUNOUT&3,ALOW-7
4068           B    RUNOUT
4069 SDA       BCE  SDALL,CNTRA,6           STEPDOWN ON A
4070           BCE  RNOUTB,CNTRA,4
4071           BCE  RNOUTC,CNTRA,2
4072           SBR  RUNOUT&3,SKIP2
4073           B    RUNOUT
4074 SDB       BCE  SDALL,CNTRA,5           STEPDOWN ON B
4075           BCE  RNOUTA,CNTRA,4
4076           BCE  RNOUTC,CNTRA,1
4077           SBR  RUNOUT&3,COMPAC
4078           B    RUNOUT
4079 SDC       BCE  SDALL,CNTRA,3           STEPDOWN ON C
4080           BCE  RNOUTA,CNTRA,2
4081           BCE  RNOUTB,CNTRA,1
4082           SBR  COMPAB&15,ALOW-7
4083           SBR  COMPAB&10,BLOW-7
4084           B    RUNOUT
4085 RNOUTB    SBR  RUNOUT&3,BLOW-7
4086           B    RUNOUT
4087 RNOUTA    SBR  RUNOUT&3,ALOW-7
4088           B    RUNOUT
4089 RNOUTC    SBR  RUNOUT&3,CLOW-7
4090           B    RUNOUT
4091 EORA      A    @1@,CNTRA          END OF FILE A
4092           B    EOFTST
4093 EORB      A    @2@,CNTRA          END OF FILE B
4094           B    EOFTST
4095 EORC      A    @4@,CNTRA          END OF FILE C
4096 EOFTST    BCE  EOFBC,CNTRA,6      TEST EOF ON B&C
4097           BCE  EOFAC,CNTRA,5      TEST EOF ON A&C
4098           BCE  EOFC,CNTRA,4       TEST EOF ON C
4099           BCE  EOFAB,CNTRA,3      TEST EOF ON A&B
4100           BCE  EOFB,CNTRA,2       TEST EOF ON B
4101           BCE  EOFA,CNTRA,1       TEST EOF ON A
4102 ENDPAS    NOP  QTRL,SJA,2         EOF ON ALL
4103           NOP  LASTWT
4104 QTRL      NOP  LPTRS1
4105 OUTTM     WTM  0
4106           WTM  0
4107 REWIND    RWD  0
4108           RWD  0
4109           RWD  0
4110           RWD  0
4111           BCE  *&16,I3TUN,
4112 THDTP     WTM  0
4113           RWD  0
4114           RWD  0
4115           SBR  CLINP2&3,HDTRS0&4   ENTER FROM MAIN LINE
4116           B    *&8
4117           SBR  CLINP2&3,INWM12-15
4118 CLSTX1    SW   4300
4119           CS   0
4120           SBR  CLSTX1&7
4121           BWZ  CLSTX1&4,4300,1
4122           MLC  CSTCNS,CLSTX1&7
4123 CLINP2    B    0
4124 LASTWT    SBR  RETURN,QTRL
4125           B    SETGM
4126 LSTOUT    A    @1@,CNTBO1
4127           C    CNTBO1,BO
4128           BU   RTRN1-7
4129           MLC  BLANK2,CNTBO1
4130           MLC
4131 SETGM     SW   GPMK&4
4132           MLC  MTOA&6,GPMK&6
4133           CW   GPMK&4
4134           MA   @001@,GPMK&6
4135 GPMK      LCA  7998,0             LOAD GROUPMARK AT END OF OUTPUT
4136           B    WRITE
4137 EOFBC     SBR  SKIP1&3,ALOW-7
4138           B    EOSTST
4139 EOFAC     SBR  SKIP1&3,BLOW-7
4140           B    EOSTST
4141 EOFC      SBR  SKIP3&3,ALOW-7
4142           SBR  SKIP2&3,BLOW-7
4143           B    EOSTST
4144 EOFAB     SBR  SKIP1&3,CLOW-7
4145           B    EOSTST
4146 EOFB      SBR  SKIP1&3,SKIP3
4147           SBR  SKIP2&3,CLOW-7
4148           B    EOSTST
4149 EOFA      SBR  SKIP1&3,SKIP2      END OF FILE ON A
4150           B    EOSTST
4151 *              SWITCH OUTPUT TAPES
4152 SWOT      MLC  O2TUHA,SLOT1#1
4153 CNTSW     A    @1@,0              INCREMENT COUNTER
4154           NOP  RUNOUT
4155 NOSW      NOP  @B@,CNTSW&7
4156           C    SWOT&3,&O3TUHA     READY TO CYCLE
4157           BU   SETNOS             NO
4158           SBR  SWOT&3,O1TUHA      REINITIALIZE FOR FIRST TAPE
4159           B    MNO
4160 SETNOS    MA   @001@,SWOT&3       UPDATE WRITE ROUTINES FOR
4161 MNO       MLC  SLOT1,WOBR&3       NEXT OUTPUT TAPE UNIT
4162           MLC  SLOT1,WORED&3
4163           MLC  SLOT1,ERTAPE&3
4164 EOFRTN    NOP  FRAN
4165           B    RUNOUT
4166 FRAN      MLC  @M@,NOSW
4167           MLC  @N@,EOFRTN
4168           B    RTRN2-7
4169 *              REDUNDANCY SUB-ROUTINE
4170 RED       SBR  RETN&3             STORE RETURN TO MAINLINE
4171           SBR  TUNOS&3
4172           SBR  SOMORE&3
4173           MA   @I5B@,RETN&3
4174           MA   @I6B@,TUNOS&3
4175           BAV  *&1
4176           A    @1@,CNRR
4177           BAV  BBP2               DUMP TAPE RCD IF 100 TRIAL READS
4178 TUNOS     MN   0,BACKSP&3
4179 BACKSP    BSP  0                  BACKSPACE TAPE
4180 RETN      B    0                  RETURN TO REREAD RECORD
4181 EOF2      A    @2@,CNTRA          EOF ON SECOND INPUT TAPE
4182           B    READ3-14
4183 EOF1      H    *-3                EOF ON FIRST INPUT TAPE
4184 EOFW1     BCE  LPTRS1,QTRL,B      END OF REEL ON WRITE
4185           MLC  @B@,EOFRTN
4186           B    SWOT
4187 CNRR      DCW  @00@
4188 BLANK     DCW  @ @
4189 BLANK2    DCW  @00@
4190 *              WRITE REDUNDANCY ROUTINE
4191 WORED     BSP  0                  BACKSPACE TAPE
4192           BCE  ERASE,CNRR,1       SECOND TRY
4193           A    @1@,CNRR
4194           B    WOBR               BRANCH TO WRITE SECOND TIME
4195 ERASE     A    @1@,CNEOR          INCREMENT COUNTER
4196           BCE  HWRED,CNEOR-1,1    TWENTY TRIES ON THIS TAPE
4197 ERTAPE    SKP  0                  NO-ERASE FORWARD
4198           B    WOBR-7             BRANCH TO WRITE
4199 ***            USER MAY LOAD ANOTHER TAPE OR PRESS START
4200 ***            TO TRY WRITING 20 MORE TIMES
4201 HWRED     H
4202           MLC  BLANK2,CNEOR       BLANK COUNTER
4203           B    ERTAPE
4204 CNEOR     DCW  @  @
4205 ARELBO    DCW  @   @                                                  SORT2
4206 AGMEOA    DCW  #3                                                     SORT2
4207 AGMEBO    DCW  @   @                                                  SORT2
4208 AO2THA    DSA  O2TUHA
4209 I99       DSA  16000-1
4210 AOWA      DSA  3900
4211 NOZNE     DCW  @   @
4212 AIRA1     DCW  @   @
4213 AIRA2     DCW  @   @
4214 AIRA3     DCW  @   @
4215 INPUT1    DCW  @   @
4216 INPUT2    DCW  @   @
4217 INPUT3    DCW  @   @
4218 ENDRA1    DCW  @   @
4219 ENDRA2         @   @
4220 ENDRA3         @   @
4221 ARELO          @   @
4222 COMP11         @   @
4223 COMP12         @   @
4224 COMP13         @   @
4225 ACNT      DCW  @   @
4226 ACTNR          @   @
4227 SDCOMP         @   @
4228 SDCMPV         @   @
4229 LSTSD          @   @
4230 BOL       DCW  @   @
4231 AREFO          @   @
4232 VARY      EQU  FLR
4233 REKMKS    DCW  @||@
4234 SJA       DCW  @ @
4235 CLEPS          @   @
4236 N99P2     DCW  @99@
4237 TWOBL     DCW  @  @
4238 BLKCT     DCW  @0000@
4239 SET1MV    DCW  @   @
4240 REMOVE    DCW  @   @
4241 TRIHLD    DCW  @   @
4242 CNTBO1    DCW  @   @
4243 ***            EQUAL ROUTINE
4244 EQU       SBR  EQHLD#3
4245           MLC  IREG1,HOLDX1#3     SAVE INDEX REGISTER ONE
4246           MLC  EQHLD,IREG1
4247           MA   @I8E@,IREG1
4248           MLC  10&X1,CMNCF&16     INITIALIZE THE EQUAL ROUTINE
4249           MLC
4250           MLC
4251           MLC  9&X1,NEXTCF&17
4252           MLC  HOLDX1,IREG1
4253           MLC  BLANK2,CNCF2#2
4254           SBR  ICFL&3,IF1F2
4255           SBR  ICFL2&3
4256 NEXTCF    A    @1@,CNCF2
4257           C    CNCF2,NCF          LAST CONTROL FIELD
4258           BE   0                  EXIT
4259 ICFL      MA   0,CMNCF&3          UPDATE COMPARE FOR NEXT
4260 ICFL2     MA   0,CMNCF&6          CONTROL FIELD
4261 CMNCF     C    0,0                COMPARE
4262           BL   0                  LOW
4263           BH   0                  HIGH
4264           MA   @003@,ICFL&3       GET NEXT CONTROL FIELD
4265           MA   @003@,ICFL2&3
4266           B    NEXTCF
4267           LTORG*
4268 SAVE      ORG  *
4269 *
4270           ORG  *&154
4271           JOB  ** IBM 1401 SORT 7 VERSION 2 PHASE 2                   60  2
4272 *              TAPES ARE REFERRED TO AS OUTPUT OR INPUT DEPENDING
4273 *              UPON WHETHER THEY ARE OUTPUT OR INPUT REELS
4274 *              TO THE NEXT PASS-WE OPEN OUTPUT TAPES FIRST
4275 *
4276 HTHAL1    MLC  @99@,HDTRC3
4277           H    HTEXWT-7           PRESS START TO ACCEPT LABELS AS
4278 *                                 READ.  THE REDUNDANT RECORD WILL
4279 *                                 BE WRITTEN AS THE HL-OUTPUT TAPE
4280 *                               PRESS START/RESET AND START
4281           B    HTPRSW-5           TO RETRY UP TO 99 TIMES
4282 *
4283 HTHAL2    H                       PRESS START TO TRY TO
4284           MLC  @9@,HDTRC4         WRITE H.L. AGAIN-UP TO
4285           B    HTEXWT&9           9 SKIPS.
4286 *
4287 HTHAL3    H    HTEXRT             PRESS START TO ACCEPT
4288 *                            H.L.AS READ
4289           MLC  @99@,HDTRC3        PRESS RESET START AND START
4290           B    HTPRSW-5           TO RETRY UP TO 99 TIMES
4291 *
4292 HTHAL4    H    *-3                NO T/M AFTER H.L.-THERE IS A
4293 *                            1 IN COL.5 CC3. RESTART PROG
4294 *
4295 HDTRC1    DCW  @C@                B FOR 2-WAY
4296 HDTRC2    DCW  @C@                B FOR 2-WAY
4297 HDTRC8    DCW  @C@
4298           DCW  #1
4299 HDTRS0    SBR  HDTREX&3
4300           CS   181
4301           MLC  GPMARK,*&4
4302           MLCWA0,181              SET GM/WM
4303           MLC  HDTRC6,IREG1       ADDR TAPE # BUCKET-OUTPUT
4304 HDTRS1    S    &1,HDTRC1
4305           BM   HDTRRI,HDTRC1
4306           MLNS 0&X1,HDTRS2&26
4307           MLNS 0&X1,HDTRS2&21
4308           MN   0&X1,HTEXWT&7
4309           MN   0&X1,HTEXWT&12
4310           MN   0&X1,HTPRSW-2
4311           MN   0&X1,HTPEX-10
4312           MN   0&X1,HTEXRT&15
4313           MN   0&X1,HTNOSR-6
4314           MA   @001@,IREG1
4315 HDTRS2    MLC  @99@,HDTRC3#2      INIT PARITY RD BUCKET
4316           CS   180
4317           MLC  CENSIG,113
4318           RWD  0
4319           RT   0,101              READ HEADER LABEL
4320 NSYHDR    BCE  HTNOSR,113,
4321           BEF  *&1
4322           BER  HDTRPR             IF PARITY ERROR
4323           B    HTEXWT-7           NOP FOR INPUT
4324 HTEXRT    NOP  0                  CUSTOMER EXIT-ACCESS
4325 *                                 TO H.L. OF INPUT TAPE
4326           BCE  HDTRS1,THLTMO,     IF NO T/M AFTER HEADER
4327           RT   0,101
4328           BEF  HDTRS1
4329           B    HTHAL4
4330           MLC  @9@,HDTRC4#1
4331 HTEXWT    NOP  0                  CUSTOMER EXIT-ACCESS TO
4332 *                                 H.L.OF OUTPUT TAPE
4333           BSP  0
4334           WT   0,101              WRITE HEADER LABEL
4335           BER  HDTRPW
4336           BCE  HDTRS1,THLTMO,     IF T/M IS NOT TO BE WRITTEN
4337           WTM  0
4338           B    HDTRS1
4339 HTNOSR    CS   120                NOISE RECORD CLEAR
4340           B    HDTRS2&16
4341 HDTRPW    SBR  HTPEX&3,HTEXWT&9   RETURN TO WRITE INST
4342           MLC  @N@,HTPRSW         BYPASS SKIP ROUTINE
4343           B    *&15
4344 HDTRPR    SBR  HTPEX&3,HDTRS2&16  RETURN TO READ INST
4345           MLC  @B@,HTPRSW         ACTIVATE SKIP ROUTINE
4346           S    &1,HDTRC3
4347           BM   HTHAL1,HDTRC3
4348           BSP  0
4349 HTPRSW    B    HTPEX              BR IF READ I/O
4350           BCE  *&5,HDTRC3,G
4351           B    HTPEX
4352           MLC  @9@,HDTRC3
4353           S    &1,HDTRC4
4354           SKP  0
4355           BM   HTHAL2,HDTRC4
4356 HTPEX     B    0                  EX PARITY ERROR ROUTINE
4357 HDTRRI    SBR  HDTRS1&6,HDTRC2    INIT ROUT.TO PROC.INPUT
4358           SBR  HDTRS1&13,HDTRC2
4359           SBR  HDTRS1&10,HDTREX-8
4360           SBR  HTPRSW-10,HTHAL3
4361           MLC  @N@,HTEXRT-4
4362           MLC  HDTRC7,IREG1       ADDR TAPE # BUCKET-INPUT
4363           B    HDTRS1
4364           CS   080
4365           CS   181                CLEAR GM/WM
4366 HDTREX    B    NXTPS              GENERAL EXIT
4367 HDTRC6    DSA  I1TUHA
4368 HDTRC7    DSA  O1TUHA
4369           LTORG*
4370           JOB  ** IBM 1401 SORT 7 VERSION 2  PHASE 2                  60  2
4371           ORG  087
4372 IREG1     DCW  000
4373           ORG  092
4374 IREG2     DCW  000
4375           ORG  097
4376 IREG3     DCW  000
4377           ORG  4200
4378 LAYCHK    BCE  PLEPAS,LBBUCK,1
4379           MLC  CENSIG,NSYHDR&7
4380           B    SKIPPS
4381 PLEPAS    CS   80          LOAD 120 CHARACTER LABEL ROUTINE
4382           SW   24,56
4383           SW   63,67
4384           R    56
4385 SKIPPS    R
4386           BCE  OVLAP1,68,B
4387           B    SKIPPS
4388 OVLAP1    BCE  STRTN,VARY,        BRANCH IF FIXED LENGTH RECORDS
4389           MLC  @L@,MTOA            INITIALIZATION OF MOVE ROUTINE
4390           MLC  @L@,SBR-6           FOR VARIABLE LENGTH RECORDS
4391 MODMV     MLC  @L@,LMV
4392           BCE  *&8,KRUNCH,
4393           MLC  @L@,LMV&1
4394           BCE  STRTN,CTMV-1,1
4395           A    @1@,CTMV#2
4396           MA   I99,MODMV&6
4397           B    MODMV
4398 STRTN     MLC  &RETURN,ARTRN
4399           MLC  @H@
4400           MLC  &MTOA,IREG1
4401           MLC  NCF,NCFHLD#2
4402           MLC  GPMARK,*&4
4403           LCA  0,ITLI             LOAD GROUPMARK IN ITLI
4404           MLC  @N@,AWAY&12
4405           SBR  AOWA,3900
4406           SBR  SETBAK&6
4407           SBR  ADDTO&6
4408           MA   I99,SETBAK&6
4409           MA   I99,ADDTO&6
4410           BCE  MAOWA,LABELS,1
4411           SBR  AOWA,3200          INITIALIZE FOR NO LABELS
4412           SBR  SETBAK&6
4413           SBR  ADDTO&6
4414           MA   I99,SETBAK&6
4415           MA   I99,ADDTO&6
4416 MAOWA     MLC  AOWA,AIRA1
4417           MA   BL,AIRA1           I/O AREA
4418           MLC  AIRA1,AGMEOA
4419           MA   @002@,AIRA1
4420           MLC  AIRA1,AIRA2
4421           MA   BL,AIRA2
4422           MLC  AIRA2,LGMEOA&13
4423           MA   @002@,AIRA2
4424           MLC  AIRA2,AIRA3
4425           MA   BL,AIRA3
4426           MLC  AIRA3,LGMEOA&20
4427           BCE  ONLY2,I3TUN,
4428           MA   @002@,AIRA3
4429           MLC  AIRA3,AIRA4#3
4430           MA   BL,AIRA4
4431           MLC  AIRA4,LGMEOA&27
4432           MLC  AIRA3,READ3&6
4433           MLC  AIRA3,INPUT3
4434           MA   I99,INPUT3
4435 ONLY2     MLC  AIRA1,READ1&6
4436           MLC  AIRA2,READ2&6
4437           MLC  AOWA,WOBR&6
4438           MLC  AOWA,AREFO         INIT MOVE TO OUTPUT                 SORT2
4439           MA   I99,AREFO
4440           MLC  AIRA1,INPUT1
4441           MA   I99,INPUT1
4442           MLC  AIRA2,INPUT2
4443           MA   I99,INPUT2
4444           MLC  GPMARK,GPMK&3      INIT INSTRUCTIONS TO LOAD
4445           MLC  GPMARK,GMSET&3     GROUPMARKS AT THE END OF I/O
4446           MLC  GPMARK,LGMEOA&3
4447           MLC  GPMARK,LGMEOA&10
4448           MLC  GPMARK,LGMEOA&17
4449           MLC  GPMARK,LGMEOA&24
4450           MZ   *-6,INCR1-5
4451           MZ   MSBR,INCR2-5
4452           MZ   CMTOA,INCR3-5
4453           MLC  CENSIG,NSE&7
4454 CMTOA     C    NCFHLD,@10@        INITIALIZE MTOA ROUTINE ACCORDING
4455           BE   MSBR               TO NUMBER OF CONTROL FIELDS
4456           MA   @001@,IREG1
4457           A    @1@,NCFHLD
4458           B    CMTOA
4459 MSBR      LCA  SBR,6&X1
4460           LCA
4461           MLC  IREG1,SET1MV
4462           MA   @006@,SET1MV
4463           MLC  SET1MV,WRITE&6
4464           MLC  SET1MV,ALOW&13
4465           MLC  SET1MV,BLOW&13
4466           MLC  SET1MV,CLOW&13
4467           MLC  SET1MV,CKOUT&3
4468           MLC  SET1MV,SETGM&7
4469           MLC  IREG1,IREG2
4470           MA   @I9F@,IREG2
4471           MLC  IREG2,INCR1&10
4472           MLC  IREG2,INCR2&10
4473           MLC  IREG2,INCR3&10
4474           MLC  IREG1,IREG3
4475           MA   @002@,IREG3
4476           MLC  IREG3,ALOW&6
4477           MLC  IREG3,BLOW&6
4478           MLC  IREG3,CLOW&6
4479           MLC  @I9W@,IREG1
4480           BCE  LD12K,MS,5
4481           BCE  LD16K,MS,6
4482 LDCST     LCA  CNOS1,0&X1         MOVE COUNTERS INTO UPPER CORE
4483           LCA
4484           LCA
4485           MLC  IREG1,ACNT
4486           MLC  ACNT,CNTSW&6
4487           MA   @I9D@,IREG1
4488           MLC  IREG1,ACTNR
4489           MLC  ACTNR,KOWNT&6
4490           MLC  ACTNR,AWAY&3
4491           MA   @I9D@,IREG1
4492           MA   @I9D@,IREG1
4493           MLC  IREG1,CLEPS
4494           MLC  IREG1,GMSET&6
4495 TSTVRY    BCE  RDCRD,VARY,
4496           MA   RCDIST,INCR1-4     INIT MAINLINE FOR VARIABLE
4497           MA   RCDIST,INCR2-4     LENGTH RECORDS
4498           MA   RCDIST,INCR3-4
4499           MLC  RCDIST,ALOW-4
4500           SBR  SDAC-1,BPADQ8&1
4501           SBR  SDALL&17
4502           MLC  @L@,RMVRGM
4503           MLC  RCDIST,BLOW-4
4504           MLC  RCDIST,CLOW-4
4505           MZ   *-6,ALOW-5
4506           MZ   @L@,BLOW-5
4507           MZ   TSTVRY,CLOW-5
4508           MLC  @M@,ALOW-7
4509           MLC  @M@,BLOW-7
4510           MLC  @M@,CLOW-7
4511           MLC  ACTNR,VARYCT&6
4512           C    L-2,@0@
4513           BH   *&5
4514           SW   BLKCT-2
4515 MOADD     MLC  @L@,WOBR
4516           MLC  @L@,READ1
4517           MLC  @L@,READ2
4518           MLC  @L@,READ3
4519           MLC  @N@,LGMEOA
4520           MLC  @N@,KOWNT
4521           MLC  @A@,VARYCT
4522           MLC  @V@,ENDPAS
4523           MLC  @B@,ENDPAS&8
4524           MZ   *-6,CONST1-3
4525           MZ   @L@,CONST2-3
4526           MZ   TSTVRY,CONST3-3
4527           MLC  REKMKS,TWOBL
4528           LCA  CONST1&3,ISAMT&11
4529           LCA
4530           LCA  CONST2&3,ISBMT&11
4531           LCA
4532           LCA  CONST3&3,ISCMT&11
4533           LCA
4534           MLC  SET1MV,VRBSD&3
4535           LCA  FAKE&7,VARYSD&9    INIT FOR CHECK IF OUTPUT
4536           LCA                     IS FULL
4537           LCA
4538           MLC  SET1MV,WTNOW&3
4539           LCA  LOU&4,REPL&4       INIT TAPE SWITCHING TO FORCE
4540           LCA                     WRITE ON LAST BLOCK IN SEQ.
4541           LCA
4542           LCA
4543           LCA
4544           MLC  @N@,PDSW
4545 RDCRD     CS   080
4546           SW   24,56
4547           SW   63,67
4548 CHOOSE    BCE  SETURQ,URPI,P      DECIDE WHICH BAD BLOCK
4549           BCE  SETURP,URPI,C      PROCEDURE TO LOAD
4550           MLC  @T@,IDENT&7
4551           MLC  @N@,RED&8
4552           B    IDENT-1
4553 SETURQ    MLC  @N@,RED&8
4554 SETURP    MLC  URPI,IDENT&7
4555           R                       LOAD BAD BLOCK PROCEDURE
4556 IDENT     BCE  056,079,
4557           R    IDENT
4558 RANOUT    CS   080
4559           SW   24,56
4560           SW   63,67
4561           R    FORGET
4562 FORGET    BCE  056,079,
4563           R    FORGET
4564 LD12K     MA   @00|@,IREG1
4565           B    LDCST
4566 LD16K     MA   @00!@,IREG1        INITIALIZE FOR 16K
4567           B    LDCST
4568 VRBSD     MLC  0,TRIHLD           CHECK TO SEE IF OUTPUT IS FULL
4569           MA   COMET,TRIHLD
4570 FAKE      BWZ  SETGM,TRIHLD,2
4571           B    WOBR-11
4572 WTNOW     C    0,AREFO            FORCE LAST BLOCK PER SEQUENCE
4573           BE   SWOT
4574           SBR  RETURN,SWOT
4575 LOU       BIN  SETGM,
4576 ARTRN     DCW  @    @
4577 SBR       DCW  @M000000@          MOVE TO OUTPUT CONSTANT
4578           BCE  OKRD1,1,|
4579 CONST1    B    RUNOUT
4580           BCE  OKRD2,1,|
4581 CONST2    B    RUNOUT
4582           BCE  OKRD3,1,|
4583 CONST3    B    RUNOUT
4584 ARNOUT    DSA  RUNOUT
4585 NG1       DCW  @   @
4586 NG2       DCW  @   @
4587 NG3       DCW  @   @
4588           EX   LAYCHK
4589           JOB  ** IBM 1401 SORT 7 VERSION 2 PHASE 2                   60  2
4590           ORG  HTHAL1
4591 HTHEL1    MLC  @99@,HDTSC3
4592           H    HTAXWT-7            PRESS START TO ACCEPT LABELS AS
4593 *                                 READ.THE REDUNDANT RECORD WILL BE
4594 *                                  WRITTEN AS THE HL-OUTPUT TAPE
4595 *                                  PRESS START/RESET AND START TO
4596           B    HTPSSW-5            RETRY UP TO 99 TIMES
4597 HTHEL2    H                        PRESS START TO RETRY TO WRITE HL
4598           MLC  @9@,HDTSC4          UP TO 9 SKIPS
4599           B    HTAXWT&9
4600 HTHEL3    H    HTAXRT              PRESS START TO ACCEPT HL AS READ
4601           MLC  @99@,HDTSC3         PRESS START RESET AND START TO
4602           B    HTPSSW-5            RETRY UP TO 99 TIMES
4603 HTHEL4    H    *-3                 NO TAPEMARK AFTER HEADER LABEL
4604 *                                 THERE IS A 1 IN COL.5 CC3-RESTART
4605 HDTSC1    DCW  @C@                 B FOR 2-WAY
4606 HDTSC2    DCW  @C@                 B FOR 2-WAY
4607 HDTSC8    DCW  @C@
4608           DCW  #1
4609 HDTSS0    SBR  HDTREX&3
4610           CS   320
4611           MLC  GPMARK,*&4
4612           MLCWA0,321
4613           MLC  HDTSC6,IREG1        ADDR TAPE # BUCKET OUTPUT
4614 HDTSS1    S    &1,HDTSC1
4615           BM   HDTSR1,HDTSC1
4616           MLNS 0&X1,HDTSS2&15      INITIALIZE I/O INSTRUCTIONS
4617           MLNS 0&X1,HDTSS2&34
4618           MLNS 0&X1,HTAXWT&7
4619           MLNS 0&X1,HTAXWT&12
4620           MLNS 0&X1,HTPSSW-2
4621           MLNS 0&X1,HTPAX-10
4622           MLNS 0&X1,HTAXRT&15
4623           MLNS 0&X1,HTNPSR-6
4624           MA   @001@,IREG1
4625 HDTSS2    MLC  @99@,HDTSC3#2       INIT PARITY RD BUCKET
4626           CS   320
4627           CS
4628           RWD  0
4629           MLC  CENSIG,HSSSSS&7
4630           MLC  CENSIG,213
4631           RTW  0,201
4632 HSSSSS    BCE  HTNPSR,213,
4633           BEF  *&1
4634           BER  HDTSPR              BRANCH ON PARITY ERROR
4635           B    HTAXWT-7            NOP FOR INPUT
4636 HTAXRT    NOP  0                   USER EXIT-HL OF INPUT TAPE
4637           BCE  HDTSS1,THLTMO,      BRANCH IF NO TAPE MARK REQUIRED
4638           RTW  0,201
4639           BEF  HDTSS1
4640           B    HTHEL4
4641           MLC  @9@,HDTSC4#1
4642 HTAXWT    NOP  0                  USER EXIT-PRIOR TO HL WRITE-OUTPT
4643           BSP  0
4644           WT   0,201
4645           BER  HDTSPW
4646           BCE  HDTSS1,THLTMO,      BRANCH IF TAPE MARK IS NO TO BE
4647           WTM  0                   WRITTEN
4648           B    HDTSS1
4649 HTNPSR    CS   220                 CLEAR NOISE RECORD
4650           B    HDTSS2&17
4651 HDTSPW    SBR  HTPAX&3,HDTSS2&17   RETURN TO READ INSTRUCTION
4652           MLC  @N@,HTPSSW          BYPASS SKIP ROUTINE
4653           B    *&15
4654 HDTSPR    SBR  HTPAX&3,HDTSS2&17    RETURN TO READ INSTRUCTION
4655           MLC  @B@,HTPSSW          ACTIVATE SKIP ROUTINE
4656           S    &1,HDTSC3
4657           BM   HTHEL1,HDTSC3
4658           BSP  0
4659 HTPSSW    B    HTPAX
4660           BCE  *&5,HDTSC3,G
4661           B    HTPAX
4662           MLC  @9@,HDTSC3
4663           S    &1,HDTSC4
4664           SKP  0
4665           BM   HTHEL2,HDTRC4
4666 HTPAX     B    0                   EX PARITY ERROR ROUTINE
4667 HDTSR1    SBR  HDTSS1&6,HDTSC2    INIT ROUTINE TO PROCESS INPUT
4668           SBR  HDTSS1&13,HDTSC2
4669           SBR  HDTSS1&10,HDTRAX-9
4670           SBR  HTPSSW-10,HTHEL3
4671           MLC  @N@,HTAXRT-4
4672           MLC  HDTSC7,IREG1        ADDR TAPE # BUCKET-INPUT
4673           B    HDTSS1
4674           CS   80
4675           CS   332                 CLEAR GROUPMARK-WORDMARK
4676           CS
4677 HDTRAX    B    NXTPS
4678 HDTSC6    DSA  I1TUHA
4679 HDTSC7    DSA  O1TUHA
4680           LTORG*
4681           EX   OVLAP1
4682           JOB  ** IBM 1401 SORT 7 VERSION 2  PHASE 2  PUNCH URPI      60 P2
4683           ORG  SAVE
4684 BBP2      NOP                                                            P
4685           MZ   SJA,SETPUN&5
4686 SPADQ6    MLC  @1@,0              MOVE 1 INTO REDUND. BUCKET             P
4687           MA   I99,STREND
4688 SETPUN    SBR  MOVPUN&3,0                                                P
4689           MA   @001@,MOVPUN&3
4690           SBR  MOVPUN&13,101                                             P
4691           CS   180                                                       P
4692 MOVPUN    MLC  0,PUNBKT           MOVE CHAR. TO INTERMED. BUCKET
4693           MLC  PUNBKT,101                                                P
4694           C    MOVPUN&3,STREND
4695           BE   PCHBB1
4696           BCE  PCHBB2,MOVPUN&12,8
4697           MA   @001@,MOVPUN&3
4698           MA   @001@,MOVPUN&13
4699           B    MOVPUN
4700 PCHBB2    P    SETPUN&7
4701 PCHBB1    P                       PUNCH LAST BLOCK                       P
4702           CS   180
4703           MA   @I9C@,RETN&3       MODIFY EXIT TO READ NEXT BLOCK         P
4704           MLC  @B@,PDSW                                                  P
4705           B    RETN                                                      P
4706 PUNBKT    DCW  @0@                INTERMEDIATE BUCKET                    P
4707           LTORG*                                                         P
4708           EX   RANOUT                                                    P
4709           JOB  ** IBM 1401 SORT 7 VERSION 2  PHASE 2  TAPE URPI       60 T2
4710           ORG  SAVE
4711 BBP4      MA   @I9C@,RETN&3                                              T
4712           NOP
4713           MLC  @1@,0
4714           MZ   SJA,BBPQ8G&5                                              T
4715           MLC  STREND,LGMTP&6                                            T
4716 LGMTP     LCA  0,0                LOAD GROUPMARK                         T
4717 BBPQ8G    WT   0,1
4718           BEF  BBPHLT
4719           BER  BBPSKP
4720           MLC  STREND,*&7                                                T
4721           LCA  BLANK,0            CLEAR GROUPMARK                        T
4722           CS   332
4723           CS
4724           MLC  UNMSG,223
4725           W                       PRINT MESSAGE                          T
4726           CC   1
4727           MLC  *&1,PDSW
4728           B    RETN
4729 BBPSKP    BSP  0
4730           SKP  0
4731           B    BBPQ8G
4732 BBPHLT    H    BBPQ8G
4733 WTMBD     WTM  0                  CLOSE REDUNDANCY TAPE                  T
4734           RWU  0
4735           B    NDSRT
4736 UNMSG     DCW  @UNREAD BLK WRITTEN-TU 0@
4737           LTORG*
4738           ORG  4000
4739 INITTP    MLC  URPI,BBPQ8G&3      INITIALIZE FOR TAPE NUMBER             T
4740           MLC  URPI,BBPSKP&3
4741           MLNS URPI,BBPSKP&8
4742           MLC  URPI,UNMSG                                                T
4743           MLC  URPI,WTMBD&3                                              T
4744           MLC  URPI,WTMBD&8                                              T
4745           MLC  GPMARK,LGMTP&3
4746           B    RANOUT                                                    T
4747           NOP                                                            T
4748           EX   INITTP                                                    T
4749           JOB  ** IBM 1401 SORT 7 VERSION 2  PHASE 2  CORRECT URPI    60 C2
4750           ORG  SAVE
4751 BBP3      NOP
4752           MZ   SJA,*&13
4753           NOP  0,0
4754           SBR  MOVCOR&3,0         INITIALIZE MOVE INSTRUCTION            C
4755           MA   @001@,MOVCOR&3
4756           CS   332                                                       C
4757           CS                                                             C
4758           SBR  MOVCOR&13,201                                             C
4759 MOVCOR    MLC  0,CORBKT           MOVE CHAR. TO INTERMEDIATE BKT         C
4760           MLC  CORBKT,201         MOVE CHARACTER TO PRINT AREA           C
4761           MA   @001@,MOVCOR&3     UPDATE MOVE INSTRUCTIONS               C
4762           MA   @001@,MOVCOR&13                                           C
4763           C    MOVCOR&3,STREND    CHECK FOR END OF INPUT BLOCK           C
4764           BE   PRTBB2             END OF BLOCK
4765           C    MOVCOR&13,@301@
4766           BE   PRTBB1
4767           B    MOVCOR                                                    C
4768 PRTBB1    W    MOVCOR-12
4769 PRTBB2    W                       PRINT LAST BLOCK                       C
4770           CC   1                                                         C
4771 TSSG2     H                                                              C
4772 ***            TURN SENSE SWITCH G ON TO BACKSPACE AND                   C
4773 ***            REREAD IN ORDER TO CORRECT.  IF TAPE                      C
4774 ***            RECORD IS TO BE ACCEPTED AFTER CORRECTION,                C
4775 ***            TURN SENSE SWITCH G OFF AND PRESS START.                  C
4776           BSS  BACKSP,G                                                  C
4777 SOMORE    B    0                  RETURN TO PROCESS RECORD               C
4778 CORBKT    DCW  @0@                INTERMEDIATE STORAGE BUCKET            C
4779           LTORG*                                                         C
4780           EX   RANOUT                                                    C
4781           JOB  ** IBM 1401 SORT 7 VERSION 2  PHASE 2                  60  2
4782 *              OVERLAP AREA
4783           ORG  4200
4784 PADQNA    DCW  @   @
4785 NOP1      LCA  @N@,CTMSG-36
4786           B    SETTP
4787 OVLAP     BCE  NOP1,VARY,1
4788           MLC  AGMEOA,LGMEOA&6    LOAD GROUPMARK
4789 SETTP     MLC  MI1TUN,RDCPT&3     SET CHECKPOINT TAPE UNIT NUM
4790           MLC  MI1TUN,O1TUHA
4791           MLC  MI1TUN,RREDCP&3
4792           MLC  MI2TUN,O2TUHA
4793           MLC  I1TUN,I1TUHA                                           SORT2
4794           MLC  I2TUN,I2TUHA                                           SORT2
4795           A    @1@,CNOS1
4796           MLC  GMSET&3,PADQNA
4797           MA   @I9I@,PADQNA
4798           MLC  PADQNA,BPADQ8&6
4799           MLC  PADQNA,SPADQ6&6
4800           BCE  FORTWO,I3TUN,
4801           MLC  MI3TUN,O3TUHA
4802           MLC  I3TUN,I3TUHA
4803 CTMSG     MLC  CTNR,CNAR#6
4804           S    PDCPUT,CNAR
4805           MZ   BLANK,CNAR                                             SORT2
4806           ZA   @3@,NOMP#6
4807           MZ   @3@,NOMP
4808 DNMP      C    NOMP,CNSQ          DETERMINE MAX NUM OF MERGE PASSES
4809           A    @1@,NMPP2#2
4810           BE   PRINT1                                                 SORT2
4811           BL   PRINT1                                                 SORT2
4812 SWP1      B    TRITST
4813           A    NOMP                                                   SORT2
4814 OK1       C    NMPP2,@18@
4815           BE   NMPE                                                   SORT2
4816           B    DNMP                                                   SORT2
4817 PRINT1    MLC  NMPP2,PRMSA-6                                          SORT2
4818           MLC  NMPP2,NMPL                                             SORT2
4819           CS   332                                                    SORT2
4820           CS                                                          SORT2
4821           MLC  PRMSA-6,218
4822           W                                                           SORT2
4823           CC   K                                                      SORT2
4824           B    DETANM
4825 TRITST    MLC  NOMP,CTNOMP#6
4826           A    CTNOMP
4827           A    NOMP,CTNOMP
4828           MLC  CTNOMP,NOMP
4829 AMY       B    OK1
4830 NMPE      H    *-3                                                    SORT2
4831 DETANM    ZA   @3@,NOMP
4832           MZ   @3@,NOMP
4833           MLC  &OK2,AMY&3
4834 DNMP2     C    NOMP,CNOS1         DETERMINE EST NUM OF MERGE PASSES
4835           A    @1@,NMAP2#2
4836           BE   PRINT2                                                 SORT2
4837           BL   PRINT2                                                 SORT2
4838 SWP2      B    TRITST
4839           A    NOMP
4840 OK2       C    NMAP2,@18@
4841           BE   NMPE                                                   SORT2
4842           B    DETANM&14
4843 FORTWO    MLC  TWI,@3@
4844           MLC  @N@,SWP1
4845           MLC  @N@,SWP2
4846           MLC  @B@,HDTRC1
4847           MLC  @B@,HDTRC2
4848           MLC  @B@,HDTRC8
4849           MLC  &AO2THA,NOSW&13
4850           MLC  @4@,CNTRA
4851           MLC  &EOFTST,FRAN&3
4852           MLC  &CNTSW&7,FRAN&6
4853           SBR  READ2&15,EORB
4854           SBR  EOF1-1,GO
4855           SBR  COMPAB&10,BLOW-7
4856           SBR  COMPAB&15,ALOW-7
4857           MLC  &GO,FSTRD2&3
4858           MLC  @N@,LGMEOA&21
4859           B    CTMSG
4860 PRINT2    MLC  NMAP2,PRMSB-6                                          SORT2
4861           CS   332                                                    SORT2
4862           CS                                                          SORT2
4863           MLC  PRMSB-6,218
4864           W                                                           SORT2
4865           CC   L
4866           CC   L
4867           MLC  CTNR,PRMSC1-22
4868           MLC  CNAR,PRMSD-21                                          SORT2
4869           MLC  PRMSD,227
4870           W                                                           SORT2
4871           CS   332                                                    SORT2
4872           CS                                                          SORT2
4873           BCE  PSPAFQ,VARY,1
4874           MLC  PDCPUT,PRMSE-22
4875           MLC  PRMSE,228
4876           W                                                           SORT2
4877           CS   332
4878           CS
4879 PSPAFQ    MLC  PRMSC1,228
4880           W
4881           CC   K
4882 REBLK     MLC  AIRA1,ENDRA1       END OF FIRST READ AREA
4883           MA   BL,ENDRA1
4884           MA   I99,ENDRA1
4885           MLC  AIRA2,ENDRA2       END OF SECOND READ AREA
4886           MA   BL,ENDRA2
4887           MA   I99,ENDRA2
4888           MLC  AIRA3,ENDRA3       END OF THIRD READ AREA
4889           MA   BL,ENDRA3
4890           MA   I99,ENDRA3
4891           MLC  CFIRE,COMPAB&3     SET COMPARE INSTR
4892           MLC  CFIRE,COMPAB&6
4893           MLC  CFIRE,COMPBC&3
4894           MLC  CFIRE,COMPBC&6
4895           MLC  CFIRE,COMPAC&3
4896           MLC  CFIRE,COMPAC&6
4897           BCE  SETDEC,DESCND,1
4898           MZ   *-6,COMPAB&2
4899           MZ   *-6,COMPAC&2
4900           MZ   REBLK,COMPAB&5
4901           MZ   REBLK,COMPBC&2
4902           MZ   DETANM,COMPAC&5
4903           MZ   DETANM,COMPBC&5
4904 CMPRE     MLC  BL,ARELO           RT EDGE OF OUTPUT
4905           MA   I99,ARELO
4906           MA   AOWA,ARELO
4907           MLC  AIRA1,COMP11       FIRST READ AREA CF
4908           MA   CFIRE,COMP11
4909           MA   I99,COMP11
4910           MLC  AIRA2,COMP12       SECOND READ AREA CF
4911           MA   CFIRE,COMP12
4912           MA   I99,COMP12
4913           MLC  AIRA3,COMP13       THIRD READ AREA CF
4914           MA   CFIRE,COMP13
4915           MA   I99,COMP13
4916           MLC  COMP11,STEPA&6
4917           MLC  COMP12,STEPB&6
4918           MLC  COMP13,STEPC&6
4919           MLC  AOWA,SDCOMP        OUTPUT AREA CF1                     SORT2
4920           MA   CFIRE,SDCOMP
4921           MA   I99,SDCOMP
4922           BCE  CCFW1,CNOP,
4923           MLC  @N@,LMV
4924 CCFW1     C    NCF,@1@                                                SORT2
4925           BU   CMBOL-8
4926 *              CLEAR EQUALS ROUTINE                                   SORT2
4927           MLC  BLANK,COMPAB&16
4928           MLC  BLANK,COMPBC&16
4929           MLC  BLANK,COMPAC&16
4930           BCE  CMBOL-8,DESCND,1
4931           MLC  BLANK,STEPA&16
4932           MLC  BLANK,STEPB&16
4933           MLC  BLANK,STEPC&16
4934           BCE  RIDZN,VARY,1
4935 CMBOL     MA   L,BOL              COMPUTE OUTPUT BLOCK LENGTH FOR
4936           A    @1@,CNBOL#3        FIXED LENGTH RECORDS
4937           C    CNBOL,BO                                               SORT2
4938           BU   CMBOL                                                  SORT2
4939           MLC  AOWA,ARELBO
4940           MA   BOL,ARELBO
4941           MA   I99,ARELBO
4942           MLC  ARELBO,AGMEBO                                          SORT2
4943           MA   @001@,AGMEBO
4944           BCE  REED,PI,6
4945           MLC  PDCPUT,PDELIM#3    DETERMINE PADDING
4946 HOWMCH    S    BO,PDELIM          REQUIREMENTS
4947           BWZ  REED,PDELIM,K
4948           A    BO,REMOVE
4949           B    HOWMCH
4950 REED      CS   080
4951           SW   24,56                                                  SORT2
4952           SW   63,67                                                  SORT2
4953           R    56                                                     SORT2
4954 RIDZN     MLC  RCDIST,NOZNE
4955           MA   @I9H@,NOZNE
4956           B    REED
4957 SETDEC    MLC  @T@,STEPA&16       INITIALIZE FOR DESCENDING ORDER
4958           MLC  @U@,STEPA&11       OF SORT
4959           MLC  @T@,STEPB&16
4960           MLC  @U@,STEPB&11
4961           MLC  @U@,STEPC&11
4962           MLC  @T@,STEPC&16
4963           MZ   REBLK,COMPAB&2
4964           MZ   DETANM,COMPAC&2
4965           MZ   *-6,COMPAB&5
4966           MZ   DETANM,COMPBC&2
4967           MZ   *-6,COMPAC&5
4968           MZ   REBLK,COMPBC&5
4969           C    NCF,@01@
4970           BU   GOCFQ
4971           MLC  COMPAB&10,SKIP2-1
4972           MLC  COMPBC&10,SKIP3-1
4973           MLC  COMPAC&10,ALOW-8
4974           MLC  STEPA&15,ISBMT-1
4975           MLC  STEPB&15,ISCMT-1
4976           MLC  STEPC&15,RIDGM1-1
4977 GOCFQ     BCE  SW9PD,PI,9
4978           MLC  @9@,PI
4979           B    CMPRE
4980 SW9PD     MLC  @ @,PI
4981           B    CMPRE
4982 TWI       DCW  @2@
4983 LRUN      DSA  RUNOUT
4984 PRMSA     DCW  @MAX PH 2 PASSES 00-ERROR@                             SORT2
4985 PRMSB     DCW  @EST PH 2 PASSES 00-ERROR@                             SORT2
4986 PRMSC1    DCW  @       REC PROCESSED-PASS 00@
4987 PRMSD     DCW  @      -RECORDS READ-PASS 00@                          SORT2
4988 PRMSE     DCW  @000 PAD REC ADDED-PASS 00@
4989           EX   OVLAP                                                  SORT2
4990           JOB  ** IBM 1401 SORT 7 VERSION 2  PHASE 2                  60  2
4991           ORG  3900
4992 WMIRA5    CS   4299               CLEAR SET WORD MARK ROUTINE
4993           CS
4994           CS
4995           NOP  NF0?,CLSTX1&3
4996           NOP  NF0?,CLSTX1&18
4997           CS   LGMEOA,3999
4998 NF0?      DCW  @F0?@
4999 COA       EQU  WMIRA5
5000           BCE  COA,VARY,1
5001           MLC  BLANK2,CNCF#2
5002 INWM12    MLC  AIRA1,ICF12#3      SET WORD MARKS IRA1
5003           MA   CF1SL,ICF12
5004           MLC  ICF12,WMS12&3
5005           MLC  @   @,CNTB#3
5006 ***            SET WORD MARKS LEFT EDGE OF CONTROL FIELDS
5007 WMS12     SW   0
5008           A    *-6,CNTB
5009           C    CNTB,B
5010           BE   SWNCF
5011           MA   L,WMS12&3
5012           B    WMS12
5013 SWNCF     A    *-6,CNCF           NEXT CONTROL FIELD
5014           C    CNCF,NCF
5015           BE   SWIRA2
5016           MA   @003@,INWM12&10
5017           B    INWM12
5018 SWIRA2    NOP  SWIRA3-8           RESET FOR IRA2
5019           MLC  @B@,SWIRA2
5020           SBR  INWM12&3,AIRA2
5021           SBR  INWM12&10,CF1SL
5022           B    INWM12-7
5023           BCE  INWMBI,I3TUN,      BRANCH IF TWO-WAY MERGE
5024 SWIRA3    NOP  INWMBI             RESET FOR IRA3
5025           MLC  @B@,SWIRA3
5026           SBR  INWM12&3,AIRA3
5027           SBR  INWM12&10,CF1SL
5028           B    INWM12-7
5029 ***            SET WORD MARKS LEFT EDGE OF EACH RECORD
5030 INWMBI    MLC  AIRA1,ICF12
5031           MLC  ICF12,SW122&3
5032           MLC  @   @,CNTB
5033 SW122     SW   0
5034           A    *-6,CNTB
5035           C    CNTB,B
5036           BE   WMIRA2
5037           MA   L,SW122&3
5038           B    SW122
5039 WMIRA2    NOP  WMIRA3-8
5040           MLC  @B@,WMIRA2
5041           MLC  AIRA2,ICF12
5042           B    INWMBI&7
5043           BCE  COA,I3TUN,         BRANCH IF TWO-WAY MERGE
5044 WMIRA3    NOP  COA
5045           MLC  @B@,WMIRA3
5046           MLC  AIRA3,ICF12
5047           B    INWMBI&7
5048           LTORG*
5049           JOB  ** IBM 1401 SORT 7 VERSION 2  PHASE 2                  60  2
5050 SETCLR    BCE  PASMLT,LABELS,1
5051           SBR  CLSTX1&3,3600      NO LABELS INITIALIZATION
5052           SBR  CLSTX1&18
5053           SBR  CLSTX1-12,NXTPS
5054           SW   CPTGM-1
5055           SBR  QTRL&3,OUTTM
5056           MLC  @N@,CPTGM&14
5057           MLC  @N@,NOPPS2-18
5058           MLC  @N@,NOPPS2-11
5059           MLC  @N@,NOPPS2-4
5060           CS   080
5061           SW   024,056
5062           SW   063,067
5063           R    056
5064 PASMLT    R                       BYPASS MULTIPHASE PROGRAM
5065           C    021,CONEND
5066           BU   PASMLT
5067           R    NXTPS
5068 BUCPYS    SW   FILNAM&1,FILESE&1
5069           SW   SYSCRE&1
5070           MLC  @N@,NOPDDD&14
5071           MLC  @N@,NOPDDD&21
5072           B    NOPDDD
5073 CONEND    DCW  @HEADER-TRAILER-PHASE2@
5074 STPASS    NOP  WRCK2
5075           NOP  TSTPS
5076           MLC  @B@,STPASS&4
5077           BCE  *&16,LABELS,
5078           BCE  BUCPYS,LBBUCK,1
5079 NOPDDD    MLC  @N@,HSSD-9         NOP SW D OPTION IF LABELS
5080           MLC  CTNR,CTNR1
5081           SW   OHDATE-4,TPSERL-4
5082           SW   FLSERL-4
5083           C    PDCPUT,@000@
5084           BU   *&8
5085           MLC  @6@,PI
5086           BCE  NXTINS,UNLOAD,
5087           MLC  @U@,REWIND&4       INITIALIZATION FOR UNLOAD OPTION
5088           MLC  @U@,REWIND&9
5089           MLC  @U@,REWIND&14
5090           MLC  @U@,REWIND&19
5091           MLC  @U@,THDTP&9
5092           MLC  @U@,THDTP&14
5093 NXTINS    NOP
5094           MLC  GPMARK,CPTGM&3
5095           MLC  GPMARK,SETBK&3
5096           BCE  TOOQ,LDI,1
5097           BCE  TOOQ,LDI,2
5098           B    MUSHQ
5099 TOOQ      MLC  SET1MV,SETOUT&6
5100           MLC  ACNT,COMP2&3       SET COUNTERS
5101           MLC  ACTNR,RESET&3
5102           MLC  ACTNR,PAD9&3
5103           MLC  ACNT,SETNMP&3
5104           MLC  ACNT,SETNMP&10
5105           MLC  CLEPS,GMCLR&3
5106           MLC  ACNT,TSTPS&3
5107           MLC  ACNT,TSTPS&44
5108           MLC  ACTNR,SETEND&28
5109           MLC  ACTNR,RESET&10
5110           MLC  ACTNR,COMPCT-4
5111           MLC  GMSET&3,PADQQA
5112           MA   @I9I@,PADQQA
5113           MLC  PADQQA,PADQCZ&6
5114           MLC  ACTNR,COMPCT&6
5115           MLC  CSTCNS,CLSTX1&7
5116           BCE  TSTPS,I3TUN,
5117           MN   @2@,ZEROS1
5118 TSTPS     C    0,@000000@
5119           MLZS *-6,CENSIG
5120           BCE  *&8,LBBUCK,1
5121           MLC  CENSIG,NSYHDR&7
5122           MLC  CENSIG,NSE&7
5123           BE   TLMPC
5124           C    0,ZEROS1
5125           BL   PSCNT
5126           B    SLMP
5127 PADQQA    DCW  @   @
5128 PSCNT     CS   332                                                    SORT2
5129           CS                                                          SORT2
5130           MLC  CNMP,PRMSC-6                                           SORT2
5131           C    CNMP,@00@          PASS TO PASS MESSAGES
5132           BE   GOON
5133           MLC  0,PRMSC-28
5134 COMPCT    C    CTNR1,0            COMPARE RECORD COUNT
5135           BU   ERRCT                                                  SORT2
5136 SUBPAD    NOP  REMOVE,PRMSC-28
5137           MZ   SETNOS-1,PRMSC-28
5138           MLC  PRMSC-6,228                                            SORT2
5139 PRCT      W                                                           SORT2
5140           CC   K                                                      SORT2
5141           NOP                     THIS BECOMES A HALT IF THERE IS
5142 *                               AN ERROR IN THE RECORD COUNT
5143           MLC  @N@,PRCT&3
5144 GOON      A    @1@,CNMP
5145           S    @1@,NMPL                                               SORT2
5146           MZ   BLANK,NMPL                                             SORT2
5147           B    INIT1
5148 MUSHQ     MLC  @ LOW@,PDTYQ-8
5149           B    TOOQ
5150 ERRCT     MLC  PRMSC,234
5151           MLC  206,CTNR1          MOVE NEW COUNT TO CTNR1
5152           MLC  SLMP-4,PRCT&3
5153           B    PRCT
5154 TLMPC     NOP  SETEND
5155           B    SLMP
5156 SETEND    LCA  ENDBR&4,GOON&4     END OF SORT
5157 PADQCZ    BCE  PSCNT,0,1
5158           MLC  @S@,SUBPAD
5159           MZ   @ @,0
5160           B    PSCNT
5161 ENDBR     BIN  EPH2,
5162 LMPMSG    CS   332
5163           CS
5164           MLC  PRMSLP,225
5165           W                       PRINT LAST MERGE PASS MESSAGE
5166           CC   1
5167           H    SLMP&5
5168 SLMP      BSS  LMPMSG,B
5169 EXTLMP    NOP  0                  USERS EXIT
5170           LCA  @N@,CNTSW          LAST MERGE PASS INITIALIZATION
5171           LCA  @N@,TSTPS&11
5172           MLC  @B@,TLMPC
5173           MLC  @B@,QTRL
5174           MLC  @B@,PSLMP
5175           SBR  EPH2-1,RDLBRT
5176           MLC  @#@,WMIRA5&6
5177           MLC  @#@,WMIRA5&13
5178           BCE  *&22,LABELS,1
5179           MLC  @#@,WMIRB5&6
5180           MLC  @#@,WMIRB5&13
5181           SBR  EPH2-1,PASS
5182           MLC  @A@,SETBAK-7
5183           BCE  LSTVRY,VARY,1
5184           BCE  NEWOUT,PI,6        CHECK PADDING INDICATOR
5185           MLC  @N@,PDSW
5186           BCE  PAD9,PI,9
5187           BCE  PAD,PI,
5188 PAD9      MLC  0,PADCT
5189           S    REMOVE,PADCT
5190           MZ   @ @,PADCT
5191           B    NEWOUT
5192 PAD       ZA   REMOVE,PADCT
5193           MZ   @ @,PADCT
5194           MLC  @U@,AWAY&11
5195           MLC  @B@,AWAY&12
5196 NEWOUT    MLC  AGMEBO,LGMEOA&6
5197           MLC  ARELBO,ARELO                                           SORT2
5198 OURBK     MLC  &BO,KOWNT&3
5199           MLC  OUTMOD,WOBR        SET OUTPUT MODE
5200           SBR  CLINP2&3,INWM12-15
5201           BCE  INTRWU,VARY,1
5202           BCE  CKWM,CNOP,
5203           MA   I99,CKWM&6
5204           MA   I99,MOVOUT&6
5205 CKWM      BWZ  MOVOUT,LMV,1
5206           SW   CKWM&4
5207           MLC  CKWM&6,LSTMOD&6
5208           MA   @I9D@,LSTMOD&6
5209 LSTMOD    MLC  OUTMOD,0
5210           B    INTRWU
5211 MOVOUT    MLC  OUTMOD,LMV
5212           MA   I99,CKWM&6
5213           MA   I99,MOVOUT&6
5214           B    CKWM
5215 INTRWU    MLC  @U@,REWIND&19
5216           MLC  I2TUHA,WOBR&3
5217           MLC  I2TUHA,WORED&3
5218           MLC  I2TUHA,ERTAPE&3
5219           B    PSCNT
5220 *                               SET TAPE UNIT NUMBERS
5221 INIT1     MLC  I1TUHA,WRCKT&3
5222           MLC  I1TUHA,WRDCK&3                                         SORT2
5223           MLC  I1TUHA,ERSE1&3                                         SORT2
5224 ROTP      MLC  I1TUHA,CNRR                                            SORT2
5225           MLC  O1TUHA,I1TUHA                                          SORT2
5226           MLC  CNRR,O1TUHA                                            SORT2
5227           MLC  I2TUHA,CNRR                                            SORT2
5228           MLC  O2TUHA,I2TUHA                                          SORT2
5229           MLC  CNRR,O2TUHA                                            SORT2
5230           MLC  I1TUHA,REWIND&3
5231           MLC  I1TUHA,READ1&3                                         SORT2
5232           MLC  I2TUHA,REWIND&8
5233           MLC  I2TUHA,READ2&3                                         SORT2
5234           MLC  O1TUHA,REWIND&13
5235           MLC  O1TUHA,OUTTM&3
5236 PSLMP     NOP  CNTUE
5237           MLC  O1TUHA,WOBR&3                                          SORT2
5238           MLC  O1TUHA,WORED&3                                         SORT2
5239           MLC  O1TUHA,ERTAPE&3
5240 CNTUE     MLC  O2TUHA,OUTTM&8
5241           MLC  O2TUHA,REWIND&18
5242           MLC  I3TUHA,CNRR
5243           MLC  O3TUHA,I3TUHA
5244           MLC  CNRR,O3TUHA
5245           MLC  I3TUHA,READ3&3
5246           MLC  O3TUHA,THDTP&3
5247           MLC  I3TUHA,THDTP&8
5248           MLC  O3TUHA,THDTP&13
5249           SBR  RUNOUT&3,SKIP1
5250           SBR  SKIP1&3,COMPAB
5251           SBR  SWOT&3,O2TUHA
5252           MLC  SDCOMP,SDCMPV
5253           MLC  SDCOMP,STEPA&3
5254           MLC  SDCOMP,STEPB&3
5255           MLC  SDCOMP,STEPC&3
5256           MLC  O2TUHA,OUTTM&8
5257           MLC  O2TUHA,REWIND&18
5258           MLC  O1TUHA,RDCPT&3
5259           MLC  O1TUHA,RREDCP&3
5260 SETOUT    MLC  AREFO,0
5261           MLC  BLANK2,CNEOR
5262           BCE  WRCK2,I3TUN,       BRANCH IF 2-WAY MERGE
5263           MLC  BLANK,CNTRA
5264           MLC  BLANK,CNTRB
5265           SBR  COMPAB&10,SKIP2
5266           SBR  COMPAB&15,SKIP3
5267           SBR  SKIP2&3,COMPBC
5268           SBR  SKIP3&3,COMPAC
5269 WRCK2     SW   1,5                SET RESTART BRANCH
5270           MLC  &HRES
5271           MLC  @B@
5272           CW   ITLI
5273           MLC  @N@,STPASS
5274           BIN  HSSD,D                                                 SORT2
5275           B    IWRCK                                                  SORT2
5276 HSSD      CS   332                SENSE SWITCH D INTERRUPT
5277           CS                                                          SORT2
5278           MLC  PRMXX,222
5279           W                       PRINT DENSITY MESSAGE
5280           CC   1                                                      SORT2
5281           H    *&1                                                    SORT2
5282 IWRCK     MLC  @  @,CNEOR
5283           MLC  BLANK2,CNRR
5284 GMCLR     CW   0
5285 EXTCKP    NOP  0                  USERS EXIT
5286 WRCKT     WTW  0,1                WRITE CHECKPOINT
5287           BER  WRDCK                                                  SORT2
5288           BEF  WEFCK2                                                 SORT2
5289 TFI       BIN  INTRPT,E                                               SORT2
5290 RESET     S    0
5291           MZ   BLANK,0
5292           MLC  INPUT1,IREG1
5293           MLC  INPUT2,IREG2
5294           MLC  INPUT3,IREG3
5295 SETNMP    S    0                  PRINT MERGE PASS NUM MESSAGE
5296           MZ   BLANK,0
5297           CS   332                                                    SORT2
5298           CS                                                          SORT2
5299           MLC  CNMP,PRMSH-27
5300           MLC  O1TUHA,PRMSH-20
5301           MLC  I1TUHA,PRMSH-14
5302           MLC  I2TUHA,PRMSH-12
5303           MLC  I3TUHA,PRMSH-10
5304           MLC  PRMSH-10,226
5305           W                                                           SORT2
5306           CC   1                                                      SORT2
5307           B    CLSTX1-7
5308 EPH2      CS   332                                                    SORT2
5309           CS                                                          SORT2
5310           MLC  O1TUHA,RWES&3                                          SORT2
5311           MLC  O2TUHA,PRMSG-12                                        SORT2
5312           MLC  PRMSG,218                                              SORT2
5313           W                       PRINT END OF SORT MESSAGE
5314           CC   1                                                      SORT2
5315 RWES      RWD  0                  REWIND CHECKPOINT TAPE
5316           BCE  NDSRT,URPI,P
5317           BCE  NDSRT,URPI,C
5318           B    WTMBD              BRANCH TO CLOSE REDUNDANCY TAPE
5319 INTRPT    MLC  CNMP,PRMSH-27      SENSE SWITCH E INTERRUPT
5320           MLC  O1TUHA,PRMSH-20
5321           MLC  I1TUHA,PRMSH-14
5322           MLC  I2TUHA,PRMSH-12
5323           MLC  I3TUHA,PRMSH-10
5324           CS   332                                                    SORT2
5325           CS                                                          SORT2
5326           MLC  PRMSH,234
5327           W                       PRINT INTERRUPT MESSAGE
5328           CS   239
5329           MLC  PDTYQ,212
5330           W
5331           CC   1                                                      SORT2
5332           H    RESET                                                  SORT2
5333 PASS      R
5334           BCE  CLSTX1-7,040,/
5335           B    PASS
5336 HRES      CS   332                RESTART ROUTINE
5337           CS                                                          SORT2
5338           RWD  1                                                      SORT2
5339 SETBK     SW   0                  INITIALIZE MESSAGES
5340           MLC  CNMP,PRMSI-20
5341           MLC  I1TUHA,PRMSI-14
5342           MLC  I2TUHA,PRMSI-12
5343           MLC  I3TUHA,PRMSI-10
5344           MLC  O1TUHA,PRMSI-4
5345           MLC  O2TUHA,PRMSI-2
5346           MLC  O3TUHA,PRMSI
5347           MLC  PRMSI,227                                              SORT2
5348           W                       PRINT RESTART MESSAGES
5349           CS   228
5350           MLC  PDTYQ,212
5351           W
5352           CS   228
5353           MLC  CARDMG,231
5354           W
5355 CPTGM     LCA  0,ITLI             LOAD GROUPMARK TO STOP TAPE READ    60  1
5356           MLC  @B@,STPASS                                             60  1
5357           MLC  @N@,NOPPS1         NOP IF NO LABELS
5358           BEF  *&1
5359           MLZS *-6,CENSIG
5360           BCE  *&8,LBBUCK,1
5361           MLC  CENSIG,NSYHDR&7
5362           MLC  CENSIG,NSE&7
5363           CC   1                                                      60  1
5364           H
5365           BCE  *&19,LBBUCK,
5366           SBR  HDTSS1-4,HDTSC7
5367           SBR  HDTRAX-17,HDTSC6
5368           B    HDTSS0
5369           SBR  HDTRS1-4,HDTRC7
5370           SBR  HDTREX-16,HDTRC6
5371           B    HDTRS0             OPEN THE TAPES
5372 NOPPS2    MLNS I1TUHA,RCCP&3
5373           MLC  @ @,ERRCNT          INITIALIZE ERROR COUNTER
5374           MLNS I1TUHA,RSTBER&3
5375 RCCP      RTW  %U0,001
5376           BER  RSTBER
5377           BEF  RSTBEF
5378 NOPPS1    B    WRCK2
5379           SBR  HDTRS1-4,HDTRC6
5380           SBR  HDTREX-16,HDTRC7
5381           SBR  HDTRS1&10,HDTRRI
5382           MLC  HDTRC8,HDTRC1
5383           MLC  HDTRC8,HDTRC2
5384           SBR  HTPRSW-10,HTHAL1
5385           SBR  HDTRS1&6,HDTRC1
5386           SBR  HDTRS1&13,HDTRC1
5387           MLC  @B@,HTEXRT-4
5388           MLC  @B@,NOPPS1
5389           SBR  HDTREX&3,NXTPS
5390           B    WRCK2
5391 RSTBEF    H    WRCK2
5392 RSTBER    BSP  %U0
5393 CPTERR    A    @1@,ERRCNT
5394           BAV  CPTHLT
5395           B    RCCP
5396 CPTHLT    H    NOPPS2
5397 COMP2     C    0,@000001@
5398           BL   SETNMP
5399           B    SLMP
5400 EOFCP     H    STPASS
5401           B    RREDCP
5402 NDSRT     H    *-3                END OF SORT
5403 WRDCK     BSP  0                  WRITE CHECKPOINT ERROR ROUTINE
5404           BCE  ERCKP,CNRR,1
5405           A    @1@,CNRR                                               SORT2
5406           B    WRCKT                                                  SORT2
5407 ERCKP     A    @1@,CNEOR                                              SORT2
5408           C    CNEOR,@10@
5409           BE   HRTRY                                                  SORT2
5410 ERSE1     SKP  0
5411           B    IWRCK&7                                                SORT2
5412 LSTVRY    MA   NOZNE,ALOP&6       LAST MERGE PASS INITIALIZATION
5413           MA   @004@,COMETF        ALLOW FOR BLOCK COUNT FOR VLR
5414           MA   NOZNE,ALOP&13      FOR VARIABLE LENGTH RECORDS
5415           MA   NOZNE,ALOP&20
5416           MLC  ALOP&6,INCR1-8
5417           MLC  ALOP&13,INCR2-8
5418           MLC  ALOP&20,INCR3-8
5419           C    BO,@001@
5420           BE   ARL&8
5421           MLC  AOWA,SWOWA&3
5422           MA   @I9F@,SWOWA&3
5423 SWOWA     SW   0
5424           MLC  COMETF,COMET
5425           MLC  @M@,INCR1-7
5426           MLC  @M@,INCR2-7
5427           MLC  @M@,INCR3-7
5428           MLC  @?@,SETBAK
5429           MLC  @A@,ADDTO
5430           MLC  AOWA,*&14
5431           MA   I99,*&7
5432           LCA  @000D@,0
5433           SW   SWOWA&1
5434           MLC  SWOWA&3,WOBR&6
5435 ARL       BCE  OURBK&7,BO,
5436           BCE  ELIMIT,RLIIND,1
5437           MLC  &LSTOUT,ISOFL-1
5438           LCA  ISOFL,CKOUT&4
5439           B    OURBK&7
5440 CNTBO     DCW  @   @
5441 ERRCNT    DCW  @ @                 ERROR BUCKET FOR CHECKPOINT READ
5442 ISOFL          @B000 @
5443 HRTRY     H    IWRCK                                                  SORT2
5444 WEFCK2    H    TFI                                                    SORT2
5445 ZEROS1    DCW  @000001@
5446 ALOP      MZ   BLANK,0&X1
5447           MZ   BLANK,0&X2
5448           MZ   BLANK,0&X3
5449 ELIMIT    BCE  ARL&16,RTAIN,1
5450           MA   @004@,WOBR&6       ELIMINATE RLI-VLR UNBLOCKED
5451           B    ARL&16
5452 RDLBRT    CS   80                  READ IN THE FINAL HEADER-
5453           SW   24,56               TRAILER ROUTINE
5454           SW   63,67
5455           BCE  NORMAL,LBBUCK,      BRANCH IF 80 CHARACTER ROUTINE
5456 ABNORM    R
5457           BCE  NORMAL,68,B
5458           B    ABNORM
5459 NORMAL    R    56
5460 CTNR1     DCW  @000000@
5461 PRMSLP    DCW  @LAST MERGE PASS-INTERRUPT@
5462 PRMSC     DCW  @       REC PROCESSED-PASS 00-ERROR@
5463 PRMXX     DCW  @DENSITY MAY BE CHANGED@
5464 PRMSG     DCW  @OUTP  -END OF SORT@                                   SORT2
5465 PRMSH     DCW  @PASS 00-CKPT 0-INP 0,0,0 INTERRUPT@
5466 PRMSI          @PASS 00 INP 0,0,0 OUT 0,0,0@
5467 PDTYQ     DCW  @HIGH DENSITY@
5468 CARDMG    DCW  @PLACE CARDS FROM 1442 IN READER@
5469           LTORG*
5470           EX   SETCLR
5471           JOB  ** IBM 1401 SORT 7 VERSION 2  PHASE 2                  60  2
5472           ORG  CLSTX1-18
5473           SBR  CLINP2&3,NXTPS
5474           B    CLSTX1
5475           SBR  CLINP2&3,INWM22-15
5476           ORG  EOFW1
5477           BCE  RWD,QTRL,B
5478           ORG  HTHAL1
5479 RWD       MLNS WOBR&3,*&4
5480           WTM  0
5481           MLNS WOBR&3,*&4
5482           RWU  0
5483           BCE  HLT,O3TUHA,
5484           C    WOBR&3,O3TUHA
5485           BU   RTRN2-7
5486           H    SWOT
5487 HLT       H    RTRN2-7
5488           NOP
5489 ***
5490 ***            SET WORD MARK ROUTINE WITHOUT LABELS
5491 ***
5492           ORG  3200
5493 WMIRB5    CS   3599
5494           CS
5495           CS
5496           NOP  NF0?1,CLSTX1&3
5497           NOP  NF0?1,CLSTX1&18
5498           CS   LGMEOA,3299
5499 NF0?1     DCW  @F0?@
5500           BCE  WMIRB5,VARY,1
5501           MLC  BLANK2,CNCFB#2
5502 INWM22    MLC  AIRA1,ICF22#3
5503           MA   CF1SL,ICF22
5504           MLC  ICF22,WMS22&3
5505           MLC  @   @,CNTBB#3
5506 ***       SET WORD MARKS LEFT EDGE OF CONTROL FIELDS
5507 WMS22     SW   0                  SET WORD MARK
5508           A    *-6,CNTBB
5509           C    CNTBB,B
5510           BE   SWNCFB
5511           MA   L,WMS22&3
5512           B    WMS22
5513 SWNCFB    A    *-6,CNCFB          NEXT CONTROL FIELD
5514           C    CNCFB,NCF
5515           BE   SWIRB2
5516           MA   @003@,INWM22&10
5517           B    INWM22
5518 SWIRB2    NOP  SWIRB3-8           NEXT INPUT AREA
5519           MLC  @B@,SWIRB2
5520           SBR  INWM22&3,AIRA2
5521           SBR  INWM22&10,CF1SL
5522           B    INWM22-7
5523           BCE  INWMCI,I3TUN,      BRANCH IF TWO-WAY MERGE
5524 SWIRB3    NOP  INWMCI             NEXT INPUT AREA
5525           MLC  @B@,SWIRB3
5526           SBR  INWM22&3,AIRA3
5527           SBR  INWM22&10,CF1SL
5528           B    INWM22-7
5529 ***            SET WORD MARKS LEFT EDGE OF EACH RECORD
5530 INWMCI    MLC  AIRA1,ICF22
5531           MLC  ICF22,SW22&3
5532           MLC  @   @,CNTBB
5533 SW22      SW   0
5534           A    *-6,CNTBB
5535           C    CNTBB,B
5536           BE   WMIRB2
5537           MA   L,SW22&3
5538           B    SW22
5539 WMIRB2    NOP  WMIRB3-8
5540           MLC  @B@,WMIRB2
5541           MLC  AIRA2,ICF22
5542           B    INWMCI&7
5543           BCE  WMIRB5,I3TUN,      BRANCH IF TWO-WAY MERGE
5544 WMIRB3    NOP  WMIRB5
5545           MLC  @B@,WMIRB3
5546           MLC  AIRA3,ICF22
5547           B    INWMCI&7
5548           LTORG*
5549           EX   PASMLT
5550           JOB  ** IBM 1401 SORT 7 VERSION 2  MULTIPHASE               60  2
5551           ORG  STRTMP
5552           SFX  #
5553           DCW  @MULTIPHASE@
5554 *                               CLEAR CORE FROM END OF AVAILABLE
5555 *                               PHASE 2 AREA TO 700
5556 REPH1     MLC  CSTCNS,CLPH1&3
5557           SW   700
5558 CLPH1     CS   0                   CLEARING BEGINS FROM PH2 USER
5559           SBR  CLPH1&3             AREA
5560           BWZ  CLPH1,700,1
5561 *                               LOAD MAINLINE AND FIRST INIT RTN
5562 *                                  BRANCH TO STRTN
5563           CS   80                  READ FIRST MULTIPHASE OVERLAY
5564           SW   24,56
5565           SW   63,67
5566           R    056
5567           NOP
5568           EX   REPH1
5569           JOB  ** IBM 1401 SORT 7 VERSION 2  MULTIPHASE               60  2
5570           SFX  #
5571           ORG  STRTMP
5572 OWA       DCW  @B01@              START OF OUTPUT AREA
5573 CNMP      DCW  @00@               CURRENT MERGE PASS NUMBER
5574 NMPL      DCW  @  @               NUM OF MULTIPHASE PASSES LEFT
5575 CNTRB     DCW  @ @                NUM OF SEQ IF LESS THAN 8
5576 CLEPS          @   @              LOC OF GMWM FOR CHECKPOINT
5577 ACTNR          @   @              LOC OF TOTAL RCD COUNT
5578 ACNT      DCW  @   @              LOC OF UNREADABLE RCD COUNT
5579 NOMP      DCW  @00@               TOTAL NUM OF MERGE PASSES
5580 SEQMRG    DCW  @000000@           NUM SEQ TO BE MERGED CURRENT PASS
5581 YCNTR     DCW  @000000@
5582 *                                 ALGORITHM COMPUTATION BUCKETS
5583 PCNTR     DCW  @000000@
5584 XAREA     DCW  @000000@
5585 YAREA     DCW  @000001@
5586 *                                 MULTIPHASE CONSTANTS
5587 LIT001    DCW  @001@
5588 LIT003    DCW  @003@
5589 SIX 0S    DCW  @000000@
5590 NOP       DCW  @N@
5591 KB        DCW  @B@
5592 AONE      DCW  @1@
5593 ATWO      DCW  @2@
5594 AFOUR     DCW  @4@
5595 TWOBL     DCW  @  @
5596 I99       DCW  @I9I@
5597 BLANK     EQU  TWOBL-1
5598 AZERO     EQU  SIX 0S-5
5599 RUNOTP    EQU  RNOUTP
5600 *            MULTIPHASE LABELS EQUATED WITH THOSE FROM ASSN PHASE
5601           SFX
5602 THEDTE    EQU  DATE
5603 OTMOMP    EQU  HTMO
5604 OHLIMP    EQU  OTLI               OUTPUT HDR LABEL
5605 WLBKTM    EQU  WLBKT
5606 OHLOPM    EQU  OHLOP
5607 OTLIMP    EQU  TLO                OUTPUT TRAILER LABEL
5608 OUTMLT    EQU  OUTMOD             OUTPUT MODE INDICATOR
5609 LMULTI    EQU  L                  RECORD LENGTH
5610 BMULTI    EQU  B                  SORT BLOCKING
5611 BOMULT    EQU  BO                 OUTPUT BLOCKING
5612 NCFMLT    EQU  NCF                NUM CONTROL FIELDS
5613 BLMULT    EQU  BL                 SORT BLOCK LENGTH
5614 CTNRML    EQU  CTNR               TOTAL NUM OF RCDS
5615 PIMULT    EQU  PI                 PADDING IND
5616 URPIML    EQU  URPI               UNREADABLE RCD PROCED IND
5617 IF1F2M    EQU  IF1F2              DISTANCE BETWEEN CFS
5618 CNOSIM    EQU  CNOS1              NUM TIMES TAPES SWITCHED IN PH 1
5619 *                                 INPUT TAPE UNIT NUMBERS
5620 I1TUNM    EQU  I1TUN
5621 I2TUNM    EQU  I2TUN
5622 I3TUNM    EQU  I3TUN
5623 MSMULT    EQU  MS                 CORE SIZE
5624 CFIREM    EQU  CFIRE              UNITS POS CF 1
5625 CNOPML    EQU  CNOP               1 IF CF IN FIRST POS OF RCD
5626 LDIMLT    EQU  LDI                DENSITY INDICATOR
5627 CF1SLM    EQU  CF1SL              HI ORDER POS CF 1
5628           SFX  #
5629 ACNTR     DCW  @0@                STEPDOWN COUNTER
5630 SPLCHR    DCW  @|@                STEPDOWN COUNTER
5631 PADQNQ    DCW  @   @              LOC OF REDUNDANCY IND
5632 *                                 TAPE UNIT AND SEQ COUNT BUCKETS
5633 I2TUHP    DCW  @0@
5634 I1TUHP    DCW  @0@
5635 O1TUHP    DCW  @0000000@
5636 O2TUHP    DCW  @0000000@
5637 TUHOLD    DCW  @0000000@
5638 TAPSEQ    DCW  @000000@
5639 AGMEOP    DCW  #3                 END OF OUTPUT AREA
5640 ARELBP    DCW  @   @              END OF OUTPUT AREA-LAST PASS
5641 AGMEBP    DCW  @   @              LOC OF GMWM-LAST PASS
5642 *                                 START OF INPUT AREAS
5643 INPT1P    DCW  @   @
5644 INPT2P    DCW  @   @
5645 INPT3P    DCW  @   @
5646 *                                 END OF INPUT AREAS
5647 NDRA1P    DCW  @   @
5648 NDRA2P         @   @
5649 NDRA3P         @   @
5650 *                                 UNITS POS CF1 REL TO INPUT AREAS
5651 CMP11P         @   @
5652 CMP12P         @   @
5653 CMP13P         @   @
5654 ST1MVP    DCW  @   @              LOC OF MTOA&6
5655 RMOVEP    DCW  @   @              NUM OF PADDED RCDS TO BE REMOVED
5656 *                                 START OF INPUT AREAS & 1
5657 AIRA1     DCW  @   @
5658 AIRA2     DCW  @   @
5659 AIRA3     DCW  @   @
5660 *                                 START OF INPUT AREAS & 13
5661 NG1       DCW  @   @
5662 NG2       DCW  @   @
5663 NG3       DCW  @   @
5664 ARELO          @   @              OUTPUT AREA & BLOCK LENGTH
5665 BOL       DCW  @   @              BLOCK LENGTH-FINAL OUTPUT
5666 AREFO          @   @              START OF OUTPUT AREA&1
5667 CNRR      DCW  @  @               COUNT NUM TIMES RETRY READ
5668 SJA       DCW  @ @                STORE ZONE FOR REDUND READ
5669 CNEOR     DCW  @ @                COUNT NUM TIMES ERASE TAPE
5670 *                                 STANDARD LABEL BUCKETS
5671 OPENID    DCW  @ @
5672 TPNOBK    DCW  @0@
5673 KO        DCW  @O@
5674 KI        DCW  @I@
5675 EOJBK     DCW  @ @
5676 MULBKC    DCW  @00000@            BLOCK COUNT
5677 SKIP1     EQU  CMPABP
5678 SKIP2     EQU  CMPBCP
5679 SKIP3     EQU  CMPACP
5680 *
5681 *                                 MAINLINE PROGRAM
5682 *
5683 LGMEOP    LCA  0,0                SET GMKS IN I/O AREAS
5684           LCA  0,0
5685           LCA  0,0
5686           LCA  0,0
5687           MLC  SPLCHR,0
5688 REDETP    B    STRD1
5689 RNOUTP    B    SKIP1              RUNOUT SWITCH
5690 CMPABP    C    0,0                COMPARE A&B
5691           BL   SKIP2              B LT A                              SORT2
5692           BH   SKIP3              A LT B
5693           B    EQU
5694 CMPBCP    C    0,0                COMPARE B&C
5695           BL   CLOW               C LT B                              SORT2
5696           BH   BLOW               B LT C                              SORT2
5697           B    EQU
5698 CMPACP    C    0,0                COMPARE A&C
5699           BL   CLOW               C LT A
5700           BH   ALOW               A LT C
5701           B    EQU
5702 IMOVE     SBR  RTRN1&3
5703           SBR  RTRN2&3
5704 MTOA      MLC  0,0                NUM MOVE INST EQUALS NUM CF
5705           MLC                       PLUS ONE IF CF NOT IN FIRST
5706           MLC                       POSITION OF RECORD
5707           MLC                                                         SORT2
5708           MLC                                                         SORT2
5709           MLC                                                         SORT2
5710           MLC                                                         SORT2
5711           MLC                                                         SORT2
5712           MLC                                                         SORT2
5713           MLC                                                         SORT2
5714 LMV       MLC
5715 CKOUT     C    0,ARELO            Q OUTPUT BLOCK FULL
5716           BE   WRITE                                                  SORT2
5717 RTRN1     B    0                                                      SORT2
5718 WRITE     MLC  OWA,MTOA&6
5719 WTEX      NOP  0                  USERS EXIT PRIOR TO WRITE TAPE
5720 KOWNT     NOP  BMULTI,0           COUNT OUTPUT RECORDS
5721 PDSW      B    WOBR-7             NOP IF LAST PASS AND PAD. RCDS
5722 BPAQQ8    BCE  WOBR-7,0,1
5723 AWAY      C    0,PADCT#6          Q PADDED RECORD COUNT
5724           BL   RTRN2
5725           BE   RTRN2
5726           NOP  NOP,BBP2
5727           MLC  TWOBL,CNRR
5728 WOBR      WT   0,0                WRITE OUTPUT BLOCK
5729           BER  WORED
5730           MLC  BLANK,0            CLEAR FIRST POS OF OUTPUT AREA
5731 *                               LAST PASS REPLACE ABOVE WITH
5732 *                                 INCREMENT BLOCK COUNT INST
5733           BEF  EOFW1                                                  SORT2
5734 RTRN2     B    0                                                      SORT2
5735 ALOW      MZ   *-6,MTOA&2         INIT TO MOVE RCD FROM A TO OUTPUT
5736           MA   LMULTI,MTOA&6
5737 INCR1     MA   LMULTI,IREG1
5738           B    IMOVE
5739           C    IREG1,NDRA1P       ALL A RECORDS MOVED
5740           BU   RNOUTP             B SOME REMAIN
5741           MLC  INPT1P,IREG1       INITIALIZE INDEX REGISTER
5742 STRD1     SBR  RTRD&3,READ1-7
5743           SBR  RETN&3
5744           MZ   *-6,SJA            STORE ZONE FOR REDUN READ
5745           MLC  TWOBL
5746           MLC  CENSIG,NG1
5747 READ1     RT   0,0                READ FIRST INPUT TAPE
5748           BEF  EOF1
5749 INTF1     BCE  RDGM,NG1,}
5750           BER  RED
5751           NOP  SPLCHR,0&X1
5752           MLC  NOP,*-13
5753 RD1EX     NOP  0                  USERS EXIT AFTER READ FIRST TAPE
5754 RDFST1    B    STRD2              FIRST RECORD SWITCH
5755 STEPA     B    NEWASQ,0,|         START OF NEW SEQUENCE
5756           B    RNOUTP
5757 BLOW      MZ   NOP,MTOA&2         INIT TO MOVE RCD FROM B TO OUTPUT
5758           MA   LMULTI,MTOA&6
5759 INCR2     MA   LMULTI,IREG2
5760           B    IMOVE
5761           C    IREG2,NDRA2P       ALL B RECORDS MOVED
5762           BU   RNOUTP             B SOME REMAIN
5763           MLC  INPT2P,IREG2       INITIALIZE INDEX REGISTER
5764 STRD2     SBR  RTRD&3,READ2-7
5765           SBR  RETN&3
5766           MZ   NOP,SJA            STORE ZONE FOR REDUN READ
5767           MLC  TWOBL
5768           MLC  CENSIG,NG2
5769 READ2     RT   0,0                READ SECOND INPUT TAPE
5770           BEF  EOF2
5771 INTF2     BCE  RDGM,NG2,}
5772           BER  RED
5773           NOP  SPLCHR,0&X2
5774           MLC  NOP,*-13
5775 RD2EX     NOP  0                  USERS EXIT AFTER READ SECOND TAPE
5776 RDFST2    B    STRD3              FIRST RECORD SWITCH
5777 STEPB     B    NEWBSQ,0,|         START OF NEW SEQUENCE
5778           B    RNOUTP
5779 CLOW      MZ   KB,MTOA&2          INIT TO MOVE RCD FROM C TO OUTPUT
5780           MA   LMULTI,MTOA&6
5781 INCR3     MA   LMULTI,IREG3
5782           B    IMOVE
5783           C    IREG3,NDRA3P       ALL C RECORDS MOVED
5784           BU   RNOUTP             SOME REMAIN
5785           MLC  INPT3P,IREG3       INITIALIZE INDEX REGISTER
5786 STRD3     SBR  RTRD&3,READ3-7
5787           SBR  RETN&3
5788           MZ   KB,SJA             STORE ZONE FOR REDUN READ
5789           MLC  TWOBL
5790           MLC  CENSIG,NG3
5791 READ3     RT   0,0                READ THIRD INPUT TAPE
5792           BEF  EOF3
5793 INTF3     BCE  RDGM,NG3,}
5794           BER  RED
5795           NOP  SPLCHR,0&X3
5796           MLC  NOP,*-13
5797 RD3EX     NOP  0                  USERS EXIT AFTER READ THIRD TAPE
5798 RDFST3    B    RNOUTP             FIRST RECORD SWITCH
5799 STEPC     B    NEWCSQ,0,|         START OF NEW SEQUENCE
5800           B    RNOUTP             ADD THE NUMBER ASSOCIATED
5801 NEWASQ    A    AONE,ACNTR         WITH UNIT THAT HAS REACHED
5802           B    EOSTSP             A NEW SEQUENCE
5803 NEWBSQ    A    ATWO,ACNTR
5804           B    EOSTSP
5805 NEWCSQ    A    AFOUR,ACNTR
5806           B    EOSTSP
5807 *                                 CLEAR NOISE RECORD
5808 RDGM      MZ   SJA,*&6
5809           MN   TWOBL,13
5810           MN
5811           MN
5812           MN
5813           MN
5814           MN
5815           MN
5816           MN
5817           MN
5818           MN
5819           MN
5820           MN
5821           MN
5822           MN
5823 RTRD      B    0                  RETURN TO READ TAPE
5824 *                       DETERMINE CONTENTS OF ACNTR AND BRANCH TO
5825 *                       CORRESPONDING RTN TO SET RUNOUT SWITCH
5826 EOSTSP    BCE  SDALL,ACNTR,7      Q NEW SEQ ON ALL UNITS
5827           BCE  SDAC,ACNTR,5       B TO INSTRUCTIONS WHICH
5828           BCE  SDAB,ACNTR,3       RE-INITIALIZE COMPARE INSTRUCTION
5829           BCE  SDBC,ACNTR,6       FOR UNITS THAT HAVE NOT
5830           BCE  SDA,ACNTR,1        REACHED A NEW SEQUENCE
5831           BCE  SDB,ACNTR,2
5832           BCE  SDC,ACNTR,4
5833           B    RNOUTP
5834 SDAC      SBR  RNOUTP&3,BLOW
5835           B    RNOUTP
5836 SDAB      SBR  RNOUTP&3,CLOW
5837           B    RNOUTP
5838 SDBC      SBR  RNOUTP&3,ALOW
5839           B    RNOUTP
5840 SDA       SBR  RNOUTP&3,SKIP2
5841           B    RNOUTP
5842 SDB       SBR  RNOUTP&3,CMPACP
5843           B    RNOUTP
5844 SDC       SBR  CMPABP&15,ALOW
5845           SBR  CMPABP&10,BLOW
5846           B    RNOUTP
5847 SDALL     SBR  RNOUTP&3,SKIP1     RESET TO ORIGINAL COMPARE INST
5848           SBR  CMPABP&10,SKIP2    WHEN NEW SEQUENCE OR EOF HAS BEEN
5849           SBR  CMPABP&15,SKIP3    REACHED ON ALL TAPES
5850           MLC  AZERO,ACNTR
5851           MLC  SPLCHR,0           SET SEQ CHAR IN WRITE OUT AREA
5852 SEQCMP    C    0,PCNTR            Q ALL SEQUENCES PROCESSED
5853 *                                 END OF PASS BRANCH
5854           BE   RWINDP
5855           A    AONE,PCNTR
5856           B    RNOUTP
5857 *                                 LAST PASS ROUTINE
5858 LPEOJ     MLC  AONE,EOJBK
5859           BCE  RWINDP,OTLIMP,
5860           B    LMHLTP             STANDARD TRAILER LABEL BRANCH
5861 RWINDP    WTM  0                  WRITE T M ON OUTPUT TAPE
5862           RWD  0
5863           CW   0                  CLEAR WORD MARKS AT END OF
5864           CW   0                  I/O AREAS TO ALLOW WRITING
5865           CW   0                  OF CHECKPOINT
5866           CW   0
5867 *                               MAINLINE BRANCH TO WKLBLI
5868 ENDMP     B    ENDMLT
5869 *                               WRITE REDUNDANCY ROUTINE
5870 WORED     BSP  0
5871           BCE  ERASE,CNRR,1
5872           A    AONE,CNRR
5873           B    WOBR
5874 ERASE     A    AONE,CNEOR
5875           BCE  HWRED,CNEOR,0      TEN SKIPS BRANCH
5876 ERTAPP    SKP  0
5877           B    WOBR-7
5878 HWRED     H
5879           MLC  TWOBL,CNEOR
5880           B    ERTAPP
5881 *                                 EQUAL ROUTINE
5882 EQU       SBR  EQHLD#3            SET INSTRUCTIONS
5883           MLC  IREG1,HLDX1P#3     TO COMPARE SECONDARY
5884           MLC  EQHLD,IREG1        CONTROL FIELDS
5885           MA   @I8E@,IREG1
5886           MLC  0&X1,CMNCF&6
5887           MLC  4&X1,CMNCF&10
5888           MLC  9&X1,NXTCFP&17
5889           MLC  9&X1,CMNCF&15
5890           MLC  HLDX1P,IREG1
5891           MLC  TWOBL,CNCF2#2
5892           SBR  ICFL&3,IF1F2M
5893           SBR  ICFL2&3,IF1F2M
5894 NXTCFP    A    AONE,CNCF2
5895           C    CNCF2,NCFMLT
5896           BE   0
5897 ICFL      MA   0,CMNCF&3
5898 ICFL2     MA   0,CMNCF&6
5899 CMNCF     C    0,0
5900           BL   0
5901           BH   0
5902           MA   LIT003,ICFL&3
5903           MA   LIT003,ICFL2&3
5904           B    NXTCFP
5905 *                               READ REDUNDANCY ROUTINE
5906 RED       SBR  TUNOS&3
5907           SBR  SMOREP&3
5908           MA   @I7G@,TUNOS&3
5909           A    AONE,CNRR
5910           NOP  SJA,REDSQ-3
5911 SETZN     MZ   SJA,MHBB&2
5912           BWZ  SUBT B,CNRR-1,S
5913 TUNOS     MN   0,BCKSPP&3
5914 BCKSPP    BSP  0
5915 RETN      B    0
5916 SUBT B    NOP  BMULTI,0           ADD IF NOT CORRECT OPTION
5917           B    BBP2
5918 EOF1      A    AONE,ACNTR         END OF FILE ON FIRST INPUT UNIT
5919           RWD  0
5920           MLC  BLANK,0            REMOVE 1401 GENERATED GP MK
5921           B    EOSTSP
5922 EOF2      A    ATWO,ACNTR         END OF FILE ON SECOND INPUT UNIT
5923           RWD  0
5924           MLC  BLANK,0            REMOVE 1401 GENERATED GP MK
5925           B    EOSTSP
5926 EOF3      A    AFOUR,ACNTR        END OF FILE ON THIRD INPUT UNIT
5927           RWD  0
5928           MLC  BLANK,0            REMOVE 1401 GENERATED GP MK
5929           B    EOSTSP
5930 *                                 END OF REEL ON OUTPUT UNIT
5931 EOFW1     NOP  LPSQCP             LAST PASS BRANCH
5932           CS   332
5933           CS
5934           MLC  WROM,227
5935           W
5936           CC   1
5937           H    *-3
5938 LPSQCP    C    ACTNR,CTNRML
5939           BE   LPEOJ              END OF JOB BRANCH
5940           B    LMHLTP             END OF REEL BRANCH
5941 WROM      DCW  @OUTPUT EXCEEDS REEL LENGTH@
5942           LTORG*
5943 SAVE      ORG  *
5944           JOB  ** IBM 1401 SORT 7 VERSION 2 MULTIPHASE                60  2
5945           ORG  ADJEND
5946 *              MULTIPHASE WORK LABEL ROUTINE TO PROCESS STANDARD
5947 *                   HEADER LABELS ON ALL WORK TAPES
5948 *
5949 *     TAPES ARE REFERRED TO AS OUTPUT OR INPUT DEPENDING
5950 *      UPON WHETHER THEY ARE OUTPUT OR INPUT REELS TO THE
5951 *    NEXT PASS.
5952 *
5953 MLHHL1    H    MULEX1         PRESS START TO ACCEPT LABEL
5954 *                             AS READ.THE REDUNDANT REC.
5955 *                             WILL BE WRITTEN AS THE H.L.
5956           B    MULHRD-19    PRESS START RESET/START TO
5957 *                             RETRY UP TO 99 MORE TIMES.
5958 *
5959 MLHHL2    H                   PRESS START TO TRY TO WRITE
5960           MLC  AZERO,MULHC2       THE HEADER LABEL AGAIN  UP TO
5961           B    MULHWT         9 SKIPS.
5962 *
5963 MLHHL3    H    MULEX1         PRESS START TO ACCEPT INPUT
5964 *                             HEADER LABEL AS READ.
5965           B    MULHRD-19    PRESS START RESET/START TO
5966 *                             RETRY UP TO 99 MORE TIMES.
5967 *
5968 MLHHL4    H    *-3            NO T/M AFTER H.L. WHEN ONE
5969 *                             HAS BEEN SPECIFIED AS BEING
5970 *                             THERE-RESTART PROG.
5971 MLHENT    SBR  MLHEXT&3
5972           MN   TPNOBK,MULST1&14
5973           MN   TPNOBK,MULHRD&3
5974           MN   TPNOBK,MULTMR&3
5975           MN   TPNOBK,MLHST3&11
5976 MULST1    CS   181            CLEAR HDR LABEL READ/WRITE AREA
5977           MLCWA0,181
5978           RWD  0
5979           MLC  SIX 0S-4,MULHC1#2  INIT ERROR COUNTER
5980           MLC  CENSIG,MULHRD&15
5981           MLC  CENSIG,114
5982 MULHRD    RTW  0,101
5983           BCE  MLHNOS,114,        IF NOISE RECORD
5984           BEF  *&1
5985           BER  MLHRDP              PARITY ERROR ROUTINE
5986 MULEX1    NOP  0                  USERS EXIT
5987           BCE  MULST2,OPENID,O     IF OUTPUT TAPE
5988           BCE  CLR280,THLTMO,     IF NO TM AFTER HL
5989 MULTMR    RT   0,101              READ TAPEMARK
5990           BEF  CLR280
5991           B    MLHHL4              ERROR CONDITION
5992 MULST2    MN   TPNOBK,MULEX2&7     INIT I/O INSTRUCTIONS
5993           MN   TPNOBK,MULHWT&3
5994           MN   TPNOBK,CLR280-2
5995           MN   TPNOBK,MLHPWT&10
5996           MN   TPNOBK,MLHST4&3
5997           MLC  @09@,MULHC1         RESET ERROR COUNTER
5998           MLC  AZERO,MULHC2#1
5999 MULEX2    NOP  0                  USERS EXIT
6000           RWD  0
6001 MULHWT    WT   0,101
6002           BER  MLHPWT              PARITY ERROR
6003           BCE  *&6,THLTMO,         IF NO T/M AFTER H.L.
6004           WTM  0
6005 CLR280    CS   181
6006 MLHEXT    B    0                  RETURN TO NEXT SEQUENTIAL INST
6007 *
6008 MLHNOS    CS   114
6009           B    MULHRD-14
6010 *
6011 *     READ PARITY ERROR ROUTINE
6012 *
6013 *              TRY TO READ HEADER 99 TIMES THEN HALT
6014 MLHRDP    BCE  *&12,OPENID,O       IF OUTPUT TAPE
6015           SBR  MLHST3&3,MLHHL3
6016           B    *&8
6017           SBR  MLHST3&3,MLHHL1
6018           A    AONE,MULHC1
6019 MLHST3    BWZ  MLHHL1,MULHC1-1,S   IF 99 TRIES
6020           BSP  0
6021           B    MULHRD-14
6022 *
6023 *     WRITE PARITY ERROR ROUTINE
6024 *
6025 *              TRY TO WRITE HEADER TWICE IN SAME PLACE THEN
6026 *                   SPACE FORWARD   AFTER TEN SKIPS HALT
6027 MLHPWT    S    AONE,MULHC1
6028           BSP  0
6029           BCE  *&5,MULHC1,G
6030           B    MULHWT
6031           MLC  @09@,MULHC1
6032 MLHST4    SKP  0
6033           A    AONE,MULHC2
6034           BCE  MLHHL2,MULHC2,0
6035           B    MULHWT
6036           LTORG*
6037 WKLEND    ORG  *
6038           JOB  ** IBM 1401 SORT 7 VERSION 2  MULTIPHASE               60  2
6039           ORG  KEEP
6040 MLTPHZ    SBR  REDETP&3,STRD1     START OF MULTIPHASE ADJUSTMENT
6041           B    STRD2
6042 *                                 PASS P1 SEQUENCES ROUTINE
6043 PASSP1    MLC  BLANK,0
6044           MLC  NOP,RDFST2
6045           BCE  SETP3,CNTRB,1
6046 P1CHAR    MLC  SPLCHR,0           MOVE SEQ CHAR TO OUTPUT AREA
6047           C    P1AREA,PCNTR       Q SEQ PASSED EQUAL TO P1
6048           BE   SETP2
6049           A    AONE,PCNTR         BUMP SEQUENCE COUNTER
6050           B    RNOUTP
6051 P1EOF     RWD  0
6052           MLC  BLANK,0            REMOVE 1401 GENERATED GP MK
6053           C    P1AREA,SIX 0S
6054           BE   SETP2
6055           SBR  RDFST2&3,PASSP1
6056 P1EOF2    A    AONE,PCNTR
6057           MLC  KB,RDFST2
6058           MLC  I2TUHP,TPNOBK
6059           MLC  KI
6060           B    MLHENT
6061           B    STRD2
6062 *                                 INIT TO PASS P2 SEQ
6063 SETP2     MN   O1TUHP,WOBR&3      SET NEW OUTPUT TAPE
6064           MN   O1TUHP,WORED&3
6065           MN   O1TUHP,ERTAPP&3
6066           MLC  SIX 0S,PCNTR       RESET SEQUENCE COUNTER
6067           SBR  STEPB&3,PASSP2
6068           SBR  READ2&11,P2EOF
6069 *                                 PASS P2 SEQUENCES ROUTINE
6070 PASSP2    MLC  BLANK,0
6071 P2CHAR    MLC  SPLCHR,0           MOVE SEQ CHAR TO OUTPUT AREA
6072           MLC  NOP,RDFST2
6073           C    P2AREA,PCNTR       Q SEQ PASSED EQUAL TO P2
6074           BE   SETP3
6075           A    AONE,PCNTR         BUMP COUNTER
6076           B    RNOUTP
6077 P2EOF     RWD  0
6078           MLC  BLANK,0
6079           C    P2AREA,SIX 0S
6080           BE   SETP3
6081           SBR  RDFST2&3,PASSP2
6082           B    P1EOF2
6083 *                                 INIT TO PASS P3 SEQ
6084 SETP3     MLC  SIX 0S,PCNTR       RESET SEQUENCE COUNTER
6085 RTNPP3    MLC  GPMARK,*&4
6086           LCA  0,002              BYPASS CHECKPOINT WRITTEN
6087           MLC  I1TUHP,*&4         DURING PHASE 1
6088           RT   0,001
6089           SBR  RNOUTP&3,ALOW      SET RUNOUT TO PASS SEQUENCES
6090           MLC  INPT1P,STEPA&6     FROM FIRST UNIT
6091           SBR  STEPA&3,PASSP3
6092           B    STRD1              READ FIRST RECORD
6093 *                                 PASS P3 SEQUENCES ROUTINE
6094 PASSP3    MLC  BLANK,0
6095 P3CHAR    MLC  SPLCHR,0           MOVE SEQ CHAR TO OUTPUT AREA
6096           MLC  NOP,RDFST1
6097           C    P3AREA,PCNTR       Q SEQ PASSED EQUAL TO P3
6098           BE   READ X
6099           A    AONE,PCNTR         BUMP COUNTER
6100           B    RNOUTP
6101 P3EOF     RWD  0
6102           MLC  BLANK,0            REMOVE 1401 GENERATED GP MK
6103           SBR  RDFST1&3,PASSP3
6104           MLC  KB,RDFST1
6105           A    AONE,PCNTR         BUMP COUNTER
6106           MLC  I1TUHP,TPNOBK
6107           MLC  KI
6108           B    MLHENT
6109           B    RTNPP3
6110 READ X    CS   080                READ IN ROUTINE
6111           SW   024,056            FOR MERGING X SEQUENCES
6112           SW   063,067
6113           R    056
6114 P1AREA    DCW  @000000@
6115 P2AREA    DCW  @000000@
6116 P3AREA    DCW  @000000@
6117           LTORG*
6118 ADJEND    ORG  *
6119           ORG  087
6120 IREG1     DCW  000
6121           ORG  092
6122 IREG2     DCW  000
6123           ORG  097
6124 IREG3     DCW  000
6125           ORG  3200
6126 LLCHEK    BCE  STRTN,LBBUCK,
6127           CS   80
6128           SW   24,56
6129           SW   63,67
6130           R    56
6131 STRTN     BCE  STU,LABELS,1       LABELS BRANCH
6132           MLC  NOP,SETP2-8        NOP BRANCHES TO WORK LABEL RTN
6133           MLC  NOP,READ X-8
6134           SBR  OWA,2801           SET NO LABELS OUTPUT AREA
6135 STU       BCE  FRAMOR,LBBUCK,
6136           SBR  SETP2-5,MLHANT    BRANCHES CHANGED FOR 120 CHAR.
6137           SBR  READ X-5,MLHANT
6138           SBR  RWINDP-1,LMHKTP
6139           SBR  LPSQCP&15
6140 FRAMOR    MLC  I1TUNM,O1TUHP      STORE INPUT AND OUTPUT TAPE
6141           MLC  I2TUNM,O2TUHP      UNIT NUMBERS AS USED IN
6142           MLC  MI1TUN,I1TUHP      PHASE 1
6143           MLC  MI2TUN,I2TUHP
6144           SBR  IREG1,MTOA
6145           MLC  NCFMLT,NCFHDP#2
6146           MLC  NOP,AWAY&12
6147           MLC  OWA,AIRA1
6148           MA   BLMULT,AIRA1       SET LOCATIONS FOR
6149           MLC  AIRA1,AGMEOP       GROUP MARK WORD MARK AT END OF
6150           MLC  AIRA1,LGMEOP&6     EACH INPUT
6151           MLC  AIRA1,RWINDP&25    AND OUTPUT AREA
6152           MA   @002@,AIRA1
6153           MLC  AIRA1,AIRA2
6154           MA   BLMULT,AIRA2
6155           MA   LIT001,AIRA2
6156           MLC  AIRA2,LGMEOP&13
6157           MLC  AIRA2,RWINDP&13
6158           MA   @002@,AIRA2
6159           MLC  AIRA2,AIRA3
6160           MA   BLMULT,AIRA3
6161           MA   LIT001,AIRA3
6162           MLC  AIRA3,LGMEOP&20
6163           MLC  AIRA3,RWINDP&17
6164           MA   @002@,AIRA3
6165           MLC  AIRA1,EOF1&18      INITIALIZE REMOVAL OF 1401
6166           MLC  AIRA2,EOF2&18      GENERATED GROUP MARK
6167           MLC  AIRA3,EOF3&18
6168           MLC  AIRA3,AIRA4#3
6169           MA   BLMULT,AIRA4
6170           MA   LIT001,AIRA4
6171           MLC  AIRA4,LGMEOP&27
6172           MLC  AIRA4,RWINDP&21
6173           MLC  AIRA3,INPT3P
6174           MA   I99,INPT3P
6175           MLC  INPT3P,READ3&6
6176           MLC  OWA,AREFO
6177           MA   I99,OWA
6178           MLC  OWA,WOBR&6
6179           MLC  OWA,WOBR&19        SET LOCATIONS FOR START OF
6180           MLC  AIRA1,INPT1P       INPUT READ AREAS
6181           MA   I99,INPT1P
6182           MLC  INPT1P,READ1&6
6183           MLC  AIRA2,INPT2P
6184           MA   I99,INPT2P
6185           MLC  INPT2P,READ2&6
6186 *                                 SET ADDR OF GROUP MARK WORD MARK
6187           MLC  GPMARK,LGMEOP&3
6188           MLC  GPMARK,LGMEOP&10
6189           MLC  GPMARK,LGMEOP&17
6190           MLC  GPMARK,LGMEOP&24
6191           BCE  *&12,LBBUCK,
6192           MLC  GPMARK,MVLST1&8
6193           B    *&8
6194           MLC  GPMARK,MULST1&7
6195           MLC  AIRA1,NG1          SET NOISE RECORD TEST
6196           MA   @012@,NG1
6197           MLC  AIRA2,NG2
6198           MA   @012@,NG2
6199           MLC  AIRA3,NG3
6200           MA   @012@,NG3
6201           MLC  NG1,INTF1&6
6202           MLC  NG2,INTF2&6
6203           MLC  NG3,INTF3&6
6204           MLC  CENSIG,INTF1&7
6205           MLC  CENSIG,INTF2&7
6206           MLC  CENSIG,INTF3&7
6207           MLC  NG1,READ1-1
6208           MLC  NG2,READ2-1
6209           MLC  NG3,READ3-1
6210 *                                 LOAD MODE INITIALIZATION
6211           BCE  CMTOA,OUTMLT,M     OUTPUT MOVE MODE BRANCH
6212           MLC  OUTMLT,SBR-6
6213 MODMV     MLC  OUTMLT,LMV         CHANGE MOVE INST TO LOAD INST
6214           BCE  CMTOA,CTMV-1,1
6215           A    AONE,CTMV#2
6216           MA   I99,MODMV&6
6217           B    MODMV
6218 CMTOA     C    NCFHDP,@10@        INITIALIZE MOVE TO
6219           BE   CKPOS1             OUTPUT AREA DEPENDENT
6220           MA   LIT001,IREG1       UPON NUMBER OF CONTROL FIELDS
6221           A    AONE,NCFHDP
6222           B    CMTOA
6223 CKPOS1    BCE  MSBR,CNOPML,
6224           MA   LIT001,IREG1       EXEC ONLY IF CF IN FIRST RCD POS
6225 MSBR      LCA  SBR,6&X1
6226           LCA
6227           LCA
6228           MLC  IREG1,ST1MVP
6229           MA   LIT006,ST1MVP
6230           MLC  ST1MVP,*&7
6231           MLC  OWA,0              MOVE START OF OUTPUT INTO MTOA&6
6232           MLC  ST1MVP,WRITE&6
6233           MLC  ST1MVP,ALOW&13
6234           MLC  ST1MVP,BLOW&13
6235           MLC  ST1MVP,CLOW&13
6236           MLC  ST1MVP,CKOUT&3
6237           MLC  IREG1,IREG2
6238           MA   @I9B@,IREG2        ESTABLISH LOCATION OF IMOVE
6239           MLC  IREG2,INCR1&10
6240           MLC  IREG2,INCR2&10
6241           MLC  IREG2,INCR3&10
6242           MLC  IREG1,IREG3
6243           MA   @002@,IREG3        ESTABLISH LOCATION OF MTOA&2
6244           MLC  IREG3,ALOW&6
6245           MLC  IREG3,BLOW&6
6246           MLC  IREG3,CLOW&6
6247 *              ESTABLISH S, N, A1, B1, AND C1
6248 *                S, TOTAL NUM OF SEQ PRIOR TO ADJUSTMENT
6249 *                N, TOTAL NUM OF SEQ AFTER ADJUSTMENT
6250 *                A1,B1,C1  NUM OF SEQ ON EACH INPUT TAPE 1,3,4
6251 *                   RESPECTIVELY AFTER ADJUSTMENT
6252 *              COMPUTE ADJUSTMENT VALUES Y, X, P1, P2, P3
6253 *                Y, NUM OF SEQ TO BE 3 WAY MERGED TO HIGH OUTPUT
6254 *                X, NUM OF SEQ TO BE 2 WAY MERGED TO LOW OUTPUT
6255 *                P1, NUM OF SEQ TO BE PASSED FROM HIGH INPUT TO
6256 *                   HIGH OUTPUT TAPE
6257 *                P2, NUM OF SEQ TO BE PASSED FROM HIGH INPUT TO
6258 *                   LOW OUTPUT TAPE
6259 *                P3, NUM OF SEQ TO BE PASSED FROM LOW INPUT TO
6260 *                   LOW OUTPUT TAPE
6261           A    AONE,CNOSIM
6262           MLC  CNOSIM,NOSQCT
6263           A    NOSQCT             FIND NUMBER OF SEQUENCES
6264           A    NOSQCT             ON EACH INPUT TAPE REEL
6265           A    CNOSIM,NOSQCT
6266           MLC  CNOSIM,SQHOLD
6267           MLC  NOSQCT-1,SEQ1
6268           MLC  NOSQCT-1,SEQ2
6269           A    AONE,NOMP          BUMP NUM OF MERGE COUNTER
6270           C    NOSQCT,@5@
6271           BE   SEQ/
6272 TEST7     C    CNOSIM,@000008@    Q TOTAL SEQUENCES LESS THAN 8
6273           BH   MODIF1
6274           MLC  @9@,CNTRB
6275 *              TEST TO FIND FIRST N&3C1 FROM TABLE WHICH IS EQUAL
6276 *                   TO OR GREATER THAN S
6277 LOOKUP    C    HOLDC1,CNOSIM
6278           BH   UPTBLE
6279           S    AREAN,SQHOLD       FIND Y EQUAL TO S-N DIVIDED
6280           MZ   AONE,SQHOLD        BY THREE[TRUNCATED]
6281           MLC  SQHOLD,HOLDSN
6282           A    HOLDSN
6283           A    SQHOLD,HOLDSN
6284           MLC  HOLDSN,ADHOLD
6285           A    ADHOLD,HOLDSN-1
6286           A    ADHOLD,HOLDSN-2
6287           A    ADHOLD,HOLDSN-3
6288           A    ADHOLD,HOLDSN-4
6289           A    ADHOLD,HOLDSN-5
6290           A    ADHOLD,HOLDSN-6
6291           A    @5@,HOLDSN-5
6292           MLC  HOLDSN-7,YAREA
6293           MLC  SQHOLD,XAREA       FIND X EQUALTO S-N-2Y
6294           MLC  YAREA,SQHOLD
6295           A    SQHOLD
6296           S    SQHOLD,XAREA
6297           MZ   AONE,XAREA
6298           MLC  AREAC1,P1AREA      FIND PASS P1 EQUAL TO C1-Y
6299           S    YAREA,P1AREA
6300           MZ   AONE,P1AREA
6301           MLC  SEQ2,P2AREA
6302           S    XAREA,P2AREA       FIND PASS P2 EQUAL TO A-X-C1
6303           S    AREAC1,P2AREA
6304           MZ   AONE,P2AREA
6305           MLC  SEQ1,P3AREA        FIND PASS P3 EQUAL TO A&K-X-Y-A1
6306           S    XAREA,P3AREA
6307           S    YAREA,P3AREA
6308           S    AREAA1,P3AREA
6309           MZ   AONE,P3AREA
6310 SPCRTN    MLC  INPT2P,STEPB&6     INITIALIZE INSTRUCTIONS IN
6311           MLC  I2TUHP,READ2&3     ADJUSTMENT ROUTINE TO PASS
6312           MLC  I1TUHP,P3EOF&3     P1,P2,AND P3 NUMBER
6313           MLC  I2TUHP,P1EOF&3     OF SEQUENCES
6314           MLC  I2TUHP,P2EOF&3
6315           MA   EOF1&18,P1EOF&11
6316           MA   EOF2&18,P2EOF&11
6317           MA   EOF3&18,P3EOF&11
6318           MLC  INPT2P,PASSP1&6
6319           MLC  INPT3P,STEPC&6
6320           SBR  RDFST2&3,PASSP1
6321           SBR  STEPB&3,PASSP1
6322           SBR  RNOUTP&3,BLOW
6323           MLC  OWA,P1CHAR&6
6324           MLC  INPT2P,PASSP2&6
6325           MLC  OWA,P2CHAR&6
6326           MLC  INPT1P,PASSP3&6
6327           MLC  OWA,P3CHAR&6
6328           MLC  SIX 0S-5,I3TUNM
6329           MLC  SIX 0S-5,MI3TUN
6330           SBR  RDFST1&3,PASSP3
6331           MLC  P1AREA,YCNTR
6332           A    YAREA,YCNTR
6333           MN   O2TUHP,WOBR&3
6334           MN   O2TUHP,WORED&3
6335           MN   O2TUHP,ERTAPP&3
6336           MN   O1TUHP,READ3&3
6337           A    P3AREA,O2TUHP-1
6338           A    XAREA,O2TUHP-1
6339           MLC  SEQ1,TUHOLD-1
6340           MLC  O2TUHP-1,TAPSEQ
6341           A    P2AREA,TAPSEQ
6342           SBR  READ2&11,P1EOF
6343           MLC  I1TUHP,READ1&3
6344           MLC  I1TUHP,EOF1&10
6345           SBR  READ1&11,P3EOF
6346           MLC  OWA,REDETP-1
6347           CS   080                READ OVERLAP INST INTO CORE
6348           SW   24,56
6349           SW   63,67
6350           BCE  WLBLOL,LBBUCK,
6351 OLYRED    R    056
6352 WLBLOL    R
6353           BCE  OLYRED,68,B
6354           B    WLBLOL
6355 SEQ/      A    AONE,SEQ1          INCREASE SEQ1 WHEN TOTAL NUM
6356           B    TEST7              OF SEQUENCES IS ODD
6357 *              LOOP TO REACH THE NEXT HIGHER LEVEL OF THE
6358 *                   MULTIPHASE MERGE TABLE
6359 UPTBLE    MLC  AREAC1,HOLDC1
6360           A    AREAB1,AREAC1
6361           MLC  HOLDC1,AREAB1
6362           A    AREAA1,AREAB1
6363           MLC  HOLDC1,AREAA1
6364           A    AREAB1,HOLDC1
6365           A    AREAC1,HOLDC1
6366           MLC  HOLDC1,AREAN
6367           A    AREAC1,HOLDC1
6368           A    AREAC1,HOLDC1
6369           A    AREAC1,HOLDC1
6370           A    AONE,NOMP
6371           B    LOOKUP
6372           SBR  RTRN1&3
6373           SBR  RTRN2&3
6374 SBR       DCW  @M000000@
6375 HOLDSN    DCW  @0000000000000@
6376 MODIF1    BCE  SEQNO1,CNOSIM,1    SET INSTRUCTIONS FOR EXCEPTION
6377           BCE  SEQNO2,CNOSIM,2    CASES WHERE TOTAL NUMBER OF
6378           BCE  SEQNO3,CNOSIM,3    SEQUENCES IS LESS THAN EIGHT
6379           BCE  SEQNO4,CNOSIM,4
6380           BCE  SEQNO5,CNOSIM,5
6381           BCE  SEQNO6,CNOSIM,6
6382           MLC  @7@,CNTRB          SEQUENCE TOTAL EQUALS SEVEN
6383           MLC  ATWO,NOMP          SET NOMP TO TWO
6384           A    AONE,P1AREA        SET P1 TO ONE
6385           A    AONE,P2AREA        SET P2 TO ONE
6386           A    ATWO,P3AREA        SET P3 TO TWO
6387           MLC  AONE,YAREA         SET Y TO ONE
6388           B    SPCRTN
6389 SEQNO1    MLC  AONE,CNTRB         SEQUENCE TOTAL EQUALS ONE
6390           B    SPCRTN
6391 SEQNO2    MLC  ATWO,CNTRB         SEQUENCE TOTAL EQUALS TWO
6392           B    SPCRTN
6393 SEQNO3    MLC  AONE,XAREA         SEQUENCE TOTAL EQUALS THREE
6394           MLC  LIT003,CNTRB       SET X TO ONE
6395           B    SPCRTN
6396 SEQNO4    MLC  AFOUR,CNTRB        SEQUENCE TOTAL EQUALS FOUR
6397           MLC  AONE,P2AREA        SET P2 TO ONE
6398           MLC  AONE,P3AREA        SET P3 TO ONE
6399           MLC  AONE,YAREA         SET Y TO ONE
6400           B    SPCRTN
6401 SEQNO5    MLC  @5@,CNTRB          SEQUENCE TOTAL EQUALS FIVE
6402           MLC  AONE,XAREA         SET X TO ONE
6403           MLC  AONE,P3AREA        SET P3 TO ONE
6404           MLC  AONE,YAREA         SET Y TO ONE
6405           B    SPCRTN
6406 SEQNO6    MLC  ATWO,XAREA         SEQUENCE TOTAL EQUALS SIX
6407           MLC  LIT006,CNTRB       SET X TO TWO
6408           MLC  AONE,YAREA         SET Y TO ONE
6409           B    SPCRTN
6410 AREAC1    DCW  @000001@
6411 AREAB1    DCW  @000001@
6412 AREAA1    DCW  @000001@
6413 ADHOLD    DCW  @000000@
6414 NOSQCT    DCW  @0000000@
6415 SQHOLD    DCW  @000000@
6416 SEQ1      DCW  @000000@
6417 SEQ2      DCW  @000000@
6418 AREAN     DCW  @000003@
6419 HOLDC1    DCW  @000006@
6420 LIT006    DCW  @006@
6421           EX   LLCHEK
6422           JOB  ** IBM 1401 SORT 7 VERSION 2 MULTIPHASE                60  2
6423 *
6424 *              120 CHARACTER WORK LABEL ROUTINE
6425           ORG  ADJEND
6426 *              TAPES ARE REFERRED TO AS OUTPUT OR INPUT DEPENDING
6427 *              ON WHETHER THEY ARE OUTPUT OR INPUT REELS TO NXT PS
6428 MLHIL1    H    MULAX1              PRESS START TO ACCEPT LABEL AS
6429 *                                  READ.THE REDUNDANT RECORD WILL
6430 *                                  BE WRITTEN AS THE HEADER LABEL
6431           B    MVLHRD-14          PRESS START/RESET-START TO RETRY
6432 *                                  UP TO 99 MORE TIMES
6433 MLHIL2    H                        PRESS START TO TRY TO WRITE THE
6434           MLC  AZERO,MVLHC2
6435           B    MVLHWT
6436 MLHIL3    H    MULAX1              PRESS START TO ACCEPT INPUT HDR
6437           B    MVLHRD-14          LABEL AS READ.PRESS START RESET
6438 *                                  START TO RETRY UP TO 99 TIMES
6439 MLHIL4    H    *-3                NO TAPEMARK AFTER HL WHEN ONE HAS
6440 *                                  BEEN SPECIFIED-RESTART PROGRAM
6441 MLHANT    SBR  MLHAXT&3
6442           MLNS TPNOBK,MVLST1&15
6443           MLNS TPNOBK,MVLHRD&3
6444           MLNS TPNOBK,MVLTMR&3
6445           MLNS TPNOBK,MEHST3&11
6446 MVLST1    CS   332
6447           CS
6448           MLCWA0,321
6449           RWD  0
6450           MLC  SIX 0S-4,MVLHC1#2
6451           MLC  CENSIG,MKHNOS&7
6452           MLC  CENSIG,214
6453 MVLHRD    RTW  0,201
6454 MKHNOS    BCE  MLHNUS,214,        BRANCH IF NOISE RECORD
6455           BEF  *&1
6456           BER  MEHRDP              BRANCH TO PARITY ERROR ROUTINE
6457 MULAX1    NOP  0                   USERS EXIT
6458           BCE  MVLST2,OPENID,O     IF OUTPUT TAPE
6459           BCE  CLR331,THLTMO,       NO TAPEMARK AFTER HEADER LABEL
6460 MVLTMR    RT   0,201            READ TAPEMARK
6461           BEF  CLR331
6462           B    MLHIL4              A TAPEMARK SHOULD BE PRESENT
6463 MVLST2    MLNS TPNOBK,MULAX2&7     INIT I/O INSTRUCTIONS
6464           MLNS TPNOBK,MVLHWT&3
6465           MLNS TPNOBK,CLR331-2
6466           MLNS TPNOBK,MEHPWT&10
6467           MLNS TPNOBK,MEHST4&3
6468           MLC  AZERO,MVLHC2#1
6469           MLC  @09@,MVLHC1         RESET ERROR COUNTER
6470 MULAX2    NOP  0                   USER EXIT
6471           RWD  0
6472 MVLHWT    WT   0,201
6473           BER  MEHPWT              PARITY ERROR
6474           BCE  *&6,THLTMO,         NO TAPEMARK AFTER HEADER LABEL
6475           WTM  0
6476 CLR331    CS   332
6477           CS
6478 MLHAXT    B    0                   RETURN TO NEXT SEQUENTIAL INST
6479 MLHNUS    CS   220                 CLEAR NOISE RECORD
6480           B    MVLHRD
6481 *
6482 *              READ PARITY ERROR ROUTINE
6483 *              TRY TO READ HEADER 99 TIMES THEN HALT
6484 MEHRDP    BCE  *&12,OPENID,O       IF OUTPUT TAPE
6485           SBR  MEHST3,MLHIL3
6486           B    *&8
6487           SBR  MEHST3,MLHIL1
6488           A    AONE,MVLHC1
6489 MEHST3    BWZ  MLHIL1,MVLHC1-1,S   IF 99 TRIES
6490           BSP  0
6491           B    MVLHRD
6492 *
6493 *              WRITE PARITY ERROR ROUTINE
6494 *
6495 *              TRY TO WRITE HEADER TWICE IN SAME PLACE THEN SPACE
6496 *              FOWARD----AFTER TEN SKIPS-HALT----
6497 MEHPWT    S    AONE,MVLHC1
6498           BSP  0
6499           BCE  *&5,MVLHC1,G
6500           B    MVLHWT
6501           MLC  @09@,MVLHC1
6502 MEHST4    SKP  0
6503           A    AONE,MVLHC2
6504           BCE  MLHIL2,MVLHC2,0
6505           B    MVLHWT
6506           LTORG*
6507 WKLAND    ORG  *
6508           EX   STRTN
6509           JOB  ** IBM 1401 SORT 7 VERSION 2  MULTIPHASE               60  2
6510           ORG  3200
6511 OVLAP     MLC  CTNRML,CNAR#6      ESTABLISH NUM OF RCDS
6512           S    PDCPUT,CNAR
6513           MZ   BLANK,CNAR                                             SORT2
6514           MLC  NOMP,NMPP2#2
6515           MLC  NMPP2,PRMSA
6516           MLC  NMPP2,NMPL                                             SORT2
6517           CS   332                                                    SORT2
6518           CS                                                          SORT2
6519           MLC  PRMSA,227
6520           W                                                           SORT2
6521           CC   K                  PRINT TOTAL NUMBER OF MERGES        SORT2
6522           MLC  CTNRML,PMSC1P-22
6523           MLC  CNAR,PRMSD-22
6524           CS   228
6525           MLC  PRMSD,228
6526           W                       PRINT ACTUAL NUMBER OF RECORDS      SORT2
6527           CS   332                                                    SORT2
6528           CS                                                          SORT2
6529           MLC  PDCPUT,PRMSE-22
6530           MLC  PRMSE,228
6531           W                       PRINT NUMBER OF PADDED RECORDS      SORT2
6532           CS   332
6533           CS
6534           MLC  PMSC1P,228
6535           W                       PRINT TOTAL OF ACTUAL AND
6536           CC   1                  PADDED RECORDS
6537           MLC  @I9W@,IREG1
6538           BCE  LD12K,MSMULT,5
6539           BCE  LD16K,MSMULT,6
6540 LDCST     LCA  SIX 0S,0&X1        INITIALIZE AREA AND INSTRUCTIONS
6541           LCA  SIX 0S             FOR COUNTING NUMBER OF RECORDS
6542           SBR  CLEPS              PROCESSED
6543           MLC  IREG1,ACNT
6544           MLC  ACNT,SUBT B&6
6545           MA   @I9D@,IREG1
6546           MLC  IREG1,ACTNR
6547           MLC  ACTNR,KOWNT&6
6548           MLC  ACTNR,AWAY&3
6549           MLC  ACTNR,LPSQCP&3
6550           MLC  AIRA1,NDRA1P       END OF FIRST READ AREA
6551           MA   BLMULT,NDRA1P
6552           MA   I99,NDRA1P
6553           MLC  AIRA2,NDRA2P       END OF SECOND READ AREA
6554           MA   BLMULT,NDRA2P
6555           MA   I99,NDRA2P
6556           MLC  AIRA3,NDRA3P       END OF THIRD READ AREA
6557           MA   BLMULT,NDRA3P
6558           MA   I99,NDRA3P
6559           MLC  CFIREM,CMPABP&3    SET COMPARE INSTR
6560           MLC  CFIREM,CMPABP&6
6561           MLC  CFIREM,CMPBCP&3
6562           MLC  CFIREM,CMPBCP&6
6563           MLC  CFIREM,CMPACP&3
6564           MLC  CFIREM,CMPACP&6
6565           MZ   *-6,CMPABP&2
6566           MZ   *-6,CMPACP&2
6567           MZ   NOP,CMPABP&5
6568           MZ   NOP,CMPBCP&2
6569           MZ   KB,CMPACP&5
6570           MZ   KB,CMPBCP&5
6571           MLC  OWA,ARELO
6572           MA   BLMULT,ARELO
6573           MLC  AIRA1,CMP11P       FIRST READ AREA CF
6574           MA   CFIREM,CMP11P
6575           MA   I99,CMP11P
6576           MLC  AIRA2,CMP12P       SECOND READ AREA CF
6577           MA   CFIREM,CMP12P
6578           MA   I99,CMP12P
6579           MLC  AIRA3,CMP13P       THIRD READ AREA CF
6580           MA   CFIREM,CMP13P
6581           MA   I99,CMP13P
6582           BCE  CCFW1,DESCND,
6583           MLC  SNGLET,CMPABP&16   DESCENDING ORDER INITIALIZATION
6584           MLC  SNGLET,CMPBCP&16       EXCHANGE BHS AND BLS
6585           MLC  SNGLET,CMPACP&16
6586           MLC  SNGLET,CMNCF&16
6587           MLC  SNGLEU,CMPABP&11
6588           MLC  SNGLEU,CMPBCP&11
6589           MLC  SNGLEU,CMPACP&11
6590           MLC  SNGLEU,CMNCF&11
6591           BCE  CCFW1,PIMULT,6
6592           BCE  CHG9PD,PIMULT,9        CHANGE PADDING INDICATOR
6593           MLC  SNGLE9,PIMULT
6594 CCFW1     C    NCFMLT,AONE
6595           BU   CKRWD
6596 *                                 CLEAR EQUALS ROUTINE
6597           MLC  BLANK,CMPABP&16
6598           MLC  BLANK,CMPBCP&16
6599           MLC  BLANK,CMPACP&16
6600 CKRWD     BCE  CMBOL,UNLOAD,
6601           MLC  SNGLEU,EOF1&11     REWIND AND UNLOAD INITIALIZATION
6602           MLC  SNGLEU,EOF2&11
6603           MLC  SNGLEU,EOF3&11
6604           MLC  SNGLEU,RWINDP&9
6605 *                                 COMPUTE OUTPUT BLOCK LENGTH
6606 CMBOL     MA   LMULTI,BOL
6607           A    AONE,CNBOL#3
6608           C    CNBOL,BOMULT
6609           BU   CMBOL                                                  SORT2
6610           MLC  OWA,ARELBP
6611           MA   BOL,ARELBP
6612           MLC  ARELBP,AGMEBP
6613           MA   LIT001,AGMEBP
6614 *                                 COMPUTE PADDING REQUIREMENTS
6615           BCE  REED,PIMULT,6
6616           MLC  PDCPUT,PDELMP#3
6617 HWMCHP    S    BOMULT,PDELMP
6618           BWZ  REED,PDELMP,K
6619           A    BOMULT,RMOVEP
6620           B    HWMCHP
6621 CHG9PD    MLC  BLANK,PIMULT
6622           B    CCFW1
6623 LD12K     MA   @00|@,IREG1        MODIFY FOR 12K SYSTEM
6624           B    LDCST
6625 LD16K     MA   @00!@,IREG1        MODIFY FOR 16K SYSTEM
6626           B    LDCST
6627 REED      CS   080                DETERMINE REDUNDANCY ROUTINE
6628           MLC  INPT1P,IREG1       REQUESTED BY USER
6629           MLC  INPT2P,IREG2
6630           MLC  INPT3P,IREG3
6631           SW   24,56                                                  SORT2
6632           SW   63,67                                                  SORT2
6633           BCE  STURPP,URPIML,C
6634           SBR  RED&7,REDSQ&6
6635           MLC  SETZN,SETZN-7
6636           MLC  @A@,SUBT B
6637           MLC  *-6,WOBR-14
6638           BCE  STURQP,URPIML,P
6639           SBR  SETZN&6,BBPQQG&5
6640           MLC  SNGLET,IDENT&7
6641           B    IDENT-1
6642 STURQP    SBR  SETZN&6,MHBB1&2
6643 STURPP    MLC  URPIML,IDENT&7     READ INTO CORE
6644           R                       REQUESTED REDUNDANCY ROUTINE
6645 IDENT     BCE  056,079,
6646           R    IDENT
6647 RANOTP    CS   080
6648           SW   24,56
6649           SW   63,67
6650           R    FRGETP
6651 *                               BYPASS OTHER REDUND RTN
6652 *                               LOAD NEXT INIT RTN AND BR TO STBRG
6653 FRGETP    BCE  056,079,
6654           R    FRGETP
6655 SNGLET    DCW  @T@
6656 SNGLEU    DCW  @U@
6657 SNGLE9    DCW  @9@
6658 PRMSA     DCW  @NUM OF MULTIPHASE PASSES 00@
6659 PMSC1P    DCW  @       -RECORDS READ-PASS 00@
6660 PRMSD     DCW  @       -RECORDS READ-PASS 00@
6661 PRMSE     DCW  @000 PAD REC ADDED-PASS 00@
6662           EX   OVLAP
6663           JOB  ** IBM 1401 SORT 7 VERSION 1  MULTIPHASE  PUNCH URPI   60 P2
6664           ORG  SAVE
6665 BBP2      MLC  AONE,0
6666           BCE  *&8,0,             IF START OF SEQUENCE
6667 REDSQ     MLC  *-6,0              ACTIVATE SEQ CHAR MOVE
6668           MLC  SIX 0S-3,CT3DG
6669 PBB       SBR  MHBB1&13,100
6670           CS   180
6671 MBB2      MA   LIT001,MHBB1&3
6672           MA   LIT001,MHBB1&13
6673 MHBB1     MLC  0,CNRR-1
6674           MLC  CNRR-1,0
6675           MA   LIT001,CT3DG
6676           C    CT3DG,BLMULT
6677           BE   PCHB1P
6678           BCE  PCHB2P,MHBB1&12,8
6679           B    MBB2
6680 PCHB2P    P    PBB                PUNCH FULL CARD
6681 PCHB1P    P                       PUNCH LAST CHAR OF UNREADABLE BLK
6682           MLC  SIX 0S-3,MHBB1&3
6683           MA   @I8I@,RETN&3
6684           MLC  KB,PDSW
6685           CS   180
6686           B    RETN
6687 CT3DG     DCW  @   @
6688           LTORG*
6689 KEEP      ORG  *
6690           EX   RANOTP
6691           JOB  ** IBM 1401 SORT 7 VERSION 2  MULTIPHASE  CORRECT      60 C2
6692           ORG  SAVE
6693 BBP3      NOP  TSSG2
6694           MLC  SIX 0S,CT3G1P#3
6695 PRTBB     SBR  MHBB&13,200
6696           CS   332
6697           CS
6698 MBB1      MA   LIT001,MHBB&3
6699           MA   LIT001,MHBB&13
6700 MHBB      MLC  0,CNRR-1
6701           MLC  CNRR-1,0
6702           MA   LIT001,CT3G1P
6703           C    CT3G1P,BLMULT
6704           BE   PRTB2P
6705           BCE  PRTB1P,MHBB&11,3
6706           B    MBB1
6707 COREKP    MLC  KB,BBP3
6708           B    BCKSPP
6709 PRTB1P    W    PRTBB              PRINT UNREADABLE BLOCK
6710 PRTB2P    W                       100 CHARACTERS PER LINE
6711           MLC  SIX 0S-3,MHBB&3
6712           CC   1
6713 TSSG2     H
6714 *              PUT SENSE SWITCH G ON TO REREAD RECORD IN ORDER TO
6715 *              CORRECT.  IF RECORD IS TO BE ACCEPTED AFTER
6716 *              CORRECTION, SET SENSE SWITCH G OFF AND PRESS START.
6717           BSS  COREKP,G
6718           MLC  NOP,BBP3
6719 SMOREP    B    0
6720           LTORG*
6721           EX   RANOTP
6722           JOB  ** IBM 1401 SORT 7 VERSION 2  MULTIPHASE  TAPE URPI    60 T2
6723           ORG  SAVE
6724 BBP4      MLC  AONE,0
6725           BCE  *&8,0,             IF START OF SEQUENCE
6726           MLC  *-6,0              ACTIVATE SEQ CHAR MOVE
6727 BBPQQG    WT   0,1                WRITE UNREADABLE BLOCK ON TAPE
6728           BEF  BTPEF
6729           BER  BTPER
6730           CS   332
6731           CS
6732           MLC  UNMSG,223
6733           W
6734           CC   1
6735           MLC  KB,PDSW
6736           MA   @I8I@,RETN&3
6737           B    RETN
6738 BTPER     BSP  0
6739           SKP  0
6740           B    BBPQQG
6741 BTPEF     H    BBPQQG
6742 UNMSG     DCW  @UNREAD BLK WRITTEN-TU 0@
6743           LTORG*
6744           ORG  WKLAND
6745 INTBT     MLC  URPIML,BTPER&3     MOVE DUMP TAPE UNIT NUM INTO INST
6746           MLC  URPIML,BBPQQG&3
6747           MLC  URPIML,UNMSG
6748           MLC  URPIML,BTPER&8
6749           B    RANOTP
6750           NOP
6751           EX   INTBT
6752           JOB  ** IBM 1401 SORT 7 VERSION 2  MULTIPHASE               60  2
6753           ORG  WKLAND
6754 *              LABELS ROUTINE TO CLEAR AREAS AND SET WORDMARKS
6755 ACOA      SBR  REDETP&3,MLTPHZ
6756           CS   3499
6757           CS                      CLEAR OUTPUT AREA
6758           CS
6759           B    LGMEOP
6760 STBRG     MLC  NDRA3P,ACLINP&3
6761           SW   3500
6762 ACLINP    CS   0                  CLEAR INPUT AREAS
6763           SBR  ACLINP&3
6764           BWZ  ACLINP,3500,1
6765           MLC  TWOBL,ACNCF#2      SET WORD MARKS IN
6766 ANWM12    MLC  AIRA1,AICF12#3     INPUT AREAS FOR CONTROL
6767           MA   CF1SLM,AICF12      FIELD DESIGNATION
6768           MLC  AICF12,AWMS12&3
6769           MLC  @   @,ACNTB
6770 AWMS12    SW   0
6771           A    AONE,ACNTB
6772           C    ACNTB,BMULTI
6773 *                               BRANCH TO GET NEXT CF
6774           BE   ASWNCF
6775           MA   LMULTI,AWMS12&3
6776           B    AWMS12
6777 ASWNCF    A    AONE,ACNCF
6778           C    ACNCF,NCFMLT
6779 *                               BRANCH TO INIT NEXT INPUT AREA
6780           BE   AWIRA2
6781           MA   LIT003,ANWM12&10
6782           B    ANWM12
6783 AWIRA2    NOP  AWIRA3
6784           MLC  KB,AWIRA2
6785           SBR  ANWM12&3,AIRA2
6786           SBR  ANWM12&10,CF1SLM
6787           B    ANWM12-7
6788 AWIRA3    NOP  AWMSET
6789           MLC  KB,AWIRA3
6790           SBR  ANWM12&3,AIRA3
6791           SBR  ANWM12&10,CF1SLM
6792           B    ANWM12-7
6793 AWMSET    BCE  ACOA,CNOPML,1      WM ALREADY SET IN FIRST POS
6794 ANWMBI    MLC  AIRA1,AICF12
6795           MLC  AICF12,ASW12&3
6796           MLC  @   @,ACNTB#3
6797 *                               SET WORD MARKS IN FIRST POS OF EACH
6798 *                               RECORD IN INPUT AREAS
6799 ASW12     SW   0
6800           A    AONE,ACNTB
6801           C    ACNTB,BMULTI
6802           BE   AMIRA2
6803           MA   LMULTI,ASW12&3
6804           B    ASW12
6805 AMIRA2    NOP  AMIRA3
6806           MLC  KB,AMIRA2
6807           MLC  AIRA2,AICF12
6808           B    ANWMBI&7
6809 AMIRA3    NOP  ACOA
6810           MLC  KB,AMIRA3
6811           MLC  AIRA3,AICF12
6812           B    ANWMBI&7
6813           LTORG*
6814 AMV       MLC  GPMARK,PADQNQ      SET REDUNDANCY INDICATOR
6815           MA   I99,PADQNQ
6816           MLC  PADQNQ,BPAQQ8&6
6817           BCE  *&8,URPIML,C
6818           MLC  PADQNQ,BBP2&6
6819           BCE  YSLBL,LABELS,1
6820           CS   080                LOAD NO LABELS CLEAR ROUTINE
6821           SW   24,56
6822           SW   63,67
6823           R    056
6824 YSLBL     R                       BYPASS NO LABELS CLEAR ROUTINE
6825           BCE  STBRG,068,B
6826           B    YSLBL
6827           NOP
6828           EX   AMV
6829           JOB  ** IBM 1401 SORT 7 VERSION 2  MULTIPHASE               60  2
6830           ORG  ADJEND
6831 *              NO LABELS ROUTINE TO CLEAR AREAS AND SET WORDMARKS
6832 BCOA      SBR  REDETP&3,MLTPHZ
6833           CS   3199               CLEAR OUTPUT AREA
6834           CS
6835           CS
6836           CS
6837           B    LGMEOP
6838 BST       MLC  NDRA3P,BCLIN&3
6839           SW   3200
6840 BCLIN     CS   0                  CLEAR INPUT AREAS
6841           SBR  BCLIN&3
6842           BWZ  BCLIN,3200,1
6843           MLC  TWOBL,BCNCF#2      SET WORD MARKS IN INPUT AREAS FOR
6844 BAR1      MLC  AIRA1,BICF#3       CONTROL FIELD DESIGNATION
6845           MA   CF1SLM,BICF
6846           MLC  BICF,BWMS&3
6847           MLC  @   @,BCNTA#3
6848 BWMS      SW   0
6849           A    AONE,BCNTA
6850           C    BCNTA,BMULTI
6851           BE   BSWNCF             BRANCH TO GET NEXT CF
6852           MA   LMULTI,BWMS&3
6853           B    BWMS
6854 BSWNCF    A    AONE,BCNCF
6855           C    BCNCF,NCFMLT
6856           BE   BAR2               BRANCH TO INIT NEXT INPUT AREA
6857           MA   LIT003,BAR1&10
6858           B    BAR1
6859 BAR2      NOP  BAR3
6860           MLC  KB,BAR2
6861           SBR  BAR1&3,AIRA2
6862           SBR  BAR1&10,CF1SLM
6863           B    BAR1-7
6864 BAR3      NOP  BWMST
6865           MLC  KB,BAR3
6866           SBR  BAR1&3,AIRA3
6867           SBR  BAR1&10,CF1SLM
6868           B    BAR1-7
6869 BWMST     BCE  BCOA,CNOPML,1      WM ALREADY SET IN FIRST POS
6870 BWMBI     MLC  AIRA1,BICF
6871           MLC  BICF,BSWN1&3
6872           MLC  @   @,BCNTA
6873 BSWN1     SW   0                  SET WORD MARKS IN FIRST RCD POS
6874           A    AONE,BCNTA
6875           C    BCNTA,BMULTI
6876           BE   BLDAR2
6877           MA   LMULTI,BSWN1&3
6878           B    BSWN1
6879 BLDAR2    NOP  BLDAR3
6880           MLC  KB,BLDAR2
6881           MLC  AIRA2,BICF
6882           B    BWMBI&7
6883 BLDAR3    NOP  BCOA
6884           MLC  KB,BLDAR3
6885           MLC  AIRA3,BICF
6886           B    BWMBI&7
6887           LTORG*
6888           EX   BST
6889           JOB  ** IBM 1401 SORT 7 VERSION 2  MULTIPHASE               60  2
6890 *
6891 *                               TWO WAY MERGE X SEQUENCES ROUTINE
6892 *
6893           ORG  KEEP
6894 SET X     MLC  SIX 0S,PCNTR       INITIALIZE INSTRUCTIONS FOR
6895           MLC  OWA,XCHAR&6        TWO WAY MERGE OF X NUMBER
6896           MLC  INPT1P,MRGE X&6    OF SEQUENCES
6897           MLC  INPT2P,MRGE X&13
6898           SBR  RUNOTP&3,SKIP1
6899           SBR  CMPABP&15,ALOW
6900           SBR  READ1&11,ASDEOF
6901           SBR  READ2&11,BSDEOF
6902           MLC  I2TUHP,BSDEOF&3
6903           MLC  I1TUHP,ASDEOF&3
6904           MLC  EOF2&18,BSDEOF&11
6905           MLC  EOF1&18,ASDEOF&11
6906           SBR  CMPABP&10,BLOW
6907           SBR  STEPA&3,ASD
6908           SBR  STEPB&3,BSD
6909           MLC  AZERO,ACNTR
6910           BCE  MRGE X,LABELS,1
6911           MLC  NOP,ASDEND-8       NOP BRANCHES TO WORK LABEL RTN
6912           MLC  NOP,BSDEND-8
6913 MRGE X    MLC  BLANK,0
6914           MLC  BLANK,0
6915 XCHAR     MLC  SPLCHR,0
6916           C    XAREA,PCNTR        Q X SEQUENCES MERGED
6917           BE   READ Y
6918           A    AONE,PCNTR
6919           B    RUNOTP
6920 ASDEOF    RWD  0
6921           MLC  BLANK,0
6922           SBR  RDFST1&3,ASDEND
6923           MLC  KB,RDFST1
6924           MLC  I1TUHP,TPNOBK      SETX  EOF
6925           MLC  KI
6926           B    MLHENT
6927           B    STRD1
6928 ASDEND    MLC  NOP,RDFST1
6929 ASD       SBR  RUNOTP&3,BLOW      SET TO RUNOUT SECOND UNIT
6930           A    AONE,ACNTR
6931           B    ALGEOS
6932 BSDEOF    RWD  0
6933           MLC  BLANK,0
6934           SBR  RDFST2&3,BSDEND
6935           BCE  BSDEND,CNTRB,3
6936           MLC  KB,RDFST2
6937           MLC  I2TUHP,TPNOBK      SETX  EOF
6938           MLC  KI
6939           B    MLHENT
6940           B    STRD2
6941 BSDEND    MLC  NOP,RDFST2
6942 BSD       SBR  RUNOTP&3,ALOW      SET TO RUNOUT FIRST UNIT
6943           A    ATWO,ACNTR
6944 ALGEOS    B    ABSD,ACNTR,3       Q NEW SEQ ON BOTH UNITS
6945           B    RUNOTP
6946 ABSD      SBR  RUNOTP&3,SKIP1     RESTORE COMPARE INST
6947           MLC  AZERO,ACNTR        RESET COUNTER
6948           B    MRGE X
6949 READ Y    CS   080                READ INTO CORE ROUTINE
6950           SW   024,056            TO THREEWAY MERGE Y NUMBER
6951           SW   063,067            OF SEQUENCES
6952           R    056
6953           NOP
6954           EX   SET X
6955           JOB  ** IBM 1401 SORT 7 VERSION 2  MULTIPHASE               60  2
6956           ORG  KEEP
6957 *
6958 *                               THREE WAY MERGE Y SEQUENCES ROUTINE
6959 *
6960 SET Y     MLC  SIX 0S,PCNTR       INITIALIZE MAIN LINE PROGRAM
6961 *                               FOR 3 WAY MERGING Y NUM OF SEQ
6962           MN   O1TUHP,EOF3&10
6963           MN   O1TUHP,Y TPMK&3
6964           MN   O1TUHP,Y TPMK&8
6965           C    O2TUHP-1,SIX 0S
6966           BE   *&11
6967 Y TPMK    WTM  0
6968           RWD  0
6969           SBR  RUNOTP&3,SKIP1
6970           SBR  CMPABP&10,SKIP2
6971           SBR  CMPABP&15,SKIP3
6972           MLC  I1TUHP,EOF1&10
6973           MLC  I2TUHP,EOF2&10
6974           MLC  AZERO,ACNTR
6975 *                                 SET OUTPUT TAPE UNIT NUM
6976           SW   O2TUHP
6977           MLC  O2TUHP,RWINDP&3
6978           MLC  O2TUHP,RWINDP&8
6979           MLC  O2TUHP,WOBR&3
6980           MLC  O2TUHP,WORED&3
6981           MLC  O2TUHP,ERTAPP&3
6982           CW   O2TUHP
6983           SBR  STEPA&3,NEWASQ
6984           SBR  STEPB&3,NEWBSQ
6985           SBR  STEPC&3,NEWCSQ
6986           SBR  SEQCMP&10,RWINDP
6987           SBR  SEQCMP&3,YAREA
6988           MLC  OWA,SEQCMP-1
6989           MLC  YAREA,SEQMRG
6990           MLC  INPT3P,ENTER3&20
6991           SBR  RDFST3&3,ENTER3
6992           SBR  READ1&11,EOF1
6993           SBR  READ2&11,EOF2
6994           BCE  *&8,LABELS,1
6995           MLC  NOP,ENTER3-8       NOP BRANCH TO WORK LABEL RTN
6996           BCE  *&8,LBBUCK,
6997           SBR  ENTER3-5,MLHANT
6998 *                               DETERMINE IF SPECIAL CASE  TOTAL
6999           C    YLIT3,CNTRB        NUM OF SEQ LESS THAN 7
7000           BL   SETONE
7001           BCE  SETHRE,CNTRB,3
7002           C    CNTRB,YLIT7
7003           BH   SET456
7004 RDHDR3    MLC  O1TUHP,TPNOBK      SETY  RD HDR ON INPUT
7005           MLC  KI
7006           B    MLHENT
7007           B    STRD3              READ FIRST RECORD OF THIRD UNIT
7008 ENTER3    MLC  NOP,RDFST3
7009           SBR  REDETP&3,RUNOTP
7010           MLC  BLANK,0
7011           C    YAREA,PCNTR        Q Y SEQUENCES MERGED
7012           BE   ENDMLT
7013           A    AONE,PCNTR
7014           B    RUNOTP
7015 SETONE    MLC  AZERO,O1TUHP-1     SET ROTATION FOR LESS THAN
7016           MLC  AZERO,TUHOLD-1     FOUR SEQUENCES
7017           MLC  AZERO,O2TUHP-1
7018           MLC  AONE,SEQMRG
7019           B    ENDMLT
7020 SETHRE    SBR  ENTER3-1,ENDMLT
7021 SET456    MLC  AONE,O2TUHP-1
7022           MLC  ATWO,TUHOLD-1
7023           MLC  AZERO,SEQMRG
7024           MLC  AZERO,TAPSEQ
7025           MLC  AZERO,O1TUHP-1
7026           B    RDHDR3
7027 ENDMLT    CS   080                LOAD NEXT BLOCK-ADJMS
7028           SW   24,56
7029           SW   63,67
7030           R    056
7031 YLIT3     DCW  @3@
7032 YLIT7     DCW  @7@
7033           EX   SET Y
7034           JOB  ** IBM 1401 SORT 7 VERSION 2  MULTIPHASE               60  2
7035           ORG  KEEP
7036 ADJMS     CS   332
7037           CS
7038           MLC  MLTMSG,228         PRINT END OF ADJUSTMENT MESSAGE
7039           W
7040           CC   1
7041           SBR  SEQCMP&3,SEQMRG    INITIALIZE MAINLINE INSTRUCTIONS
7042           SBR  ENDMP&3,WKLBLI
7043           SBR  RDFST1&3,STRD2
7044           SBR  RDFST2&3,STRD3
7045           C    PDCPUT,SIX 0S-3
7046           BU   *&8
7047           MLC  @6@,PIMULT
7048           SW   3200
7049           MLC  CSTCNS,CLADJ&3
7050 CLADJ     CS   0
7051           SBR  CLADJ&3
7052 REPLAC    BWZ  CLADJ,3200,1
7053           BCE  CLAD,LABELS,1
7054           CS   3199
7055           CS
7056           CS
7057           CS
7058 CLAD      CS   180
7059 *                               LOAD RESTART AND PHASE TO PHASE RTN
7060           CS   080
7061           SW   24,56
7062           SW   63,67
7063           R    056
7064 MLTMSG    DCW  @END OF MULTIPHASE ADJUSTMENT@
7065           LTORG*
7066           EX   ADJMS
7067           JOB  ** IBM 1401 SORT 7 VERSION 2  MULTIPHASE               60  2
7068 *         RESTART ROUTINE
7069 *             EXECUTED ONLY IF PROGRAM INTERRUPTED AND SUBSEQUENTLY
7070 *             RESTARTED BY TAPE LOAD OF CHECKPOINT
7071 *         NOTE NOT APPLICABLE FOR RUN REQUIRING ONLY ONE MERGE PASS
7072 *             SENSE SWITCH F MUST BE ON TO RESTART LAST PASS
7073           ORG  RSTORG
7074 HRES      MLC  PRMSJ,231          PRINT CARD READER MESSAGE
7075           W
7076           BEF  *&1
7077           MLZS *-6,CENSIG
7078           MLC  CENSIG,INTF1&7
7079           MLC  CENSIG,INTF2&7
7080           MLC  CENSIG,INTF3&7
7081           MLC  GPMARK,IREG1       SET GMWM IN UPPER CORE
7082           SW   0&X1
7083           MLC  GM,0&X1
7084           MLC  INPT1P,IREG1
7085           BSS  FSTLP,F            RESTART LAST PASS BRANCH
7086 SWFRTN    CS   240
7087           MLC  PRMSI,238
7088           MLC  PRMSH-9
7089           W                       PRINT RESTART MESSAGE
7090           CS   240
7091           MLC  PDTYQP,212
7092           W                       PRINT DENSITY MESSAGE
7093           CC   1
7094           BSS  ALTRD,F            LAST PASS BRANCH  TAPES SHOULD
7095 *                               ALREADY BE POS PAST HDRS IF PRESENT
7096           H                       HALT  SET TAPE UNIT NUMS
7097 *                               READY CARD READER[IF NOT LAST PASS]
7098           BCE  *&22,LBBUCK,
7099           SBR  ALTRD-1,MLHANT
7100           SBR  ALTRD-12,MLHANT
7101           SBR  ALTRD-23,MLHANT
7102           BCE  ALTRD,LABELS,      NO LABELS BRANCH
7103           MLC  I1TUHP,TPNOBK      INIT TO RD HDR ON INPUT TAPES
7104           MLC  KI
7105           B    MLHENT
7106           MLC  I2TUHP,TPNOBK
7107           B    MLHENT
7108           MLC  O1TUHP,TPNOBK
7109           B    MLHENT
7110 *                               ALTER RD TAPE 1 RD AREA & BRS
7111 ALTRD     MLC  INTF1&4,SAVE4
7112           MLC  BLANK,INTF1&4
7113           SBR  INTF1&3,RDFST1
7114           SBR  READ1&6,245
7115           SBR  STEPA&6
7116           SW   249                SET GMWM
7117           MLC  GM,249
7118           SBR  STEPA&11,READ1
7119           SBR  STEPA&3,REENT1
7120           B    READ1
7121 *                                 READ TAPE 1 UNTIL POS CORRECTLY
7122 REENT1    A    AONE,RECNT#6
7123           C    O2TUHP-1,RECNT
7124           BH   RSTRD1
7125           B    READ1
7126 *                                 RESTORE RD TAPE 1 RTN AND ALTER
7127 *                                   RD TAPE 2 RD AREA & BRS
7128 RSTRD1    MLC  SAVE4,INTF1&4
7129           MLC  INPT1P,READ1&6
7130           MLC  INPT1P,STEPA&6
7131           MLC  INTF2&4,SAVE4
7132           MLC  BLANK,INTF2&4
7133           SBR  INTF2&3,RDFST2
7134           SBR  READ2&6,245
7135           SBR  STEPB&6
7136           SBR  STEPB&11,READ2
7137           SBR  STEPB&3,REENT2
7138           MLC  XAREA,RECNT
7139           B    READ2
7140 *                                 READ TAPE 2 UNTIL POS CORRECTLY
7141 REENT2    A    AONE,RECNT
7142           C    O1TUHP-1,RECNT
7143           BH   RSTRD2
7144           B    READ2
7145 *                                 RESTORE RD TAPE 2 RTN
7146 RSTRD2    MLC  SAVE4,INTF2&4
7147           MLC  INPT2P,READ2&6
7148           MLC  INPT2P,STEPB&6
7149           MLC  BLANK,249          CLEAR GMWM
7150           SBR  STEPA&11,RUNOTP
7151           SBR  STEPB&11,RUNOTP
7152           SBR  STEPA&3,NEWASQ
7153           SBR  STEPB&3,NEWBSQ
7154           C    AZERO1,CNMP
7155 RESUME    BE   SCLINP             FIRST AND LAST PASS BRANCH
7156           SW   249
7157           MLC  GM,249
7158           MLC  READ3&3,RDT3&3
7159 RDT3      RT   0,245
7160           MLC  BLANK,249
7161           B    SCLINP
7162 FSTLP     CC   1
7163           H                       HALT TO READY CARD RDR
7164 *                               SET TAPE UNIT NUMS
7165           BCE  FSETLP,LABELS,     NO LABELS BRANCH
7166           MLC  I1TUHP,TPNOBK      READ HDR ON INPUT TAPES PRIOR TO
7167           MLC  KI                 LAST PASS RESTART INIT
7168           BCE  *&8,LBBUCK,
7169           SBR  *&4,MLHANT
7170           B    MLHENT
7171           MLC  O1TUHP,TPNOBK
7172           BCE  *&8,LBBUCK,
7173           SBR  *&4,MLHANT
7174           B    MLHENT
7175 FSETLP    MLC  BLANK,RESUME&4     RESTART LAST PASS INIT
7176           MLC  BLANK,PPSMS&25
7177           MLC  &SWFRTN
7178           MLC  KB
7179           B    PSTPAS
7180 PRMSJ     DCW  @PLACE CARDS FROM 1507 IN READER@
7181           LTORG*
7182 SAVE4     DCW  #04
7183 GM        DC   @}@
7184 RSTEND    ORG  *
7185 *
7186 *              READ CHECKPOINT ROUTINE
7187 *
7188           ORG  KEEP
7189 *                                 INIT FOR NEXT MERGE PASS
7190 WKLBLI    MLC  O2TUHP,TPNOBK      INIT TO READ HDR ON INPUT
7191           MLC  KI
7192           B    MLHENT             BRANCH TO WORK LABEL ROUTINE
7193 FRSTME    B    PSTPAS             FIRST PASS BRANCH ONLY
7194 GMSET     LCA  0,0                SET GM FOR CHECK POINT
7195 RDCPT     RTW  0,1                READ CHECKPOINT
7196           BER  RERDCP-4
7197           BEF  EOFCP
7198           B    PSTPAS
7199           H    PSTPAS
7200 RERDCP    BSP  0
7201           B    RDCPT
7202 ASIX      DCW  @6@
7203 MLEND     ORG  *
7204           ORG  RSTEND
7205 EOFCP     H    PSTPAS
7206           B    RERDCP
7207 LBLCK     BCE  RDEOJ-22,LABELS,
7208           BCE  *&15,LBBUCK,
7209           SBR  GO ON-8,MLHANT
7210           SBR  FRSTME-1,MLHANT
7211           SBR  PSTPAS&10,PNWM12-8
7212           MLC  NOP,IWRCK-5        NOP SW D OPTION IF LABELS
7213 RDBY      R
7214           BCE  *&5,068,B
7215           B    RDBY
7216 RDBY1     SBR  RDBY&4,*&5         BYPASS LAST 2 BLOCKS OF BAL MERGE
7217           B    RDBY
7218           SBR  RDBY&4,*&5
7219           B    RDBY
7220           SBR  RDBY&4,*&5
7221           B    RDBY
7222           C    ATWO,CNTRB         CHECK FOR 1 OR 2 SEQ
7223           BH   WKLBLI
7224           MN   O2TUHP,*&4
7225           RWD  0
7226 *              PHASE TO PHASE ROUTINE
7227 *                   START OF NEXT MERGE PASS FOLLOWING THE READING
7228 *                   INTO CORE OF CHECKPOINT
7229 PSTPAS    NOP  TSTPS
7230           LCA  LGMEOP&27,NLAR1-8  INIT INST TO LOAD GMWMS
7231           LCA
7232           LCA
7233           MLC  KB,PSTPAS
7234 *              EXECUTE PSTPAS ROUTINE ONLY ONCE  THEREAFTER, BRANCH
7235 *                DIRECTLY TO TSTPS RTN TO DETERMINE MERGE PASS NUM
7236           MLC  NOP,FRSTME
7237           MLC  GPMARK,GMSET&3
7238           MLC  CLEPS,GMSET&6
7239           MLC  ACNT,PDCHKP&3
7240           MLC  ST1MVP,STOUTP&6
7241           MLC  CLEPS,GMCLR&3
7242           BCE  MUSHQP,LDIMLT,
7243 TSTPS     C    AZERO1,NMPL        START OF LAST MERGE PASS
7244           MLZS *-6,CENSIG
7245           MLC  CENSIG,INTF1&7
7246           MLC  CENSIG,INTF2&7
7247           MLC  CENSIG,INTF3&7
7248           BE   SLMP
7249           MLC  I2TUHP,WRCKT&3
7250           MLC  I2TUHP,WRDCK&3     SET TAPE UNIT NUM FOR
7251           MLC  I2TUHP,ERSE1&3     READING AND WRITING OF
7252           MLC  I2TUHP,PRMSH-26    CHECKPOINT
7253           MLC  I2TUHP,RDCPT&3
7254           MLC  I2TUHP,TPNOBK      INIT TO WRITE HDR ON OUTPUT
7255           MLC  KO
7256           B    MLHENT             BRANCH TO WORK LABEL ROUTINE
7257           MLC  I2TUHP,RERDCP&3
7258 GO ON     A    AONE,CNMP          BUMP MERGE COUNTER
7259           A    @I9@,NMPL          DECREASE COUNT OF MERGES LEFT
7260           NOP  RSTONE
7261           MLC  SIX 0S,PCNTR
7262 *              ROTATE TAPE UNIT NUMS AND ESTABLISH NUM SEQ TO BE
7263 *                   MERGED IN PASS
7264           MLC  I2TUHP,TUHOLD      STORE SECOND TAPE UNIT NUMBER
7265           MLC  I1TUHP,I2TUHP
7266           MLC  O1TUHP,I1TUHP
7267           MLC  O2TUHP,O1TUHP      MOVE CNT OF SEQ MRGED ON 1ST UNIT
7268           MLC  TUHOLD,O2TUHP
7269 UPDTCT    MLC  SEQMRG,O2TUHP-1    MOVE CNT OF LAST MERGE FOR 2ND
7270           A    O2TUHP-1,O1TUHP-1  ADD TOT SEQ MERGED ON 1ST AND 2ND
7271           S    O1TUHP-1,TUHOLD-1  SUB FROM TOT SEQ INIT ON 3RD
7272           MZ   BLANK,TUHOLD-1     STORE RESULT FOR NUM OF SEQ
7273           MLC  TUHOLD-1,SEQMRG    IN NEXT MERGE PASS
7274           MLC  TAPSEQ,TUHOLD-1    MOVE SEQ TOT OF PREVIOUS MERGE
7275           MLC  YCNTR,TAPSEQ       MOVE SEQ TOT OF PASS P1 & Y MERGE
7276           SBR  *-10,O2TUHP-1      AFTER 1ST MERGE REPLACE YCNTR
7277 *                               WITH TOTAL FROM PREVIOUS MERGE
7278 *              SET INPUT AND OUTPUT UNIT NUMS FOR PASS
7279 FORONE    SW   O2TUHP,O1TUHP
7280           MLC  O2TUHP,PRMSH-10
7281           MLC  O2TUHP,WOBR&3
7282           MLC  O2TUHP,WORED&3
7283           MLC  O2TUHP,ERTAPP&3
7284           MLC  O2TUHP,RWINDP&3
7285           MLC  O2TUHP,RWINDP&8
7286           MLC  I1TUHP,READ1&3
7287           MLC  I1TUHP,EOF1&10
7288           MLC  I2TUHP,READ2&3
7289           MLC  I2TUHP,EOF2&10
7290           MLC  O1TUHP,READ3&3
7291           MLC  O1TUHP,EOF3&10
7292           MLC  O1TUHP,PRMSH-16
7293           CW   O2TUHP,O1TUHP
7294 STBCK     MLC  I1TUHP,BACK2&3
7295           MLC  I2TUHP,BACK1&3
7296           A    AONE,PCNTR
7297 *                               SET BRANCH INST FOR RESTART
7298           SW   1,5
7299           MLC  &HRES
7300           MLC  KB
7301           BIN  HSSD,D
7302 IWRCK     MLC  TWOBL,CNEOR        RESET CHECKPOINT REDUND COUNTER
7303           MLC  TWOBL,CNRR
7304 STOUTP    MLC  OWA,0              RESET MOVE TO OUTPUT AREA
7305           CS   332
7306           CS
7307 PPSMS     MLC  CNMP,PRMSH-33
7308           MLC  I2TUHP,PRMSH-18
7309           MLC  I1TUHP,PRMSH-20
7310           MLC  PRMSH-10,230       PRINT MESSAGE LISTING UNIT
7311           W                       NUMBERS OF INPUT,OUTPUT,AND
7312           CC   1                  CHECKPOINT TAPES
7313 GMCLR     CW   0
7314           MLC  SIX 0S,XAREA
7315           C    AZERO1,CNMP
7316           BU   WRCKT-4
7317           MLC  AONE,XAREA
7318 CPEX      NOP  0                  USERS EXIT PRIOR TO WRITE CHKPT
7319 WRCKT     WTW  0,1                WRITE CHECKPOINT
7320           BER  WRDCK
7321           BEF  WFCK2P
7322 TF1       BIN  INTRPP,E           INTERRUPT IF SENSE SWITCH E IS ON
7323           B    SCLINP
7324 BLKCNT    A    AONE,MULBKC        LAST PASS INST TO INC BLK COUNT
7325 MUSHQP    MLC  @ LOW@,PDTYQP-8
7326           B    TSTPS
7327 SLMP      C    LIT003,CNTRB       LAST MERGE PASS INITIALIZATION
7328           BL   *&12
7329           MLC  I2TUHP,TPNOBK
7330           B    *&8
7331           MLC  O2TUHP,TPNOBK
7332 SLMP1     BSS  LPMSGP,B
7333 LPEX      NOP  0                  USERS EXIT LAST MERGE PASS INIT
7334           MLC  @N00@,WRCKT&2
7335           MLC  BLANK,SEQCMP&11
7336           MLC  @A@,KOWNT
7337           MLC  @U@,RWINDP&9       UNLOAD FINAL OUTPUT TAPE
7338           MLC  KB,EOFW1           INIT LAST PASS BRANCH
7339           SBR  SEQCMP&10,LPEOJ
7340           MLC  OWA,WOBR&6
7341           MA   LIT001,WOBR&6
7342           LCA  RDEOJ,GMSET&3      INSERT RTN TO LOAD END OF JOB IN
7343           LCA                    WKLBLI SO EXEC AT END OF LAST PASS
7344           LCA
7345           LCA
7346           LCA
7347           BCE  BYLBL,LABELS,      NO LABELS BRANCH
7348 *                                 LOAD FINAL LABEL RTN
7349           BCE  OKEIGH,LBBUCK,
7350 NOKEIY    R
7351           BCE  OKEIGH,68,B
7352           B    NOKEIY
7353 WELEAT    R
7354           BCE  INTLB,68,B
7355           B    WELEAT
7356 OKEIGH    CS   80
7357           SW   24,56
7358           SW   63,67
7359           R    56
7360 RDEOJ     NOP                     LOAD RTN FOR END OF JOB
7361 *                                 INIT FINAL LABEL RTN
7362 INTLB     MLC  TPNOBK,FPHDS3-10
7363           MLC  TPNOBK,FPHDS3&3
7364           MLC  TPNOBK,FPHDX2&7
7365           MLC  TPNOBK,FPHDX1&7
7366           MLC  TPNOBK,FPHDX3&15
7367           MLC  TPNOBK,FPPSW-2
7368           MLC  TPNOBK,FPPARX-17
7369           MLC  TPNOBK,LMHLTP&22
7370           MLC  TPNOBK,FTREX1&21
7371           MLC  TPNOBK,FTREX2&26
7372           MLC  TPNOBK,FTREX2&31
7373           MLC  TPNOBK,FPTSMG      INIT CHANGE REEL MSG
7374           MLC  TPNOBK,SAVM2
7375           BCE  *&15,OHLIMP,2
7376           MLC  NOP,FPHDX1&24      NOP CHAINED MOVES IF INPUT HDR
7377           MLC  NOP,FPHDX1&25      AND OUTPUT HDR ARE THE SAME
7378           MLC  GPMARK,LMHLTP&7
7379           MLC  GPMARK,FPHDS1&7
7380           MLC  BLKCNT&6,WOBR&19   INSERT INST TO INC BLOCK COUNT
7381           BCE  NWOUTP,PIMULT,6    SET FOR ELIMINATION
7382 PDCHKP    C    0,SIX 0S
7383           BU   NWOUTP
7384           MLC  NOP,PDSW           OF RECORD PADDING
7385           BCE  PAD9,PIMULT,9
7386           BCE  PAD,PIMULT,
7387 PAD9      MLC  CTNRML,PADCT
7388           S    RMOVEP,PADCT
7389           B    PAD&21
7390 PAD       MLC  @U@,AWAY&11
7391           MLC  KB,AWAY&12
7392           ZA   RMOVEP,PADCT
7393           MZ   BLANK,PADCT
7394 NWOUTP    MLC  AGMEBP,LGMEOP&6    SET BLOCKING FOR
7395           MLC  AGMEBP,ENDMP-1     FINAL OUTPUT
7396           MLC  ARELBP,ARELO
7397           SBR  KOWNT&3,BOMULT
7398           BCE  *&8,OUTMLT,M       OUTPUT MOVE MODE BRANCH
7399           MLC  OUTMLT,WOBR        CHANGE WT INST SO FINAL OUTPUT
7400 *                               IN LOAD MODE
7401           BCE  SPLCAS,LABELS,
7402           BCE  FPHES1,LBBUCK,1
7403           B    FPHDS1             BRANCH TO FINAL LABEL ROUTINE
7404 SPLCAS    C    ASIX,CNTRB         CHECK FOR NUM SEQ LESS THAN 7
7405           BH   GO ON
7406           LCA  PRMSH-33,PRMSH-26  ELIMINATE CHECKPOINT REF IN MSG
7407           SBR  PPSMS&6,PRMSH-26   WHEN ONLY ONE PASS
7408           SBR  PPSMS&27,223
7409           SBR  INTRPP&6,233
7410           BCE  ONESEQ,CNTRB,1
7411           BCE  TWOSEQ,CNTRB,2
7412           BCE  TRISEQ,CNTRB,3
7413 FIVSEQ    SBR  RSTONE&10,GO ON&18  NUM OF SEQ IS 4,5 OR 6
7414           MLC  ATWO,ACNTR
7415           SBR  ONESEQ&17,I1TUHP
7416           B    ONESEQ&7
7417 ONESEQ    MLC  ASIX,ACNTR
7418           MLC  I2TUHP,I2HOLD#1
7419           MLC  O1TUHP,I2TUHP
7420           MLC  KB,GO ON&14
7421 MKSBR     MLC  FIVSEQ,ENTRTN&21
7422           B    GO ON
7423 RSTONE    MLC  I2HOLD,I2TUHP
7424           B    FORONE
7425 TWOSEQ    MLC  AFOUR,ACNTR
7426           B    ONESEQ&7
7427 TRISEQ    SBR  TWOSEQ-1,UPDTCT
7428           MLC  NOP,ONESEQ&7
7429           MLC  O1TUHP,I2HOLD
7430           MLC  O2TUHP,O1TUHP
7431           MLC  I2TUHP,O2TUHP
7432           MLC  AZERO,O1TUHP-1
7433           MLC  AONE,O2TUHP-1
7434           SBR  STEPA&3,EOSTSP
7435           SBR  STEPB&3
7436           SBR  STEPC&3
7437           MLNS I1TUHP,*&4
7438           BSP  0
7439           MLC  NOP,RSTONE-11
7440           B    TWOSEQ
7441 HSSD      CS   332                SENSE SWITCH D ON
7442           CS
7443           MLC  PRMSF,222
7444           W                       PRINT DENSITY CHANGE MESSAGE
7445           CC   1
7446           H    IWRCK              RETURN TO INIT PRIOR TO WT CHKPT
7447 *                               LAST MERGE PASS INTERRUPT
7448 *                                 SENSE SWITCH B ON
7449 LPMSGP    CS   332
7450           CS
7451           MLC  TPNOBK,PRMSH-10
7452           SW   216
7453           MLC  PRMSH,231
7454           MLC  PMSLPP
7455           W
7456           CC   1
7457           H    SLMP1&5
7458 PDTYQP    DCW  @HIGH DENSITY@
7459 *                        NO LABELS RTN-EXEC IN LAST PASS INIT
7460 BYLBL     MLC  TPNOBK,WROM1        SET UP CHANGE REEL MESSAGE
7461           MLCWAWROM1,WROM
7462           SBR  LPSQCP-1,RTRN2
7463           MLC  TPNOBK,MARTIF&3
7464           MLC  TPNOBK,MARTEF-2
7465           MLCWAMARTEF&4,WROM-15
7466           MLCWA
7467           MLCWA
7468           MLCWA
7469           MLC  NOP,WOBR&13        NOP INST TO CLEAR FIRST POS OUTPT
7470 BYLBL1    R                       BYPASS FINAL LABEL ROUTINE
7471           BCE  *&5,68,B
7472           B    BYLBL1
7473           SBR  BYLBL1&4,PDCHKP-8
7474           B    BYLBL1
7475 MARTIF    WTM  0
7476           RWU  0
7477 MARTEF    B    EOFW1&4
7478           DCW  @ @
7479 WROM1     DCW  @CHANGE UNIT 0@
7480 *                               SENSE SWITCH E ON  INTERRUPT
7481 INTRPP    MLC  PRMSH,240
7482           W
7483           CS   240
7484           MLC  PDTYQP,212
7485           W
7486           CC   1
7487           H    SCLINP
7488 *                        WRITE CHECKPOINT ERROR ROUTINE
7489 WRDCK     BSP  0
7490           BCE  ERCKP,CNRR,1
7491           A    AONE,CNRR
7492           B    WRCKT                                                  SORT2
7493 ERCKP     A    AONE,CNEOR
7494           BCE  HRTRY,CNEOR,0      TEN SKIPS BRANCH
7495 ERSE1     SKP  0
7496           MLC  TWOBL,CNRR
7497           B    WRCKT
7498 HRTRY     H    IWRCK                                                  SORT2
7499 WFCK2P    H    TF1
7500 AZERO1    DCW  @01@
7501 PMSLPP    DCW  @LAST MERGE PASS@
7502 PRMSF     DCW  @DENSITY MAY BE CHANGED@
7503 PRMSH     DCW  @PASS 00-CKPT 0-INP 0,0,0 OUT-0 INTERRUPT@
7504 PRMSI     DCW  @RESTART@
7505           LTORG*
7506           ORG  WKLAND
7507 *
7508 *              LABELS ROUTINE TO CLEAR AREAS AND SET WORDMARKS
7509 *
7510 ENTRTN    MLC  NOP,RDFST1         RETURN FROM READING INPUT TAPE[S]
7511           MLC  NOP,RDFST2
7512           MLC  NOP,RDFST3
7513           NOP  REDETP&3,EOSTSP    SBR INST IF NUM SEQ 1,2,4,5 OR 6
7514           SBR  RDFST3&3,RUNOTP
7515           CS   3599               CLEAR OUTPUT AREA
7516           CS
7517 ENCSTN    CS
7518           CS
7519           B    LGMEOP
7520 COAP      SBR  RDFST3&3,ENTRTN
7521           C    ASIX,CNTRB         TEST FOR NUM OF SEQ LESS THAN 7
7522           BH   ENTREC
7523           C    LIT003,CNTRB
7524           BE   CNTRB3             NUM OF SEQ IS 3
7525           BL   CNTRB2             NUM OF SEQ IS 1 OR 2
7526           SBR  RDFST1&3,STRD3     NUM OF SEQ IS 4, 5 OR 6
7527 *                               RESTORE FIRST RCD SWITCHES AND
7528 *                               BACKSPACE TWO TAPES
7529 ENTREC    MLC  KB,RDFST3
7530           MLC  KB,RDFST2
7531 BACK2     BSP  0
7532           MLC  KB,RDFST1
7533 BACK1     BSP  0
7534 *                               READ INPUT TAPES
7535           B    STRD1
7536 CNTRB2    MN   O1TUHP,*&4
7537           RWD  0
7538           BCE  ENTRTN,CNTRB,3
7539           BCE  CNTQQ1,CNTRB,2
7540           SBR  RDFST1&3,ENTRTN
7541           B    BACK2-7
7542 CNTQQ1    SBR  RDFST2&3,ENTRTN
7543           B    BACK2-7
7544 CNTRB3    SBR  RDFST2&3,CNTRB2
7545           MLC  KB,RDFST2
7546           B    STRD2
7547           SW   3600
7548 CLINPP    CS   0                  CLEAR INPUT AREAS
7549           SBR  CLINPP&3
7550           BWZ  CLINPP,3600,1
7551           LCA  0,0                SET GMWMS IN INPUT AREAS PRIOR
7552           LCA  0,0                TO READING TAPES
7553           LCA  0,0
7554           MLC  TWOBL,PCNCF        SET WORD MARKS IN
7555 PNWM12    MLC  AIRA1,PICF12       INPUT AREAS FOR CONTROL
7556           MA   CF1SLM,PICF12      FIELD DESIGNATION
7557           MLC  PICF12,PWMS12&3
7558           MLC  SIX 0S-3,PCNTB
7559 PWMS12    SW   0
7560           A    AONE,PCNTB
7561           C    PCNTB,BMULTI
7562 *                               BRANCH TO GET NEXT CF
7563           BE   PSWNCF
7564           MA   LMULTI,PWMS12&3
7565           B    PWMS12
7566 PSWNCF    A    AONE,PCNCF
7567           C    PCNCF,NCFMLT
7568 *                               BRANCH TO INIT NEXT INPUT AREA
7569           BE   PWIRA2
7570           MA   LIT003,PNWM12&10
7571           B    PNWM12
7572 PWIRA2    NOP  PWIRA3
7573           MLC  KB,PWIRA2
7574           SBR  PNWM12&3,AIRA2
7575           SBR  PNWM12&10,CF1SLM
7576           B    PNWM12-7
7577 PWIRA3    NOP  PWMSET
7578           MLC  KB,PWIRA3
7579           SBR  PNWM12&3,AIRA3
7580           SBR  PNWM12&10,CF1SLM
7581           B    PNWM12-7
7582 PWMSET    BCE  COAP,CNOPML,1      WM ALREADY SET IN FIRST POS
7583 PNWMBI    MLC  AIRA1,PICF12
7584           MLC  PICF12,PSW12&3
7585           MLC  SIX 0S-3,PCNTB#3
7586 *                               SET WORD MARK IN FIRST POS OF EACH
7587 *                               RECORD IN INPUT AREAS
7588 PSW12     SW   0
7589           A    AONE,PCNTB
7590           C    PCNTB,BMULTI
7591           BE   PMIRA2
7592           MA   LMULTI,PSW12&3
7593           B    PSW12
7594 PMIRA2    NOP  PMIRA3
7595           MLC  KB,PMIRA2
7596           MLC  AIRA2,PICF12
7597           B    PNWMBI&7
7598 PMIRA3    NOP  COAP
7599           MLC  KB,PMIRA3
7600           MLC  AIRA3,PICF12
7601           B    PNWMBI&7
7602           LTORG*
7603 PCNCF     EQU  CNRR
7604 PICF12    EQU  CSTCNS
7605 SCLINP    MLC  NDRA3P,CLINPP&3
7606           MLC  TWOBL,CNRR
7607           B    CLINPP-4
7608           NOP
7609 RSTORG    ORG  *
7610           EX   LBLCK
7611           JOB  ** IBM 1401 SORT 7 VERSION 2  MULTIPHASE               60  2
7612 *
7613 *              NO LABELS ROUTINE TO CLEAR AREAS AND SET WORDMARKS
7614 *
7615           ORG  RESUME
7616           BE   NLST
7617           ORG  FSTLP-4
7618           B    NLST
7619           ORG  WKLBLI&11
7620           NOP  MLHENT
7621           ORG  GO ON-11
7622           NOP  MLHENT
7623           ORG  STBCK
7624           MLC  I1TUHP,NLBK2&3
7625           MLC  I2TUHP,NLBK1&3
7626           ORG  TF1&5
7627           B    NLST
7628           ORG  MKSBR
7629           MLC  FIVSEQ,NLENT&21
7630           ORG  INTRPP&22
7631           H    NLST
7632           ORG  MLEND
7633 NLENT     MLC  NOP,RDFST1         RETURN FROM READING INPUT TAPE[S]
7634           MLC  NOP,RDFST2
7635           MLC  NOP,RDFST3
7636           NOP  REDETP&3,EOSTSP    SBR INST IF NUM SEQ 1,2,4,5 OR 6
7637           SBR  RDFST3&3,RUNOTP
7638           CS   LGMEOP,2899
7639 NLCLO     SBR  RDFST3&3,NLENT
7640           C    ASIX,CNTRB         TEST FOR NUM SEQ LESS THAN 7
7641           BH   NLREC
7642           C    LIT003,CNTRB
7643           BE   BCNTR3             NUM OF SEQ IS 3
7644           BL   BCNTR2             NUM OF SEQ IS 1 OR 2
7645           SBR  RDFST1&3,STRD3     NUM OF SEQ IS 4,5, OR 6
7646 NLREC     MLC  KB,RDFST3
7647           MLC  KB,RDFST2
7648 NLBK2     BSP  0
7649           MLC  KB,RDFST1
7650 NLBK1     BSP  0
7651           B    STRD1              READ INPUT TAPE[S]
7652 BCNTR2    MN   O1TUHP,*&4
7653           RWD  0
7654           BCE  NLENT,CNTRB,3
7655           BCE  NLCTQ,CNTRB,2
7656           SBR  RDFST1&3,NLENT
7657           B    NLBK2-7
7658 NLCTQ     SBR  RDFST2&3,NLENT
7659           B    NLBK2-7
7660 BCNTR3    SBR  RDFST2&3,BCNTR2
7661           MLC  KB,RDFST2
7662           B    STRD2
7663 NLST      MLC  NDRA3P,NLCLI&3
7664           SW   2900
7665 NLCLI     CS   0                  CLEAR INPUT AREAS AND TO 2900
7666           SBR  NLCLI&3
7667           BWZ  NLCLI,2900,1
7668           LCA  0,0                SET GMWMS IN INPUT AREAS PRIOR
7669           LCA  0,0                TO READING TAPES
7670           LCA  0,0
7671           MLC  TWOBL,NLCNF#2      SET WORD MARKS IN INPUT AREAS FOR
7672 NLAR1     MLC  AIRA1,NLPCF#3      CONTROL FIELD DESIGNATION
7673           MA   CF1SLM,NLPCF
7674           MLC  NLPCF,NLSWM&3
7675           MLC  @   @,NLCNT#3
7676 NLSWM     SW   0
7677           A    AONE,NLCNT
7678           C    NLCNT,BMULTI
7679           BE   NLNCF              BRANCH TO GET NEXT CF
7680           MA   LMULTI,NLSWM&3
7681           B    NLSWM
7682 NLNCF     A    AONE,NLCNF
7683           C    NLCNF,NCFMLT
7684           BE   NLAR2              BRANCH TO INIT NEXT INPUT AREA
7685           MA   LIT003,NLAR1&10
7686           B    NLAR1
7687 NLAR2     NOP  NLAR3
7688           MLC  KB,NLAR2
7689           SBR  NLAR1&3,AIRA2
7690           SBR  NLAR1&10,CF1SLM
7691           B    NLAR1-7
7692 NLAR3     NOP  NLWMST
7693           MLC  KB,NLAR3
7694           SBR  NLAR1&3,AIRA3
7695           SBR  NLAR1&10,CF1SLM
7696           B    NLAR1-7
7697 NLWMST    BCE  NLCLO,CNOPML,1     WM ALREADY SET IN FIRST POS
7698 NLWMBI    MLC  AIRA1,NLPCF
7699           MLC  NLPCF,NLST1&3
7700           MLC  @   @,NLCNT
7701 NLST1     SW   0                  SET WORD MARK IN FIRST POS OF
7702           A    AONE,NLCNT         EACH RECORD IN INPUT AREAS
7703           C    NLCNT,BMULTI
7704           BE   NLST2
7705           MA   LMULTI,NLST1&3
7706           B    NLST1
7707 NLST2     NOP  NLST3
7708           MLC  KB,NLST2
7709           MLC  AIRA2,NLPCF
7710           B    NLWMBI&7
7711 NLST3     NOP  NLCLO
7712           MLC  KB,NLST3
7713           MLC  AIRA3,NLPCF
7714           B    NLWMBI&7
7715           EX   RDBY1
7716           JOB  ** IBM 1401 SORT 7 VERSION 2  PHASE 2                  60  2
7717 ***
7718 ***            MULTIPHASE BYPASS CONSTANT
7719 ***
7720           SFX
7721 HEADER    DCW  @HEADER-TRAILER-PHASE2@
7722           EX   PASMLT
7723           JOB  ** IBM 1401 SORT 7 VERSION 2  PHASE 2                  60  2
7724 ***
7725 ***            PHASE 2 - FINAL HEADER/TRAILER LABEL ROUTINE
7726 ***
7727           SFX
7728           ORG  INIT1
7729 *
7730 *      INIT. FINAL PASS HEADER TRAILER ROUTINE
7731           JOB  ** IBM 1401 SORT 7 VERSION 2 PHASE 2                   60  2
7732 ***
7733 ***            PHASE 2 - FINAL HEADER/TRAILER LABEL ROUTINE
7734 ***
7735           ORG  INIT1
7736 *
7737 *              INITIALIZATION FINAL PASS HDR-TRL ROUTINE
7738 *
7739 REDEMP    BCE  RDMP,LBBUCK,
7740           CS   80
7741           SW   24,56
7742           SW   63,67
7743           R    056
7744 RDMP      R
7745           BCE  *&5,40,/
7746           B    RDMP
7747           BCE  CLSTX1-7,LABELS,   BRANCH IF BYPASSING LABELS
7748           MN   O2TUHA,LPHDX2&12
7749           MN   O2TUHA,LPHDX2&7
7750           MN   O2TUHA,LPHDX3&15
7751           MN   O2TUHA,LPHDS3-10
7752           MN   O2TUHA,LPHDS3&3
7753           MN   O2TUHA,LPPSW-2
7754           MN   O2TUHA,LPPARX-2
7755           MN   O2TUHA,LPTSMG
7756           MN   O2TUHA,LPTRS1&29
7757           MN   O2TUHA,LPTRX1&21
7758           MN   O2TUHA,LPTRX2&14
7759           MN   O2TUHA,LPTRX2&19
7760           MLCWANOPINC-1,THDTP-10
7761           MLC  LPPSW,REWIND&14
7762           MLC  CENSIG,LPHDSH&7
7763           SBR  CLSTX1-12,NXTPS
7764           B    LPTRET&7
7765           NOP
7766 NOPINC    DC   @0000@
7767           ORG  HTHAL1
7768 OHLI      EQU  OTLI
7769 OTMO      EQU  HTMO
7770 *
7771 *         HALT AREA FOR FINAL OUTP HEADER TRAILER ROUTINE
7772 *
7773 LPHDH1    MLC  N99P2,LPHDC1
7774           H    LPHDX1             PRESS START TO ACCEPT
7775 *                             UNREADABLE BLK AS H.L.
7776 *                             RETEN CYC WILL NOT BE CK
7777           B    LPPSW-5            PRESS START/RESET AND START
7778 *                             TO RETRY UP TO 99 MORE TIMES
7779 *                             -A NEW REEL MAY BE MOUNTED
7780 *
7781 LPHDH2    H    LPHDS2        PRESS START TO PROCESS NEW REEL
7782           MLC  @10@,LPHDC2   PRESS START RESET AND START TO
7783           B    LPPARX-5       RETRY UP TO 10 SKIPS MORE
7784 *
7785 LPHDH3    H    LPHDX1             PRESS START TO ACCEPT THIS TAPE
7786           B    LPHDS2        PRESS START RESET AND START IF
7787 *                             A NEW REEL IS TO BE PROCESSED
7788 *
7789 LPTRH1    H    LPTRX2        PRESS START TO ACCEPT T.L.AS WT.
7790           MLC  @10@,LPHDC2   PRESS START RESET AND START TO
7791 *                          TRY WRITING
7792           B    LPPARX-5       T.L.UP TO 10 MORE SKIPS
7793 *
7794 LPTRH2    H    LPHDS1&7      PRESS START AFTER MOUNTING A
7795 *                             NEW REEL FOR OUTPUT
7796 *
7797 CKPTET    SBR  LPHDEX&3           ENTER FROM RESTART ROUT.
7798           B    *&8
7799 LPTRET    SBR  LPHDEX&3,RTRN2-7   ENTER FROM TRAILER ROUTINE
7800           B    LPHDS1
7801           CS   332
7802           CS
7803           MLC  LPTSMG,228
7804           W                       CHANGE TAPE MESSAGE
7805           CC   1
7806           B    LPTRH2
7807 LPHDS1    MLC  @N@,LPTRET&7
7808           CS   179
7809           MLC  GPMARK,*&4
7810           MLCWA0,180              LOAD A G/M-W/M
7811 LPHDS2    MLC  N99P2,LPHDC1#2
7812           MLC  @10@,LPHDC2#2
7813           CS   179
7814           MLC  CENSIG,113
7815           RWD  0
7816           BCE  LPHDEX&4,OHLI,     IF NO NEW H.L.-COL.22 CC.1
7817 LPHDS3    RT   0,100
7818 LPHDSH    BCE  LPHDNR,113,
7819           BEF  *&1
7820           BER  LPERRT
7821           BCE  LPHDRC,WLBKT,1     IF NO RETEN CYC CK-COL.4 CC.3
7822           BCE  LPHDRC,OHLOP,1     IF NO RETEN CYC CK-COL.1 CC.5
7823 LPHDX1    NOP  0                  EXIT-ACCESS TO H.L.
7824           BCE  LPHDX2,OHLI,       IF NO H.L.-COL.22 CC.1
7825           MLC  RTCYCL&1,139       H.L. INFORMATION
7826           MLC                      TO WRITE FIELD
7827           MLC
7828           MLC  HDRTAG,104         HEADER FLAG
7829           SW   140
7830           MLC  331,179
7831           SW   105
7832           BCE  *&8,TPSROP,        IF TO RETAIN TAPE SERIAL #
7833 *                                  COL.34 CC.5
7834           MLC  TPSERL,109         NEW TAPE SERIAL #
7835           BCE  *&8,FLSROP,        COL.2 CC.5
7836           MLC  109,114            TAPE SERIAL # REPLACES FILE
7837 *                                  SERIAL #
7838 LPHDX2    NOP  0                  EXIT-BEFORE WRITING H.L.
7839           BSP  0
7840           WT   0,100
7841           BER  LPERWT
7842 LPHDX3    NOP  0                  EXIT AFTER WRITING H.L.
7843           BCE  *&6,OTMO,          IF NO T/M AFTER H.L.
7844 *                                  COL.23 CC.1
7845           WTM  0
7846           BCE  *&8,RLSQOP,        NO REEL SEQ UPDATE
7847 *                                  COL.3 CC.5
7848           A    &1,REELSQ
7849           CS   181
7850 LPHDEX    B    CLSTX1-7           GENERAL EXIT
7851           B    LPHDEX-4
7852 LPHDNR    CS   120                CLEAR NOISE REC AREA
7853           B    LPHDS3
7854 ****           RETENTION CYCLE CHECK
7855           DCW  @  @
7856           DCW  @   @
7857 CRTC2     DCW  @    @
7858 LPHDRC    ZA   138,CRTC2          MOVE LABEL INFORMATION
7859           MLC                        INTO CHECK BUCKET
7860           MLC
7861           SW   OHDATE-2
7862 CLWL2     C    OHDATE-3,CRTC2-7
7863           BU   MODYR2
7864           A    CRTC2-4,CRTC2         ADD TAPE DAYS TO RT. CYL.
7865           S    OHDATE,CRTC2          SUB. CONT. DAYS FROM RT. CYL.
7866           CW   OHDATE-2
7867           BWZ  LPHDX1,CRTC2,K        CAN TAPE BE WRITTEN ON
7868           CS   332                   NO
7869           CS
7870           MLC  SAVMP2,227            PRINT MESSAGE INDICATING
7871           MLNS CRTC2,222             DAYS TAPE IS TO BE RETAINED
7872           MLNS
7873           MLNS
7874           MLC  SAVMP1
7875           MLC  O2TUHA
7876           MLC  SAVMP3
7877           W
7878           CC   1
7879           B    LPHDH3                BRANCH TO HALT
7880 MODYR2    S    TSF2,CRTC2            SUB. 365 FROM RET.
7881           A                          CYCLE AND ADD 1 TO
7882           A                          TAPE YEARS
7883           B    CLWL2                 CHECK YEAR COMPARE AGAIN
7884           DCW  @1@
7885           DCW  @0@
7886 TSF2      DCW  @365@
7887 SAVMP3    DCW  @RETAIN TAPE @
7888 SAVMP1    DCW  @ FOR @
7889 SAVMP2    DCW  @ DAYS@
7890 *
7891 *       HEADER LABEL READ ERROR ENTRANCE
7892 *
7893 LPERRT    SBR  LPPARX&3,LPHDS3
7894           MLC  @B@,LPPSW
7895           S    &1,LPHDC1
7896           BM   LPHDH1,LPHDC1      UNREADABLE BLK
7897           BSP  0
7898 LPPSW     B    LPPARX             NOP IF WRITE CONDITION
7899           BCE  *&5,LPHDC1,G       IF TIME TO SKIP
7900           B    LPPARX
7901           MLC  N99P2-1,LPHDC1
7902           S    &1,LPHDC2
7903           BM   LPHDH2,LPHDC2
7904           SKP  0
7905 LPPARX    B    0                  ERROR ROUTINE EXIT
7906 *
7907 *         TRAILER LABEL WRITE ERROR ENTRANCE
7908 *
7909 LPTRPE    SBR  LPPARX&3,LPTRX1&18
7910           SBR  LPPARX-10,LPTRH1
7911           B    *&15
7912 *
7913 *         HEADER LABEL WRITE ERROR ENTRANCE
7914 *
7915 LPERWT    SBR  LPPARX&3,LPHDX2&9
7916           SBR  LPPARX-10,LPHDH2
7917           MLC  @N@,LPPSW
7918           B    LPERRT&14
7919 LPTSMG    DCW  @ CHANGE REEL ON UNIT 0@
7920 *
7921 *     TRAILER LABEL ROUTINE-ENTER FROM EOF ON OUTP OR EOJ
7922 *
7923 LPTRS1    CS   180
7924           MLC  GPMARK,*&4
7925           MLCWA0,180              LOAD IN A G/M-W/M
7926           BCE  LPTRX2,TLO,    NO TRAILER LABEL-COL.25 CC.1
7927           WTM  0
7928           BCE  *&12,CNTRA,7       END OF JOB
7929           MLC  @1EOR @,104
7930           B    *&8
7931           MLC  @1EOF @,104
7932           MLC  TAPBLC,109         TAPE BLK COUNT
7933           MLC  ACTNR,*&4
7934           MLC  000,119
7935 LPTRX1    NOP  0                  EXIT-ACCESS TO T.L.
7936           MLC  N99P2,LPHDC1
7937           MLC  @10@,LPHDC2
7938           WT   0,100
7939           BER  LPTRPE
7940 LPTRX2    NOP  0                  EXIT-AFTER T.L.WRITE
7941           MLC  @00000@,TAPBLC
7942           WTM  0
7943           RWU  0
7944           CS   181
7945           BCE  REWIND,CNTRA,7
7946           B    LPTRET
7947           EX   INIT1
7948           JOB  ** IBM 1401 SORT 7 VERSION 2 PHASE 2                   60  2
7949 ***
7950 ***            FINAL PASS INIT FOR HEADER-TRAILER ROUTINE
7951 ***            120 CHARACTER LABELS
7952 ***
7953           ORG  INIT1
7954 *
7955 *
7956 REDMPS    R
7957           BCE  *&5,40,/
7958           B    REDMPS
7959           MLNS O2TUHA,LPHEX2&12
7960           MLNS O2TUHA,LPHEX2&7
7961           MLNS O2TUHA,LPHEX3&15
7962           MLNS O2TUHA,LPHES3-10
7963           MLNS O2TUHA,LPHES3&3
7964           MLNS O2TUHA,LPPPSW-2
7965           MLNS O2TUHA,LPPERX-2
7966           MLNS O2TUHA,LPTMEG-1
7967           MLNS O2TUHA,LPTSS1&30
7968           MLNS O2TUHA,LPTSX1&21
7969           MLC  CENSIG,LANOIS&7
7970           MLNS O2TUHA,LPTSX2&14
7971           SBR  QTRL&3,LPTSS1
7972           MLNS O2TUHA,LPTSX2&19
7973           MLCWANOPINK-1,THDTP-10
7974           MLC  LPPPSW,REWIND&14
7975           SBR  CLSTX1-12,NXTPS
7976           B    LPTRAT&7
7977           NOP
7978 NOPINK    DC   @0000@
7979           ORG  HTHEL1
7980 UHLI      EQU  OTLI
7981 UTMU      EQU  HTMO
7982 *
7983 *              HALT AREA FOR FINAL OUTPUT HDR-TRL ROUTINE
7984 *
7985 LPHEH1    MLC  N99P2,LPHEC1        PRESS START TO ACCEPT UNREADABLE
7986           H    LPHEX1              BLOCK AS H.L. RET CYCLE WILL NOT
7987           B    LPPPSW              BE CHECKED PRESS START RESET AND
7988 *                                  START TO RETRY UP TO 99 TIMES
7989 *                                  A NEW REEL MAY BE MOUNTED
7990 *
7991 LPHEH2    H    LPHES2              PRESS START TO PROCESS NEW REEL
7992           MLC  @10@,LPHEC2         PRESS START-RESET AND START TO
7993           B    LPPERX-5            RETRY UP TO 10 MORE SKIPS
7994 LPHEH3    H    LPHEX1              PRESS START TO ACCEPT THIS TAPE
7995           B    LPHES2              PRESS START-RESET AND START IF A
7996 *                                  NEW REEL IS TO BE PROCESSED
7997 LPTSH1    H    LPTSX2              PRESS START TO ACCEPT TL AS WT.
7998           MLC  @10@,LPHEC2         PRESS START-RESET AND START TO
7999           B    LPPERX-5            TRY WRITING-UP TO 10 MORE SKIPS
8000 LPTSH2    H    LPHES1&7            PRESS START AFTER MOUNTING A NEW
8001 *                                  REEL FOR OUTPUT
8002 CKPTAT    SBR  LPHDAX&3            ENTER FROM RESTART ROUTINE
8003           B    *&8
8004 LPTRAT    SBR  LPHDAX&3,RTRN2-7    ENTER FROM TRAILER ROUTINE
8005           B    LPHES1
8006           CS   332
8007           CS
8008           MLC  LPTMEG,228          CHANGE TAPE MESSAGE
8009           W
8010           CC   1
8011           B    LPTSH2
8012 LPHES1    MLC  @N@,LPTRAT&7
8013           MLC  GPMARK,*&4
8014 LEMARK    MLCWA0,320
8015 LPHES2    MLC  N99P2,LPHEC1#2
8016           MLC  @10@,LPHEC2#2
8017           CS   319
8018           CS
8019 LENOSE    MLC  CENSIG,213
8020           RWD  0
8021           BCE  LPHDAX&4,OHLI,
8022 LPHES3    RTW  0,200
8023 LANOIS    BCE  LPHENR,213,
8024           BEF  *&1
8025           BER  LPARRT
8026           BCE  LPHERC,OHLOP,1     IF NO RET CYC CK-COL1 CC5
8027 LPHEX1    NOP  0
8028           BCE  LPHEX2,OHLI,
8029           MLC  RESEQE,239
8030           MLC  FILESE,229
8031           MLC
8032           MLC  SYSCRE,255
8033           SW   225
8034           BCE  *&8,FLSROP,        COL2 CC5
8035           MLC  234,229
8036 LPHEX2    NOP  0                  EXIT-BEFORE WRITING HL
8037           BSP  0
8038           WT   0,200
8039           CS   332
8040           BER  LPARWT
8041 LPHEX3    NOP  0                  EXIT AFTER WRITING HL
8042           BCE  *&6,OTMO,          BRANCH IF NO TM AFT HL
8043 *                                 COL23 CC1
8044           WTM  0
8045           BCE  *&8,RLSQOP,
8046           A    &1,RESEQE
8047           CS   181
8048 LPHDAX    B    CLSTX1-7           GENERAL EXIT
8049           B    LPHDAX-4
8050 LPHENR    CS   220                CLEAR NOISE RECORD
8051           B    LPHES3
8052 ****                RETENTION CYCLE CHECK
8053           DCW  @    @
8054           DCW  @  @
8055 UTCRTY    DCW  @   @
8056 LPHERC    MLC  214,UTCRTY
8057           MLC
8058           MLC
8059           SW   CREATD-2
8060 CLWIL2    C    CREATD-3,UTCRTY-3
8061           BU   MUDIFY
8062           A    UTCRTY,UTCRTY-5
8063           S    CREATD,UTCRTY-5
8064           CW   CREATD-2
8065           BWZ  LPHEX1,UTCRTY-5,K  CAN TAPE BE WRITTEN ON
8066           CS   319
8067           CS
8068           MLC  S2VMEP,227
8069           MLNS UTCRTY-5,222
8070           MLNS
8071           MLNS
8072           MLC  S1VMEP
8073           MLC  O2TUHA
8074           MLC  S3VMEP
8075           W
8076           CC   1
8077           B    LPHDH3             BRANCH TO HALT
8078 MUDIFY    A    FST365&2,UTCRTY    SUB 365 FROM RET. CYC AND ADD 1
8079           A                       TO TAPE YEARS
8080           S
8081           B    CLWIL2             CHECK YEAR COMPARE AGAIN
8082 FST365    DCW  @365@
8083           DCW  @1@
8084           DCW  @0@
8085 S3VMEP    DCW  @RETAIN TAPE @
8086 S1VMEP    DCW  @ FOR @
8087 S2VMEP    DCW  @ DAYS@
8088 *
8089 *              HEADER LABEL READ ERROR ENTRANCE
8090 *
8091 LPARRT    SBR  LPPERX&3,LPHES3
8092           MLC  @B@,LPPPSW
8093           S    &1,LPHEC1
8094           BM   LPHEH1,LPHEC1      UNREADABLE BLOCK
8095           BSP  0
8096 LPPPSW    B    LPPERX             NOP IF WRITE CONDITION
8097           BCE  *&5,LPHEC1,G
8098           B    LPPERX
8099           MLC  N99P2-1,LPHEC1
8100           S    &1,LPHEC2
8101           BM   LPHEH2,LPHEC2
8102           SKP  0
8103 LPPERX    B    0                  ERROR ROUTINE EXIT
8104 *
8105 *              TRAILER LABEL WRITE ERROR ENTRANCE
8106 *
8107 LPTSPE    SBR  LPPERX&3,LPTSX1&18
8108           SBR  LPPERX-10,LPTRH1
8109           B    *&15
8110 *
8111 *              HEADER LABEL WRITE ERROR ENTRANCE
8112 *
8113 LPARWT    SBR  LPPERX&3,LPHEX2&9
8114           SBR  LPPERX-10,LPHEH2
8115           MLC  @N@,LPPPSW
8116           B    LPARRT&14
8117 LPTMEG    DCW  @ CHANGE REEL ON UNIT 0 @
8118 *
8119 *              TRAILER LABEL ROUTINE
8120 *
8121 LPTSS1    CS   332
8122           CS
8123           MLC  GPMARK,*&4
8124           MLCWA0,320
8125           BCE  LPTSX2,TLO,        NO TRAILER LABEL
8126           WTM  0
8127           BCE  *&12,CNTRA,7       END OF JOB
8128           MLC  @1EOR @,204
8129           B    *&8
8130           MLC  @1EOF @,204
8131           MLC  TAPBLC,271         TAPE BLK COUNT
8132           MLC  N99P2,LPHEC1
8133 LPTSX1    NOP  0                  USER EXIT
8134           MLC  @10@,LPHEC2
8135           MLC  N99P2,LPHEC1
8136           WT   0,200
8137           BER  LPTSPE
8138 LPTSX2    NOP  0                  USER EXIT
8139           MLC  @00000@,TAPBLC
8140           WTM  0
8141           RWU  0
8142           CS   332
8143           CS
8144           BCE  REWIND,CNTRA,7
8145           B    LPTRAT
8146           EX   INIT1
8147           JOB  ** IBM 1401 SORT 7 VERSION 2 MULTIPHASE                60  2
8148 *              MULTIPHASE FINAL OUTPUT LABEL ROUTINE TO WRITE
8149 *              STANDARD HEADER AND TRAILER LABELS ON FINAL
8150 *              OUTPUT TAPES
8151           SFX  #
8152           ORG  MLEND
8153 *
8154 *     HALT AREA FOR FINAL OUTP HEADER TRAILER ROUTINE
8155 *
8156 FPHDH1    MLC  FTRAC3-3,FHTC1     PRESS START TO ACCEPT UNREADABLE
8157 *                                 BLK AS HDR--RETEN CYC WILL NOT
8158 *                                 BE CHECKED
8159           H    FPHDX1
8160           B    FPHDS2             PRESS START RESET AND START TO
8161 *                                 RETRY UP TO 99 MORE TIMES
8162 *                               A NEW REEL MAY BE MOUNTED
8163 FPHDH2    H    FPHDS2         PRESS START TO PROCESS A NEW REEL.
8164           MLC  FTRAC3-4,FHTC2  PRESS START RESET AND START TO
8165           B    FPHDX2             RETRY UP TO 9 SKIPS
8166 *
8167 FPHDH3    H    FPHDX1             RETEN CYC HALT  PRESS START TO
8168           B    FPHDS1         ACCEPT THIS TAPE.PRESS START
8169 *                             RESET AND START IF A NEW REEL
8170 *                             IS TO BE PROCESSED.
8171 *
8172 FPTRH1    H    FTREX2         PRESS START TO ACCEPT T.L.
8173 *                             AS WRITTEN
8174           B    FTREX1&11      PRESS START RESET AND START TO
8175 *                             TRY WRITING T.L. UP TO 10 MORE
8176 *                             SKIPS.
8177 FPTRH2    H    FPHDS1         PRESS START AFTER MOUNTING A
8178 *                             NEW REEL FOR OUTPUT
8179 FPTRET    SBR  FPHDEX&3,RTRN2
8180           CS   332
8181           CS
8182           MLC  FPTSMG,228
8183           W                        CHANGE REEL MESSAGE
8184           CC   1
8185           B    FPTRH2
8186 FPHDS1    CS   180
8187           MLCWA0,180
8188 FPHDS2    MLC  FTRAC3-3,FHTC1#2
8189           MLC  FTRAC3-4,FHTC2#1
8190           CS   179
8191           MLC  CENSIG,113
8192           MLC  CENSIG,MLNOIS&7
8193           RWD  0
8194           BCE  FPHDEX&4,OHLIMP,   IF NO HEADER LABEL
8195 FPHDS3    RTW  0,100
8196 MLNOIS    BCE  FPHDNR,113,
8197           BEF  *&1
8198           BER  FPERRT
8199           BCE  FPHDRC,WLBKTM,1    IF RETEN CYC CK
8200           BCE  FPHDRC,OHLOPM,1
8201 FPHDX1    NOP  0                   EXIT-ACCESS TO H.L.
8202           RWD  0
8203           BCE  FPHDEX-4,OHLIMP,   IF NO HEADER LABEL
8204           MLC  RTCYCL&1,139        H.L.INFORMATION TO
8205           MLC                      READ-WRITE H.L.AREA
8206           MLC
8207           MLC  HDRTAG,104          HEADER FLAG
8208           SW   140
8209           MLC  331,179
8210           SW   105
8211           BCE  *&8,TPSROP,         IF TO RETAIN TAPE SERIAL #
8212           MLC  TPSERL,109          NEW TAPE SERIAL #
8213           BCE  *&8,FLSROP,
8214           MLC  109,114             TAPE SERIAL # REPLACES THE
8215 *                                  FILE SERIAL #
8216 FPHDX2    NOP  0                   EXIT-BEFORE WRITING H.L.
8217           WT   0,100
8218           BER  FPERWT
8219 FPHDX3    NOP  0
8220           BCE  *&6,OTMOMP,        IF NO TM AFTER H.L.
8221           WTM  0
8222           BCE  *&8,RLSQOP,         IF NO REEL SEQ UPDATE
8223           A    AONE,REELSQ
8224           CS   181
8225 FPHDEX    B    SPLCAS             RETURN TO LAST PASS INIT
8226           BCE  FPHDEX-4,WLBKTM,   NO WK TAPE HL CK
8227           B    FPHDS3
8228 FPHDNR    CS   120                 CLEAR NOISE REC AREA
8229           B    FPHDS3
8230 *                    RETENTION CYCLE CK.
8231           DCW  #2
8232           DCW  #3
8233 CRTCY     DCW  #4
8234 FPHDRC    ZA   138,CRTCY          MOVE TAPE INFO. TO CHECK BUCKET
8235           MLC
8236           MLC
8237           SW   OHDATE-2
8238 CLW       C    OHDATE-3,CRTCY-7   COMPARE YEAR
8239           BU   MODY
8240           A    CRTCY-4,CRTCY      ADD TAPE DAYS TO RT CYCLE
8241           S    OHDATE,CRTCY       SUB CONT DAYS FROM RT CYCLE
8242           CW   OHDATE-2
8243           BWZ  FPHDX1,CRTCY,K     CAN WE WRITE ON TAPE
8244           CS   332                NO-PRINT MESSAGE
8245           CS                      INDICATING DAYS TAPE
8246           MLC  SAVMS,227          IS TO BE RETAINED
8247           MLNS CRTCY,222
8248           MLNS
8249           MLNS
8250           MLC  SAVM1
8251           MLC  SAVM2
8252           W
8253           CC   1
8254           B    FPHDH3
8255 MODY      S    TSF1,CRTCY         SUBTRACT 365 FROM
8256           A                       RT CYCLE AND ADD 1 TO
8257           A                       TAPE YEARS
8258           B    CLW
8259           DCW  @1@
8260           DCW  @0@
8261 TSF1      DCW  @365@
8262 SAVM2     DCW  @RETAIN TAPE  @
8263 SAVM1     DCW  @ FOR @
8264 SAVMS     DCW  @ DAYS@
8265 *
8266 *     HEADER LABEL READ ERROR ENTRANCE AND READ-WRITE
8267 *              ERROR  ROUTINE
8268 FPERRT    MLC  KB,FPPSW
8269           A    AONE,FHTC1
8270           BWZ  FPHDH1,FHTC1-1,S    IF UNREADABLE BLK
8271           BSP  0
8272 FPPSW     B    FPHDS3             NOP IF WRITE CONDITION
8273           BCE  *&5,FHTC1,2         IF TIME TO SKIP
8274           B    FPPARX
8275           MLC  FTRAC3-4,FHTC1
8276           SKP  0
8277           A    AONE,FHTC2
8278           BCE  FPHDH2,FHTC2,0
8279 FPPARX    B    0
8280 *
8281 *     HEADER LABEL WRITE ERROR ENTRANCE
8282 *
8283 FPERWT    SBR  FPPARX&3,FPHDX2
8284           SBR  FPPARX-5,FPHDH2
8285           MLC  NOP,FPPSW
8286           B    FPERRT&7
8287 *
8288 *     TRAILER LABEL WRITE ERROR ENTRANCE
8289 *
8290 FPTRPE    SBR  FPPARX&3,FTREX1&18
8291           SBR  FPPARX-5,FPTRH1
8292           B    FPERWT&14
8293 FPTSMG    DCW  @CHANGE UNIT 0@
8294 *
8295 *     TRAILER  LABEL  ROUTINE
8296 *
8297 LMHLTP    CS   180
8298           MLCWA0,180               LOAD IN A G/M-W/M
8299           BCE  FTREX2,OTLIMP,     NO TRAILER LABEL
8300           WTM  0
8301           MLC  @1EOR @,104
8302           BCE  *&5,EOJBK,1        IF END OF JOB
8303           B    *&8
8304           MLC  @F@,103
8305           MLC  MULBKC,109          TAPE BLOCK COUNT
8306           MLC  ACTNR,*&4
8307           MLC  000,119
8308           SW   110
8309           S    RMOVEP,119
8310 FTREX1    NOP  0                   EXIT-ACCESS TO T.L.
8311           MLC  FTRAC3-3,FHTC1
8312           MLC  FTRAC3-4,FHTC2
8313           WT   0,100
8314           BER  FPTRPE
8315 FTREX2    NOP  0                   EXIT-AFTER T.L. WRITE
8316           CS   180
8317           BCE  RWINDP,EOJBK,1
8318           MLC  FTRAC3,MULBKC
8319           WTM  0
8320           RWU  0
8321           B    FPTRET             OPEN NEW REEL
8322 FTRAC3    EQU  SIX 0S-1           FIVE ZEROS
8323           LTORG*
8324           EX   WELEAT
8325           JOB  ** IBM 1401 SORT 7 VERSION 2 MULTIPHASE                60  2
8326 *              MULTIPHASE FINAL OUTPUT LABEL ROUTINE TO WRITE
8327 *              STANDARD HEADER AND TRAILER LABELS ON FINAL OUTPUT
8328 *              TAPES FOR 120 CHARACTER LABEL OPTION
8329           SFX  #
8330           ORG  INTLB
8331           MLC  TPNOBK,FPHES3-24
8332           MLC  TPNOBK,FPHES3&3
8333           MLC  TPNOBK,FPHEX2&7
8334           MLC  TPNOBK,FPHEX1&7
8335           MLC  TPNOBK,FPHEX3&15
8336           MLC  TPNOBK,FPPSSW-2
8337           MLC  TPNOBK,FPPERX-17
8338           MLC  TPNOBK,LMHKTP&23
8339           MLC  TPNOBK,FTRAX1&21
8340           MLC  TPNOBK,FTRAX2&26
8341           MLC  TPNOBK,FTRAX2&31
8342           MLC  TPNOBK,FPTMEG
8343           MLC  TPNOBK,SMVM2
8344           BCE  *&15,OHLIMP,4
8345           MLC  NOP,PRILAL
8346           NOP  NOP,PRILAL
8347           MLC  GPMARK,LMHKTP&8
8348           MLC  GPMARK,FPHES1&8
8349           MLC  BLKCNT&6,WOBR&19
8350           BCE  NWOUTP,PIMULT,6
8351           ORG  MLEND
8352 *
8353 *              HALT AREA FOR FINAL OUTPUT HEADER TRAILER ROUTINE
8354 *
8355 FPHEH1    MLC  FTREC3-3,FHTD1
8356 *                                 BLK AS HDR---RETEN CYC WILL NOT
8357           H    FPHEX1             BE CHECKED-PRESS START RESET AND
8358           B    FPHES2             START TO RETRY UP TO 99 TIMES
8359 *                                 A NEW REEL MAY BE MOUNTED
8360 FPHEH2    H    FPHES2             PRESS START TO PRO A NEW REEL.
8361           MLC  FTREC3-4,FHTD2
8362           B    FPHEX2             TO 9 SKIPS
8363 FPHEH3    H    FPHEX1             RET CYC HALT PRESS START TO
8364           B    FPHES1             ACCEPT THIS TAPE.START RESET AND
8365 *                                 START IF A NEW REEL IS TO BE PRO-
8366 *                                 CESSED
8367 FPTSH1    H    FTRAX2             PRESS START TO ACCEPT TL AS
8368           B    FTRAX1&11          WRITTEN-START RESET AND START TO
8369 *                                 WRITING TL UP TO 10 MORE SKIPS
8370 FPTSH2    H    FPHES1             PRESS START AFTER MOUNTING A NEW
8371 *                                 REEL FOR OUTPUT
8372 FPTRAT    SBR  FPHDAX&3,RTRN2
8373           CS   332
8374           CS
8375           MLC  FPTMEG,228
8376           W                       CHANGE REEL MESSAGE
8377           CC   1
8378           B    FPTSH2
8379 FPHES1    CS   332
8380           CS
8381           MLCWA0,320
8382 FPHES2    MLC  FTREC3-3,FHTD1#2
8383           MLC  FTREC3-4,FHTD2#1
8384           CS   319
8385           CS
8386           RWD  0
8387           BCE  FPHDAX&4,OHLIMP,     IF NO HEADER LABEL
8388           MLC  CENSIG,213
8389           MLC  CENSIG,FPNSSE&7
8390 FPHES3    RTW  0,200
8391 FPNSSE    BCE  FPHENR,213,        NOISE RECORD TEST
8392           BEF  *&1
8393           BER  FPARRT
8394           BCE  FPHERC,OHLOPM,1
8395 FPHEX1    NOP  0                  USER EXIT
8396           RWD  0
8397           MLC  RESEQE&1,239
8398           MLC  FILESE,229
8399 PRILAL    MLC
8400           NOP
8401           MLC  HDRTAG,204
8402           MLC  SYSCRE,255
8403           BCE  *&12,FLSROP,
8404           SW   225
8405           MLC  234,229
8406 FPHEX2    NOP  0                  USER EXIT
8407           WT   0,200
8408           BER  FPARWT
8409 FPHEX3    NOP  0                  USER AREA
8410           BCE  *&6,OTMOMP,        IF NO TM AFTER HL
8411           WTM  0
8412           BCE  *&8,RLSQOP,        IF NO REEL SEQ UPDATE
8413           A    AONE,REELSQ
8414           CS   332
8415           CS
8416 FPHDAX    B    SPLCAS             RETURN TO LAST PASS INIT
8417           BCE  FPHDAX-5,WLBKTM,     NO WORK TAPE HL CHECK
8418           B    FPHES3
8419 FPHENR    CS   220                CLEAR NOISE RECORD AREA
8420           B    FPHES3
8421 *              RETENTION CYCLE CHECK
8422           DCW  #4
8423           DCW  #2
8424 UTCRTZ    DCW   #3
8425 FPHERC    MLC  214,UTCRTZ
8426           MLC
8427           ZA
8428           SW   CREATD-2
8429 CLWIL8    C    CREATD-3,UTCRTZ-7
8430           BU   CHANGE
8431           A    UTCRTZ,UTCRTZ-5    ADD TAPE DAYS TO RETENTION CYCLE
8432           S    CREATD,UTCRTZ-5
8433           CW   CREATD-2
8434           BWZ  FPHEX1,UTCRTZ-5,K
8435           CS   180
8436           MLC  280,180            STORE LABEL PRO TEMPORE
8437           CS   319
8438           CS                      PRINT MESSAGE INDICATING DAYS
8439           MLC  SMVMS,227          TAPE IS TO BE RETAINED
8440           MLNS UTCRTZ-5
8441           MLNS
8442           MLNS
8443           MLC  SMVM1
8444           MLC  SMVM2
8445           W
8446           CC   1
8447           MLC  180,280
8448           B    FPHEH3
8449 CHANGE    A    FST364&2,UTCRTZ
8450           A
8451           S
8452           B    CLWIL8
8453 FST364    DCW  @365@
8454           DCW  @1@
8455           DCW  @0@
8456 SMVM2     DCW  @RETAIN TAPE  @
8457 SMVM1     DCW  @ FOR @
8458 SMVMS     DCW  @DAYS@
8459 *              HEADER LABEL READ-WRITE ERROR ROUTINE
8460 FPARRT    MLC  KB,FPPSSW
8461           A    AONE,FHTD1
8462           BWZ  FPHEH1,FHTD1,S     IF UNREADABLE BLOCK
8463           BSP  0
8464 FPPSSW    B    FPHES3             NOP IF WRITE CONDITION
8465           BCE  *&5,FHTD1,2
8466           B    FPPERX
8467           MLC  FTREC3-4,FHTC1
8468           SKP  0
8469           A    AONE,FHTD2
8470           BCE  FPHEH2,FHTD2,O
8471 FPPERX    B    0
8472 *
8473 *              HEADER LABEL WRITE ERROR ENTRANCE
8474 *
8475 FPARWT    SBR  FPPERX&3,FPHEX2
8476           SBR  FPPERX-5,FPHEH2
8477           MLC  NOP,FPPSSW
8478           B    FPARRT&7
8479 *              TRAILER LABEL WRITE ERROR ENTRANCE
8480 FRTSPE    SBR  FPPERX&3,FTRAX1&18
8481           SBR  FPPERX-5,FPTSH1
8482           B    FPARWT&14
8483 FPTMEG    DCW  @CHANGE REEL ON UNIT 0@
8484 *
8485 *              TRAILER LABEL ROUTINE
8486 *
8487 LMHKTP    CS   330
8488           CS
8489           MLCWA0,320
8490           BCE  FTRAX2,OTLIMP,     NO TRAILER LABELS
8491           WTM  0
8492           BCE  *&12,EOJBK,1       IF END OF JOB
8493           MLC  @1EOR @,204
8494           B    *&8
8495           MLC  @1EOF @,204
8496           MLC  MULBKC,271
8497 FTRAX1    NOP  0                  USERS EXIT
8498           MLC  FTREC3-3,FHTD1
8499           MLC  FTREC3-4,FHTD2
8500           WT   0,200
8501           BER  FRTSPE
8502 FTRAX2    NOP  0                  USERS EXIT
8503           CS   332
8504           BCE  RWINDP,EOJBK,1
8505           MLC  FTREC3,MULBKC
8506           WTM  0
8507           RWU  0
8508           B    FPTRAT             OPEN NEW REEL
8509 FTREC3    EQU  SIX 0S-1
8510           LTORG*
8511           EX   INTLB
8512           JOB  ** IBM 1401 SORT 7 VERSION 2  MULTIPHASE               60  2
8513           ORG  3200
8514 *                               INITIALIZE END OF JOB ROUTINE
8515 EOJ       MLC  ACNT,UNRDCK&6
8516           MLC  ACNT,FERMS&3
8517           MLC  ACTNR,PERCK&3
8518           MLC  ACTNR,ERRC-8
8519           MLC  ACTNR,PADQZ&11
8520           MLC  PADQNQ,PADQZ&6
8521 UNRDCK    C    SIX 0S,0           UNREADABLE RCD CHECK
8522           CS   332
8523           CS
8524           BU   FERMS
8525 PERCK     C    0,CTNRML           TOTAL RCD CHECK
8526           BU   ERRC
8527           MLC  CTNRML,TOTMS-24
8528           MLC  TOTMS,230
8529           W                       PRINT TOTAL RCD MSG
8530           CS   230
8531           MLC  RMOVEP,PDMSG-23
8532           C    PDMSG-23,@      @  PADDED RCD CHECK
8533           BU   PRNTQ
8534           MLC  SIX 0S,PDMSG-23
8535 PRNTQ     MLC  PDMSG,229
8536           W                       PRINT PADDED RCD MSG
8537           CS   230
8538           S    RMOVEP,CTNRML
8539           MZ   BLANK,CTNRML
8540           MLC  CTNRML,FINMS-21
8541 PTFIN     MLC  FINMS,227
8542           W                       PRINT FINAL RCD OUTPUT MSG
8543           CC   K
8544           CS   332
8545           CS
8546           MLNS O2TUHP,PRMS-12
8547           MLC  PRMS,218
8548           W                       PRINT END OF SORT MSG
8549           CC   1
8550           BWZ  IWTM2P,URPIML,2    DUMP TAPE OPTION BRANCH
8551 ENDSRT    H    *-3                FINAL HALT
8552 FERMS     MLC  0,FINER-19
8553           MLC  FINER,225
8554           W                       PRINT UNRD RCD MSG
8555           CS   230
8556           SW   PTFIN-10,PTFIN-17
8557           MLC  ERRC-8,PTFIN-4
8558           MLC  ERRC-8
8559           MLC  ERRC-8,PTFIN-15
8560           CW   PTFIN-10,PTFIN-17
8561 PADQZ     BCE  PERCK&12,0,
8562           MLC  0,FINMS-21
8563           B    PTFIN
8564 ERRC      MLC  ERCTMG,236
8565           B    ERRC-11
8566 IWTM2P    MLC  URPIML,WTMBD&3     REWIND DUMP TAPE
8567           MLC  URPIML,WTMBD&8
8568 WTMBD     WTM  0
8569           RWU  0
8570           B    ENDSRT
8571           LTORG*
8572 TOTMS     DCW  @        TOTAL RECORDS PROCESSED@
8573 PDMSG     DCW  @        PADDED RECORDS REMOVED@
8574 FINMS     DCW  @       RECORDS FINAL OUTPUT@
8575 FINER     DCW  @       UNREADABLE RECORDS@
8576 ERCTMG    DCW  @ERROR@
8577 PRMS      DCW  @OUTP  -END OF SORT@
8578           END  EOJ

