***********************************************************************
*M*      ASSGR    PROCESSES THE ASSIGN AND XEQ CONTROL COMMANDS
***********************************************************************
*P*
*P*      NAME:    ASSGR
*P*
*P*      PURPOSE: TO PROCESS THE ASSIGN AND XEQ CONTROL COMMANDS
*P*
*P*      DESCRIPTION: SEE FUNCTION PREAMBLES FOR ASSGR AND XEQR ROUTINES.
*P*
*P*      REFERENCE: BATCH PROCESSING REFERENCE MANUAL
*P*                 DATA BASE TECHNICAL MANUAL
*P*
         SYSTEM   SIG7FDP
         SYSTEM   BPM
*
       PAGE
*                 SYMBOLIC REGISTER DEF'S.
R0       EQU      0
R1       EQU      1
R2       EQU      2
R3       EQU      3
R4       EQU      4
R5       EQU      5
R6       EQU      6
R7       EQU      7
SR1      EQU      8
SR2      EQU      9
SR3      EQU      10
SR4      EQU      11
D1       EQU      12
D2       EQU      13
D3       EQU      14
D4       EQU      15
         PAGE
*                 CHANGE STACK POINTER AMOUNT SPEC. BY 1ST ARGUMENT.
*                 SECOND ARGUMENT SPEC. AVAILABLE REGISTER.
BUMP     CNAME
         PROC
LF       LI,AF(2) AF(1)
         MSP,AF(2)  TSTACK
         PEND
*                 PUSH OR PULL N WORDS SPECIFIED BY 1ST ARGUMENT INTO
*                 REG'S STARTING AT 2ND ARGUMENT.
PUSH     CNAME    X'9',X'B'
PULL     CNAME    X'8',X'A'
         PROC
         DO       NUM(AF)=1
LF       GEN,1,7,4,3,17 0,NAME(1),AF(1),0,TSTACK
         ELSE
         DO       AF(1)=1
LF       GEN,1,7,4,3,17  0,NAME(1),AF(2),0,TSTACK
         ELSE
         DO       AF(1)=16
LF       LCI      0
         ELSE
LF       LCI      AF(1)
         FIN
         GEN,1,7,4,3,17  0,NAME(2),AF(2),0,TSTACK
         FIN
         FIN
         PEND
         PAGE                      *
         DEF      ASSGR             ENTRY POINT TO MODULE FOR
*,*                                 PROCESSING THE ASSIGN COMMAND
         DEF      XEQR              ENTRY POINT TO MODULE FOR PROCESSING
*,*                                 THE XEQ COMMAND.
         DEF      ASSG              START OF PROCEDURE ADDRESS
         DEF      FLISTPPI          EQU; OFFSET INTO OPEN PRIME PLIST
*,*                                 (WORD 2)
         DEF      LOUTSN3           GET SERIAL NUMBER FROM COMMAND AND
*,*                                 MOVE TO OPEN PRIME PLIST
         REF      TSTACK            INPUT/OUTPUT; PRESERVE REGISTERS
         REF      M:X1              INPUT; DECLARE TEMPORARY FILE WHEN
*,*                                 M:GO SPECIFIED ON ASSIGN
         REF      BLANK             INPUT; DETERMINE LENGTH OF DCB NAME
*,*                                 TO BE SAVED
         REF      J:ASSIGN          OUTPUT; BIT 22; ASSIGN-MERGE RECORD
*,*                                 HAS BEEN WRITTEN
         REF      Y8                CONSTANT
         REF      Y4                CONSTANT
         REF      Y2                CONSTANT
         REF      Y1                CONSTANT
         REF      Y08               CONSTANT
         REF      Y04               CONSTANT
         REF      Y02               CONSTANT
         REF      Y01               CONSTANT
         REF      Y008              CONSTANT
         REF      Y004              CONSTANT
         REF      Y002              CONSTANT
         REF      Y001              CONSTANT
         REF      Y0008             CONSTANT
         REF      Y0004             CONSTANT
         REF      Y0002             CONSTANT
         REF      Y0001             CONSTANT
         REF      Y14               CONSTANT
         REF      YFFFF             CONSTANT
         REF      XFFFF             CONSTANT
         REF      XFF               CONSTANT
         REF      X1000             CONSTANT
         REF      X200020           CONSTANT
         REF      X100010           CONSTANT
         REF      X80008            CONSTANT
         REF      X40004            CONSTANT
         REF      X20002            CONSTANT
         REF      X10001            CONSTANT
         REF      X8000             CONSTANT
         REF      X4000             CONSTANT
         REF      X1                CONSTANT
         REF      X2                CONSTANT
         REF      X3                CONSTANT
         REF      Y07               CONSTANT
         REF      Y05               CONSTANT
         REF      Y06               CONSTANT
         REF      X202              CONSTANT
         REF      X2000202          CONSTANT
         REF      X3000202          CONSTANT
         REF      X4000202          CONSTANT
         REF      M:LL              INPUT; DCB ADDRESS FOR PLIST
         REF      M:C               INPUT; DCB ADDRESS FOR PLIST
         REF      M:BI              INPUT; DCB ADDRESS FOR PLIST
         REF      M:LO              INPUT; DCB ADDRESS FOR PLIST
         REF      F:CF              INPUT; DCB ADDRESS FOR PLIST
         REF      SCCLF             SET CONTROL COMMAND LIST FLAGS
*,*                                 FOR LL DEVICE
         REF      WDTBLSRH          SEARCH TABLE OF LEGAL ASSIGN
*,*                                 KEYWORDS
         REF      GETDECVAL         GET VALUE ASSOCIATED WITH KEYWORD
*,*                                 ON CONTROL COMMAND
         REF      EOCCSCAN          SCAN TO END OF CONTROL COMMAND AND
*,*                                 LIST
         REF      CHSTSHFT          CONVERT TEXT STRING TO TEXTC
         REF      GETSN             GET SERIAL NUMBER FROM CONTROL
*,*                                 COMMAND
         REF      GETPASSW          GET PASSWORD FROM CONTROL COMMAND
         REF      CALENDTE          GET EXPIRATION DATE FROM
*,*                                 CONTROL COMMAND
         REF      GETACCN           GET ACCOUNT FROM CONTROL COMMAND
         REF      CJOB              INPUT; JIT ADDRESS
         REF      BLNKOUTFLG        EQU; OUTPUT; BIT 1; SET TO INDICATE
*,*                                 PASSWORD IN BUFFER TO BE BLANKED OUT
         REF      NAMSCAN           GET NAME FROM CONTROL COMMAND
         REF      DECSCAN           GET DECIMAL VALUE FROM CONTROL
*,*                                 COMMAND
         REF      CHARSCAN          GET NEXT ACTIVE CHARACTER FROM
*,*                                 CONTROL COMMAND AND COMPARE
         REF      QUOTSCAN          GET KEYWORD FROM CONTROL COMMAND
         REF      NXACTCHR          GET NEXT ACTIVE CHARACTER FROM
*,*                                 CONTROL COMMAND
         REF      CHKTERM           DETERMINE IF CONTROL COMMAND
*,*                                 TERMINATOR LEGAL
*,*                                 LEGAL
         REF      WRCFM             OUTPUT; WRITE COMMAND FILE MESSAGE
         REF      FTRMDM            OUTPUT; EXECUTE FILE NAME AND RECORD
*,*                                 NUMBER
         REF      FEXECM            OUTPUT; EXECUTE FILE NAME AND RECORD
*,*                                 NUMBER INTO MESSAGE
         REF      OPNXS             DETERMINE IF COMMAND FILE EXISTS
*,*                                 AND SKIP TO SPECIFIED RECORD
         REF      J:JIT             INPUT/OUTPUT; USER INFORMATION
         REF      :AMHED            INPUT; EQU; OFFSET INTO ASSIGN-MERGE
*,*                                 RECORD HEAD
         REF      AM:ORG            INPUT; EQU; POINTER TO AVAILABLE
*,*                                 SPACE IN A-M
         REF      AM:LNK            INPUT; EQU; LINK TO FIRST PLIST ENTRY
         REF      AM:END            INPUT; EQU; MAX. DISPLACEMENT FOR
*,*                                 PLIST
         REF      CCLFLAGS          OUTPUT FLAG
*,*                                 BIT 23-PREVENT OR ALLOW LISTING OF
*,*                                 CONTROL COMMANDS
         REF      OPERR             ERROR CODE CONSTANT
         REF      OPNERCD           ERROR CODE CONSTANT
         REF      CCBEF             OUTPUT; BIT 8; SET CONTROL
*,*                                 COMMAND BUFFER FULL FLAG IN JIT
         REF      CCREAD            READ NEXT CONTROL COMMAND
         REF      CSL               INPUT; EQU; CHECK LENGTH OF
*,*                                 CHARACTER STRING SCANNED
         REF      PLB               INPUT; EQU; BUFFER CONTAINING MOST
*,*                                 RECENT CHARACTER STRING SCANNED
         REF      FLAGS             OUTPUT; OFFSET INTO PARAMETER TABLE
*,*                                 FOR SETTING/RESETTING F2 FLAGS (BIT 1)
         REF      IDCBNAM           ERROR CODE CONSTANT
         REF      SDCBNA            ERROR CODE CONSTANT
         REF      ILLASGCD          ERROR CODE CONSTANT
         REF      BLNKERCD          ERROR CODE CONSTANT
         REF      COMERCD           ERROR CODE CONSTANT
         REF      VALERCD           ERROR CODE CONSTANT
         REF      LPERCD            ERROR CODE CONSTANT
         REF      RPERCD            ERROR CODE CONSTANT
         REF      CHSTERCD          ERROR CODE CONSTANT
         REF      NAMERCD           ERROR CODE CONSTANT
         REF      KWERCD            ERROR CODE CONSTANT
         REF      DUPERCD           ERROR CODE CONSTANT
         REF      DVERCD            ERROR CODE CONSTANT
         REF      BIGERCD           ERROR CODE CONSTANT
         REF      OUTERCD           ERROR CODE CONSTANT
         REF      PARAMCD           ERROR CODE CONSTANT
         REF      CFEXAM            ERROR MESSAGE
         REF      AM:CNAME          OUTPUT; FILE NAME STORED IN A/M RECD
         REF      AM:CACCT          OUTPUT; ACCOUNT STORED IN A/M RECD
         REF      AM:CPASS          OUTPUT; PASSWORD STORED IN A/M RECD
         REF      AM:CREC           OUTPUT; RECORD STORED IN A/M RECD
         REF      MXEXECCD          ERROR CODE CONSTANT
         REF      NOPGERR           ERROR CODE CONSTANT
         REF      Y15               CONSTANT
         REF      XF                CONSTANT
         REF      Y00FF             CONSTANT
         REF      CPPO              OUTPUT; BIT5 15-31; RESET FILE
*,*                                 EXTENSION BITS IN JIT
         REF      SIXPACK           HASH SERIAL NUMBER FROM CONTROL
*,*                                 CPMMAND
         REF      ANYSCAN           SCAN CONTROL COMMAND FOR ANS TAPE
*,*                                 LABEL
         REF      WAMR              WRITE ASSIGN-MERGE RECORD
         REF      RAMR              READ ASSIGN-MERGE RECORD
         REF      CCP               EQU; DECREMENT CURRENT CHARACTER
*,*                                 POINTER IN PARAMETER TABLE
         REF      J:ACCN            INPUT; DEFAULT ACCOUNT IF NONE
*,*                                 SPECIFIED FOR FILE/TAPES
*,*                                 AND LABEL
         REF      CCLFM             OUTPUT; BIT 23; DON'T LIST CONTROL
*,*                                 COMMAND
         REF      CCLIST            LIST OX CONTROL COMMAND
         SPACE    3
         CSECT        1
ASSG     EQU      %
TXASSI   TEXT     'ASSI'
         BOUND    8
TXMOC    RES      0
         DATA,4   X'04D47AD6'
         DATA,4   X'C3000000'
TXMLL    RES      0
         DATA,4   X'04D47AD3'
         DATA,4   X'D3000000'
TXMGO    RES      0
         DATA,4   X'04D47AC7'
         DATA,4   X'D6000000'
TXMC     RES      0
         TEXTC    'M:C'
         DATA,4   0
TXMBI    RES      0
         DATA,4   X'04D47AC2'
         DATA,4   X'C9000000'
TXMLO    RES      0
         DATA,4   X'04D47AD3'
         DATA,4   X'D6000000'
TXMAST   RES      0
         TEXTC    'M:*'
         DATA,4   0
TXMEQU   RES      0
         TEXTC    'M:='
         DATA,4   0
TXFCF    RES      0
         DATA,4   X'04C67AC3'
         DATA,4   X'C6000000'
         SPACE    3
TXTALL   TEXTC    'ALL'
TXTNONE  TEXTC    'NONE'
TXTSHARE TEXT     'SHAR'
TXTEXCL  TEXT     'EXCL'
         SPACE    3
GETPAGE  DATA     X'08000001'
FREEPAGE DATA     X'09000001'
D100     DATA     X'0000C4D7'       'DP'
D101     DATA     X'0000C4D7'       'SP'
         PAGE
K0       EQU      0
K1       EQU      1
K2       EQU      2
K3       EQU      3
K4       EQU      4
K8       EQU      8
KB       EQU      X'B'
K40      EQU      X'40'
K80      EQU      X'80'
K100     EQU      X'100'
K200     EQU      X'200'
K300     EQU      X'300'
K320     EQU      X'320'
K640     EQU      X'640'
K641     EQU      X'641'
K8000    EQU      X'8000'
KF0F0    EQU      X'F0F0'
KFC67A   EQU      X'FC67A'
KN2      EQU      -2
KBLANK   EQU      ' '
KCOMMA   EQU      ','
KLPAREN  EQU      '('
KRPAREN  EQU      ')'
CFESIZE  EQU      8                 SIZE OF COMMAND FILE ENTRIES
         PAGE
*F*
*F*      NAME:    ASSGR
*F*
*F*      PURPOSE: TO PROCESS THE ASSIGN CONTROL COMMAND AND CREATE AN
*F*               ENTRY IN THE ASSIGN-MERGE RECORD FOR THE SPECIFIED DCB.
*F*
*F*      DESCRIPTION: ASSGR IS CALLED WHENEVER AN ASSIGN CONTROL
*F*               COMMAND IS ENCOUNTERED. THE COMMAND IS PROCESSED
*F*               AND OUTPUT ON THE LL DEVICE. AN ASSIGN PLIST IS
*F*               CONSTRUCTED FROM THE PARAMETERS ON THE COMMAND AND IS
*F*               MERGED WITH THE ASSIGN-MERGE RECORD. UPON COMPLETITION
*F*               OF PROCESSING THE ASSIGN COMMAND(S), THE ASSIGN-MERGE
*F*               RECORD IS WRITTEN TO RAD AND CONTROL IS RETURNED TO
*F*               CCIR.
*F*
*F*      REFERENCE: BATCH PROCESSING REFERENCE MANUAL
*F*                 DATA BASE TECHNICAL MANUAL
*F*
**********************************************************************
*        ASSGR    ASSIGN CONTROL COMMAND PROCESSOR                   *
*                                                                    *
*                 PROCESSES THE INFORMATION  AND PUTS IN PLIST. IF   *
*                 ERROR IS ENCOUNTERED, RUN STATUS IS SET FOR ABORT  *
*                 IF SYS DCB, THE DCB IS CLOSE AND ASSIGN INFO.      *
*                 IS MERGE WITH THE DCB. IF USER DCB, PLIST          *
*                 IS WRITTEN ON DISC IN FILE   *IDA                  *
*                                                                    *
*        ENTER WITH                                                  *
*                 (R5) = JIT  POINTER                                *
*                 (R7) = CC PARAM LIST POINTER                       *
*                 (SR1) = CUR CHAR                                   *
*                                                                    *
************************************************************************
         PAGE                      *
**FORMAT OF PAGE IN WHICH THE OPEN PRIME PLIST IS BUILT.
**PAGE GOTTEN AFTER ASSGR.
**R6 CONTAINS POINTER TO TOP OF PAGE.
**                                 *AA. HEADER OF A/M ENTRY
DCBNAME  EQU      1                *  DCB NAME IN TEXTC FORMAT
**                                 *A. BASIC PLIST
**                                 *   A.1 HEADER OF BASIC PLIST
OPENLIST EQU      9                *
CYLPPI    DATA X'200000'
NOSEPPPI  DATA X'400000'
FLISTPPI EQU      10               *F FLAGS -- IF FLAG IS PRESENT.
VPARMPNT EQU      FLISTPPI        *     FOR EXT REF TO F FLAGS
VBLFFI     EQU    X4000            *  VBL LENGTH PARAMETERS PRESENT
DEVICEFFI  EQU    X1000            *  DEVICE ORIENTED FPT PRESENT
DEV2FFI  EQU      X3               *
LABELFFI   EQU       X2            *  FILE IS A LABEL TYPE
FILEFFI    EQU       X1            *  FILE IS A FILE TYPE
PLISTPPI EQU      11               *P FLAGS -- PRESENCE OF WRDS IN BODY
RECLPPI    EQU    Y1               *  RECLPARM PRESENT IF 1
TRIESPPI   EQU    Y08              *  TRIES PRESENT IF 1
ORGPPI     EQU    Y04              *  ETC.
ACCESSPPI  EQU    Y02              *
FUNPPI     EQU    Y01              *
FFILEPPI   EQU    Y004             *
KEYMPPI    EQU    Y0008            *
DEVICEPPI  EQU    Y0004            *
VOLPPI     EQU    Y0001            *
SLIDPPI  EQU X8000
SPARPPI   EQU X4000
RSTORPPI EQU X1000
DSFPPI   EQU      X'800'
CCFPPI   EQU      X'400'
**                                 *   A.2 BODY OF BASIC PLIST
P        EQU      11               *PARAMETERS FOR ASSIGN OPTIONS:
RECLPARM   EQU    P+4              *  RECL
TRIESPARM  EQU    P+5              *  TRIES
ORGPARM    EQU    P+6              *  CONSEC(1),KEYED(2)
ACSPARM    EQU    P+7              *  SEQUEN(1),DIRECT(2)
FUNCPARM   EQU    P+8              *  IN(1),OUT(2),INOUT(4),OUTIN(8)
FFILEPARM  EQU    P+10             *  REL(1),SAVE(2)
KEYMPARM   EQU    P+13             *  KEYM
DEVICEPARM EQU    P+14             *  DEVICE
VOLPARM    EQU    P+16             *  VOL
SLIDPARM   EQU P+17          SLIDE=BYTE 2, CONSEC=BYTE 3
SPARPARM   EQU P+18              SPATE VALUE
RSTRPARM EQU P+20            RSTORE VALUE
DSFPARM  EQU      P+21              *DENSITY SELECTION FLAG
CCFPARM  EQU      P+22              *CORE CONVERSION FLAG
**                                 *B. VARIABLE LENGTH PARAMETERS
**                                 *FIRST WORD OF EACH PARAMETER HAS
**                                 *THE FORMAT:
**                                 *  BYTE 1: ENTRY NO.
**                                 *  BYTE 2: 1 IF LAST ENTRY
**                                 *  BYTE 3: NO. OF SIGNIFICANT WORDS
**                                 *  BYTE 4: NO. OF ACTUAL WORDS
E        EQU      P+23
NAMEPARM   EQU    E                *ENTRY 1: LENGTH BYTE FOLLOWED BY
**                                 *  NAME FROM FILE OR LABEL OPTION.
ACCPARM    EQU    E+9              *ENTRY 2: 2 WRD ACCOUNT NAME FROM
**                                 *  FILE OR LABEL OPTION
PASSPARM   EQU    E+12             *ENTRY 3: 2 WORD PASSWORD FROM
**                                 *  PASS OPTION
EXPIPARM EQU      E+15             *ENTRY 4: 2 WORD EXPIRATION DATE
**                                 *  EITHER MMDD YY OR NEVER
READPARM EQU      E+18             *ENTRY 5: UP TO 8 2-WORD ACCOUNT
**                                 *  NAMES FROM READ OPTION
WRITEPARM  EQU    E+35             *ENTRY 6: UP TO 8 2-WORD ACCOUNT
**                                 *  NAMES FROM WRITE OPTION
INSNPARM   EQU    E+52             *ENTRY 7: UP TO 50 REEL NUMBERS
**                                 *  FROM INSN OPTION
OUTSNPARM EQU     E+153            *ENTRY 8: UP TO 50 REEL NUMBERS
**                                 *  FROM OUTSN OPTION
EXECPARM EQU      E+254             *ENTRY 14: UP TO 8 2-WORD EXECUTE
**                                  * ACCOUNT NAMES FROM EXECUTE OPTION
UNDEPARM EQU      E+271             *ENTRY 15: 3 WORD EXECUTE VEHICLE
**                                  *  FROM UNDER OPTION
**                                 *  FROM CATALOG OPTION.
**                                 *C. DEVICE ORIENTED PLIST
**                                 *  C.1 HEADER
QLISTPPI EQU      E+275             *Q FLAGS -- PRESENCE OF DEVICE WORDS
TABPPI   EQU      Y8               *
SEQIDPPI EQU      Y4               *  SEQIDPARM PRESENT IF 1 ETC.
DATAPPI  EQU      Y2               *
COUNTPPI EQU      Y1               *
LINESPPI EQU      Y04              *
SPACEPPI EQU      Y02              *
BITSPPI  EQU      Y01              *
**                                 *   C.2 BODY
**                                 *PARAMETERS FOR ASSIGN OPTIONS
TABPARM  EQU      QLISTPPI+1       *  TAB
Q        EQU      TABPARM+2        *
SEQIDPARM  EQU    Q+2              *  SEQ WITH ID PRESENT
DATAPARM   EQU    Q+3              *  DATA
COUNTPARM  EQU    Q+4              *  COUNT
LINESPARM  EQU    Q+6              *  LINES
SPACEPARM  EQU    Q+7              *  SPACE
BITSPARM   EQU    Q+8              *  OTHER DEVICE ORIENTED OPTIONS
**                                 *OPTIONS THAT GO IN BITSPARM:
BINVAL     EQU      X200020        *  BIN
BCDVAL     EQU    Y002             *  BCD
PACKVAL    EQU      X100010        *  PACK
UNPACKVAL  EQU    Y001             *  UNPACK
SEQVAL     EQU       X80008        *  SEQ
FBCDVAL    EQU       X40004        *  FBCD
NOFBCVAL EQU      Y0004            *
VFCVAL     EQU       X20002        *  VFC
NOVFCVAL   EQU    Y0002            *  NOVFC
LVAL       EQU       X10001        *  L
**                                 *D. NOT PART OF OPEN PRIME PLIST
ELISTPPI   EQU    Q+9              *P FLAGS -- PRESENCE OF OPTIONS
NAMEPPI    EQU    Y8               *  NAMEPARM IS PRESENT IF 1
ACCNPPI    EQU    Y4               *  ACCNPARM IS PRESENT IF 1
PASSPPI  EQU      Y2                *  ETC.
EXPIREPPI  EQU    Y1               *
RDACNPPI   EQU    Y08              *
WTACNPPI   EQU    Y04              *
INSNPPI    EQU    Y02              *
OUTSNPPI   EQU    Y01              *
EXACNPPI EQU      Y008
UNDERPPI EQU      Y004
SAVELENG EQU      Q+11             *
DELFLAG  EQU      Q+13             *
TABFLAG  EQU      Q+14             *
PAGESIZE EQU      Q+15             *
**                                 *END OF FORMAT OF PAGE DESCRIPTION
**                                 *
EXTF     EQU      CPPO
         PAGE
************************
**   INITIALIZATION   **
************************
ASSGR    EQU      %
         PUSH     SR4
         PUSH     R7
         LI,R4    K2                SET CC LIST
         BAL,SR4  SCCLF                        FLAGS FOR LL DEV
************************************************************************
*
*
************************************************************************
*
*        INITIALIZE PLIST FOR PROCESSING OF ASSIGN CC
*
         PUSH     2,SR1
         CAL1,8   GETPAGE
         BCS,8    ASSGR538          ERROR, COULDN'T GET PAGE
         LI,R0    0
         STW,SR2  R6
         STW,R0   0,R6
ASSGLP   RES      0
**PAGE INITIALIZATION              *
         LI,R0    K0               *
         LW,R2    R6               *INITIALIZE PTER TO START OF PAGE.
         AI,R2    1
         LI,R1    PAGESIZE         *DO PAGESIZE TIMES.
ASSGRA   STW,R0   0,R2             * STORE ZERO IN NEXT WORD OF PAGE.
         AI,R2    K1               *  INCREMENT PTER TO PAGE.
         BDR,R1   ASSGRA           *END.
         LW,R1    Y14              *INITIALIZE 1ST WRD OF PLIST.
         STW,R1   OPENLIST,R6      *
         LI,R1    X'A000'
         STW,R1   FLISTPPI,R6      *
**
         PULL     2,SR1
*
         CI,SR1   KBLANK            CHECK IF BLANK FOLLOWS ASSIGN COMMAN
         BNE      ABLNKERR          ERROR IF NO BLANK
*
*        GET DCB NAME AND MOVE BYTE COUNT AND NAME IN FRONT OF PLIST
*
         BAL,SR4  NAMSCAN           DCB NAME MUST BE ALPHANUMERIC
         BCS,12   ANAMERR           ERROR IF NOT ALPHANUMERIC
         LW,R4    CSL,R7            MOVE
         CI,R4    K3                CHECK IF DCB NAME > 2 CHAR
         BL       ASSGR520
         CI,R4    31                CHECK IF DCB NAME > 31 CHARS.
         BG       ASSGR520          ERROR
         STW,R4   SAVELENG,R6      *SAVE LENGTH OF DCB NAME.
         LW,R1    R7
         AI,R1    PLB
         AI,R1    -1
         LW,R2    R6
         LI,R3    K8
ASSGR1   LW,R4    *R1,R3
         CW,R4    BLANK            *
         BE       ASSGR1B          *
         STW,R4   *R2,R3
ASSGR1B  EQU      %                *
         BDR,R3   ASSGR1
         LW,R2    R7
         AI,R2    PLB
         LH,R3    *R2
         CI,R3    KFC67A            CHECK  IF F: OR USER DCB
         BNE      ASSGR4
         LI,R1    KF0F0
         STH,R1   *R2               SET CHAR'S F: TO ZERO (F0F3)
ASSGR4   EQU      %
*
         LI,SR2   KCOMMA
         BAL,SR4  CHARSCAN          CHECK IF NEXT ACTIVE CHAR IS A
         BCR,8    ASSGR2            COMMA. IF SO, GET NEXT OPTION.
         CI,SR1   X'F0'             WAS THERE A 0?
         BE       ASSGR5            YES, ACCEPTABLE FOR DELETING ENTRY
         BAL,SR4  CHKTERM           DELETITION, CHECK IF LEGAL TERM.
         BCS,8    ASSGR200          ERROR
ASSGR5   LI,R0   -1
         STW,R0   DELFLAG,R6       *TURN ON FLAG FOR DELETING ENTRY ONLY
         B        ASSGR125
         PAGE                      *
*************************
**   GET NEXT OPTION   **
*************************
ASSGR2   EQU      %
         LI,SR2   KLPAREN
         BAL,SR4  CHARSCAN          CHECK IF NEXT ACTIVE CHAR IS A
         BCS,8    ALPERR            ERROR IF NOT            LEFT PAREN
*
*        GET FIELD   FOLLOWING LEFT PAREN AND USE 1ST FOUR CHAR AND
*        CHECK IF A LEGAL KEYWORD FOR ASSIGN CC
*
         BAL,SR4  NAMSCAN           KEYWORD MUST BE ALPHANUMERIC
*
         LW,R1    PLB,R7            (R1) = 1ST 4 CHAR OF KEYWORD
         LI,R2    ASGKWTBL          (R2) = ADR OF KEYWORD TABLE
         LI,R3    NASGKW            (R3) = NUMBER OF KEYWORDS IN TABLE
         LI,R4    AKWERR            (R4) = BRANCH ADR IF SEARCH FAILURE
         BAL,SR4  WDTBLSRH          SEARCH TABLE
         B        ASGJPTBL,R3       BRANCH TO PROCESS PARAMETER
         PAGE
****************************************
**   END ACTION FOR OPTION HANDLERS   **
****************************************
*
*
*        GET VALUE  AN  PUT IN  PLIST
*
**                                 *
*
*          SET PRESENCE BIT INTO 1ST WORD OF BASIC PLIST
*
ASSGR50    EQU %
           STW,R1 R2       SAVE R1
           AND,R1 Y00FF     MASK OFF PRESENCE BIT FIELDS
           CS,R1 OPENLIST,R6
           BE ADVPERR      OPTION ALREADY SPECIFIED
           LW,R1 R2
           STS,R1 OPENLIST,R6                  SET PRESENCE BIT
           B ASSGR120      GET NEXT COMMAND
ASSGR60  EQU      %                 *VBL LENGTH PARAMS COME HERE.
         LW,R1    VBLFFI            *SET F BIT THAT INDICATES A VARIABLE
         STS,R1   FLISTPPI,R6       *LENGTH PARAMETER LIST IS PRESENT.
         B        ASSGR120          *
**                                  *
ASSGR70  EQU      %                 *DEVICE OPTIONS FOR BITSPARM GO HERE
         LW,R3    BITSPPI           *SET THE PRESENCE BIT
         STS,R3   QLISTPPI,R6       *FOR BITSPARM.
         STW,R1   R2                *
         AND,R1   YFFFF             *IS THE PRESENCE BIT ON FOR
         CS,R1    BITSPARM,R6       *THIS OPTION?
         BE       ADVPERR           *IF YES, ERROR.
         LW,R1    R2                *SET PRESENCE BIT AND VALUE OF
         STS,R1   BITSPARM,R6       *OPTION IF 1.
         B        ASSGR91           *
ASSGR80  EQU      %                 *DEVICE OPTIONS EXCEPT BITS GO HERE.
         PUSH     2,R3              *
         BAL,SR4  GETDECVAL         *GETVALUE FOLLOWING KEYWORD.
         BCS,8    ASSGR130          *
         STW,R2   R1                *PUT VALUE IN R1.
         PULL     2,R3              *
**                                  *
ASSGR90  EQU      %                 *
         CS,R3    QLISTPPI,R6       *IS THE OPTION PRESENT ALREADY?
         BE       ADUPERR           *IF YES, ERROR.
         STS,R3   QLISTPPI,R6       *IF NO, TURN ON PRESENCE BIT.
         STW,R1   *R6,R4            *STORE VALUE IN DEVICE ORIENTED LIST
ASSGR91  LW,R1    DEVICEFFI        *SET F BIT THAT INDICATES PRESENCE
         STS,R1   FLISTPPI,R6       *OF DEVICE ORIENTED PLIST.
         B        ASSGR120          *
**                                  *
ASSGR100 EQU      %
         PUSH     2,R3
         BAL,SR4  GETDECVAL         GET DECIMAL VALUE
         BCS,8    ASSGR130
         STW,R2   R1
         PULL     2,R3
ASSGR110 EQU      %
         CS,R3    PLISTPPI,R6       CHECK FOR DUP OF PARAM
         BE       ADUPERR           ERROR IF DUP
         STS,R3   PLISTPPI,R6       SET PPI(PARM PRESENCE INDICATOR)
         STW,R1   *R6,R4            STORE VALE IN PLIST
         PAGE                      *
*
**********************************
**   CHECK FOR END OF COMMAND   **
**********************************
ASSGR120 EQU      %
         LI,SR2   KRPAREN
         BAL,SR4  CHARSCAN          CHECK FOR RIGHT PAREN
         BCS,8    ARPERR            ERROR IF NOT
ASSGR121 EQU      %
         LI,SR2   KCOMMA
         BAL,SR4  CHARSCAN          CHECK FOR COMMA
         BCR,8    ASSGR2            BRANCH IF COMMA
ASSGR123 EQU      %
         BAL,SR4  CHKTERM           CHECK IF LEGAL CC TERMINATOR
         BCS,8    ASSGR200          ERROR
ASSGR125 EQU      %
         BAL,SR4  EOCCSCAN          SKIP TO END OF CC
         B        ASSGR500
         PAGE                      *
********************
**   ERROR EXIT   **
********************
ASSGR130 EQU      %
         PULL     2,R3
*
*
ASSGR200 EQU      %
         LI,R4    K2
         LI,R2    0                 RESET CFE BIT ON ABORTS
         LW,R3    Y08
         STS,R2   J:JIT
         CAL1,8   FREEPAGE
         CAL1,8   FREEPAGE
         PULL     R7
         PULL     SR4
         B        *SR4              ERROR EXIT
         PAGE
**********************
**   FINALIZATION   **
**********************
*
*
ASSGR500 EQU      %
*
*                                                                       734
         LW,R0    DELFLAG,R6       *
         BNEZ     ASGR500E
         LW,R2    DEVICEPARM,R6    *
         CI,R2    C'9T'            *
         BE       ASGR500B                                              734
         CI,R2    C'7T'            *
         BNE      ASGR500D          NO                                  734
ASGR500B EQU      %                                                     734
         LW,R3    UNPACKVAL        *
         CS,R3    BITSPARM,R6      *
         BE       ASGR500C
         LW,R3    PACKVAL          *
         STS,R3   BITSPARM,R6      *
         LW,R3    BITSPPI          *
         STS,R3   QLISTPPI,R6
ASGR500C EQU      %
         LW,R3    BCDVAL           *
         CS,R3    BITSPARM,R6      *
         BE       ASGR500D         *
         LW,R3    BINVAL           *
         STS,R3   BITSPARM,R6      *
         LW,R3    BITSPPI          *
         STS,R3   QLISTPPI,R6      *
ASGR500D EQU      %                                                     734
* IF EXEC OPTION SPECIFIED, DEFAULT FOR READ SHOULD = 'NONE'.
* A FILE MANAGEMENT REQUIREMENT.
         LW,R1    EXACNPPI          WAS EXEC SPEC'D
         CW,R1    ELISTPPI,R6
         BAZ      ASGR500E          NO, DON'T SET DEFAULT
         LW,R1    RDACNPPI          WAS READ SPEC'D
         CW,R1    ELISTPPI,R6
         BANZ     ASGR500E          YES, DON'T SET DEFAULT
         LI,R1    READPARM          SET DEFAULT TO 'NONE'
         LW,R3    Y05               (R3) = PLIST READ CODE
         AW,R3    X202
         STW,R3   *R6,R1            STORE CODE IN PLIST
         AI,R1    1
         LCI      2
         LM,D1    TXTNONE           STORE 'NONE'
         STM,D1   *R6,R1
ASGR500E EQU      %
* SET DEVICE = 'DP' WHEN DEVICE NOT SPECIFIED AND WHEN SN AND FILE
* SPECIFIED.
         LW,R1    DEVICEPPI         WAS A DEVICE SPEC'D
         CS,R1    PLISTPPI,R6
         BE       ASSGR500F
         LI,R1    7
         LS,R1    FLISTPPI,R6       WAS THIS A FILE ASSIGNMENT
         CI,R1    1
         BNE      ASSGR500F         NO
         LW,R1    INSNPPI           WAS SN SPECIFIED
         CS,R1    ELISTPPI,R6
         BNE      ASSGR500F
         LW,R1    D100              YES, SET 'DP' AS THE DEVICE
         STW,R1   DEVICEPARM,R6
         LW,R1    DEVICEPPI         SET P14
         STS,R1   PLISTPPI,R6
ASSGR500F EQU     %
         LW,R0    R6
         AI,R0    DCBNAME          *
         LW,R1    SAVELENG,R6      *
         LI,R2    1
         BAL,SR4  CHSTSHFT
         LW,R2    DCBNAME,R6       *
         SLS,R2   -8
         AND,R2   XFFFF
         CI,R2    'F:'
         BE       AS503A
         CI,R2    'M:'
         BNE      ASSGR524
*
         LW,D1    DCBNAME,R6       *(D1-D2) = 1ST 2 WORDS
         LW,D2    DCBNAME+1,R6     *          OF DCB NAME.
         LB,R3    D1                *
         CI,R3    4                 *CHECK IF DCB NAME <= 4 CHAR
         BG       ASSGR501          *NO, BRANCH
*
*
*
         SLD,D1   24
         SAS,D1  -16
         LI,R3   (FILEND-FILEXTP)*2
         CH,D1    FILEXTP,R3
         BE       ASSGRXX
         BDR,R3   %-2
         B        ASSGR501
ASSGRXX  RES      0
         LI,D2    1
         SLS,D2   -1,R3             POSITION MASK.
         LI,D1    0
         STS,D1   EXTF+J:JIT        RESET FILE EXTEND  BIT
*
*
ASSGR501 EQU      %                                                     734
         LW,D1    DCBNAME,R6
         LW,D2    DCBNAME+1,R6
         CD,D1    TXMOC             CHECK IF M:OC
         BE       ASSGR524          YES, ERROR
         LI,R7    M:LL
         CD,D1    TXMLL             CHECK IF M:LL
         BE       ASSGR503          YES                                 734
         LI,R7    M:C
         CD,D1    TXMC              CHECK IF M:C
         BE       ASSGR502          YES
         CD,D1    TXMAST            CHECK IF M:*
         BE       ASSGR524          YES, ERROR
         CD,D1    TXMEQU            CHECK IF M:=
         BE       ASSGR524          YES, ERROR
         LI,R7    M:BI
         CD,D1    TXMBI
         BE       ASSGR503
         LI,R7    M:LO                                                  734
         CD,D1    TXMLO                                                 734
         BE       ASSGR503                                              734
         CD,D1    TXMGO             CHECK IF M:GO
         BNE      AS503B           *NO.
         MTW,0    DELFLAG,R6        IGNORE CHECK IF A DELETION
         BLZ      AS503C
         LW,R2    FLISTPPI,R6
         AND,R2   X3
         CI,R2    1
         BNE      ASSGR528          NOT A FILE.
         M:SETDCB M:X1,(ERR,ERAB),(ABN,ERAB)
         M:CLOSE  M:X1              MAKE SURE CLOSED.
         LI,D1    NAMEPARM+1        GET FILE
         AW,D1    R6                NAME ADDRESS.
         M:TFILE  M:X1,(TFILE,*D1)   DECLARE TEMPORARY M:GO.
         B        AS503B
*
ERAB     B        *SR1              IGNORE ERR,ABN BECAUSE OF CLOSE
ASSGR502 EQU      %
         MTW,0    DELFLAG,R6        IGNORE CHECK IF A DELETION
         BLZ      AS503C
         LW,R2    FLISTPPI,R6
         AND,R2   X3
         CI,R2    3
         BNE      ASSGR528
**INSERT DCB ADDRESS
ASSGR503 EQU      %
         OR,R7    OPENLIST,R6      *PUT DCB ADDRESS IN PLIST.
         STW,R7   OPENLIST,R6      *
         B        AS503C           *
AS503A   EQU      %
         CD,D1    TXFCF             CHECK IF F:CF(USED FOR CFE MODE)
         BE       ASSGR524          YES, ERROR
AS503B   LI,R7    M:X1             *PUT DUMMY DCB ADDRESS IN PLIST.
         B        ASSGR503         *
**GET ASSIGN/MERGE TABLE           *
AS503C   RES      0
         LW,R4    0,R6
         BGZ      AS503CC           HAVE A/M IN R4
         CAL1,8   GETPAGE
         BCS,8    ASSGR539          ERROR, COULDN'T GET PAGE
         STW,SR2  R4
         BAL,SR4  RAMR              READ A/M RECORD
         MTW,0    SR3               CHECK FOR A/M READ
         BNEZ     ASSGR200          ERROR IF SR3 NOT = 0
AS503CC  RES      0
*                 R6=PLIST
*                 R4= A/M
*                                   DCB  NAME SCAN
         LI,R0    AM:LNK
         AW,0     R4
         AI,R6    DCBNAME
         LI,R1    1
MATCH1   EQU      %
         LW,R2    R1                SAVE PREVIOUS LINK
         LW,R1    *R2,R4            GET NEXT LINK
         BNEZ     MATCH2
         MTW,0    DELFLAG-1,R6      DCB NOT FOUND
         BEZ      ENDMOVE           IF ASSIGNMENT DELETION,
         B        ENDOPNP           WRITE A-M
MATCH2   EQU      %
         LW,R3    R1
         AW,R3    0                 POINT TO DCB
         LB,R5    *R3
         CB,R5    *R6
         BNE      MATCH1            NO
MATCH3   EQU      %
         LB,D4    *R3,R5
         CB,D4    *R6,R5
         BNE      MATCH1            GO TO NEXT
         BDR,R5   MATCH3
*                                   FOUND
*                 R1=CURRENT LINK   =TO
*
         LW,D4   *R1,R4             GET SIZE
         BNEZ     MATCH5
         STW,R1   0,R4              SET POINTER TO NEXT ENTRY
         STW,D4   *R2,R4            SET LINK IN LAST ENTRY TO 0
         MTW,0    DELFLAG-1,R6      IF ASSIGNMENT DELETION,
         BEZ      ENDMOVE           WRITE A-M.
         B        ENDOPNP
MATCH5   EQU      %
         SW,D4    R1                N
         LW,R5    AM:ORG,R4
         SW,R5   *R1,R4             SIZE TO MOVE
         LW,R2   *R1,R4             FROM
         LCW,D4   D4
         AWM,D4   0,R4              AVIAL INCREASED
         LW,R3    R1
         LW,R0   *R3,R4             NEXT
         BEZ      MOVE
         AWM,D4  *R3,R4             ADJ LINK BY -N
         LW,R3    R0
         B        %-4
MOVE     RES      0                 FIN ADJUSTMENT
         AW,R1    R4
         AW,R2    R4
         LW,0     0,R2
         STW,0    0,R1
         AI,R2    1
         AI,R1    1
         BDR,R5   %-4
         MTW,0    DELFLAG-1,R6      IF ASSIGNMENT DELETION,
         BLZ      ENDOPNP           WRITE A-M.
ENDMOVE  RES      0
*        CHAIN    NEW TO OLD
         LW,R2    AM:ORG,R4         GET POINTER TO AVAIL. SPACE
         LI,R0    1
         LW,R1    R0
         LW,R0   *R1,R4
         BNEZ     %-2               ADD TO
         STW,R2  *R1,R4             OLD CHAIN
         LW,D4    R4                DETERMINE END OF PAGE ADDRESS
         AI,D4    AM:END
         ANLZ,D1  ENDMOVE5          ABORT IF MAX. A/M RECORD SIZE
         CW,D1    D4                EXCEEDED
         BG       ABIGERR
ENDMOVE5 EQU      %
         STW,0   *R2,R4             ZERO END
*        R4       AM
*        R6       PLIST
         LW,R2    R4
         AW,R2    AM:ORG,R4
         AI,R2    1
         LW,D1    R2
*
         LW,R3     R6             FROM
         LI,R5    PLISTPPI-DCBNAME
         BAL,SR4  MLPOOP            MOVE DCB NAME TO PLIST
*        R3 NOW POINTS TO PLISTPPI
         LI,R5    NAMEPARM-PLISTPPI-1
         BAL,SR4  MPLISTP           MOVE PLIST
*        R3 =     NAMELIST
         LI,R1    0                 SET POINTER
         LW,0     VPARMPNT-1,R6
         CI,0     X'4000'           VAR LIST
         BANZ     %+3               YES
         AI,3     QLISTPPI-NAMEPARM
         B        VARDONE
         LI,R5    ACCPARM-NAMEPARM
         BAL,11   VARLIST
         LI,R5    PASSPARM-ACCPARM
         BAL,11   VARLIST
         LI,5     EXPIPARM-PASSPARM
         BAL,11   VARLIST
         LI,5     READPARM-EXPIPARM
         BAL,11   VARLIST
         LI,5     WRITEPARM-READPARM
         BAL,11   VARLIST
         LI,5     INSNPARM-WRITEPARM
         BAL,11   VARLIST
         LI,5     OUTSNPARM-INSNPARM
         BAL,11   VARLIST
         LI,R5    EXECPARM-OUTSNPARM
         BAL,11   VARLIST
         LI,R5    UNDEPARM-EXECPARM
         BAL,11   VARLIST
         LI,R5    QLISTPPI-UNDEPARM
         BAL,11   VARLIST
         LW,0     =X'00010000'
         AWM,0    0,R1              END LIST
VARDONE  RES      0
*        PROCESS    DEVICE  PARAM'S
         LW,D3    0,R3
         BEZ      OPENTEST          DONE
         CW,D4    R2                CHECK IF ENOUGH ROOM IN A-M IMAGE
         BLE      ABIGERR
         STW,D3   0,R2
         AI,2     1
         AI,3     1
         SLS,D3   1
         BCR,8    NOTABS
         CW,D4    R2                AGAIN, CHECK A-M IMAGE SIZE
         BL       ABIGERR
         LCI      4
         LM,SR1   0,R3
         STM,SR1  0,R2
         AI,2     4
NOTABS   RES      0
         AI,3     4
         LI,R5    7                 #QLIST ENTRIES LEFT TO PROCESS
         BAL,11   MPLISTP2          DO QLIST
OPENTEST  RES     0
         SW,R2    R4
         STW,R2   0,R4
         LW,R2    D1
         LB,R1   *R2               * DIVIDE BY FOUR. ADD QUOTIENT AND
         SLS,R1  -2                *  1 TO R2. THIS WILL POINT
         AW,R2    R1               *    R2 TO THE BEGINNING OF THE
         AI,R2    1                *      PLIST SO AN OPEN PRIME
         LW,D1    0,R2
         LW,D2    DMASK
         CS,D1    DUMMY
         BE       ENDOPNP           NOT CCI'S
         M:SETDCB M:X1,(ERR,ASSGROPERR),(ABN,ASSGROPERR)
         LW,D2    *D1
         CW,D2   =X'00200000'       OPEN
         BAZ      %+2               NO--
         CAL1,1   CLSDCB
         CAL1,1   *R2
ENDOPNP  RES      0
         AI,R6    -1
         STW,R4   0,R6              SAVE  A/M
         LW,7      *TSTACK
         LW,R5    CJOB
         BAL,SR4  CCREAD
         LW,R3    Y08               ARE WE IN CFE MODE
         CW,R3    J:JIT
         BAZ      ENDOPNP5          NOPE
         LW,R4    0,R6              UPDATE RECORD COUNT IN A/M RECORD
         MTW,1    AM:CREC,R4
ENDOPNP5 EQU      %
         CW,R1    TXASSI
         BE       ASSGLPP
         LW,R3    Y008
         STS,R3   CCBEF,R5
         LW,SR2   0,R6              SET A/M ADDRESS
         BAL,SR4  WAMR              WRITE A/M RECORD
         MTW,0    SR3               CHECK FOR A/M WRITE ERROR
         BNEZ     ASSGR200          ERROR IF SR3 NOT = 0
         LI,R3     X'200'
         STS,3     J:ASSIGN
AMOVERX  RES   0
         CAL1,8   FREEPAGE         *         FREE
         CAL1,8   FREEPAGE         *      STORAGE.
         PULL     R7
         PULL     SR4
         AI,SR4   1
         B        *SR4              EXIT
ASSGLPP   RES   0
         PUSH     2,SR1
         B        ASSGLP
CLSDCB   DATA      X'9500000C'         CLOSE
         PZE      *0                N
         DATA     2                 SAVE
DUMMY    GEN,8,24  X'14',M:X1
DMASK    GEN,32   X'FF01FFFF'
         PAGE
**************************
**   OPTION HANDLERS    **
**************************
*
*
*        PROCESS JRNL PARAMETER
LJRNL    EQU      %
         LI,R1    4
         B        LLABEL1
*
*        PROCESS ANS TAPE PARAMETER
LANSLBL  EQU      %
         LI,R1    5                 ANS CODE
         B        LLABEL1
*
*        PROCESS  FILE   PARAMETER
*
LFILE    EQU      %
         LW,R1    FILEFFI          *
         B        LLABEL1
*
*        PROCESS  LABEL  PARAMETER
*
LLABEL   EQU      %
         LW,R1    LABELFFI          *
LLABEL1  EQU      %
         LW,R3    DEVICEPPI         *
         CS,R3    PLISTPPI,R6       *
         BNE      LLABEL2          * BRANCH IF DEV FLAG NOT SET
         LI,R2    0                *
         LW,R3    XF               *
         STS,R2   FLISTPPI,R6      * CLEAR DEV FLAG
LLABEL2  EQU      %                *
         STS,R1   FLISTPPI,R6      *
         LW,R1    NAMEPPI           *
         CW,R1    ELISTPPI,R6       *CHECK FOR DUPLICATION
         BANZ     ADUPERR           *YES, BRANCH-ERROR
         STS,R1   ELISTPPI,R6       *SET FILE/LABEL FLAG
         LI,SR2   KCOMMA
         BAL,SR4  CHARSCAN          CHECK FOR A COMMA
         BCS,8    ACOMERR           ERROR IF NOT
         LI,SR4   7
         AND,SR4  FLISTPPI,R6       GET ASSIGN
         CI,SR4   5                 ANS
         BNE      LLABEL3
         BAL,SR4  ANYSCAN
         LI,R2    K0                RESET BUFFER FULL FLAG
         LW,R3    Y2
         STS,R2   FLAGS,R7
         B        LLABEL4
LLABEL3  EQU      %
         BAL,SR4  NAMSCAN           GET NAME
         BCS,8    ANAMERR           ERROR IF NOT LEGAL NAME
LLABEL4  EQU      %
         LI,R2    K1
         LW,R0    R7
         AI,R0    PLB
         LW,R1    CSL,R7
         LI,SR4   7
         AND,SR4  FLISTPPI,R6
         CI,SR4   5
         BNE      LLABEL5
         CI,R1    17
         BG       ANAMERR
LLABEL5  EQU      %
         BAL,SR4  CHSTSHFT          SHIFT FILE NAME
         LW,R2    CSL,R7
         STB,R2   *R0
         AI,R2    4
         SLS,R2   KN2
         LI,R4    K2
         STB,R2   R2,R4
         OR,R2    Y01               (R2) = FILE IND. + WORD LENGTH
         LI,R3    NAMEPARM         *
         STW,R2   *R6,R3            STORE IND. WORD BEFORE FILE NAME
         AI,R3    K1                                          IN PLIST
         AND,R2   XFF
LLABEL6  EQU      %
         LW,D2    *R0
         STW,D2   *R6,R3            MOVE FILE NAME TO PLIST
         AI,R0    K1
         AI,R3    K1
         BDR,R2   LLABEL6
         LI,SR2   KCOMMA
         BAL,SR4  CHARSCAN          CHECK FOR COMMA
         BCR,8    LLABEL8
         LCI      2                 USE SYSTEM ACCOUNT AS DEFAULT
         LM,R3    J:ACCN
         B        LLABEL9
LLABEL8  EQU      %
         BAL,SR4  GETACCN           GET ACCOUNT NUMBER
         BCS,8    ASSGR200          ERROR IF NOT LEGAL ACCOUNT
         LCI      2
         LM,R3    PLB,R7
LLABEL9  EQU      %
         LW,R1    ACCNPPI
         STS,R1   ELISTPPI,R6
         LI,R1    ACCPARM
         LW,R2    X2000202
         LCI      3
         STM,R2   *R6,R1
         B        ASSGR60
*
*
*        PROCESS  DEVICE PARAMETER
*
LDEVICE  EQU      %
         LW,R1    LABELFFI          *
         CS,R1    FLISTPPI,R6       *
         BE       LDEV1             *DO NOT SET DEV FLAG
         LW,R1    FILEFFI           *IF LABEL/FILE
         CS,R1    FLISTPPI,R6       *SPECIFIED
         BE       LDEV1            *
         LW,R1    DEV2FFI          *
         STS,R1   FLISTPPI,R6      *
LDEV1    EQU      %
         LW,R1    DEVICEPPI        *
         CS,R1    PLISTPPI,R6      *
         BE       ADUPERR          *
         STS,R1   PLISTPPI,R6      *
         LI,SR2   KCOMMA
         BAL,SR4  CHARSCAN          CHECK FOR COMMA
         BCS,8    ACOMERR           ERROR IF NOT
         BAL,SR4  NAMSCAN           GET DEV NAME OR OP LABEL
         BCS,12   ANAMERR
         LW,R2    PLB,R7            *
         SLS,R2   -16               *
         CW,R2    D100              IS DEVICE
         BNE      D000              .NAME ='DP'. -NO
         LW,R2    D101              -YES. SUBSTITUTE 'SP'.
D000     EQU      %
         STW,R2   DEVICEPARM,R6     *STORE 1ST 2 CHAR
         B        ASSGR120          *
*
*        PROCESS ORG KEYWORD PARAMETERS
*
LCONSEC  EQU      %                 PROCESS CONSEC PARAM
         LI,R1    K1
         B        LKEYED1
*
LKEYED   EQU      %                 PROCESS KEYED PARAM
         LI,R1    K2
LKEYED1  EQU      %
         LW,R3    ORGPPI            (R3)=PARAM PRESENCE IND. FOR ORG
         LI,R4    ORGPARM           (R4) = ADDR OF ORG PARAM IN PLIST
         B        ASSGR110          STORE VALUE IN PLIST
**                                 *
LRANDOM  EQU      %                *PROCESS RANDOM OPTION
         LI,R1    3                 RANDOM
         B         LKEYED1
*
*
*        PROCESS ACCESS KEYWORD PARAMETERS
*
LSEQUEN  EQU      %                 PROCESS SEQUEN PARAM
         LI,R1    K1
         B        LDIRECT1
*
LDIRECT  EQU      %                 PROCESS DIRECT PARAM
         LI,R1    K2
LDIRECT1 EQU      %
         LW,R3    ACCESSPPI         (R3) = PARM PRESENCE IND. FOR ACCESS
         LI,R4    ACSPARM           (R4) = ADR OF ACESS PARM IN PLIST
         B        ASSGR110          PUT PARM IN PLIST
*
*
*        PROCESS   FUNCTION KEYWORD PARAMETERS
*
LIN      EQU      %                 PROCESS IN  PARM
         LI,R1    K1
         B        LOUTIN1
*
LOUT     EQU      %                 PROCESS OUT PARM
         LI,R1    K2
         B        LOUTIN1
*
LINOUT   EQU      %                 PROCESS INOUT PARM
         LI,R1    K4
         B        LOUTIN1
*
LOUTIN   EQU      %                 PROCESS  OUTIN PARM
         LI,R1    K8
LOUTIN1  EQU      %
         LW,R3    FUNPPI            (R3) = FUNCTION PPI
         LI,R4    FUNCPARM          (R4) = ADR OF FUNC PARM IN PLIST
         CS,R3    PLISTPPI,R6       CHECK FOR DUP OF PARAM
         BE       ADUPERR           ERROR IF DUP
         STS,R3   PLISTPPI,R6       SET PPI(PARAMETER PRESENCE INDICATOR)
         STW,R1   *R6,R4            STORE VALUE IN PLIST
*
         LI,SR2   KRPAREN           CHECK FOR RIGHT PAREN
         BAL,SR4  CHARSCAN
         BCR,8    ASSGR121          GET NEXT OPTION IF ENCOUNTERED
         CI,SR1   KCOMMA
         BNE      ACOMERR           ERROR IF NO COMMA
         LI,SR1   0
         BAL,SR4  NAMSCAN           GET KEYWORD FOLLOWING MODE
         BCS,12   ANAMERR           ERROR IF NOT ALPHANUMERIC
         LI,R1    K300
         LW,R3    PLB,R7            GET 1ST 4 CHAR OF PARAMETER
         CW,R3    TXTSHARE          IS IT SHAR
         BE       LOUTIN5
         CW,R3    TXTEXCL           IS IT EXCL
         BNE      ASSGR532          IF NOT, ERROR
         LI,R1    K200
LOUTIN5  EQU      %
         LI,R4    FUNCPARM          SET SHARE/EXCLUSIVE BITS (S=1/S=0)
         STS,R1   *R6,R4
         B        ASSGR120
*
*        PROCESS  INSN   PARAMETER
*
LINSN    EQU      %
         LW,R1    INSNPPI
         LW,R3    Y07               (R3) = IN SERIAL # CODE
         CW,R1    ELISTPPI,R6      *
         BANZ     ADUPER           *
         STS,R1   ELISTPPI,R6      *
         LI,R1    INSNPARM         *
         B        LOUTSN1
*
*        PROCESS  OUTSN PARAMETER
*
LOUTSN   EQU      %
         LW,R1    OUTSNPPI
         LW,R3    Y08               (R3) = OUT SERIAL NO. CODE
         CW,R1    ELISTPPI,R6      *
         BANZ     ADUPER
         STS,R1   ELISTPPI,R6      *
         LI,R1    OUTSNPARM        *
LOUTSN1  EQU      %                *
         STW,R1   R2
         STW,R3   *R6,R1            STORE CODE IN PLIST
         AI,R1    K1
         PUSH     2,R1
*
         LI,SR2   KCOMMA
         BAL,SR4  CHARSCAN          CHECK FOR A COMMA FULLOWING
         BCR,8    LOUTSN2
         PULL     2,R1              RESET SN IN DCB
         B        ASSGR60
LOUTSN2  EQU      %
         BAL,SR4  GETSN             *GET SERIAL NO,
         BCS,8    LOUTSN4           *CHECK IF LEGAL
         PULL     2,R1              *
         LW,R0    *R6,R2            *
         AND,R0   XFF               *
         CI,R0    100
         BGE      AOUTERR           *YES, BRANCH-ERROR
         LI,SR4   7
         AND,SR4  FLISTPPI,R6
         CI,SR4   5
         BNE      LOUTSN3
         PUSH     2,R1
         ANLZ,R1  LOUTSN3
         SLS,R1   2
         BAL,SR4  SIXPACK
         LW,R3    R2
         PULL     2,R1
         B        LOUTSN3+1
LOUTSN3  EQU      %
         LW,R3    PLB,R7            MOVE SERIAL #
         STW,R3  *R6,R1
         AI,R1    1
         MTW,1   *R6,R2
*
         PUSH     2,R1
         LI,SR2   KCOMMA
         BAL,SR4  CHARSCAN          CHECK FOR COMMA
         BCR,8    LOUTSN2
         PULL     2,R1
         LW,R4    *R6,R2
         SLS,R4   8
         AWM,R4   *R6,R2
         B        ASSGR60          *
LOUTSN4  EQU      %
         PULL     2,R1
         B        ASSGR200
*
*        PROCESS  READ   PARAMETER
*
LREAD    EQU      %
         LW,R1    RDACNPPI
         LW,R3    Y05               (R3) = PLIST READ CODE
         CW,R1    ELISTPPI,R6      *
         BANZ     ADUPER           *
         STS,R1   ELISTPPI,R6      *
         LI,R1    READPARM         *
         B        LWRITE1
*
*        PROCESS  WRITE  PARAMETER
*
LWRITE   EQU      %
         LW,R1    WTACNPPI
         LW,R3    Y06               (R3) = PLIST WRITE CODE
         CW,R1    ELISTPPI,R6      *
         BANZ     ADUPER
         STS,R1   ELISTPPI,R6      *
         LI,R1    WRITEPARM        *
LWRITE1  EQU      %                *
         STW,R1   R2
         STW,R3   *R6,R1            STORE CODE IN PLIST
         AI,R1    K1
*
         PUSH     2,R1
         LI,SR2   KCOMMA
         BAL,SR4  CHARSCAN          CHECK FOR COMMA FOLLOWING
         BCR,8    LWRITE2           LEYWORD
         PULL     2,R1              RESET READ/WRITE ACCTS IN DCB.
         B        ASSGR60
LWRITE2  EQU      %
         LI,SR2   TXTALL
         BAL,SR4  QUOTSCAN
         BCR,8    LWRITE5
         LI,SR2   TXTNONE
         BAL,SR4  QUOTSCAN
         BCR,8    LWRITE5
LWRITE2A EQU      %                 *
         BAL,SR4  GETACCN           GET ACC #
         BCS,8    LWRITE4
         PULL     2,R1
         LW,R0    *R6,R2            *
         AND,R0   XFF               *
         CI,R0    15                *CHECK IF READ/WRITE ACCN LIMIT
         BG       LWRITE3
         LCI      2                 *
         LM,R3    PLB,R7            *MOVE ACCN  NO.
         STM,R3   *R6,R1            *
         AI,R1    2                 *
         MTW,2    *R6,R2            BUMP  ACC #COUNT IN PLIST
*
         PUSH     2,R1
         LI,SR2   KCOMMA
         BAL,SR4  CHARSCAN          CHECK FOR COMMA
         BCR,8    LWRITE2A          *
         PULL     2,R1
LWRITE3  EQU      %
         LW,R4    *R6,R2
         SLS,R4   8
         AWM,R4   *R6,R2
         B        ASSGR60          *
LWRITE4  EQU      %
         PULL     2,R1
         B        ASSGR200
LWRITE5  EQU      %
         PULL     2,R1
         LW,R3    X202
         AWM,R3   *R6,R2
         LCI      2
         LM,R3    PLB,R7
         STM,R3   *R6,R1
         B        ASSGR60           *
*
*        PROCESS EXECUTE PARAMETER
*
LEXEC    EQU      %
         LW,R1    EXACNPPI          CHECK FOR DUP. OF PARM
         CW,R1    ELISTPPI,R6
         BANZ     ADUPER
         STS,R1   ELISTPPI,R6
*
         LW,R3    Y14               STORE CODE IN PLIST
         LI,R1    EXECPARM
         STW,R3   *R6,R1
         LI,SR2   KCOMMA
         BAL,SR4  CHARSCAN
         BCS,8    ASSGR60           RESET EXEC ACCTS IN DCB
LEXEC5   EQU      %
         LI,SR2   TXTALL            CHECK FOR ALL/NONE
         BAL,SR4  QUOTSCAN
         BCR,8    LEXEC7
         LI,SR2   TXTNONE
         BAL,SR4  QUOTSCAN
         BCS,8    LEXEC10
LEXEC7   EQU      %
         CI,SR1   KRPAREN           ERROR IF ADDITIONAL ACCOUNTS FOLLOW
         BNE      ARPERR
         B        LEXEC15
LEXEC10  EQU      %
         BAL,SR4  GETACCN
         BCS,8    ASSGR200
LEXEC15  EQU      %
         LI,R1    EXECPARM
         LW,R2    *R6,R1
         AND,R2   XFF
         CI,R2    15                CHECK IF EXEC ACCN LIMIT EXCEEDED
         BG       ASSGR536
         AW,R2    R1
         AI,R2    1
         LCI      2
         LM,R3    PLB,R7            MOVE ACCN NO.
         STM,R3   *R6,R2
         MTW,2    *R6,R1
*
         LI,SR2   KCOMMA            CHECK FOR COMMA
         BAL,SR4  CHARSCAN
         BCR,8    LEXEC10
         LI,R1    EXECPARM
         LW,R4    *R6,R1
         SLS,R4   8
         AWM,R4   *R6,R1
         B        ASSGR60
*
*        PROCESS UNDER PARAMETER (EXECUTE VEHICLE)
*
LUNDE    EQU      %
         LW,R1    UNDERPPI          CHECK FOR DUP. OF PARAM
         CW,R1    ELISTPPI,R6
         BANZ     ADUPER
         STS,R1   ELISTPPI,R6
*
         LW,R3    Y15               STORE CODE IN PLIST
         LI,R1    UNDEPARM
         STW,R3   *R6,R1
         LI,SR2   KCOMMA
         BAL,SR4  CHARSCAN
         BCS,8    ASSGR60           RESET VEHICLE IN DCB
         BAL,SR4  NAMSCAN
         BCS,8    ANAMERR           ERROR IF ILLEGAL ALPHA. NAME
         LW,SR4   CSL,R7
         CI,SR4   10
         BG       ANAMERR           ERROR IF LENGTH > 10 CHARS.
*
         LI,R2    K1                CONVERT LMN TO TEXTC
         LW,R0    R7
         AI,R0    PLB
         LW,R1    CSL,R7
         BAL,SR4  CHSTSHFT          CONVERT LMN TO TEXTC
*
         LI,R1    UNDEPARM          STORE LMN
         LI,R2    X'303'
         AWM,R2   *R6,R1
         AI,R1    1
         PUSH     R5
         LCI      3
         LM,R3    PLB,R7
         STM,R3   *R6,R1
         PULL     R5
         B        ASSGR60
*
*        PROCESS  PASS   PARAMETER-BLANK OUT PASS WORD IN BUFFER
*        TO  STOP PRINTING OF PASSWORD
*
LPASS    EQU      %
         LW,R1    PASSPPI
         CW,R1    ELISTPPI,R6      *
         BANZ     ADUPER
         STS,R1   ELISTPPI,R6      *
         LI,SR2   KCOMMA
         BAL,SR4  CHARSCAN          CHECK FOR COMMA
         BCS,8    ACOMERR           ERROR IF NOT
         BAL,SR4  GETPASSW          GET PASSWORD
         BCS,8    ACHSTERR
         LW,R2    CSL,R7
         CI,R2    K8                CHECK IF PASSWORD <= 8 CHAR
         BG       ACHSTERR          ERROR IF NOT
         LW,R3    X3000202
         LI,R1    PASSPARM         *
         STW,R3   *R6,R1
         AI,R1    K1
         LCI      2                 *
         LM,R3    PLB,R7            *MOVE  PASS  WORD
         STM,R3   *R6,R1            *
         B        ASSGR60          *
*
*        PROCESS  EXPIRE PARAMETER
*
LEXPIRE  EQU      %
         LW,R1    EXPIREPPI
         CW,R1    ELISTPPI,R6      *
         BANZ     ADUPER
         STS,R1   ELISTPPI,R6      *
         LW,R3    X4000202
         LI,R1    EXPIPARM         *
         STW,R1   R2
         STW,R3   *R6,R1
         AI,R1    K1
         STW,R1   R0
         AW,R0    R6
         BAL,SR4  CALENDTE          GET EXPIRE DATE
         B        ASSGR200          ILLEGAL EXPIRE DATE
         B        ASSGR60          *
*
*        PROCESS  FILE KEYWORD PARAMETERS
*
LREL     EQU      %
         LI,R1    K1
         B        LSAVE1
*
LSAVE    EQU      %
         LI,R1    K2
LSAVE1   EQU      %
         LW,R3    FFILEPPI          (R3) = PPI OF FIXED FILE PARAM
         LI,R4    FFILEPARM         (R4)= ADR OF FIXED FILE PARM
         B        ASSGR110          STORE PARM IN PLIST
*
LJOB     RES      0
         LI,R1    3
         B        LSAVE1
*
*        PROCESS   KEYMAX
*
LKEYM    RES      0
         LI,R1    K40
         LW,R3    KEYMPPI           PPI
         LI,R4    KEYMPARM          ADDR
         B        ASSGR100
*
*        PROCESS  LINES  PARAMETER
*
LLINES   EQU      %
         LI,R1    K8000             (R1) = MAX VALUE FOR LINES
         LW,R3    LINESPPI          (R3) = PPI FOR LINES PARM
         LI,R4    LINESPARM         (R4) = ADR OF LINES PARM IN PLIST
         B        ASSGR80          *
*
*        PROCESS  RECL  PARAMETER
*
LBLKL    EQU      %
LRECL    EQU      %
         LI,R1    K8000             (R1) = MAX VALUE FOR RECL PARAM
         LW,R3    RECLPPI           (R3) = PPI FOR RECL PARM
         LI,R4    RECLPARM          (R4) = ADR OF RECL PARM IN PLIST
         B        ASSGR100          GET PARM VALUE AND PUT IN PLIST
*
*        PROCESS  TRIES  PARAMETER
*
LTRIES   EQU      %
         LW,R3    TRIESPPI          (R3) = PPI FOR TRIES PARM
         LI,R4    TRIESPARM         (R4) = ADR OF TRIES PARM IN PLIST
         LI,R1    K100
         B        ASSGR100         *
*        PROCESS VOL OPTION
*
LVOL     EQU      %
         LI,R1    50                *VOL MAX VALUE
         LW,R3    VOLPPI
         LI,R4    VOLPARM
         B        ASSGR100
*
*        PROCESS RSTORE OPTION
*
LRSTORE  LW,R3    RSTORPPI
         LI,R4    RSTRPARM
         LW,R1    Y01
         B        ASSGR100
*
*        PROCESS NEWX OPTION
*
LSLID    EQU      %
         LW,R3    SLIDPPI
         CW,R3    PLISTPPI,R6       CHECK FOR DUP.
         BANZ     ADUPERR           ERROR
         STS,R3   PLISTPPI,R6       SET NEWX INDICATOR
         LI,R1    X'100'            MAX=256
         BAL,SR4  GETDECVAL         GET SLIDES VALUE
         BCS,8    ASSGR200          ERROR
         PUSH     R2                SAVE SLIDES VALUE
         LI,SR2   ','
         BAL,SR4  CHARSCAN          CHECK FOR COMMA,I.E.CONSEC.SLIDE
         BCR,8    LSLID1            YES,IT IS PRESENT
         LI,R1    0                 WILL BE INTPR AS DEFAULT
         B        LSLID2
LSLID1   LI,SR1   ','               SET CURR CHR, WILL BE SCANNED AGAIN
         LI,R1    X'100'
         BAL,SR4  GETDECVAL         GET CONSEC SLIDE VALUE
         BCS,8    ASSGR200
         STW,R2   R1                R1=CONSEC. SLIDE
LSLID2   PULL R2                    R2=SLIDE VALUE
         SLS,R2   8                 BYTE 2=SLIDE
         OR,R2    R1                BYTE 3=CONSEC. SLIDE
         STW,R2   SLIDPARM,R6       STORE IN P+17
         B        ASSGR120
*
*
*        PROCESS SPARE OPTION
LSPAR    EQU      %
         LW,R3    SPARPPI
         CW,R3    PLISTPPI,R6       CHECK FOR DUP.
         BANZ     ADUPERR           ERROR
         STS,R3   PLISTPPI,R6       SET SPARE INDICATOR
         LI,R1    X'FFFF'
         BAL,SR4  GETDECVAL
         BCS,8    ASSGR200
         AND,R2   XFF               TREAT VALUE MODULO
         STW,R2   SPARPARM,R6       STORE VALUE (NO. BYTES) IN P+18
         B        ASSGR120
*
*        PROCESS  DEN PARAMETER
*
LDEN     EQU      %
         LI,R1    K641              VALUE SPEC. MAY NOT BE>1600 BPI
         BAL,SR4  GETDECVAL
         BCS,8    ASSGR200          ERROR, ILLEGAL VALUE
         LI,R1    0                 DSF BIT SET=0 IF 1600
         CI,R2    K640              WAS 1600 SPEC.
         BE       LDEN5
         CI,R2    K320              WAS 800 SPEC.
         BNE      AVALERCD          IF NOT, ERROR
         LI,R1    1                 DSF BIT SET=1 IF 800
LDEN5    EQU      %
         LI,R3    DSFPPI            (R3) = PPI FOR DSF PARM
         LI,R4    DSFPARM           (R4) = ADR OF DSF PARM IN PLIST
         B        ASSGR110          STORE PARM IN PLIST
*
*        PROCESS  ASCII AND EBCDIC PARAMETERS
*
LASCII   EQU      %
         LI,R1    1                 CCF BIT SET = 1 IF ASCII
         B        LEBCDIC5
LEBCDIC  EQU      %
         LI,R1    0                 CCF BIT SET = 0 IF EBCDIC
LEBCDIC5 EQU      %
         LI,R3    CCFPPI            (R3) = PPI FOR CCF FLAG
         LI,R4    CCFPARM           (R4) = ADR OF CCF PARM IN PLIST
         B        ASSGR110          STORE PARM IN PLIST
*
*          NEW OPTIONS REQUIRING ONLY BIT SETTINGS
*
LCYL       LW,R1 CYLPPI                        CYLINDER OPTION
           B ASSGR50
*
LNOSEP     LW,R1 NOSEPPPI                      NOSEP OPTION
           B ASSGR50
**                                 *
**DEVICE OPTIONS                   *
**                                 *
**                                 *
**       TAB OPTION                *
**                                 *
LTAB     EQU      %                *
         LI,R0    1                *
         STW,R0   TABFLAG,R6       *
         LW,R1    TABPPI            *
         CW,R1    QLISTPPI,R6       *CHECK FOR DUP.
         BANZ     ADUPERR           *YES, BRANCH-ERROR
         STS,R1   QLISTPPI,R6       *SET TAB INDICATOR
         LI,SR2   ','               *
         BAL,SR4  CHARSCAN          *CHECK FOR COMMA
         BCS,8    ACOMERR           *NO, BRANCH
         LI,SR1   ','               *SET CUR CHAR = COMMA
         LW,R3    R6                *
         AI,R3    TABPARM           *ADR OF WHERE TO STORE TABS
         LI,R4    0                 *
LTAB1    EQU      %                 *
         PUSH     2,R3              *
         LI,R1    255               *MAX TAB VALUE
         BAL,SR4  GETDECVAL         *GET TAB VALUE
         BCS,8    LTAB3             *CHECK IF OK
         PULL     2,R3              *
         STB,R2   *R3,R4            *STORE TAB
         AI,R4    1                 *
         CI,R4    15                *CHECK IF TOO MANY TABS
         BL       LTAB1             *NO,BRANCH
         B        ASSGR91           *
LTAB3    EQU      %
         CI,SR3   COMERCD           *
         BNE      ASSGR120          *
         PULL     2,R3              *
         B        ASSGR91           *
**                                 *
*
*        PROCESS  COUNT  PARAMETER
*
LCOUNT   EQU      %
         LW,R3    COUNTPPI          (R3) = PPI FOR COUNT  PARAMETER
         LI,R4    COUNTPARM         (R4) = ADDR OF COUNT PARM IN PLTST
         B        LDATA1
*
*        PROCESS  DATA   PARAMETER
*
LDATA    EQU      %
         LW,R3    DATAPPI           (R3) = PPI FOR DATA PARAMETER
         LI,R4    DATAPARM          (R4) = ADR OF DATAPARM IN PLIST
LDATA1   EQU      %
         LI,R1    K100              (R1) = MAX VALUE OF PARM
         B        ASSGR80          *GET AND PUT MORE VALUE IN PLIST
*
*        PROCESS  SEQ    PARAMETER
*
LSEQ     EQU      %
         LI,SR2   KCOMMA
         BAL,SR4  CHARSCAN          CHECK IF COMMA FOLLOWS SEQ KEYWORD
         BCS,8    LSEQ1             BRANCH IF NOT
         BAL,SR4  NAMSCAN           GET ID
         BCR,12   LSEQ3             LEGAL ALPHANUMERIC - BRANCH
         LW,R1    Y2
         STS,R1   FLAGS,R7          SET BUF. FULL FLAG
         BAL,SR4  DECSCAN           CK IF LEGAL DEC. VALUE
         BCS,8    AVALERCD          NO-BRANCH
LSEQ3    EQU      %
         LW,R2    CSL,R7
         CI,R2    4                 CK IF  4 CHAR OR LESS
         BG       AVALERCD          NO-ERROR-BRANCH
         LW,R1    PLB,R7            (R1) = ID
         STW,R1   SEQIDPARM,R6      *
         LW,R3    SEQIDPPI         *
         STS,R3   QLISTPPI,R6      *
LSEQ1    EQU      %
         LW,R1    SEQVAL            *
         B        ASSGR70          *PUT VALUE IN PLIST
*
*        PROCESS  SPACE  PARAMETER
*
LSPACE   EQU      %
         LI,R1    15                *
         BAL,SR4  GETDECVAL         GET VALUE
         BCS,8    ASSGR200
         PUSH     R2                SAVE  VALUE
         BAL,SR4  NXACTCHR
         CI,SR1   KCOMMA            ,
         BNE      LSPACE1           NO 2ND VALUE
         LI,R1    K200
         BAL,SR4  GETDECVAL
         BCS,8    LSPACE3
LSPACE1  PULL     R1                IGNORE   'TOP'
         LW,R3    SPACEPPI          (R3) = PPI FOR SPACE PARM
         LI,R4    SPACEPARM         (R4) = ADR OF SPACE PARM IN PLIST
         B        ASSGR90          *PUT VALUE IN PLIST
LSPACE3  PULL     R1
         B        ASSGR200
*
*        PROCESS  VFC-NOVFC  KEYWORDS
*
LVFC     EQU      %
         LW,R1    VFCVAL           *
         B        ASSGR70          *
*
LNOVFC   EQU      %
         LW,R1    NOVFCVAL         *
         B        ASSGR70          *PUT VALUE IN PLIST
*
*        PROCESS  MODE  PARAMETERS
*
LBCD     EQU      %                 PROCESS BCD KEYWORD
         LW,R1    BCDVAL           *
         B        ASSGR70          *
*
LBIN     EQU      %                 PROCESS BIN KEYWORD
         LW,R1    BINVAL           *
         B        ASSGR70          *
*
LFBCD    EQU      %
         LW,R1    FBCDVAL          *
         B        ASSGR70          *PUT VALUE IN PLIT
**                                 *
LNOFBCD  EQU      %                *
         LW,R1    NOFBCVAL         *
         B        ASSGR70          *
*                                                                       734
*        PROCESS  PACK/UNPACK  OPTION                                   734
*                                                                       734
LUNPACK  EQU      %                                                     734
         LW,R1    UNPACKVAL        *
         B        ASSGR70          *
LPACK    EQU      %                                                     734
         LW,R1    PACKVAL          *
         B        ASSGR70          *
*
* PROCESS L OPTION                  *
LL       EQU      %                 *
         LW,R1    LVAL              *
         B        ASSGR70           *
         PAGE
*
LCONCAT  EQU      %
         LW,R3    SPARPPI           CONCAT USES SPARE SLOT
         LI,R4    SPARPARM
         LI,R1    X'FF'             MAX CONCAT
         B        ASSGR100
*
LFORMAT  EQU      %
         LI,SR2   ','
         BAL,SR4  CHARSCAN
         BCS,8    ACOMERR
         BAL,SR4  NAMSCAN           GET RECORDING FORMAT
         BCS,12   AVALERCD
         LW,R1    CSL,R7
         CI,R1    1
         BNE      AVALERCD
         ANLZ,R3  LOUTSN3
         LB,R3    *R3
         LI,R1    #FORMATS
         CB,R3    FORMATS,R1
         BE       LFORMAT1
         BDR,R1   %-2
         B        AVALERCD
LFORMAT1 EQU      %
         LW,R3    ORGPPI
         LI,R4    ORGPARM
         B        ASSGR110
*
FORMATS  DATA,1   ,'F','D','V','U'
#FORMATS EQU      BA(%)-BA(FORMATS)-1
         BOUND    4
*
LLRECL   EQU      %
         LW,R3    RSTORPPI          LRECL  USES RSTORE
         LI,R4    RSTRPARM
         LI,R1    X'7FFF'           MAX LRECL
         B        ASSGR100
*
LABCERR  EQU      %
         LW,R1    Y001              ABCERR BIT
         STS,R1   FLISTPPI-1,R6
         B        ASSGR120
*
         PAGE
FILEXTP  DATA,2      0,C'GO'
         DATA,2   C'OC',C'LO'
         DATA,2   C'LL',C'DO'
         DATA,2   C'PO',C'BO'
         DATA,2   C'LI',C'SI'
         DATA,2   C'BI',C'SL'
         DATA,2   C'SO',C'CI'
         DATA,2   C'CO',C'AL'
         DATA,2   C'EI',C'EO'
         DATA,2   C'C ',0
FILEND   RES      0
         PAGE                      *
******************************
**   SET UP ERROR MESSAGES   **
******************************
*
ABLNKERR EQU      %
*E*      MESSAGE: EXPECTED BLANK MISSING
         LI,SR3   BLNKERCD
         B        ASSGR200
*
ACOMERR  EQU      %
*E*      MESSAGE: EXPECTED COMMA MISSING
         MTW,-1   CCP,R7            SET % TO CORRECT CHAR. IN ERR. MSGE.
         LI,SR3   COMERCD
         B        ASSGR200
*
ALPERR   EQU      %
*E*      MESSAGE: EXPECTED LEFT PARENTHESIS MISSING
         LI,SR3   LPERCD
         B        ASSGR200
*
ARPERR   EQU      %
*E*      MESSAGE: EXPECTED RIGHT PARENTHESIS MISSING
         LI,SR3   RPERCD
         B        ASSGR200
*
ACHSTERR EQU      %
*E*      MESSAGE: ILLEGAL CHARACTER STRING
*E*      DESCRIPTION: THE PASSWORD SPECIFIED FOR THE PASS OPTION
*E*               EITHER EXCEEDED THE MAXIMUM LENGTH OR CONTAINED
*E*               AN ILLEGAL ALPHANUMERIC CHARACTER.
         LI,SR3   CHSTERCD          (SR3) = CHAR STRING ERR CODE
         B        ASSGR200
ANAMERR  EQU      %
*E*      MESSAGE: ILLEGAL ALPHANUMERIC NAME
*E*      DESCRIPTION: THE SPECIFIED NAME CONTAINED AN ILLEGAL
*E*               CHARACTER OR EXCEEDED THE MAXIMUM LENGTH.
         LI,SR3   NAMERCD
         B        ASSGR200
*
AKWERR   EQU      %
*E*      MESSAGE: ILLEGAL KEYWORD
*E*      DESCRIPTON: THE SPECIFIED KEYWORD WAS NOT RECOGNIZED.
         LI,SR3   KWERCD
         B        ASSGR200
*
ADUPERR  EQU      %
ADUPER   EQU      ADUPERR
*E*      MESSAGE: DUPLICATION OF FIELDS
*E*      DESCRIPTION: AN OPTION WAS SPECIFIED MORE THAN ONCE.
         LI,SR3   DUPERCD
         B        ASSGR200
*
AVALERCD EQU      %
*E*      MESSAGE: ILLEGAL VALUE
*E*      DESCRIPTION: THE MESSAGE IS OUTPUT FOR THE FOLLOWING CONDITIONS:
*E*                   1. THE VALUE SPECIFIED FOR DEN IS NOT 800 OR 1600.
*E*                   2. THE CHARACTER SPECIFIED FOR FORMAT IS ILLEGAL.
*E*                   3. THE ID SPECIFIED FOR SEQ IS GREATER THAN FOUR
*E*                      CHARACTERS OR CONTAINS AN ILLEGAL DECIMAL VALUE.
         LI,SR3   VALERCD
         B        ASSGR200
*                                  *
ADVPERR  EQU      %                *
*E*      MESSAGE: DUPLICATE OR CONFLICTING OPTION
         LI,SR3   DVERCD           *DUPLICATE OR CONFLICTING OPTION
         B        ASSGR200         *
*                                  *
ABIGERR  EQU      %                *
*E*      MESSAGE: TOO MANY ASSIGNMENTS
*E*      DESCRIPTION: THE NUMBER OF ASSIGNMENTS EXCEEDED THE AVAILABLE
*E*               SPACE IN THE ASSIGN-MERGE RECORD.
         LW,R5    CJOB              R5 COULD HAVE BEEN CHANGED
         LI,SR3   BIGERCD          *NOT ENOUGH ROMM IN A/M TABLE
         B        ASSGR200         *FOR NEW ENTRY
*                                  *
AOUTERR  EQU      %
*E*      MESSAGE: TOO MANY INSNS OR OUTSNS
         LI,SR3   OUTERCD          *TO MANY INSNS OR OUTSNS
         B        ASSGR200         *
*                                  *
*
ASSGR520 EQU      %
*E*      MESSAGE: ILLEGAL DCB NAME
*E*      DESCRIPTION: THE DCB NAME WAS <3 OR >31 CHARACTERS IN LENGTH.
         LI,SR3   IDCBNAM           ILLEGAL DCB NAME
         B        ASSGR200
*
ASSGR524 EQU      %
*E*      MESSAGE: SYSTEM DCB NOT-ASSIGNABLE
*E*      DESCRIPTION: THE USER IS PROHIBITED FROM ASSIGNING THE
*E*               SPECIFIED SYSTEM DCB.
         LI,SR3   SDCBNA            SYS DCB NOT ASSIGNABLE
         B        ASSGR200
*                                  *
ASSGR528 EQU      %
*E*      MESSAGE: ILLEGAL ASSIGNMENT
*E*      DESCRIPTION: THE M:GO DCB WAS ASSIGNED TO A DEVICE OR THE
*E*               M:C DCB WAS ASSIGNED TO A TAPE OR DISK FILE.
         LI,SR3   ILLASGCD          (SR3) = ILLEGAL ASSIGN CODE
         B        ASSGR200
ASSGROPERR    RES  0
         LW,R5    CJOB              RESTORE JIT POINTER
         LW,SR2   SR3
         SLS,SR2  -17
         LI,SR3   OPERR
*E*      MESSAGE: OP LABEL ERROR
*E*               THE SPECIFIED DCB CONTAINS AN INVALID OP LABEL.
         CI,SR2   X'A05'            OP LABEL ERROR
         BE       ASSGR200
         LI,SR3   OPNERCD
*E*      MESSAGE: ABN. COND. IN OPENING DCB
*E*               ASSGR WAS UNABLE TO OPEN THE SPECIFIED DCB.
         B        ASSGR200
*
ASSGR532 EQU      %
*E*      MESSAGE: ILLEGAL PARAMETER
*E*      DESCRIPTION: THE MODE SPECIFIED FOR IN OR INOUT WAS NOT SHARE
*E*               OR EXCL.
         LI,SR3   PARAMCD           (SR3) = ILLEGAL PARAM CODE
         B        ASSGR200
ASSGR536 EQU      %
*E*      MESSAGE: MAXIMUM NUMBER OF EXECUTE ACCOUNTS EXCEEDED
         LI,SR3   MXEXECCD          TOO MANY EXECUTE ACCOUNTS
         B        ASSGR200
ASSGR538 EQU      %
         PULL     SR1
ASSGR539 EQU      %
*E*      MESSAGE: CAN'T GET DYNAMIC PAGES
         LI,SR3   NOPGERR           (SR3) = CAN'T GET DYNAMIC PAGES
         B        ASSGR200
AS503CR  RES      0
*                 USE  R0,D3
*                 R3=LIST
*                 R2= TO
*                 R5= COUNT
*                 D4= MAX
*                 SR4= EXIT
MPLISTP  AI,R2    1
         AI,R3    1
         CW,R2    D4                TEST FOR END OF PAGE
         BG       ABIGERR
         LW,D3   -1,R3
         STW,D3  -1,R2
         BNEZ     MPLISTP2
         AW,R3    R5                BUMP BY COUNT
         B        *SR4
MPLISTP2 SLS,D3   1
         BCR,8    MPLISTP1
         CW,D4    R2                TEST FOR RUN OVER
         BLE      ABIGERR           TO MUCH DATA
         LW,0     0,R3              THERE
         STW,0    0,R2
         AI,R2    1
MPLISTP1 AI,R3    1
         BDR,5    MPLISTP2
         B        *SR4
*                 USE   R0
*                 R2= TO
*                 R3= FROM
*                 R5= COUNT
*                 SR4= EXIT
*                 D4 = MAX
MLOOP     RES   0
MLPOOP   RES      0
         CW,R2    D4
         BG       ABIGERR
MLPOOP2  LW,0     0,R3
         BEZ      MLPOOP1
         STW,0    0,R2
         AI,R2    1
MLPOOP1  AI,R3    1
         BDR,5    MLOOP
         B        *SR4
*                 TYPE,END,WDS,RES
*
VARLIST  LW,0     0,R3
         BNEZ     VAR1
         AW,R3    R5                INCREASE POINTER
         B        *SR4
VAR1     LW,R1    R2                UPDATE LAST
         B        MLPOOP            MOVE NON-ZEROS
         PAGE                      *
**********************************************
**   OPTION KEYWORD TABLE & CORRESPONDING   **
**   SWITCH TO OPTION HANDLERS              **
**********************************************
ASGKWTBL EQU      %                 ASSIGN KEYWORD TABLE
         TEXT     '    '            DUMMY ENTRY
         TEXT     'JRNL'
         TEXT     'FILE'
         TEXT     'LABE'
         TEXT     'DEVI'
         TEXT     'RAND'
         TEXT     'RSTO'
         TEXT     'CONS'
         TEXT     'KEYE'
         TEXT     'SEQU'
         TEXT     'DIRE'
         TEXT     'IN  '
         TEXT     'OUT '
         TEXT     'INOU'
         TEXT     'OUTI'
         TEXT     'PASS'
         TEXT     'REL '
         TEXT     'SAVE'
         TEXT     'JOB '
         TEXT     'READ'
         TEXT     'WRIT'
         TEXT     'EXPI'
         TEXT     'INSN'
           TEXT 'SN  '
         TEXT     'OUTS'
         TEXT     'RECL'
         TEXT     'TRIE'
         TEXT     'KEYM'
         TEXT     'NOVF'
         TEXT     'VFC '
         TEXT     'COUN'
         TEXT     'DATA'
         TEXT     'TAB '
         TEXT     'SEQ '
         TEXT     'LINE'
         TEXT     'SPAC'
         TEXT     'BIN '
         TEXT     'BCD '
         TEXT     'FBCD'
         TEXT     'NOFB'
         TEXT     'PACK'                                                734
         TEXT     'UNPA'                                                734
         TEXT     'L'
         TEXT     'VOL'                                                 734
           TEXT 'NOSE'
           TEXT 'CYLI'
           TEXT 'NEWX'
           TEXT 'SPAR'
         TEXT     'ANSL'            ANS TAPE
         TEXT     'LREC'            LOGICAL RECORD SIZE
         TEXT     'BLKL'            BLOCK LENGTH
         TEXT     'FORM'            FORMAT
         TEXT     'CONC'            CONCATINATION
         TEXT     'ABCE'            ACCEPT CLOCK COUNT ERROR
         TEXT     'LOGR'            SYNON FOR LRECL
         TEXT     'RECF'            SYNON  FOR FORMAT
         TEXT     'RETE'            SYNON  FOR EXPIRE
         TEXT     'BLKS'            SYNON  FOR BLKL
         TEXT     'DEN'             DENSITY SELECTION FLAG
         TEXT     'ASCI'            EBCDIC-ASCII CONVERSION ON TAPE
         TEXT     'EBCD'            EBCDIC-NO CONVERSION
         TEXT     'EXEC'            EXECUTE ACCOUNTS
         TEXT     'UNDE'            UNDER (VEHICLE)
NASGKW   EQU      %-ASGKWTBL-1      NUMBER OF ASSIGN KEY WORDS
*
ASGJPTBL EQU      %                 ASSIGN KEYWORD JUMP TABLE
         B        %                 DUMMY ENTRY
         B        LJRNL
         B        LFILE
         B        LLABEL
         B        LDEVICE
         B        LRANDOM
         B        LRSTORE
         B        LCONSEC
         B        LKEYED
         B        LSEQUEN
         B        LDIRECT
         B        LIN
         B        LOUT
         B        LINOUT
         B        LOUTIN
         B        LPASS
         B        LREL
         B        LSAVE
         B        LJOB
         B        LREAD
         B        LWRITE
         B        LEXPIRE
         B        LINSN
           B LINSN
         B        LOUTSN
         B        LRECL
         B        LTRIES
         B        LKEYM
         B        LNOVFC
         B        LVFC
         B        LCOUNT
         B        LDATA
         B        LTAB
         B        LSEQ
         B        LLINES
         B        LSPACE
         B        LBIN
         B        LBCD
         B        LFBCD
         B        LNOFBCD
         B        LPACK                                                 734
         B        LUNPACK                                               734
         B        LL                *L  OPTION
         B        LVOL                                                  734
           B LNOSEP
           B LCYL
           B LSLID
           B LSPAR
         B        LANSLBL
         B        LLRECL
         B        LBLKL
         B        LFORMAT
         B        LCONCAT
         B        LABCERR
         B        LLRECL
         B        LFORMAT
         B        LEXPIRE
         B        LBLKL
         B        LDEN
         B        LASCII
         B        LEBCDIC
         B        LEXEC
         B        LUNDE
         PAGE
*F*      NAME:    XEQR
*F*
*F*      PURPOSE: TO PROCESS THE XEQ CONTROL COMMAND
*F*
*F*      DESCRIPTION: XEQR IS CALLED BY CCIR WHENEVER AN XEQ CONTROL
*F*               COMMAND IS ENCOUNTERED. THE CONTROL COMMAND IS
*F*               PROCESSED AND OUTPUT ON THE LL DEVICE. EXISTENCE OF
*F*               THE SPECIFIED COMMAND FILE AND RECORD IS DETERMINED.
*F*               IF NEITHER EXISTS OR IF A SYNTAX ERROR IS
*F*               DETECTED, THE ERROR EXIT IS TAKEN AND A RETURN MADE TO
*F*               CCIR. OTHERWISE A NORMAL EXIT IS MADE TO CCIR.
*F*               ENTRIES ARE MADE IN THE ASSIGN-MERGE RECORD CONTAINING
*F*               THE COMMAND FILE NAME, ACCOUNT, PASSWORD, AND STARTING
*F*               RECORD NUMBER. THE CFE BIT IS SET IN THE JIT TO
*F*               INDICATE COMMAND FILE EXECUTE MODE.
*F*
*F*      REFERENCE: BATCH PROCESSING REFERENCE MANUAL
*F*                 DATA BASE TECHNICAL MANUAL
*F*
XEQR     EQU      %
         PUSH     SR4               SAVE RETURN TO CCIR
         PUSH     R7                SAVE CC PARAM LIST POINTER
         LI,R4    K2                SET CC LIST FLAGS FOR LL DEVICE
         BAL,SR4  SCCLF
*
         PUSH     SR1               SAVE LAST CHAR. SCANNED
         CAL1,8   GETPAGE           GET PAGE FOR A/M RECORD
         BCS,8    ASSGR538          ERROR IF NOT AVAIL.
         STW,SR2  R6
         BAL,SR4  RAMR              READ A/M RECORD
         PULL     SR1
         MTW,0    SR3
         BNEZ     ASSGR200          ERROR IF SR3 NOT=0
*
         LW,R1    AM:LNK,R6         IS THERE ROOM FOR CFE ENTRIES?
         CI,R1    :AMHED+CFESIZE    (PERHAPS WE WERE IN CFE MODE BEFORE)
         BE       XEQR30            IF SO, DON'T HAVE TO MOVE A/M ENTRIES
         MTW,0    AM:LNK,R6         ANY PLIST ENTRIES
         BEZ      XEQR25            NO, DON'T HAVE TO MOVE ENTRIES
*
         LW,R1    AM:ORG,R6         MAKE ROOM FOR CFE ENTRIES
         AI,R1    CFESIZE-1
         CI,R1    AM:END            DETERMINE IF ENOUGH ROOM
         BG       XEQR100           NOT ENOUGH
*
         LW,R2    AM:ORG,R6         CALC. ENTRIES TO MOVE DOWN
         SW,R2    AM:LNK,R6
         LW,R3    AM:ORG,R6         FROM
         AI,R3    -1
XEQR10   EQU      %
         LW,R4    *R6,R3
         STW,R4   *R6,R1            TO
         AI,R3    -1
         AI,R1    -1
         BDR,R2   XEQR10
*
         LW,R1    AM:LNK,R6         ADJUST LINKS BY 8
         MTW,7    AM:LNK,R6
         MTW,1    AM:LNK,R6
XEQR20   EQU      %
         AI,R1    CFESIZE           NEW LINK LOCATION
         LW,R2    *R6,R1            IS THIS THE LAST ENTRY
         BEZ      XEQR25            YES
         MTW,7    *R6,R1
         MTW,1    *R6,R1
         STW,R2   R1
         B        XEQR20
XEQR25   EQU      %
         MTW,7    AM:ORG,R6         ADJUST POINTER TO AVAIL. SPACE
         MTW,1    AM:ORG,R6
XEQR30   EQU      %
         LW,D1    F:CF              CLOSE DCB IF OPEN
         CW,D1    Y002
         BAZ      XEQR32
         LI,D1    F:CF
         CAL1,1   CLSDCB
XEQR32   EQU      %
         LI,D1    1                 SET DEFAULT STARTING RECD. NUMBER
         STW,D1   AM:CREC,R6
*
         CI,SR1   KBLANK            CHECK IF BLANK FOLLOWS XEQ
         BNE      ABLNKERR          ERROR IF NO BLANK
XEQR35   EQU      %
         LI,SR2   KLPAREN           CHECK IF NEXT CHAR IS LEFT PAREN
         BAL,SR4  CHARSCAN
         BCS,8    ALPERR            ERROR IF NOT
         BAL,SR4  NAMSCAN           GET KEYWORD
         LW,R1    PLB,R7            (R1) = 1ST 4 CHAR OF KEYWORD
         LI,R2    XEQKWTBL          (R2) = ADR OF KEYWORD TABLE
         LI,R3    NOXKW             (R3) = NUMBER OF KEYWORDS IN TABLE
         LI,R4    AKWERR            (R4) = BRANCH ADR IF SEARCH FAILURE
         BAL,SR4  WDTBLSRH          SEARCH TABLE
         B        XEQJPTBL,R3       BRANCH TO PROCESS PARAMETER
         PAGE
XEQR40   EQU      %
         LI,SR2   KRPAREN           CHECK FOR RIGHT PAREN
         BAL,SR4  CHARSCAN
         BCS,8    ARPERR            ERROR IF NOT
         LI,SR2   KCOMMA            CHECK FOR COMMA
         BAL,SR4  CHARSCAN
         BCR,8    XEQR35            GET NEXT OPTION
         BAL,SR4  CHKTERM           CHECK IF LEGAL CC TERMINATOR
         BCS,8    ASSGR200          ERROR
         BAL,SR4  EOCCSCAN          SKIP TO END OF CC AND LIST
* FINALIZATION
         LW,R1    Y08               WERE WE PREVIOUSLY IN CFE MODE?
         CW,R1    J:JIT
         BANZ     XEQR45            YES
         STS,R1   J:JIT             NO, SET CFE BIT
         B        XEQR50
XEQR45   EQU      %
         CAL1,8   GETPAGE           GET PAGE TO READ OLD A/M REC'D
         BCS,8    ASSGR539          TO GET CURRENT FILE NAME ETC.
         BAL,SR4  RAMR              READ IN OLD A/M REC'D
         MTW,0    SR3
         BNEZ     ASSGR200          ERROR READING A/M REC'D
         PUSH     R6
         STW,SR2  R6
         MTW,-1   AM:CREC,R6        REC'D NUMBER OFF BY 1
         LI,D2    FTRMDM            STORE REC'D NUMBER INTO MSGE.
         BAL,SR4  WRCFM             WRITE MSGE. 'XXX TERMINATED ETC.'
         CAL1,8   FREEPAGE          RELEASE THE PAGE
         PULL     R6
XEQR50   EQU      %
         LW,SR2   R6
         BAL,SR4  WAMR              WRITE THE NEW A/M RECORD
         MTW,0    SR3               CHECK FOR A/M WRITE ERROR
         BNEZ     ASSGR200          ERROR
*
         LI,D3    0                 SET ERR ADDR
         LI,D4    0                 SET ABN ADDR
         BAL,SR4  OPNXS             DETERMINE IF FILE AND RECORD EXIST
         MTW,0    SR3
         BNEZ     ASSGR200          NO
         LI,D2    FEXECM            STORE RECD. NO. INTO MESSAGE AND
         BAL,SR4  WRCFM             WRITE MESSAGE 'XXX EXECUTING AT NNN'
         LI,D1    F:CF
         CAL1,1   CLSDCB
         CAL1,8   FREEPAGE
         PULL     R7
         PULL     SR4
         AI,SR4   1
         B        *SR4
         PAGE
*************************
**   OPTION HANDLERS   **
*************************
XEQFLE   EQU      %
         LI,SR2   KCOMMA            CHECK FOR COMMA
         BAL,SR4  CHARSCAN
         BCS,8    ACOMERR           ERROR IF NOT
         BAL,SR4  NAMSCAN           GET NAME
         BCS,8    ANAMERR           ERROR IF NOT LEGAL NAME
         LW,R1    CSL,R7
         CI,R1    KB                ERROR IF NAME>11 CHARS
         BG       ANAMERR
         LW,R0    R7
         AI,R0    PLB
         LI,R2    1
         BAL,SR4  CHSTSHFT          FORM TEXTC NAME
         LCI      K3                STORE COMMAND FILE NAME
         LM,R0    PLB,R7
         STM,R0   AM:CNAME,R6
*
         LI,SR2   KCOMMA            CHECK FOR COMMA
         BAL,SR4  CHARSCAN
         BCR,8    XEQFLE5
         LCI      K2                USE USER ACCN FOR DEFAULT
         LM,R0    J:ACCN
         STM,R0   AM:CACCT,R6
         B        XEQFLE12
XEQFLE5  EQU      %
         BAL,SR4  GETACCN
         BCS,8    ASSGR200          ERROR IF NOT LEGAL ACCOUNT
         LCI      K2
         LM,R0    PLB,R7
XEQFLE10 EQU      %
         STM,R0   AM:CACCT,R6       STORE ACCOUNT NAME
*
         LI,SR2   KCOMMA            CHECK FOR COMMA
         BAL,SR4  CHARSCAN
         BCR,8    XEQFLE15
XEQFLE12 EQU      %
         LI,R0    0                 SET PASSWORD=0
         LI,R1    0
         LCI      K2
         B        XEQFLE20
XEQFLE15 EQU      %
         BAL,SR4  GETPASSW          GET PASSWORD
         BCS,8    ASSGR200          ILLEGAL
         LW,R1    CSL,R7            CHECK IF PASSWORD<=8 CHARS
         CI,R1    K8
         BG       ACHSTERR
         LCI      K2
         LM,R0    PLB,R7
XEQFLE20 EQU      %
         STM,R0   AM:CPASS,R6       STORE PASSWORD
         B        XEQR40
         PAGE
XEQREC   EQU      %
         LW,R1    Y4                GET STARTING RECORD NUMBER
         BAL,SR4  GETDECVAL
         BCS,8    ASSGR200
         STW,R2   AM:CREC,R6
         B        XEQR40
XEQR100  EQU      %
*E*      MESSAGE: COMMAND FILE EXECUTION ABORTED DUE TO LACK OF
*E*               SPACE IN ASSIGN-MERGE RECORD.
*E*      DESCRIPTION: THE ASSIGN-MERGE RECORD CONTAINS INSUFFICIENT
*E*               SPACE TO RETAIN COMMAND FILE INFORMATION.
         BAL,SR4  EOCCSCAN          PRINT CC
         LI,SR3   CFEXAM
         B        ASSGR200
         PAGE
**********************************************
**   OPTION KEYWORD TABLE & CORRESPONDING   **
**   BRANCH TO XEQ OPTION HANDLERS          **
**********************************************
XEQKWTBL EQU      %
         TEXT     '    '
         TEXT     'FILE'
         TEXT     'REC '
NOXKW    EQU      %-XEQKWTBL-1      NUMBER OF XEQ KEYWORDS
*
XEQJPTBL EQU      %                 XEQ KEYWORD JUMP TABLE
         B        %
         B        XEQFLE
         B        XEQREC
         END

