* CATALOG NO 704985-0    SIGMA 5/7 SORT           OVERLAY 0
*  VERSION C00
         SYSTEM   SIG7FDP
         SYSTEM   BPM
PGMSEG0  CSECT    0
*
         PAGE
*
         DEF      SCR1X,SIN21X,SIN122X,SIN2X,SIN24X
         DEF       SIN293X,SIN214X,SIN230X
         REF      F:SORTIN,F:SORTOUT
         REF      SCR2,CKDEC,SETCD10,SETCD43
         REF      GIL1,ALLBL,SIN121,SIN145,SIN24
         REF      SIN281,SIN2R
         REF      SIN295,SIN222,ER2
         REF      BCT0,CCT0
         REF      SORTSV
         REF      KTT0,STT0,HEDBUF
         REF      CNVRT,SEQLNG,SEQRCD
         REF      BNEBC,EBCBN
         REF      OUTLENSW
         REF      NUSO
         REF      ID2,IDR1,IDC
         REF      SC5,SIN27
         REF      CALLSW
         REF      NUMPGS
         REF      SIN1R
         REF      ENDSORT
         REF      SINTMP,RLKCM,DCBTABLE
         REF      BLKCTLSY          OUTPUT
         REF      BLKCTLSZ          INPUT
         REF      ANSISWIN          INPUT
         REF      ANSISWOU          OUTPUT
*
         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
R0       EQU      8
R1       EQU      9
R2       EQU      10
R3       EQU      11
R4       EQU      12
R5       EQU      13
R6       EQU      14
R7       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
R13      EQU      13
R14      EQU      14
PRAMLOC  EQU      SIN1R+1
BINEBC   EQU      BNEBC
SETCD4   EQU      SETCD10
*
*
         PAGE
         BOUND    8
DIGLIM   DATA,4   X'0'
         DATA,4   X'9'
*
SKLIM    DATA,4   X'10000'
         DATA,4   X'1060000'
HEDFLG   DATA     X'80000000'
ANSSW    DATA     0                 HOLD 1 IF USERS DCB IS ANS
*
*
*                                                                /VALUES
INCLS    DATA     0
KSRTC    DATA,4   51                KEY START
*
IDC2     BCR,0    ID2
SCR1X    RES      0
         LI,6     ENDP01
         STW,6    ENDSORT           DUMP  IN CASE OF ERROR
         LH,6     CALLSW            IS IT CALLED BY A SUBTRN
         BCS,X3    SCR2
         LW,X6    STT0               EXECUTE M:OPEN FOR INPUT
         LW,X7    SORTSV+6               AND OUTPUT FILES IF
         BCR,3    SCR2              BUT BYPASS IF NO DCB'S /SIG7-1035/*C4986
          LI,R0   F:SORTIN               THE SORT IS CALLED BY
         BAL,R1    INOPD                  A USER'S PROGRAM
         LI,R0    F:SORTOUT               (AS A SUBROUTINE)
         BAL,R1   INOPD
         STW,X7   SORTSV+6          OUTPUT LABEL ADDRESS IF ANY
         LB,9     *7                 USER LABEL SPEC
         BNEZ     SCR2
         LI,9     0                 CLEAR NO LABEL GIVEN
         STW,9    SORTSV+6          0 FOR OUT HDR/TRLR RTNS TO CHK
         B        SCR2              RETURN TO P0 MAIN
         PAGE
*  THIS REGION TESTS VALIDITY OF INPUT/OUTPUT FILE FORMAT
*                 (A PARAMETER REQUIRED FOR ALL FILES).
SIN21X   RES      0
         LI,X1    1
         LW,X5    F:SORTIN
         SLS,X5   28
         SLS,X5   -28
*        3=NON BLOCKABLE DEV, B=BLOCKABLE DEV, A=ANSI
         CI,X5    X'A'             ANSI
         BE       SINEAAA          YES
         B        SINED
SINEAAA  RES      0
         LW,X7    F:SORTIN+5
         SLS,7    +24
         SLS,7    -28               HAS BITS 24-27 IN BITS 28-31
         CI,7     1                 1 FOR ANSI FIXED
         BG       SINEA
         CI,X7    0
         BE       SINEC
         LI,7     3                 3 FOR ANSI FIXED IN SWITCH
         STW,7    ANSISWIN
         B        SINED             CHECK OUT TYPE
SINEA    CI,7     3                 3 FOR ANSI VAR
         BNE      SINEB
         LI,7     2                 2 FOR ANSI BLOCKED VAR
         STW,7    ANSISWIN
         LI,7     4                 4 FOR BLK-CTL-FIELD INPUT
         STW,7    BLKCTLSZ          (MAY BE CHANGED IF UTS GIVES IT)
         B        SINED
SINEB    CI,7     4                 4 FOR ANSI UNDEFINED
         BNE      SINEC
         LI,7     1                 1 FOR ANSI UNDEFINED
         STW,7    ANSISWIN
         B        SINED
SINEC    RES      0
         LI,7     18                MUST BE ANSI DECIMAL ERROR
         B        SC5               ABORT
SINED    LW,7     F:SORTOUT
         SLS,7    +28
         SLS,7    -28
         CI,7     X'A'               A FOR ANSI
         BNE      SINEI
         LW,7     F:SORTOUT+5              WORD 5 OUT DCB
         SLS,7    +24
         SLS,7    -28               HAS BITS 24-27 IN BITS 28-31
         CI,7     1                 1 FOR ANSI FIXED
         BG       SINEE
         CI,X7    0
         BE       SINEG
         LI,7     3                 3 FOR ANSI FIXED IN SWITCH
         STW,7    ANSISWOU
         B        SINEI
SINEE    CI,7     3                  3 FOR ANSI VAR
         BNE      SINEF
         LI,7     2                 2 FOR ANSI VAR IN SWITCH
         STW,7    ANSISWOU
         LI,7     4                 4 FOR BLK-CTL-FIELD-OUTPUT
         STW,7    BLKCTLSY          (MAY BE CHANGED IF UTS PASSES SIZE
         B        SINEI
SINEF    CI,7     4                 4 FOR ANSI UNDEFINED
         BNE      SINEG
         LI,7     1                 1 FOR ANSI UNDEFINED IN SWITCH
         STW,7    ANSISWOU
         B        SINEI
SINEG    RES      0
         LI,7     18                ERROR ABORT
         B        SC5
SINEI    RES      0
         BAL,R1   GIBLF            GET INPUT FILE BLK-FACTOR
         LI,5     3
         BAL,9    CKDEC             CHECK FOR VALID DIGITS
         BCR,0    SETCD5            BAD DIGIT
SINEK    RES      0
         BAL,9    GOBLF
         LI,5     3
         LI,7     X'FF'
         BAL,9    CKDEC             CHECK VALID DIGITS
         BCR,0    SETCD5             INVAL DIGIT IN OUT-BLK
         PAGE
*
*  THIS REGION TESTS THE VALIDITY OF THE FORWARD SPACE FILE PARAMETER
*                 (THIS IS AN OPTIONAL PARAMETER.)                     R
SIN12    LI,X5    25
         LI,X7    6                                                    R
         BAL,R1   ALLBL             TEST FOR BLANKITEM                 R
         BCR,0    SIN121
*
         BAL,R1   GFSP1             GO GET NUMBER TO FORWARD SPACE
         LI,X5    4                 COUNT       /FIRST FOUR DIGITS.
         BAL,R1   CKDEC             CHECK FOR ILLEGAL DECIMAL DIGITS
         BCR,0    SETCD6            INVALID DIGIT IN FORWARD SPACE FILE
         BAL,R1   GFSP2             GO GET LAST TWO DIGITS
         LI,X5    2
         BAL,R1   CKDEC
         BCR,0    SETCD6            INVALID DIGIT IN FORWARD SPACE FILE
*
         B        SIN121            RETURN TO P0
*                                                                      R
*  THIS REGION TESTS THE VALIDITY OF THE SLICE SIZE PARAMETER          R
*                 THIS IS AN OPTIONAL PARAMETER.                       R
SIN122X  LI,X5    14                                                   R
         LI,X7    6                                                    R
         BAL,R1   ALLBL             TEST FOR BLANK ITEM                R
         BCR,0    SIN14             YES: BYPASS TEST                   R
*                                                                      R
         BAL,R1   GSSP1             GO GET SLICE SIZE                  R
         LI,X5    4                 FIRST FOUR DIGITS                  R
         BAL,R1   CKDEC             CHECK FOR ILLEGAL DECIMAL DIGITS   R
         BCR,0    SETCD12           INVALID DIGIT IN SLICE SIZE        R
         BAL,R1   GSSP2             GET LAST TWO DIGITS                R
         LI,X5    2                                                    R
         BAL,R1   CKDEC                                                R
         BCR,0    SETCD12           INVALID DIGIT IN SLICE SIZE        R
*                                                                      R
         PAGE
         PAGE
*
*  THIS REGION TESTS THE VALIDITY OF THE OUTPUT FILE LOGICAL RECORD
*                 LENGTH. (THIS IS AN OPTIONAL PARAMETER.)             R
SIN14    LI,X5    35
         LI,X7    4                                                    R
         BAL,R1   ALLBL             TEST FOR BLANK ITEM                R
         BCR,0    SIN145            YES, BYPASS TEST
*
         BAL,R1   GOLRL             GET LOGICAL RECORD LENGTH
         LI,X5    4
         BAL,R1   CKDEC             CHECK FOR BALID DIGITS
         BCR,0    SETCD8            INVALID DIGIT IN OUTPUT LRL
         CI,6     1                 MIN ALLOWED SIZE
         BL       SETCD4
         B        SIN145            RETURN TO P0
*
*
*
*  THIS REGION SETS THE INPUT AND OUTPUT DCB ADDRESSES INTO BCT0
*       AND TESTS FILE TYPE.
*
SIN2X    RES      0
         LI,X6     DA(F:SORTIN)      ADDRESS OF INPUT DCB
         STH,X6   BCT0,X1
         LI,X5    DA(F:SORTOUT)      ADDRESS OF OUTPUT DCB
         STH,X5   BCT0
*
         PAGE
*
*  THIS REGION SETS USER FORMATTED INPUT FILE VALUES--BLOCKING
*       FACTOR, RECORD TYPE, AND READ DIRECTION.
*
         LI,X6    X'100'
         LW,X4    =C'UFV '          SET UP FOR OPEN INPUT FILE
         LB,X5    *PRAMLOC         GET FORMAT TYPE FROM PARAM
         CI,5     X'FA'             IS IT MANAGE
         BNE      SIN22X            NO CHECK FOR ANSI
         LW,4     =C'BFFM'           SET MANAGE FILE INDICATOR
         B        SIN23
SIN22X   LW,9     ANSISWIN
         CI,9     0                 NOT ANSI
         BE       SIN225
         LW,4     =C'BVAR'
         CI,9     2                  ANS BVAR
         BE       SIN23
         LW,4     =C'UFV '
         CI,9     3                 ANS FIXED
         BE       SIN224
         B        SIN23
SIN224   RES      0
         LW,4     =C'BFF '          BLOCKED ASSUME
         LI,6     0
         B        SIN23
SIN225   BAL,9    GIBLF             GET INPUT BLKING
         AND,6    =X'F0F0F00'
         CI,6     X'100'
         BLE      SIN229            DEFAULT TO 1
         LW,4     =C'BFF '
         B        SIN23
SIN229   RES      0
         LI,6     X'100'            DEFAULT TO 1 IF USER DIDNT SPECIFY
SIN23    STW,X4   BCT0+19           SAVE INPTU FILE OPEN PARAMETER
*
         SLS,X6   -8                SET INPUT FILE'S BLOCKING FACTOR
         STW,X6   CNVRT             RIGHT JUSTIFIED IN CNVRT
         BAL,R1   EBCBN             GO:  CONVERT EBCDIC TO BINARY
         LW,X6    CNVRT+1           INPUT BLOCKING FACTOR (BINARY)
         STW,X6   BCT0+18           INPUT BLOCKING FACTOR
*
         PAGE
*
*  THIS REGION SETS USER FORMATTED OUTPUT FILE VALUES.
*
         BAL,R1   GOBLF             GET OUTPUT FILE'S BLOCKING FACTOR
         SLS,X6   -8
         STW,X6   CNVRT             RIGHT JUSTIFIED IN CNVRT
         BAL,R1   EBCBN             GO:  CONVERT EBCDIC TO BINARY
         LW,X6    CNVRT+1           OUTPUT FILE'S BLOCKING FACTOR
         STW,X6   BCT0+17               AS A BINARY INTEGER
         LW,6     ANSISWOU           IS IT ANSI
         CI,6     0
         BE       SIN23Y            NOT ANSI
         CI,6     3                 ANSI FIXED
         BE       SIN24
         STW,1    BCT0+17           SET BLKING  TO 1,ANSI-UNDEF/VARBLK
         B        SIN24             RETURN TO P0
SIN23Y   RES      0
         LW,6     BCT0+17           WAS OUTPUT SPECIFIED
         CI,6     0
         BNEZ     SIN24             YES
         MTW,1    BCT0+17           NO SO DEFAULT TO 1
         B        SIN24             BACK TO P0
*
         PAGE
*
*  THIS REGION SETS ALL LOGICAL RECORD LENGTHS INTO BCT0.
*
*
SIN24X   RES      0
*
         LI,X5    38                IS THE OUTPUT FILE'S LOGICAL
         LB,R1    *PRAMLOC,X5           RECORD LENTH SPECIFIED
         CI,R1    C' '
         BE       SIN26            NO USE INPUT
         MTW,1    OUTLENSW          USER WANTS US TO USE OUT REC LEN
*
* CODE DELETED
         BAL,R1   GOLRL             GET OUTPUT REC LENGTH  /SIG7-1344/*D4985
         STW,X6   CNVRT                 LOGICAL RECORD LENGTH
         BAL,R1   EBCBN             GO:  CONVERT EBCDIC TO BINARY
         LW,X6    CNVRT+1
         LI,X7    0
         CW,X6    RLKCM
         BCR,1    SIN25B            NOT LESS               /SIG7-4622/*F4985
         LI,5     23                                       /SIG7-4622/*F4985
         LB,R1    *PRAMLOC,X5                              /SIG7-4622/*F4985
         CI,R1    'S'                IS SEQ CHK SPEC       /SIG7-4622/*F4985
         BCR,3    SIN25A                                   /SIG7-4622/*F4985
         BCR,0    SIN25B                                   /SIG7-4622/*F4985
* IF AT SIN25A, SEQ CHK IS SPECIFIED AND OUTPUT            /SIG7-4622/*F4985
* RECORD LENGTH IS LESS THAN INPUT                         /SIG7-4622/*F4985
* RECORD LENGTH. RLKCM WILL NOT HAVE THE OUTPUT            /SIG7-4622/*F4985
* RECORD LENGTH IN ALL OTHER CONDITIONS BECAUSE            /SIG7-4622/*F4985
* SIN33 WILL CAUSE A ABORT IF THE KEY IS                   /SIG7-4622/*F4985
* BEYOND OUTPUT RECORD LENGTH. SEE SIDR 1344.              /SIG7-4622/*F4985
SIN25A   STW,6    RLKCM                                    /SIG7-4622/*F4985
SIN25B   SLD,6    -2                                       /SIG7-4622/*F4985
         SLS,X7   -30
SIN26    STH,X6   BCT0+4,X1         SET INTO BCT0 FOR LATER USE
         STH,X7   BCT0+15,X1        OUTPUT BYTE INCREMENT
*
         PAGE
*
*  THIS REGION COMPUTES INPUT AND OUTPUT FILE BUFFER LENGTHS AND
*       SETS THEM INTO BCT0.
*
         LW,5     ANSISWOU          OUTPUT ANSI SW
         CI,5     0                 NOT ANSI
         BEZ      SIN26A
         LW,9     F:SORTOUT+3
         SLS,9    -19               TO  WORDS
         MTW,0    9                 IS BLKL SPEC, IF NOT USE CTL/CARD
         BEZ      SIN26A
         MTW,1    9                  UP ONE WORD
         STH,9    BCT0+2,1          STORE OUT BUFFER LENGTH
         B        SIN26B
SIN26A   SLS,6    2
         AW,6     7
         MTH,0    BCT0+17,1         WAS BLKING GIVEN ON .BLOCK          CTSRTP01
         BEZ      SETCD5A           NO SO GIVE MESSAGE                  CTSRTP01
         MH,6     BCT0+17,1         OUT REC LEN X OUT BLK FACTOR
         AI,7     3
         SLS,7    -2                TO WORDS
         STH,7    BCT0+2,1          OUTPUT FILES BUFFER LENGTH
SIN26B   LW,5     ANSISWIN           IN ANSI SW
         CI,5     0                 NOT ANSI
         BEZ      SIN26C
         LW,9     F:SORTIN+3
         SLS,9    -19               TO  WORDS
         MTW,0    9                 IS BLKL SPEC, IF NOT USE CTL/CARD
         BEZ      SIN26C
         MTW,1    9                  UP ONE WORD
         STH,9    BCT0+2            INPUT BLK SIZE (WORD)
         B        SIN26D
SIN26C   LH,6     BCT0+4             INPUT REC LENGTH
         SLS,X6   2
         AH,X6    BCT0+15
         MTH,0    BCT0+18,1         WAS BLKING GIVEN ON .BLOCK          CTSRTP01
         BEZ      SETCD5A           NO SO GIVE MESSAGE                  CTSRTP01
         MH,X6    BCT0+18,X1            TIMES INPUT BLOCKING FACTOR
         AI,X7    3
         SLS,X7   -2
         STH,X7   BCT0+2            INPUT BUFFER LENGTH
SIN26D   LH,6     BCT0+16
         BCR,X3   %+2               INTERMEDIATE RECORD BYTE
         MTH,1    BCT0+5                INCREMENT NOT NEEDED
         LI,X6    3
         LB,X6    BCT0+19,X6
         CI,X6    C'M'
         BNE      SIN26E
         LI,X6    512
         STH,X6   BCT0+2
         STH,X6   BCT0+2,X1
*
SIN26E   RES      0
         LH,6     CALLSW            IS IT CALLED BY A SUBTRN
         BNEZ     SIN27            NOT SUBRTN CALLED
         PAGE
*
*  THIS REGION SETS UP FOR KEY PARAMETER PROCESSING LATER.  IT
*       GENERATES THE STANDARD KTT0 TABLE.
*
         LI,X6    255
SIN27X   STB,X6   KTT0,X6           CREATE STANDARD TRANSLATION TABLE
         MTW,15   X6
         BCR,X1   SIN27X
         B        SIN27             RETURN TO P0
*
*
SIN293X  RES      0
         LI,X6    23
         LB,X7    *PRAMLOC,X6
         LW,X6    BCT0+11
         CI,X7    C'S'
         BCS,X3   SIN295
         LW,X7    SEQLNG
         AWM,X7   STT0
         SW,X6    SEQLNG
         STW,X6   BCT0+11
         B        SIN295            RETURN TO P0
         PAGE
*
*  THIS REGION SETS ALL OPTION INDICATORS TO REFLECT THE OPTIONS
*       REQUESTED IN THE SORT SPECIFICATIONS.
*
SIN214X  RES      0
SIN218   LI,X5    22
         LB,X7    *PRAMLOC,X5
SIN219   CI,X7    X'F0'             IS WORD = EBCDIC 0
         BE       SIN220
         OR,X6    =X'400000'       SET FLAG
*
SIN220   RES      0
         LI,X5    23
         LB,X7    *PRAMLOC,X5
         CI,X7    C'S'              IS SEQUENCE CHECK DESIRED
         BCR,X3   SIN221            YES
         AI,X6    X'10000'
SIN221   STW,X6   BCT0+8            SET OPTIONS INTO BCT0
         B        SIN222            RETURN TO P0
SIN230X  RES      0
         LW,X5    NUSO
         BEZ      SIN234               NO OWN CODE
         LW,X5    IDC2
         STW,X5   IDC               SET OWN CODE INDICATOR
SIN234   RES      0
         LI,X7    0
         LI,X5    12               INDEX
         LB,X5    *PRAMLOC,X5      SEE HEADER OPTION COL 13
         BEZ      SIN2B            ZERO
         CI,X5    X'40'            BLANK
         BE       SIN2B            EXIT
         CI,X5    X'C6'            IS IT 'F'
         BE       *SIN2R           YES EXIT
         CI,X5    X'F1'            IS IT NUMERIC
         BL       SIN23C           NO. ERROR
         CI,X5    X'F9'            IS IT BETWEEN 1 AND 9
         BG       SIN23C           NO. ABORT
         LI,X7    15               GET NUMBER
         AND,X7   X5               RECORDS TO SKIP
SIN2A    RES      0
         LI,X5    12
         STB,X7   *PRAMLOC,X5      SAVE NUMBER OF RECORDS
         B        *SIN2R
SIN2B    RES      0
         LW,X6    BCT0+8
         OR,X6    HEDFLG           SET HEADER FLAG TO NONE
         STW,X6   BCT0+8
         B        SIN2A
SIN23C   RES      0
         LI,X7    21               ERROR NOT BLANK,F,1-9
         B        SC5              GO ABORT
         BCR,0    *SIN2R            OUT OF THIS SUBROUTINE /SIG7-1345/*D4985
*                                                          /SIG7-1883/*D4985
* CODE DELETED
         PAGE
*
*  THIS ROUTINE TAKES USER SUPPLIED FILE PARAMETERS IN DCB FORMAT
*        AND CREATES A FILE PARAMETER TABLE FOR A M:DEVICE REQUEST.
*        AFTER EXECUTING THE M:DEVICE REQUEST, THIS ROUTINE BUILDS
*        A FILE PARAMETER TABLE FOR A M:OPEN REQUEST AND EXECUTES
*        IT.  THIS ROUTINE LEAVES THE DCB IN THE CLOSED STATE WHEN
*        IT EXITS.
*
*  ON ENTRY TO INOPD:
*        REGISTER:  6=THE WORD ADDRESS OF THE FPT
*                   7=THE WORD ADDRESS OF THE USER SUPPLIED DCB
*                   8=THE WORD ADDRESS OF THE SORT'S DCB
*                   9=THE RETURN ADDRESS
*
*  ON EXIT FROM INOPD:
*        REGISTER:  6=THE WORD ADDRESS OF THE END OF THE FPT+1
*                   7=THE WORD ADDRESS OF THE END OF THE CALLER'S DCB+1
*
         PAGE
*
*
INOPDR   DATA     0
*
INOPD    STW,R1   INOPDR            SAVE RETURN ADDRESS
*
         STW,R0   RE                SORT'S DCB
         STW,R0   INCLS
         OR,RE    =X'22000000'      M:DEVICE -MODE- CALL CODE
         LI,RF    0                 OPTION WORD OF FPT
         LI,13    X'F'              MASK
         AND,13   *7                DCB WORD 0
         CI,13    3                 DEV TYPE
         BNE      INOP3
         LI,RD    X'20000'          TEST:  IS THE USER SPECIFIED
         AND,RD   *X7                      MODE EBCDIC OR BINARY
         BCR,X3   INOP1             EBCDIC:
         AI,RF    X'10'             BINARY:  TURN ON BINARY SETTING
*
INOP1    LI,RD    X'4000'           TEST:  DID THE USER SPECIFY
         AND,RD   *X7                      FBCD FORMAT
         BCR,X3   INOP2             NO:
         AI,RF    X'20'             YES:  TURN ON FBCD SETTING
*
INOP2    LI,RD    X'200'            TEST:  DID THE USER SPECIFY
         AND,RD   *X7                      PACKED BINARY FORMAT
         BCS,X3   INOP3             YES:
         AI,RF    X'40'             NO:   TURN ON UNPACKED BINARY SETTING
*
INOP3    CAL1,1   RE                EXECUTE M:DEVICE DCB,MODE REQUEST
*
         OR,R0    =X'14000000'      M:OPEN REQUEST CODE
         STW,R0   *X6               STORE IN WORD 0 OF THE FPT
         STW,X6   RC
         AI,X6    1                 STEP FPT POINTER
         STW,X6   RA                SAVE ADDRESS OF FPT FLAG WORD
         AI,X6    1                 STEP FPT POINTER
         LI,8     X'3F8'               SET FLAGS 3-9 ON
         LI,2     X'F'
         AND,2    *7                SEE USERS DCB ASN
         CI,2     10                A FOR ANS
         BNE      INOP4
         MTW,1    ANSSW             FLAG FOR ANS
         OR,8     =X'10000000'       SET P4 ON
         LI,2     3
         LW,3     *7,2              GET BLKL
         SLS,3    -17
         STW,3    *6                STORE AS FIRST OPTION
         AI,6     1                 UP FPT POINTER
INOP4    RES      0
         LI,2     2
         LW,3     *7,2              GET NRA IN USERS DCB
         SLS,3    -24
         CI,3     0
         BEZ      INOP5              NOT GIVEN
         OR,8     =X'8000000'        SET P5 ON
         STW,3    *6                  STORE AS NEXT OPTION
         AI,6     1                 UP FPT POINTER
INOP5    RES      0
         MTW,0    ANSSW             IS IT ANS
         BEZ      INOP6
         OR,8     =X'4000000'       SET  P6 ON
         LI,2     5
         LW,3     *7,2               GET FMT
         AND,3    =X'F0'
         SLS,3    -4
         STW,3    *6                  STORE AS NEXT OPTION
         AI,6     1                 UP FPT POINTER
INOP6    RES      0
         LI,2     X'F'
         AND,2    *7
         CI,2     3
         BE       INOP61
         LI,2     20
         LB,3     *7,2
         AND,3    =X'C0'
         BEZ      INOP61             NO  FIL1 PARAM GIVEN
         OR,8     =X'400000'        P10 ON
         SLS,3    -6
         STW,3    *6                  STORE AS NEXT OPTION
         AI,6     1                 UP FPT POINTER
INOP61   RES      0
         OR,8     =X'40000'         SET  P14 ON
         LI,X3    1
         LB,2     X'2B'             MON FLAG               /SIG7-2171/*F4985
         SLS,2    -4                                       /SIG7-2171/*F4985
         CI,2     6                                        /SIG7-2171/*F4985
         BE       INOP10            UTS                    /SIG7-2171/*F4985
         CI,2     7                 IS IT CP-V
         BE       INOP10             YES
         LI,X2    X'FFFF'           GET USER DCB'S DSI
         AND,X2   *X7,X3
INOP65   AI,2     X'10000'
         STW,X2   *X6               STORE DSI PARAMETER
         AI,X6    1                 STEP FPT POINTER
         LI,2     X'F'              MASK
         AND,2    *7                GET USERS DCB  ASN
         MTW,0    ANSSW
         BEZ      INOP69
         LI,2     5                 SET F10-F12 ON FOR ANS
         OR,8     2
         B        INOP7
INOP69   RES      0
         OR,8     2                 SET F11-F12 ON
INOP7    RES      0
         MTW,0    ANSSW
         BEZ      INOP8
         AI,8     X'1000'           SET P20 ON
         LI,2     18
         LW,3     *7,2               GET USER LRCSZ
         SLS,3    -17
         STW,3    *6                STORE  NEXT PARAM
         AI,6     1                  UP FPT POINTER
*
INOP8    STW,R0   *RA               STORE FPT FLAGS
         LB,X3    *X7               GET USER DCB TOTAL WORDS (TTL)
         AW,X3    X7                END LOCATION OF DCB+1
         AI,X7    22                LENGTH OF FIXED PORTION
         SW,X7    X3                LENGTH OF VARIABLE PARAMETERS AS A
         SW,X6    X7                END OF M:OPEN FPT  /NEGATIVE INTEGER
*
INOP9    LW,X2    *X3,X7
         STW,X2   *X6,X7
         BIR,X7   INOP9
         STW,X3   X7
*
         CAL1,1   *RC               EXECUTE M:OPEN REQUEST
*
         M:CLOSE  *INCLS,(PTL)      POSIT AT LABEL         /SIG7-1069/*C4986
         LI,3     0
         STW,3    ANSSW             SET OFF
*
         BCR,0    *INOPDR
*
INOP10   RES      0
         LI,2     X'F'              MASK
         AND,2    *7                WHAT IS DEVICE TYPE
         CI,2     1                 IS IT A FILE
         BNE      INOP10A           NO
         LW,2     =X'00400000'      SEE BIT 9 FCI WORD 0                CTSRTP01
         AND,2    *7                                                    CTSRTP01
         CI,2     0                                                     CTSRTP01
         BE       INOP12            NOT ON                              CTSRTP01
         LI,3     5                 INDEX
         LI,2     X'7F00'           MASK
         AND,2    *7,3              GET RNDEV
         B        INOP65+1
INOP10A  RES      0
         LW,2     =X'00400000'        SEE BIT 9 FCI WORD 0
         AND,2    *7
         CI,2     0
         BE       INOP12            BIT 9 OFF NEVER OPENED
         LI,2     X'10000'          CHECK BIT 15
         AND,2    *7,3              WORD 1 OF DCB
         CI,2     0
         BNE      INOP11
         LI,2     X'7F00'           GET BITS 17-23
         AND,2    *7,3
         OR,2     =X'00018000'          SET BITS 15/16 ON
         B        INOP65+1
*
* CODE DELETED
INOP11   LI,2     X'FFFF'
         AND,2    *7,3              GET TEXT FROM 16-31
         B        INOP65+1
*
INOP12   RES      0
         LI,2     X'10000'
         EOR,2    *7,3
         STW,2    INOP13            SAVE REVERSED BIT 15
         LI,2     X'FFFF'
         AND,2    *7,3              GET R HALF WRD 1 ONLY
         OR,2     INOP13             BRING IN ON OR OFF BIT 15
         B        INOP65+1
*
INOP13   DATA     0                 HOLD COMPLEMENTED BIT 15
         PAGE
*
GIBLF    LI,X5    1                 GET INPUT FILE'S BLOCKING FACTOR
         LW,X6    *PRAMLOC,X5           LEFT JUSTIFIED INTO X6
         SLS,X6   8
         BCR,0    *R1
*
GOBLF    LI,X5    2                 GET OUTPUT FILE'S BLOCKING FACTOR
         LW,X6    =X'FFFFFF00'          LEFT JUSTIFIED INTO X6
         AND,X6   *PRAMLOC,X5
         BCR,0    *R1
*
GFSP1    LI,X5    6                 GET FIRST 4 CHARS OF FORWARD SPACE
         LW,X6    *PRAMLOC,X5       FILE PARAMETER INTO X6
         AI,X5    1
         BCR,0    GIL1
*
GFSP2    LI,X5    7                 GET LAST 2 CHARACTERS OF FORWARD
         LW,X6    *PRAMLOC,X5       SPACE FILE PARAMETER LEFT
         SLS,6    8                 GET COL 30-31 LEFT JUST/SIG7-6404/*F4985
         AND,X6   =X'FFFF0000'          JUSTIFIED INTO X6
         BCR,0    *R1
*
GSSP1    LI,X5    3                 GET FRIST TWO CHARS OF             R
         LW,X6    *PRAMLOC,X5       SLICE SIZE PARAM INTO X6           R
         LI,X5    4                                                    R
         LW,X7    *PRAMLOC,X5                                          R
         SLD,X6   16                                                   R
         BCR,0    *R1                                                  R
*                                                                      R
GSSP2    LI,X5    4                 GET LAST FOUR CHARS OF             R
         LW,X6    *PRAMLOC,X5       SLICE SIZE PARAM INTO X6           R
         SLS,X6   16                                                   R
         BCR,0  *R1                                                    R
*                                                                      R
GSL1     RES      0
         AI,X5    1
         LW,X7    *PRAMLOC,X5
         SLD,X6   24
         B        *R1
*
GOLRL    LI,X5    8                 GET OUTPUT FILE'S LOGICAL
         LW,X6    *PRAMLOC,X5           RECORD LENGTH INTO X6
         BCR,0    GSL1
*
         PAGE
*                 ILLEGAL DECIMAL DIGIT IN INPUT/OUTPUT BLOCKING FACTOR
SETCD5   LI,RF    X'5'
         BAL,R2   ER2
         LI,R1    SIN12
         BCR,0    SIN12
SETCD5A  RES      0                                                     CTSRTP01
         LI,15    X'5'              INDEX FOR MSG                       CTSRTP01
         BAL,10   ER2               PRINT MSG                           CTSRTP01
         B        SIN26D                                                CTSRTP01
*                 ILLEGAL DECIMAL DIGIT IN FORWARD SPACE FILE
SETCD6   LI,RF    X'6'
         BAL,R2   ER2
         LI,9     SIN121
         BCR,0    SIN121
         BCR,0    SIN122X                                              R
*                 ILLEGAL DECIMAL DIGIT IN OUTPUT LOGICAL RECORD LENGTH
SETCD8   LI,RF    X'8'
         BAL,R2   ER2
         AI,R1    1
         BCR,0    *R1
*                 ILLEGAL DECIMAL DIGIT IN SLICE SIZE.                 R
SETCD12  LI,RF    X'13'                                                R
         BAL,R2   ER2                                                  R
         LI,R1    SIN14                                                R
ENDP01   RES      0
         BCR,0    SIN14                                                R
         PAGE
*
         END

