MONPROC  SET      1
ANSPROC  SET      1
         SYSTEM   UTS
         DEF      OBSE
OBSE     EQU      %
         PAGE
         BOUND    8
K2       EQU      2
K9       EQU      X'9'
K0       EQU      X'0'
K1       EQU      X'1'
K3       EQU      X'3'
K4       EQU      X'4'
K5       EQU      X'5'
K6       EQU      X'6'
K14      EQU      X'14'
K4000    EQU      X'4000'
KF0      EQU      X'F0'
KFFFF    EQU      X'FFFF'
K1FFFF   EQU      X'1FFFF'
KN1      EQU      -X'1'
         PAGE
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     DEFS OPN
         DEF      LOCCODEA,LOCCODE
         DEF      LOCCODE1
         DEF      COMPARE
         DEF      MSRMOVE
         DEF      GETACNADR,GETFILADR
         DEF      CHKFLACN
         DEF      SECCHK
         DEF      OPER
         DEF      SETACOG
         DEF      SETSCR
         DEF      OPENER03
         SREF     OPNER
         DEF      OPNX
         SPACE    3
         OPEN     WXBUFSIZ,XBUFSIZ
WXBUFSIZ EQU      X'200'
XBUFSIZ  EQU      X'800'
         PAGE     REFS OPEN
         REF      DOUBLEONE
         REF      GETFUN
         REF      MSR01EXIT
         REF      MSRWRTX
         REF      PULLEXIT,PULLEXIT1
         REF      XFF
         REF      Y0038
         REF      Y01
         REF      Y00FF
         REF      PUF
         REF      S:CUN,UH:FLG
         BOUND    8
NONE     TEXT     'NONE'
ALL      TEXT     'ALL'
         REF      ACCN
         REF      JB:PRIV
         REF      Y0008,Y00FE
         REF      J:ACCN
         REF      SYSACT
         REF      CHKANS0,ANSFLGS
         REF      M7,BATAPE,AVRTBLSIZ
         SREF     CLSVNO
         REF      J:BASE
         PAGE
OPENER01 LI,SR3   K1
         DEF      OPENER01
         B        OERX
OERXM1   PULL     SR3               RESTORE ERROR CODE
         DEF      OERX
OERX     EQU      %
         LI,11    MSR01EXIT
         B        T:SELFDESTRUCT
OPNX     EQU      %
         LI,R1    BADSI
         LB,R1    *R6,R1
         AI,R1    -BATAPE
         BLZ      OPNX1
         CI,R1    AVRTBLSIZ
         BGE      OPNX1
         LB,R4    ANSFLGS,R1
         AND,R4   M7
         BAL,R0   CHKANS0
         AI,R4    X'80'
         STB,R4   ANSFLGS,R1
OPNX1    EQU      %
         LI,11    MSRWRTX
         B        T:SELFDESTRUCT
*
*
*
*
LOCCODEA EQU      %
*                                   ENTRY POINT IF CURRENT SIZE OF
*                                   ZERO IS TO REPRESENT NO CODE
         BAL,R4   LOCCODEB
         B        0,R5              DIDN'T FIND CODE
         LI,R1    K2
         LB,R1    D2,R1             CURRENT SIZE
         BEZ      0,R5              DIDN'T FIND
         B        ONE,R5
LOCCODEB LW,R7    FLP,R6
LOCCODE  EQU      %                 LOCATE CODE OF VARIABLE LENGTH
*                                   PARAMETER
*                                   R7 = ADDR OF LIST
*                                   D1 = CODE DESIRED
         LI,R3    K0
LOCCODE1 LW,D2    *R7,R3
         AI,R3    K1
         CB,D1    D2
         BE       ONE,R4
         CW,D2    Y00FF             DONE
         BANZ     0,R4
         AND,D2   XFF
         AW,R3    D2
         B        LOCCODE1
*
         SPACE    3
ORGCHK   EQU      %
         DEF      ORGCHK
*          CHECK DCB FOR RANDOM ORGANIZATION
         LI,D2    X'30'
         CS,D2    ORG,R6
         B        0,4
         SPACE    3
GETFUNA  EQU      %
         LW,D1    FUN,R6
         REF      Y0014
         CW,D1    Y0014             CHK OUTIN & OUT
         B        *D2
         DEF      GETFUNA
         SPACE    3
*
COMPARE  EQU      %                 COMPARE WORD STRING
         LI,R0    K2
COMPL    RES      0
*                                   R7 # SOURCE ADR
*                                   R3 = SOURCE DISPLACEMENT
*                                   D3 = DEST ADR
*                                   R1 = DEST DISPLACEMENT
*                                   R0 = NUMBER OF WORDS TO COMPARE
         LW,D2    *R7,R3
         CW,D2    *D3,R2
         BNE      PLX1SR4+1         NO COMPARE, GO TO SR4
         AD,R2    DOUBLEONE
         BDR,R0   COMPL
         B        PLX1SR4           DO COMPARE, GO TO SR4+1
         REF      PLX1SR4
MSRMOVE  EQU      %
         AW,R0    R3                R0 = END DISPLACEMNT
         B        MSRMOVE1
MSROPN14 LW,D2    *R7,R3            XFER FILE PARAMS
         STW,D2   *D3,R2
         AD,R2    DOUBLEONE
MSRMOVE1 EQU      %
         CW,R3    R0
         BL       MSROPN14
         B        *SR1
*
GETACNADR  EQU    %                 GET ADR OF ACCOUNT NO
         LI,R2    HAACD
GETACNADR1  EQU   %
         LH,R7    *R6,R2
         AW,R7    FLP,R6
         B        *R0
GETFILADR EQU     %
         LI,R2    HAFLD             GET ADDRESS OF FILE NAME
         B        GETACNADR1
*
*
*
*
*                                   AND FILE NAME TO OPEN FILE
CHKFLACN EQU      %
         LI,D4    K1FFFF            MUST HAVE KEY BUFFER
         AND,D4   KBUF,R6
         BEZ      OPENER03
*                                   MUST BE SPACE FOR ACCOUNT NUMBER
         LI,D1    K1                MUST HAVE FILE NAME
*                                   CHECK FOR NEXT OPTION
         LW,D3    Y01               CLR X'4000' FOR USR RESET
         AND,D3   NXTF,R6
         BNEZ     CHKFLACN3         SPECIFIED
*
         BAL,R5   LOCCODEA
         B        OPER3
         LW,R2    *R7,R3
         LB,R2    R2                CHK NAME LEGAL
         BEZ      OPER3             CAN'T BE ZERO
         CI,R2    FNEMAX
         BL       1A1
*
OPER3    LI,SR4   X'40000'
         AND,SR4  NXTA,R6
         BNEZ     CHKFLACN5
OPENER03 EQU      %
         LI,SR3   K14
ER1401   RES      0
         DEF      ER1401
         LI,SR4   14
         CW,SR4   ASN,R6            CHK FOR FILE
         BAZ      OPNER             IT IS
OPER     RES      0
         PUSH     SR3               SAVE ERROR CODE
         LI,SR4   OERXM1            SET RETURN
OPER1    RES      0
         REF      OPERC
         LI,R0    X'E'
         CW,R0    ASN,R6
         BANZ     PLX1SR4+1         NOT A FILE GO TO SR4
         LI,R1    0
         STB,R1   J:STAR            RESET FETCH FLAG
         LI,R1    X'1FFFF'
         AND,R1   CFU,R6
         CI,R1    BGRCFU
         BGE      2W3
         LW,R1    J:BASE+7
         CI,R1    BGRCFU
         REF      BGRCFU
         BL       OPERC             NO CFU HERE
         CI,R1    X'FFFF'
         BGE      OPERC
2W3      RES      0
         LW,D2    0,R1
         AI,D2    -X'20000'         DECREASE # OF USERS
         CW,D2    Y00FE
         BANZ     3A1               THERE'S A USER
         MTW,1    ACNCFU+12
         REF      ACNCFU
         LI,R2    X'FFFF'           CHK 4 SCFU
         AND,R2   SCFU,R1
         BEZ      3A2               THERE'S NONE
         LI,R3    X'F0000'
         AND,R3   SCFU,R2
         STW,R3   SCFU,R2
3A2      RES      0
         LI,D2    0
         STW,D2   2,R1              CLOBBER THE NAME & ACCT
         STW,D2   SCFU,R1
3A1      RES      0
         STW,D2   0,R1
         B        OPERC
1A1      SLS,R2   -2                WORD ALIGN
         AND,D2   XFF               # WDS AVAIL
         CW,R2    D2
         BL       CHKFLACN5         THERE'S ENUF ROOM
         LI,SR3   1                 NOT ENUF RUUM
         B        ER1401
*
CHKFLACN3 BAL,R4  LOCCODEB
         B        OPENER03
         CI,D2    X'F8'             MUST BE 8 WORDS OR MORE
         BAZ      OPENER03          LESS THAN 8
CHKFLACN5 EQU     %
         LI,R2    HAFLD             SAVE FILE NAME DISP
         STH,R3   *R6,R2
*
*
*
         LI,D1    K2
         BAL,R4   LOCCODE
         B        OPENER03
*                                   SET UP ACCOUNT NO
         CI,D2    X'FE'             2 WORDS REQUIRED
         BAZ      OPENER03          BAD NEWS
         LI,R2    HAACD
         STH,R3   *R6,R2
         REF      J:JIT
         LW,R1    J:JIT+ACCN
         LW,R2    J:JIT+ACCN+1
         CI,D2    X'FF00'
         BANZ     CHKFLACN1         USER SPEC'D AN ACCT
         LCI      2
         STM,R1   *R7,R3
         B        CHKFLACN2A        CLR USR FLG
*
CHKFLACN1  EQU    %
         CW,R1    *R7,R3
         BNE      CHKFLACN2         DIFFERENT FILE
         AI,R3    1
         CW,R2    *R7,R3
         BE       CHKFLACN2A
CHKFLACN2  EQU    %
         LI,D3    K4000
CHKFLACN2A   EQU  %
         LI,D4    K4000
         STS,D3   USR,R6
         B        *R0
*
*        IS USER QUALIFIED TO USE THIS FILE
*                                   CHECK SECURITY
*                                   R3 = DISPLACEMENT IN BUFFER OF DEY
*                                   D3 = BUFFER ADDRESS
SECCHK   EQU      %                 CHECK SECURITY
         PUSH     1,R0
*                                   MONITOR CAN OPEN ALLFILES
         LB,4     JB:PRIV
         CI,4     X'C0'
         BGE      PULLEXIT1
SECCHK0  LI,D1    K3
         BAL,R4   LOCCODE
         B        SECCHK1           PASSWORD IS NOT SPECIFIED
         CI,13    X'FF'
         BANZ     SECCHK05          PASSWORD HAS REAL WORDS
         LCI      2
         LM,4     J:ACCN
         CD,4     SYSACT            AND IS IT SYS ACCT
         BNE      CLRFIB            NO
SEC3     LI,D2    K4000
         STS,D1   USR,R6
         B        PULLEXIT1         YES PERMIT NULL ACCESS
SECCHK05 EQU      %
         LW,R2    R3
         BAL,R5   LOCCODEA
         B        CLRFIB
         BAL,SR4  COMPARE
         B        CLRFIB
         LW,R7    D3                GO BACK AND CHECK ACCOUNTS
SECCHK1  EQU      %
         LI,D1    K4000             IS THIS USERS OWN FILE
         AND,D1   USR,R6
         BEZ      PULLEXIT1         YES--CAN READ OR WRITE
         LI,D1    K6                WRITE ACCTS
         BAL,R4   LOCCODE
         B        SECCHK4
SECCHK2  LI,SR2   X'FF'
         AND,SR2  D2
SECCHK2B LW,D2    *R7,R3
         CLM,D2   NONE
         BCR,12   SECCHK3
         BE       SECCHK2R
         LI,D3    J:JIT
         LI,R2    ACCN
         BAL,SR4  COMPARE
         B        SECCHK2A
SECCHK3  CI,D1    K6
         BNE      PULLEXIT1
         B        SEC3
SECCHK2A AW,R3    R0
         AI,SR2   KN1
         BDR,SR2  SECCHK2B
SECCHK2R CI,D1    K6
         BE       SECCHK4           TRY FOR READS
         LI,D1    X'14'             EXECUTE ACCTS
         BAL,R4   LOCCODE
         B        PULLEXIT          NO ACCESS
         B        SEC1
*
SEC0     LI,D1    X'14'             EXECUTE ACCTS
         BAL,R4   LOCCODE
         B        PULLEXIT1         GIVE ACCESS
SEC1     LI,SR2   X'FF'
         AND,SR2  D2
SEC11    LW,D2    *R7,R3
         CLM,D2   NONE
         BE       PULLEXIT          NO ACCESS
         BCR,12   SEC99             GIVE ACCESS
         LI,D3    J:JIT
         LI,R2    ACCN
         BAL,SR4  COMPARE
         B        SEC12             NO HIT
SEC99    LI,D1    X'15'             ACCESS VEHICLE
         BAL,R4   LOCCODE
         B        SEC98             TRY FOR FETCH
         LW,D1    MXFPL+5           M:XX ACCT
         LW,D2    MXFPL+6
         CD,D1    SYSACT            IS IT :SYS
         BNE      PULLEXIT          NO ACCESS
         AW,R3    R7
         SLS,R3   2                 BYTE ALIGN
         LB,R2    0,R3              TEXTC LENGTH
         AI,R2    1
         STB,R2   R3
         REF      J:STAR,MXFPL
         LI,R2    MXFPL+1           M:XX NAME
         SLS,R2   2                 BYTE ALIGN
         CBS,R2   0
SEC99M1  BNE      PULLEXIT          NO ACCESS
SEC97    LI,D2    X'100'            SPECIAL ACCESS FLAG
         STS,D2   0,R6
         B        PULLEXIT1         GIVE ACCESS
SEC12    AW,R3    R0
         AI,SR2   KN1
         BDR,SR2  SEC11
         B        PULLEXIT          NO ACCESS
SEC98    LC       J:STAR
         BCR,8    PULLEXIT          NOT FETCH
         B        SEC97             OPEN IT UP
*
SECCHK4  RES      0
         BAL,D2   GETFUN
         CI,D1    14
         BANZ     PULLEXIT
         LI,D1    K5                READ ACCTS
         BAL,R4   LOCCODE
         B        SEC0
         B        SECCHK2
*
CLRFIB   LI,0     BUF2MSK
         AND,0    BUFX,R6
         BEZ      PULLEXIT
         LI,R2    WXBUFSIZ-1
         STW,R2   BUFF2,R2          DESTROY THE FIT
         BDR,R2   %-1
         B        PULLEXIT
*
SETACOG  EQU      %                 SET ACCESS AND ORGANIZATION
         BAL,R4   ORGCHK
         BNE      SETACOG1
         BAL,D2   GETFUNA
         BAZ      SETACOG1
         LW,D1    Y0008
         LW,D2    Y00FE
         STS,D1   FUN,R6            SET FUN = UPDATE
         B        *SR4
SETACOG1 EQU      %
         BAL,D2   GETFUNA
         BANZ     PPSET0X
         LI,D1    K9
         BAL,R4   LOCCODE           GET FILE INFO
         B        PPSET0X
         LW,D1    *R7,R3
         LI,D2    1
         SLD,D1   17
         STS,D1   CYL,R6            SET CYL ALLOC
         SLS,D1   -1
         SLD,D1   -8
         STS,D1   NOSEP,R6          NOSEP(INDEX ON PACK)
*                                   R3 = DISPLACEMENT OF CODE
         LM,D2    *R7,R3
         LB,D1    D2                ORG
         SLS,D1   K4
         LI,R1    BAKEYM
         LH,R0    D2                KEYM
         STB,R0   *R6,R1
         STW,D3   WRDL0,R6          SLIDES,LSLIDES,LRDL0,SPARE
         REF      MULSEG,OPV#
*
*        MUST ASSURE CORRECT NUMBER OF VOLS ARE OPEN
*        FOR PRIV. PACKS, WHEN REPLACING EXISTTINGG
*        FILES, WHEN CONSEC IS INVOLVED
*
         LI,R1    X'800'
         CW,R1    PRIV,R6
         BAZ      PPSET0            NOT PRIVATE CONTINUE
         LI,D2    X'20'             CHECK THAT PROPER # VOLS OPEN
         CS,D1    ORG,6
         BE       PPSET0            YES
         STS,D1   ORG,6             NO, SET FOR OPV
         PUSH     2,11              NOW GO OPEN THE PROPER NUMBER
         BAL,11   CLSVNO            CLOSE ALL OPEN VOLUMES
         LI,9     X'80000'          SET 9 NEG SO OPV KNOWS US
         OVERLAY  MULSEG,OPV#
         PULL     3,11
         AI,13    0                 CHECK RETURN CODE FROM OPV
         BEZ      OPNER             NO GOOD
PPSET0   LI,D2    X'70'
         STS,D1   ORG,R6
PPSET0X  EQU      %
         LI,R3    3                 ASSUME CONSEC
         LI,1     BAKEYM
         LI,2     X'20'
         CW,2     ORG,R6            ORGTEST
         BAZ      SETACOG3B         IT'S CONSEC
         LB,R3    *R6,R1
         BNEZ     SETACOG3A
SETACOG3C AI,R3   11
SETACOG3B   EQU   %
         LW,R0    SR4
         STB,R3   *R6,R1
         AI,R3    1
SETSCR   LI,R2    BASCR
         STB,R3   *R6,R2
         B        *R0
SETACOG3A  EQU    %
         CI,R3    FNEMAX-1          KEY CAN'T BE TOO LARGE
         BLE      SETACOG3B
         LI,R3    FNEMAX-1
         B        SETACOG3B
         REF      DOUBLEZERO
FRSTWRD  GEN,8,8,8,8 1,0,FNEMAX/4+1,FNEMAX/4+1
         SPACE    3
*****    FPARAM   *****
*  THE FOLLOWING CODE TRANSFERS THE FIT INFO TO THE USER'S
*  FPARAM AREA.
*
TRNINFO  LI,D3    K1FFFF
         AND,D3   FPARAM,R6
         BEZ      *SR1
         DEF      TRNINFO,CHKADR    FOR OPNL
         LI,D2    89
         BAL,R2   CHKADR            RETURN IF D3 THRU D3+D2 IS USERS
         BNE      TRNABRT           FPARAM NOT IN USER AREA
         LW,R7    QBUF,R6           INPUT FROM QBUF+1 IF TAPE
         AI,R7    1
         LI,D2    2
         CW,D2    ASN,R6
         BANZ     TRNINFO1
         BAL,0    SETVAR
         SREF     SETVAR
         NOP
         AI,7     -((8+FNEMAX)/4)+1
         LW,2     FRSTWRD
         LW,D3    FPARAM,R6
         STW,2    *D3
         AI,D3    1
TRNINFO1 LI,0     89
         LD,2     DOUBLEZERO
         B        MSRMOVE+1
         SPACE    3
CHKADR   LW,R7    D3             CHECK D3 AND D3+D2 FOR USER AREA
*                                    RETURN CC1 & CC2 =0 IF OK
         AW,R7    D2
         SLS,R7   -9
         BAL,11   T:IACU
         BCS,3    CHKADR1           BAD ADDRESS, CHK SJAC
         LW,R7    D3
         SLS,R7   -9
         BAL,11   T:IACU
         BCR,3    0,R2
CHKADR1  LW,R7    S:CUN             CHECK FOR SPECIAL JIT ACCESS
         LH,R7    UH:FLG,R7
         EOR,R7   BT31TO0+13
         AND,R7   BT31TO0+13        SETS EQ IF BIT WAS SET, ELSE NE
         B        0,R2
         SPACE    3
         REF      TRNABRT,T:IACU    DEF'D IN OPNF,AND OPNTP
*
*     CHECKS DCB NAME FOR 4 CHARS STARTING M: AND ENDING
*            WITH AN OPLBL.  EXITS SKIPPING IF PRESENT
DCBNAMCHK EQU      %
         DEF      DCBNCHK
DCBNCHK  RES      0
         LW,R5    TSTACK
         LW,R4    -4,R5
         LB,SR1   R4
         LI,R5    J:JIT
         LW,D1    0,R4
         LW,D2    1,R4
         SLD,D1   -8
         CI,D1    X'4D47A'
         BNE      BISR4
         SLD,D1   16
         LI,R2    17                # ENTRIES FOR FILE EXTENSION
         LI,D2    KFFFF
OPFIND1  LH,D3    SH:OPNM,2         FIND M:II OPLB
         REF      SH:OPNM
         CS,D1    D3
         BE       OPFIND2           MATCH
         BDR,R2   OPFIND1
         CW,D1    MGODCB            M:GO ISN'T IN TABLE
         BNE      *SR4
         LI,R2    1                 M:GO IS FIRST ENTRY
OPFIND2  RES      0
         LI,D2    K1
         SLS,D2   -1,R2
         AI,SR4   1
BISR4    RES      0
         B        *SR4
MGODCB   TEXT     'M:GO'
*
         DEF      BISR4
         SPACE    3
SETOPN   LW,D1    Y002
         LW,D2    Y002C3
         STS,D1   FCD,R6
         B        SETTYC
Y002C3   DATA     X'002C3000'
         DEF      SETOPN
         REF      Y002
         REF      SETTYC
         END

