         SYSTEM   SIG7FDP
         SYSTEM   BPM
         DEF      SAVAL,INIT
         REF      M:SI
         REF      DCBADDR,SSORT,RSORT,CCT01,LDTC,FINALEND
         REF      F:SCRF1,F:SCRF17,UTSCPVSW
         REF      KTT0
         REF      STEPCODE
         PAGE
X0       EQU      0
X1       EQU      1
X2       EQU      2
X3       EQU      3
X4       EQU      4
X5       EQU      5
X6       EQU      6
X7       EQU      7
R8       EQU      8
R9       EQU      9
R10      EQU      10
R11      EQU      11
R12      EQU      12
R13      EQU      13
R14      EQU      14
R15      EQU      15
SR1      EQU      8
SR2      EQU      9
SR3      EQU      10
RA       EQU      10
RB       EQU      11
RC       EQU      12
RD       EQU      13
RE       EQU      14
RF       EQU      15
DCBTYPE  SET      1
SAVAL    DO1      16
         DATA     0
         BOUND    8
CARD     DO1      20
         DATA     0
PARTBL   DATA     '.REC'
         DATA     '.BLO'
         DATA     '.FIL'
         DATA     '.KEY'
         DATA     '.NOT'
         DATA     '.LIM'
         DATA     '.TRA'
CEOD     DATA     ' EOD'
PARJMP   B        PRE
         B        PBLO
         B        PFIL
         B        PKEY
         B        INIT2
         B        PLIM
         B        PTRA
         B        INIT4
PARSET   DATA     0,0,0
KFLD     DO1      4
         DATA     0
SRSAV    DO1      3
         DATA     0
HF0F0    DATA    X'0F0F0'
H0FFF    DATA     X'000F0F0F'
HF1F0    DATA    X'0F1F0'
HF0      DATA    X'F0000000'
HFF00    DATA    X'FFFF0000'
H4       DATA     X'F0F4'
H12      DATA    X'0F1F2'
PAGES    DATA    C'AGES'
CBLNK    DATA    C'.   '
BLANK    DATA     C'    '
TRAN     DATA    C'TRAN'
CSOR     DATA     C' SOR'
CBA      DATA     C'  BA'
TFLG     DATA     0
HDCB     DATA     C'3690'
DIS      DATA    0
CNT      DATA    0
CPG      DATA     0
CPG2     DATA     0                  HOLD POS INTO COM PG FOR OLD FMT
WORK1    DATA     0                 WORD  COM PAGE ADDR OF TRANS/TABLE
CPG1     DATA     0                 BYTE  COM PAGE ADDR OF TRANS/TABLE
WORK     DATA     0
SCANRTN  RES      1                 RETURN ADDR FOR SCAN
LPARA    DATA     C'(   '
RPARA    DATA     C')   '
COMMA    DATA     C',   '
FINOU    DATA     0
PSET     DATA     X'FF000000'
HDR      DATA     C' HDR'
SEQ      DATA     C' SEQ'
DROP     DATA     C'DROP'
SKIP     DATA     C'SKIP'
SORT     DATA     C'SORT'
DUMP     DATA     C'DUMP'
TBUF     DATA     C'TBUF'
PGS      DATA     C'AGES'
DCBS     DATA     C'DCBS'
REM      DATA     C' REM'
CS       DATA     C'   S'
HF0F     DATA     X'0F0F'
HF       DATA     X'0F'
HFF      DATA     X'0FF'
DCBT     DATA     C'ABCD','EFGH'
STRT     DATA     0
PFLG     DATA     0
PFLG1    DATA     0
PFLG2    DATA     0
PFLG3    DATA     0
PFLG4    DATA     0                 TBUF SW
KDIS     DATA     50
KNUM     DATA     1
KCNT     DATA     0
BINIT25  BNE      EREAD
CDMV     GEN,32   BA(CARD)
*
ERTBL    DATA     0,E1
ERTBL1   DATA     E11,E22
SRTMES   TEXTC    'SORT VERSION  F03:  04-01-77'
E1       TEXTC    'SPECIFICATION ERROR'
E11      TEXTC    'TRANSLATION TABLE LOCATION ERROR'
E22      TEXTC    'MEMORY OVERFLOW'
TESTB    TEXTC    'SORT OPEN TEST    '
*
         PAGE
*
*        THIS ROUTINE INITIALIZES THE SORT PRE-PROCESSOR.
*        IT CHECKS TO SEE IF THE SORT IS LINKED TO OR CALLED AS
*        A PROCESSOR.  IF IT IS LINKED, PRE WILL GO CHECK THE DCB'S.
*        IF CALLED AS A PROCESSOR IT WILL CHECK THE PARAMETER
*        CARDS AND BUILD A STANDARD PARAMTER LIST IF NECESSARY.
*
INIT     RES      0
         LCI      15                SAVE ALL GENERAL
         STM,X1   SAVAL            SAVE ENVIRONMENT
         M:PRINT  (MESS,SRTMES)     PRINT SORT VERSION
         LI,9     BA(KTT0)
         STW,9    CPG1
         SLS,9    -2
         STW,9    WORK1
         BAL,9    TRANSB
         LW,SR1   SAVAL+7           IS SORT CALLED AS A MAIN PROGRAM
         BNE      SLINK
         LI,X7    0
         STW,X7   FINOU             INITIALIZE DCB ADDRESS POINTER
         LI,X7    1
         STH,7    CCT01             SET TO INDICATE MAIN PROG CALLED
         LI,X7    40                INITIALIZE KEY DISPLACEMENT
         STW,X7   KDIS
         M:GCP    1                 GET COMMON PAGE
         BCR,R8   INIT1             A PAGE IS AVAILABLE
         LI,7     1
         B        SC5               GO ABORT
INIT1    RES      0
         STW,SR2  SAVAL+6           SET COMMON PAGE ADDRESS
         STW,SR2  WORK
         SLS,SR2  2                 BA OF COMMON PAGE
         STW,SR2  CPG
         STW,9    CPG2              SAVE ADDR
         LI,X6    64
         LW,X5    BLANK
INIT15   RES      0
         STW,X5   *SAVAL+6,X6
         BDR,X6   INIT15
         LI,X5    C'M'             SET FORMAT TYPE
         STB,X5   *WORK            TO MONITOR
INIT2    RES      0
         BAL,R9   SPECRD            GO READ SPECIFICATION CARDS
         LW,X7    CARD              IS CARD !SORT
         BEZ      INIT4             NO CARDS LEFT
         CW,X7    CSOR
         BE       INIT2             YES. READ AGAIN
         CW,X7    CEOD              IS IT EOD
         BE       INIT4             YES.
         BAL,R9   SPECPT            GO PRINT CARD IMAGE
         LB,X7    CARD              IS PARAM IN NEW FORMAT
         CW,X7    =C'.'
         BNE      STDPAR            NO. GO PROCESS STANDARD FORMAT
         LW,X3    BINIT25          SET BRANCH  TO
         STW,X3   %-2              BYPASS THE STANDARD
INIT25   RES      0
         LI,X3    8
INIT28   RES      0
         LW,X4    CARD              FIND TYPE OF PARAMETER CARD
         CW,X4    PARTBL-1,X3
         BE       INIT35            CHECK FOR DUPL OR PROCESS CARD
         BDR,X3   INIT28            CHECK AGAIN
INIT3    RES      0
         SLS,X4   -16
         CH,X4    CBLNK             CHECK IF '. '
         BE       PARJMP,X1         YES. GO TO
INIT31   RES      0
         LI,X6    1                 SYNTAX ERROR IN PARAMETER CARD
         B        ERRTYP            GO PRINT ERROR MESSAGE
INIT35   RES      0
         LB,4     PARSET,3          HAVE WE HAD THIS TYPE BEFORE
         BNEZ     INIT37             YES
         LI,4     1
         STB,4    PARSET,3          FLAG SWITCH
         B        PARJMP-1,3          GO PROCESS
INIT37   RES      0
         CI,3     4                 OK TO HAVE DUPL KEY CARDS
         BE       PARJMP-1,3
         CI,3     7                 OK TO HAVE MULT TRAN CARDS
         BE       PARJMP-1,3
         CI,3     5                  OK TO HAVE MULT NOTE CARDS
         BE       PARJMP-1,3
         LI,6     1
         B        ERRTYP            PROCESS ERROR CARD
INIT4    RES      0
         LW,R15   KCNT              NUMBER OF SORT KEYS
         CI,R15   10                LESS THAN 10
         BGE      INIT6             NO.
         OR,R15   HF0F0             SET TO EBCDIC
INIT5    RES      0
         LI,X4    2
         LI,X5    48                MOVE NUMBER OF KEYS INTO
         BAL,R9   MOV               COLUMN 49-50 OF PARAMETER CARD
INIT53   RES      0
         LI,X4    1                 CHECK INPUT BLOCKING
         LW,R15   *WORK,X4
         SLS,15   8
         SLS,15   -8
         CW,15    =X'404040'
         BNE      INIT55            BLOCKING HAS BEEN SPECIFIED
         LI,X4    3                 MOVE TO
         LI,X5    5                 COMMON PAGE
         BAL,R9   MOV
INIT55   RES      0
         LI,X4    2                 CHECK OUTPUT BLOCKING
         LW,X5    *WORK,X4
         SLS,X5   -8                MASK OUTPUB BLOCKING
         CW,5     =X'404040'
         BNE      CHDCB             OK. RETURN TO CONTROL
         LI,X4    1                GET INPUT BLOCKING FACTORE
         LW,R15   *WORK,X4
         LI,X4    3                 MOVE INPUT BLOCKING
         LI,X5    8                 INTO OUTPUT BLOCKIN
         BAL,R9   MOV
         B        CHDCB             GO CHECK DCB'S
INIT6    RES      0
         AI,R15   -10
         OR,R15   HF1F0             SET NUMBER TO EBCDIC
         B        INIT5
         PAGE
*
*        SPECRD READS THE PARAMETER CONTROL CARDS AND SPECPT
*        PRINTS THEM ON THE M:LL DEVICE.
*             R9 = RETURN ADDRESS
*
SPECRD   RES      0
         LCI      3
         STM,R8   SRSAV             SAVE SYSTEM REG
         LI,X3    20                BLANK OUT CARD
         LI,X4    0
SPECLP   RES      0
         STW,X4   CARD-1,X3
         BDR,X3   SPECLP            CONTINUE BLANKING
         M:READ   M:SI,(BUF,CARD),(SIZE,80),(ABN,SPABN)
SPECRT   RES      0
         LCI      3
         LM,R8    SRSAV             RESTORE AND RETURN
         B        *R9
SPECPT   RES      0
         LCI      3
         STM,R8   SRSAV             SAVE SYSTEM REG
         M:WRITE  M:LL,(BUF,CARD),(SIZE,80),WAIT
         B        SPECRT
*
SPABN    RES      0
         LB,R9    R10              GET ABNORM CODE
         CI,R9    5                EOD
         BE       SPABN10          YES
         CI,R9    6                EOF
         BNE      SPECRT           NO. IGNORE ABNORMAL
SPABN10  RES      0
         LI,R9    0
         STW,R9   CARD             SET CARD TO ZERO
         B        SPECRT           RETURN
         PAGE
*
*        THIS ROUTINE SCANS THE NEW SORT PARAMETER CARDS AND
*        PLACES THE PARAMETER FIELDS INCOUNTERED INTO R14 AND R15.
*             X3 = BYTE DISPLACEMENT OF SCAN
*             X6 = NUMBER OF CHARACTERS SCANNED
*             R9 = ROUTINE
*             R14= DATA FIELD IF ANY
*             R15= DATA FIELD
*
*
SCAN     RES      0
         STW,9    SCANRTN           SAVE RETURN ADDR
         LI,X6    0                 SCAN CHARACTER COUNT
         LW,R14   BLANK
         STW,R14  R15               BLANK OUT HOLD REGISTERS
         LI,X4    0
         LI,X2    0
SCAN10   RES      0
         LB,X4    CARD,X3           CHECK FOR  LEFT PAREN
         AI,X3    1                 UPDATE DISPLACEMENT POINTER
         CB,X4    LPARA             LEFT PAREN?
         BE       SCAN20            YES.
         CB,X4    COMMA            ANY MORE FIELDS IN THIS PARAM
         BE       SCAN20           YES.
         CI,4     ';'               ; FOR CONTINUATION CARDS
         BNE      SCAN12
         BAL,9    SPECRD             READ NEXT CARD
         LW,4     CARD
         BEZ      INIT31            ERROR NO CARD FOLLOWS
         BAL,9    SPECPT             PRINT
         LH,4     CARD
         CI,4     '. '              IS IT CONTINUED CORRECTLY
         BNE      INIT31            ERROR
         LI,3     2                 SET TO 3 RD BYTE
         B        SCAN10            GO ON AND SEE FIELDS
SCAN12   RES      0
         CI,X3    81                SCANNED INTIRE CARD
         BGE      SCAN50            YES. GO RETURN
         B        SCAN10            GET NEXT BYTE
SCAN20   RES      0
         LB,X4    CARD,X3           CHECK FOR NUMERIC FIELD
         AI,X3    1                 UPDATE POINTER DISPLACEMENT
         CB,X4    HF0               NUMERIC?
         BL       SCAN40            NO
SCAN30   RES      0
         AI,X6    1                NUMBER OF BYTES SCANNED
         SLD,R14  8                 MAKE ROOM IN HOLD REGISTERS
         AND,X4   HFF               MASK FIRST BYTE
         OR,R15   X4                PLACE IN HOLD REG.
         B        SCAN20            GO GET MORE
SCAN40   RES      0
         CB,X4    COMMA             COMMA
         BE       SCAN70            YES.
         CB,X4    RPARA             RIGHT PAREN?
         BNE      SCAN30            NO. PLACE IN HOLD REG
         CI,3     81                 AT END OF CARD  ??
         BGE      SCAN50             YES
         LB,2     CARD,3            LOOK AHEAD TO NEXT BYTE
         CI,2     X'40'
         BLE      SCAN50
         CI,2     X'6B'             , MEANS MORE TO COME
         BE       SCAN50            .CARD ROUTINES WILL GET HERE AGAIN
         B        INIT31            ERROR UNRECOG CHARA OR NO COMMA
SCAN50   RES      0
         LI,X2    1                 SETEND-OF-CARD FLAG
SCAN60   RES      0
         B        *SCANRTN          RETURN
SCAN70   RES      0
         AI,X3    -1                SET SCAN POINTER BACK
         B        *SCANRTN          RETURN
         PAGE
*
*        THIS ROUTINE MOVES THE SORT PARAMETER FIELD LOCATED
*        IN REGISTER 14 AND/OR 15 TO THE STANDARD SORT PARAMETER
*        CARD LOCATED IN COMMON PAGE.
*             X4 = BYTES TO BE MOVED
*             X5 = BYTE DISPLACEMENT INTO COMMON PAGE
*             R9 = RETURN ADDRESS
*             R14 = DATA TO BE MOVED IF ANY
*             R15 = DATA TO BE MOVED
*
MOV      RES      0
         LI,X6    64                SET TO LAST BYTE +1 OF GEN REG
         SW,X6    X4                SET TO ACTUAL DISPLACEMENT
MOV1     RES      0
         LW,X7    CPG               ADDRESS OF COMMAN PAGE
         AW,X7    X5                DISPLACEMENT OF SORT PARAMETER
         STB,X4   X7                STORE BYTE COUNT
         MBS,X6   0                 MOVE FIELD TO COMMON PAGE
         B        *R9               RETURN TO CALLER
         PAGE
*
*        PFIL SCANS THE '.FILE' CARD PICKING OUT THE SKIP AND SORT
*        PARAMTERS IF ANY.
*
PFIL     RES      0
         LI,X2    0
         LI,X3    4                 STARTING BYTE
         STW,2    PFLG
         STW,2    PFLG1
         STW,2    PFLG2
PFIL10   RES      0
         BAL,R9   SCAN              SCAN FIRST FIELD
         LW,R13   R15               SAVE FIELD TYPE
         BAL,R9   SCAN              SCAN SECOND FIELD
         CW,R13   SKIP              SKIP?
         BE       PFIL30            YES
         CW,R13   HDR               CHECK IF HDR OPTION IS PRESENT
         BE       PFIL50            YES.
         CW,R13   SORT              SORT?
         BNE     PFIL40            NO
         MTW,0    PFLG2
         BGZ      EREAD
         LI,X5    14                BYTE DISPLACEMENT OF MOVE
         MTW,1    PFLG2
PFIL20   RES      0
         LI,X4    6                 NUMBER OF BYTES TO MOVE
         BAL,R9   MOV               GO MOVE
         AI,X3    1                POINT TO NEXT CHARACTER
         B        PFIL10            GO SCAN AGAIN
PFIL30   RES      0
         MTW,0    PFLG
         BGZ      EREAD
         LI,X5    25                BYTE DISPLACEMENT OF MOVE
         MTW,1    PFLG
         B        PFIL20            GO MOVE
PFIL40   RES      0
         CW,R13   BLANK             BLANK FIELD
         BNE      EREAD
         CW,15    BLANK
         BNE      EREAD
         B        INIT2             GET NEXT CARD
PFIL50   RES      0
         MTW,0    PFLG1
         BGZ      EREAD
         LI,X4    12
         STB,R15  *WORK,X4          SET HEADER SKIP OPTION IN COL 13
         MTW,1    PFLG1
         AI,3     1
         B        PFIL10            GO CHECK NEXT FIELD
         PAGE
*
*        PRE SCANS THE '.REC' CARD OBTAINING THE INPUT/OUTPUT RECORDS
*        LENGTH AND IF SEQUENCE CHECKING IS DESIRED.
*
PRE      RES      0
         LI,X3    4                 INITIALIZE
         LI,X2    0
         STW,X2   PFLG
         STW,2    PFLG1
PRE10    RES      0
         CI,X2    1                 IS SCAN COMPLETED
         BE       INIT2             YES. GET NEXT CARD TYPE
         BAL,R9   SCAN              SCAN CARD FOR FIELD
         CW,R15   SEQ               SEQUENCE CHECK?
         BE       PRE40             YES
         LI,X5    1                 POSITION 2-5
         MTW,0    PFLG              INPUT REC SIZE
         BEZ      PRE30             YES.
         LW,5     PFLG
         CI,5     1
         BNE      EREAD
         LI,X5    35                POSITION 36-39
PRE30    RES      0
         LI,X4    4                 BYTE COUNT
         BAL,R9   MOV               GO MOVE FIELD TO COMMON PAGE
         MTW,1    PFLG
         B        PRE10             GET NEXT FIELD
PRE40    RES      0
         MTW,0    PFLG1
         BGZ      EREAD
         LI,X5    23                SET COL 23
         LI,R15   C'S'
         STB,R15  *WORK,X5
         MTW,1    PFLG1
         B        PRE10             GET NEXT FIELD
         PAGE
*
*        PBLO SCANS THE '.BLOCK' CARD FOR INPUT/OUTPUT BLOCKING FACTOR
*        AND IF BAD BLOCKS SHOULD BE DROPPED.  IF NO INPUT/OUTPUT
*        BLOCKING IS SPECIFIED 1 IS DEFAULT.
*
PBLO     RES      0
         LI,X3    4                 STARTING BYTE
         LI,X2    0                 SET FIELD COUNTER TO ZERO
         STW,2    PFLG
         STW,2    PFLG1
PBLO10   RES      0
         CI,X2    1                 RIGHT PAREN REACHED
         BE       INIT2             YES. GO CHECK IF OUTPUT BLOCKING =0
         BAL,R9   SCAN              GO SCAN
         CW,R15   DROP              FIELD DROP
         BE       PBLO40            YES
         LI,X5    5                 BYTE DISPLACEMENT OF MOVE
         MTW,0    PFLG              INPUT BLOCKING FACTOR
         BEZ      PBLO30            YES
         LW,5     PFLG
         CI,5     1
         BG       EREAD
         LI,X5    8                 NO. SET FOR OUTPUT BLOCKING FACTOR
PBLO30   RES      0
         LI,X4    3                 NUMBER OF BYTES TO MOVE
         BAL,R9   MOV               GO MOVE BLOCKING FACTOR
         MTW,1    PFLG
         B        PBLO10            GO CHECK NEXT FIELD
PBLO40   RES      0
         MTW,0    PFLG1
         BGZ      EREAD
         LI,X5    22                SET BYPASS UNREADABLE RECORDS
         LI,X4    C'0'              SWITCH ON
         STB,X4   *WORK,X5
         MTW,1    PFLG1
         B        PBLO10            GO CHECK NEXT FIELD
*
         PAGE
*
*        PLIM SCANS THE '.LIMIT' CARD AND OBTAINES THE NUMBER OF
*        PAGES AND DCB'S AND IF THE INTERMEDIATE REWIND IS DESIRES.
*
PLIM     RES      0
         LI,2     0
         STW,2    PFLG
         STW,2    PFLG1
         STW,2    PFLG2
         STW,2    PFLG3
         LI,X3    4                 STARTING BYTE OF SCAN
PLIM10   RES      0
         BAL,R9   SCAN              SCAN FIELD
         CW,R15   BLANK            BLANK
         BE       INIT2             YES GO GET NEXT CARD
         LW,R13   R15               SAVE FIELD TYPE
         CW,R13   REM               REM?
         BE       PLIM40            YES
         CW,13    DUMP              DOES USER WANT ERROR DUMP
         BE       PLIM60
         BAL,R9   SCAN              SCAN NEXT FIELD
         CW,R13   PAGES             PAGES?
         BE       PLIM30            YES
         CW,13    TBUF              IS THIS THE TBUF PARAM
         BE       PLIM20            YES
         CW,R13   DCBS              DCBS
         BNE      INIT3             NO. ERROR
         MTW,0    PFLG
         BGZ      EREAD
         MTW,1    PFLG
         LI,X4    2
         LB,X5    R15,X4            NUMBER OF DCBS LESS THAN 10
         CB,X5    BLANK            ONLY ONE DIGIT
         BE       PLIM15             DCBS LESS THAN 10
         CB,5     HF0               WAS IT F0
         BE       PLIM15            DCBS LESS THAN 10
         CB,5     =X'F1000000'          WAS IT A F1
         BE       PLIM13
         LI,X6    1                SYNTAX ERROR
         B        ERRTYP           PRINT ERROR MESSAGE
PLIM13   RES      0
         LW,X5    R15
         AND,X5   HF
         CI,X5    7
         BG       PLIM13-2
         LB,R15   DCBT,X5           GET A - H FROM TABLE
PLIM15   RES      0
         AND,R15  HFF
         LI,X5    39
         STB,R15  *WORK,X5          STORE DCB NUMBER IN COLUMN 40
         B        PLIM50
PLIM20   RES      0
         MTW,0    PFLG4             HAVE WE BEEN HERE BEFORE
         BGZ      EREAD             YES ERROR
         LI,4     1                 NUM OF BYTES TO MOVE
         LI,5     13                 POS INTO COM PAGE
         BAL,9    MOV               GO MOVE IT
         MTW,1    PFLG4              SET SW
         B        PLIM50            SEE NEXT FIELD IF ANY
PLIM30   RES      0
         MTW,0    PFLG1
         BGZ      EREAD
         LI,X4    3                 NUMBER OF BYTES TO MOVE
         LI,X5    40                BYTE DISPLACEMENT
         BAL,R9   MOV               GO MOVE
         MTW,1    PFLG1
         B        PLIM50            GO CHECK NEXT FIELD TYPE
PLIM40   RES      0
         MTW,0    PFLG2
         BGZ      EREAD
         LI,X4    C'R'              SET 'R'
         LI,X5    11                INTO COLUMN 12
         STB,X4   *WORK,X5         OF COMMAN PAGE
         MTW,1    PFLG2
         AI,3     1
         B        PLIM10
PLIM50   RES      0
         AI,X3    1                POINT TO NEXT CHARACTER
         B        PLIM10           GO CHECK NEXT FIELD TYPE
PLIM60   RES      0
         MTW,0    PFLG3             HAVE WE BEEN HERE BEFORE
         BGZ      EREAD
         LI,4     C'D'              D FOR DUMP IN POS 25
         LI,5     24
         STB,4    *WORK,5
         MTW,1    PFLG3
         AI,3     1
         B        PLIM10
*
*
         PAGE
*
*        PTRA SCANS THE '.TRAN' CARD FOR THE STARTING LOCATION
*        AND ALTERNATE VALUES TO BE PLACED IN THE TRANSLATION
*        TABLE.
*
PTRA     RES      0
         LI,X3    1
         CI,X1    6                IS THIS THE FIRST TRAN CARD
         BE       PTRA20           NO.
         STH,3    CCT01,3           SET TO INDICATE TRANS TABLE
         LI,X3    4                STARTING BYTE OF SCAN
PTRA20   RES      0
         BAL,R9   SCAN             SCAN STARTING POSITION
         CI,X2    1                END OF THIS CARD
         BE       PTRA70           YES.
         LI,X4    3                NUMBER OF DIGITS TO CONVERT
         BAL,R9   HCONV            GO CONVERT R15 TO HEX
         AI,X4    -1
         STW,X4   STRT             SAVE STARTING POSITION
         BAL,R9   SCAN             SCAN FOR LENGTH
         AI,X3    1                POINT TO ALTERNATE CHARACTER STRING
         LI,X4    3                NUMBER OF DIGITS TO CONVERT
         BAL,R9   HCONV            GO CONVERT R15 TO HEX
         CI,X4    255              GREATER THAN TRANS TABLE
         BG       PTRA35           YES. ISSUE ERROR
         STW,X4   CNT              SAVE NUMBER TO MOVE
         LW,X6    CDMV             ADDRESS OF CARD
         AW,X6    X3               POINT TO STRING
         LW,7     CPG1              BYTE TRANS TABLE ADDR
         AW,X7    STRT             POINT TO STARTING POSITION OF CHANGE
         STB,X4   X7               SET IN NUMBER TO MOVE
         AW,X4    STRT             CHECK TO INSURE THAT LENGTH +
         CI,4     256                DISPL DOESNT EXCEED TRANS TBL
         BG       PTRA35           YES IT DOES
         MBS,X6   0                ALTER TRANSLATION TABLE
         AW,X3    CNT              ADD DISPLACEMENT
         AI,X3    2                FOR SCAN
         B        PTRA20           GO CHECK THIS CARD FOR MORE
PTRA35   RES      0
         LI,7     0                   TRANS TABLE LOC ERROR ABORT
         B        SC5               ABORT
PTRA70   RES      0
         LI,X1    6                SET TO RETURN TO PTRA IF MORE CARDS
         B        INIT2
*
HCONV    RES      0
         LI,X7    0
         LI,X1    4                MAX NUMBER TO CONVERT
         SW,X1    X4               DISPLACEMENT OF DIGITS
HCONV10  RES      0
         LB,X4    R15,X1           LOAD DIGIT
         CI,X4    X'F0'            NUMERIC?
         BL       HCONV30          NO
HCONV20  RES      0
         AND,X4   HF               STRIP OFF HALF BYTE
         AW,X7    X4               ADD TO COUNTER
         CI,X1    3                ANY MORE
         BGE      HCONV25          YES.
         MI,X6    10               CONVERT TO HEX
         AI,X1    1                INCREMENT DISPLACEMENT
         B        HCONV10
HCONV25  RES      0
         LW,X4    X7               CONVERTED VALUE
         BEZ      HCONV30
         B        *R9              RETURN
HCONV30  RES      0
         CB,X4    BLANK            IS IT A BLANK
         BE       HCONV20          YES. CONTINUE PROCESSING
         LI,X6    1                SYNTAX ERROR
         B        ERRTYP
*
*
TRANSB   RES      0
         LI,X3    255
TRANS10  RES      0
         STB,3    *WORK1,3          BUILD STAND EBCDIC OLL SEQ
         MTW,-1   X3                SEQUENCE
         BGEZ     TRANS10
         B        *R9               RETURN
         PAGE
*
*        PKEY SCANS THE '.KEY' CARD FOR THE KEY INFORMATION.
*        THE NUMBER OF KEYS IS COUNTED AND INSERTED INTO THE
*        PARAMTER CARD LATER.
*
PKEY     RES      0
         LI,X3    1
         CI,X1    3                IS THIS THE FIRST KEY CARD
         BE       PKEY05           NO
         LI,3     4                 START BYTE OF SCAN FOR .KEYS
PKEY05   RES      0
         LI,X1    0                 SCAN COUNTER
         LI,X2    0
PKEY10   RES      0
         CI,X2    1                 RIGHT PAREN?
         BE       PKEY40            YES
         BAL,R9   SCAN              SCAN FIELD
         LW,R13   R15
         AND,R13  HFF              CHECK FIELD
         CI,R13   X'0F0'           FOR NUMERIC
         BL       PKEY50           NO.
         AI,X1    1                SET TO STARTING BYTE OR LENGTH
         CI,X1    2                LENGTH?
         BE       PKEY30           YES
         BG       INIT3             ONLY TWO NUMERIC FIELDS
         STW,R15  KFLD+1           SAVE STARTING BYTE
         B        PKEY10           GET NEXT FIELD
PKEY30   RES      0
         SLS,R15  8
         LI,4     X'40'
         OR,15    4                 TEMP STORE OF BLANK DIRECTION
         OR,R15   KFLD+2           PUT LENGTH WITH DIRECTION
         STW,R15  KFLD+2
         B        PKEY10
PKEY50   RES      0
         CW,R15   TRAN             TRANSLATION TABLE KEY?
         BE       PKEY60           YES.
         LI,4     1
         LH,4     15,4
         AND,4    =X'FFFF'
         CI,4     C'AN'
         BE       PKEY70
         CI,4     C'BN'
         BE       PKEY70
         CI,4     C'BA'
         BE       PKEY70
         CI,4     C'PD'
         BE       PKEY70
         CI,4     C'ZD'
         BE       PKEY70
         OR,R15   KFLD+2
         STW,R15  KFLD+2           SET DIRECTION INTO LENGTH WORD
         B        PKEY10           GET NEXT KEY
PKEY60   RES      0
         LI,R15   C'T'             SET 'T' INTO
         STB,R15  KFLD+3           TRANSLATION FIELD
         B        PKEY10           GET NEXT FIELD
PKEY70   RES      0
         CW,R15   CBA              TYPE ABSOLUTE BINARY?
         BNE      PKEY75           NO.
         LI,X4    C'A'
         STB,X4   KFLD+3           SET 'A' INTO TRANSLATION FLD
PKEY75   RES      0
         SLS,R15  -8               DROP LOW ORDER CHARACTER
         STW,R15  KFLD             SAVE IN TYPE FIELD
         B        PKEY10           GET NEXT FIELD
PKEY40   RES      0
         LI,X1    3                GET TYPE BYTE
         LI,X4    C'A'             DEFAULT TO ALPHANUMBERIC/ASCEND
         LB,X2    KFLD,X1          ZERO?
         BNEZ     PKEY42           NO
         STB,X4   KFLD,X1
PKEY42   RES      0
         LB,X2    KFLD+2,X1        IS DIRECTION ZERO?
         CI,2     X'40'
         BNE      PKEY45
         STB,X4   KFLD+2,X1        DEFAULT TO ASCENDING
PKEY45   RES      0
         LI,X4    10
         LW,X5    KDIS             KEY DISPLACEMENT
         AW,X5    X4               UPDATE KEY DISPLACEMENT
         STW,X5   KDIS
         LI,X6    BA(KFLD)          ADDRESS OF KEYS TO MOVE
         AI,X6    3                 DISPLACEMENT OF KEY IN TEMP STORE
         BAL,R9   MOV1             GO MOVE CARD TO COMMON PAGE
         LI,X4    0
         STW,X4   KFLD             RESET
         STW,X4   KFLD+1           TEMPORARY KEY FILED
         STW,X4   KFLD+2           TO ZERO
         STW,X4   KFLD+3
         LW,X2    X4               RESET KEY TERMINATER
         LW,X1    X4               RESET LENGTH/START FLAG
         LW,X4    KCNT
         AI,X4    1                UPDATE NUMBER OF KEYS FOR SORT
         STW,X4   KCNT
         LB,X4    CARD,X3          ANY MORE KEYS ON THIS CARD
         CB,X4    COMMA
         BE       PKEY47           YES
         LI,X1    3                CHECK FOR ANOTHER KEY CARD
         B        INIT2
PKEY47   RES      0
         AI,X3    1                POINT TO NEXT CHARACTER
         B        PKEY10           GET NEXT KEY THIS CARD
         PAGE
*
*        THIS ROUTINE MOVES THE STANDARD SORT PARAMETER CARD
*        TO A COMMON PAGE.  IT CHECKS THE NUMBER OF SORT
*        KEYS AND READS ANY ADDITIONAL CARDS NEEDED.
*
STDPAR   RES      0
         BAL,R9   STDMOV           MOVE FIRST CARD TO COMMON PAGE
         LI,X2    24               CHECK THE
         LH,R12   CARD,X2          NUMBER OF
         AND,R12  =X'FFFF'
         LI,R13   1                KEYS
         CW,R12   H4               MORE THAN 3 KEYS?
         BL       INIT53           NO. ONLY ONE CARD
         LI,X6    1                SET INDEX COUNTER
         CW,R12   H12              MORE THAN 11 KEYS?
         BL       STDPAR1          NO. ONLY TWO CARDS
         AI,X6    1                INCREMENT INDEX
STDPAR1  RES      0
         LI,X1    80               UPDATE COMMON
         AWM,1    CPG2               UP DATE
         BAL,R9   SPECRD           GET NEXT CARD
         LW,X7    CARD
         CW,X7    CEOD             EOD?
         BE       INIT53           YES.
         BAL,R9   SPECPT           NO. PRINT CARD
         BAL,R9   STDMOV           MOVE CARD TO COMMON PAGE
         BDR,X6   STDPAR1          LOOP BACK
         B        INIT53           FINISHED READING PARAMETER CARDS
STDMOV   RES      0
         LW,5     CPG2              CM PG ADDR FOR OLD CRD FMT
         LW,X4    CDMV             BYTE ADDRESS OF CARD
         LI,X3    80               80 CHARACTERS LENGTH
         STB,X3   X5
         MBS,X4   0                MOVE CARD TO COMMON PAGE
         B        *R9              RETURN TO CALLER
         PAGE
*
*        THIS ROUTINE OPENS THE N DCBS WHERE N IS THE NUMBER SPECIFIED
*        ON THE .LIMIT (DCBS,NN) CARD OR DEFAULTS TO EIGHT. IT ALSO
*        CHECKS THE DEVICE TYPE IN ORDER TO DETERMINE IF THE DISK SORT
*        CAN RUN.  ALL INTERMEDIATE FILES MUST BE ASSIGNED TO DISK/RAD
*        IN ORDER FOR DISK SORT TO BE CALLED.
*
CHDCB    RES      0
         LI,X4    39                CHECK NUMBER OF DCBS TO USE
         LB,X5    *WORK,X4
         CB,X5    BLANK
         BEZ      CH40              EQUAL TO BLANK
         CI,5     0
         BE       CH40              DEFAULT TO SIX
         CB,X5    HF0               GREATER THAN 9 - ABCDEFGH
         BL       CH30              YES.
         CB,X5    HDCB              BETWEEN 0 AND 3
         BL       CH50              OPEN 6, LET RSORT OR SSORT ABORT
         AND,X5   HF               NUMBER OF DCBS
         LW,X6    X5               BETWEEN 3 AND 9
         B        OPDCB
CH30     RES      0
         LI,X6    7
CH32     RES      0
         CB,X5    DCBT,X6           CHECK FOR ALPHA CHARACTERS
         BE       CH35              EQUAL
         BDR,X6   CH32              CHECK NEXT ONE
         CB,X5    DCBT              CHECK FOR 'A'
         BNE      CH50              OPEN 6, LET RSORT OR SSORT ABORT
CH35     RES      0
         AI,6     9
         B        OPDCB             GO OPEN DCBS
CH40     RES      0
         LI,5     X'F6'             6 IS NEW DEFAULT
         STB,X5   *WORK,X4          PARAMETER LIST
CH50     RES      0
         LI,6     6                  OPEN 6
         B        OPDCB             GO OPEN DCBS
*
         PAGE
*
ASW      DATA     0
*
OPDCB    RES      0
         LB,3     X'2B'
         SLS,3    -4
         CI,3     6                  UTS
         BL       OP04
         CI,3     7                 CPV
         BG       OP04
         CI,3     6                 UTS
         BE       OP04-1            YES SET TO 1
         LH,3     X'2B'             SEE VERSION NUMBER
         AND,3    =X'FF'
         CI,3     X'30'             CPV C00 OR LATER
         BL       OP04-1            PRE C00
         MTW,1    UTSCPVSW           SET TO 2, C00 OR LATER
         MTW,1    UTSCPVSW             SET ON UTS/CPV
OP04     RES      0
         MTW,0    UTSCPVSW
         BEZ      OP05
         LI,3     20
         B        %+2
OP05     RES      0
         LI,3     21                BUG IN BPM/BTM RSTORE NOT IN WRD 20
         LI,X5    0
OP10     RES      0
         LW,4     DCBADDR,5          GET DCB ADDR
         LW,X2    *X4              FOR TYPE DEVICE
         AND,X2   HF
         CI,X2    1                IS IT A FILE?
         BNE      OP15             NO.
         LW,2     *4,3              SEE RSTORE PARAM
         AND,2    =X'FFFF'
         BNEZ     OP20             YES
OP15     RES      0
         LI,X2    1                AT LEAST ONE DCB IS NOT A RANDOM FILE
         STW,X2   TFLG             SET TAPE SORT FLAG
         B        BSRT             GO CALL SORT
*
OP20     RES      0
         AI,5     1                  UP COUNTER FOR THIS DCB
         CW,X5    X6               ANY MORE DCB'S TO CHECK
         BL       OP10             YES.
*
*
         PAGE
BSRT     RES      0
*  BRANCH TO TAPE SORT OR DISK SORT
         LW,X7    FINOU            ADDRESS OF SORTIN/SORTOUT DCB'S
         LW,X6    WORK             COMMON PAGE ADDRESS
         OR,X6    PSET             SET BYTE 0 TO FF
         LI,R8    0
         LW,5     CCT01             SET SUBTR FLAG FOR SORTS TO CHECK
         LW,X4    TFLG             CHECK TYPE OF SORT TO CALL
         BEZ      RSORT             RANDOM
         B        SSORT             SEQN
*
         PAGE
*
*        THIS ROUTINE SAVES THE REQUIRED REGISTERS
*        WHEN SORT IS LINKED TO
*
SLINK    RES      0
         STW,X7   FINOU            ADDRESS OF SORTIN/SORTOUT DCBS
         STW,X6   WORK             SAVE COMMON PAGE ADDRESS
         STW,R8   LDTC+1           SET MONITORS ASSIGNED NAME OF
         STW,R9   LDTC+2           CALLING PROGRAM INTO LOAD AND TRANSF.
         LI,X5    0
         STW,5    CCT01             SET TO INDICATE SUBR CALLED
         B        INIT53           GO CHECK BLOCKING FACTORE
SC5      RES      0
         MTW,6    STEPCODE          SIGNAL ERROR TO USER
         LW,9     ERTBL1,7          GET CORRECT MESSAGE
         M:PRINT  (MESS,*9)
         M:SNAP   'DCBS',(F:SCRF1,F:SCRF17+56)
         B        FINALEND
         PAGE
ERRTYP   RES      0
         LW,R9    ERTBL,X6          ADDRESS OF ERROR MESSAGE
         M:PRINT  (MESS,*R9)
         B        INIT2
EREAD    RES      0
         LI,X6    1                SYNTAX ERROR
         B        ERRTYP
         END

