*M*      OPNF     OPEN FILE MODULE
BITS     SET      1
UFLAGS   SET      1
MONPROC  SET      1
ANSPROC  SET      1
         SYSTEM   UTS
         PCC      0
OPNF:    EQU      %
         SPACE    2
*P*      NAME:    OPNF
*P*      PURPOSE  OPEN DCB TO DISC FILE
         SPACE    3
         BOUND    8
K2       EQU      2
K7       EQU      X'7'
KD       EQU      X'D'
K3       EQU      X'3'
K4       EQU      X'4'
KF       EQU      X'F'
K4000    EQU      X'4000'
K1FFFF   EQU      X'1FFFF'
KN2      EQU      -X'2'
K55      EQU      X'55'
         SPACE    3
         OPEN     WXBUFSIZ,XBUFSIZ
WXBUFSIZ EQU      X'200'
XBUFSIZ  EQU      X'800'
         TITLE    '    OPEN FILE MODULE'
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
*
DESC     EQU    17      BYTES 1-3,WD 17,DCB-DESCRIPTORS TEMP STOR IN OPN
NOACUP   EQU      5                 DCB WD 5,BIT 5-NO ACCESS UPDATE
TSTF     EQU      16                TEST FILE FLAG IN DCB-WD 16,BIT 12
CFUDCB   EQU      1                 M:* DCB PROCESSING FOR CFU'S
         SPACE    2
         DEF      OPNF:             NAME FOR MODULE PATCHING
         DEF      SETFUNCN          STORE (D1) IN DCB:FUN
         DEF      RAND31            RETURN FROM GRAND
         DEF      SETVAR            LOCATE FIT IN FIT GRANULE
         DEF      CHNGNAM           PART OF NAME CHANGING LOGIC
         DEF      SETOPEN           FINISH DIAGNOSTIC OPEN
         DEF      OPENER            ABNORMAL 03-00
         DEF      9H38              ALIGN ERROR CODE & EXIT
         SPACE    3
FITSIZE  EQU      80
NWFITST  EQU      WXBUFSIZ-FITSIZE
         SPACE    1
         SPACE    2
         REF      ACNCFU            THE ACCOUNT CFU
         REF      BGRCFU            THE 1ST USER CFU ADDRESS
         REF      CFUSIZE           THE SIZE OF A CFU BLOCK
         REF      DOUBLEZERO        DBLWD OF ALL ZEROS
         REF      FILCFU            THE FILE CFU
         REF      FNDKY             GO FRWRD IN A DRCTRY
         REF      GETCMD            FIND POS'N IN GRANULE
         REF      GETFUN            WHAT IS THE DCB FUNCTION
         REF      GETTYC            WHAT IS THE DCB TYPE OF COMPLETE
         REF      CFUGARB           CFU AREA RECONSTRUCTION
         REF      TRUNC             TRUNCATE THE BUFFERS FROM A DCB
GARB1    EQU      -1
GARB2    EQU      0
         REF      OPV#              OPEN PRIV VOL ENTRY TO MULSEG
         REF      ERFILDA           REPORT 75 ERROR
         REF      LASTCFU           END OF CFU AREA
         REF      PULLEXIT          PULL REG, BR INDIRECT
         REF      PULLEXIT1         PULL REG, INCR 1, BR INDIRECT
         REF      PULLFOUR          GET NEXT FOUR BYTES FROM BUFF2
         REF      REDSEC            READ DISC
         REF      SETUPUB           SEARCH FOR SPECIFIC KEY
         REF      OPNX              FINAL EXIT FROM OPEN
         REF      ER1400            REPORT ABNORMAL 14-00
         REF      SETACOG           SET ACCESS AND ORG
         REF      SECCHK            PERFORM SECURITY CHECKS
         REF      CHKFLACN          VALIDATE FILE NAME/ACCOUNT
         REF      GETACNADR         LOCATE ACCOUNT IN DCB VLPS
         REF      GETFILADR         LOCATE FILE NAME IN DCB VLPS
         REF      LOCCODEA          FIND VLP IN DCB
         REF      LOCCODE           FIND VLP
         REF      SETSCR            STORE SCR INTO DCB
         REF      OPER              ERROR EXIT
         REF      J:FDDA            USER'S FILE DIR FDA
         REF      J:ACCN            ACCOUNT IN JIT
         REF      SETCMD            SET DCB:CMD TO MIDIS
         REF      J:CPPO            FILE EXTENSION FLAGS
         REF      Y00FF             BITS 8-15
         REF      Y00FE             BITS 8-14
         REF      Y006
         REF      REDSECL           READ DISC WITH LINK CHECK
         REF      T:REG             REPORT EVENT, GIVE UP CONTROL
         REF      E:OCR             EVENT:  BECOME OPEN/CLOSE USER
         REF      S:CUN             CURRENT USER #
         REF      OPNCLSUS          CURRENT OPEN/CLOSE USER
         REF      JB:PRIV           USER'S PRIVILEGE
         REF      FMCHKDA           VALIDATE DISC ADDRESS
         REF      PRIVDCB           CHECK IF PRIVATE PACK
         REF      TB:FLGS           DEVICE FLAGS
         REF      UH:FLG            USER FLAGS
         REF      J:DCBLINK         ADDR OF FIRST DCB TABLE
         REF      TYPMNSZ           SIZE OF TB:FLGS
         REF      U:MISC            MISCELLANEOUS USER CELLS
         REF      GARBING           NON-ZERO IF COLLECTING
         REF      E:SL              SLEEP CODE FOR SCHEDULER
         REF      SV:DFDK           DEFAULT DISC TYPE
         REF      EOFMITST          TEST FOR END-OF-FILE
         REF      KEYTRAN           TRANSFER KEY TO DCB
         REF      SYSID             USER SYSID IN JIT
         REF      J:STAR            TABLE OF * FILE DISC ADDRESSES
         REF      DOUBLEONE
         REF      DCBNCHK           CHECK FOR M:OPLABEL TYPE DCB
         REF      TXTCFU            NAME OF M:*
         REF      GRAND:            ALLOCATE RANDOM FILE
         REF      CLRBBUF           RELEASE BUF1
         REF      CLRBFUB           RELEASE BUF2
         REF      T:SBUF            SWITCH DCB POOL BUFFERS
         REF      ENTERO            ENTER KEY IN DIRECTORY
         REF      OERX              EXIT WITH ERROR
         REF      PEOF#             ENTRY IN MISOV FOR POSITION EOF
         REF      MISOVSEG          OVERLAY # OF MISOV
         REF      ORGCHK            CHECK FOR RANDOM FILE
         REF      SYSACCT           TEXT :SYS
         REF      SYSACTL           DISC ADDR OF :SYS FILE DIRECTORY
         REF      ACNTBL            TABLE OF ACCOUNT DIR GRANULES
         REF      J:BASE            TEMP STORAGE IN JIT
         REF      J:CLS             SPECIAL FLAGS FOR REDSEC
         REF      Y3FFF
         REF      YFF
         REF      MULSEG            SEG # OF MUL (GARBAGE COLLECTOR)
         REF      J:JIT             ADDRESS OF JIT
         REF      GETFUNA           GET DCB:FUN, CHECK FOR OUT/OUTIN
         REF      Y0014
         REF      TRNINFO           TRANSFER FPARAM INFO
         REF      1A7               FIND MI ENTRY MOVING FORWARD
         REF      C:CFU             # ACTIVE CFUS
         REF      T:UBLKOCU         RELEASE OPEN/CLOSE USER STATUS
         REF      EPWRT1            ADD NEW NAME TO DIRECTORY
         REF      IOSPIN            WAIT FOR I/O TO COMPLETE
         REF      LOCCODEB          SEARCH FOR VLPS
         REF      PVQUEUE           QUEUE UP DISK I/O
         REF      RESBLK            RESTORE DCB INFO
         REF      RWREX             SAVE DCB INFO
         REF      SETCMD1           STORE R3 INTO DCB:CMD
         REF      YC                BITS 0,1
         REF      Y06               BITS 5,6
         REF      SETTYC            SET TYC FIELD IN DCB
         REF      MAPBUFS           REMAP THE BUFFERS
         SPACE    2
         BOUND    8
ACTUSR   DATA     X'077AC1C3',X'067AE4E2' :ACCTLG,:USERS
         OPEN     TDA
TDA      EQU      5
CYLFLG   EQU      FILCFU+FILDISP+6
FITCFU   EQU      FILCFU+4          FITCFU+CDAM = FILCFU+SREC
         OPEN     FILDISP
FILDISP  EQU      2
SHARE    EQU      7
         SPACE    3
         DEF      OPNFIL            MODULE ENTRY POINT
         PULL     1,R6              RESTORE DCB POINTER
OPNFIL   LW,D1    GARBING           IS THERE A COLLECTION GOING
         BEZ      OPNFIL0           BRANCH IF NOT
         PUSH     1,R6              SAVE THE DCCB POINTER
         LW,R6    S:CUN             CURRENT USER #
         LI,D1    2                 SLEEP COUNT
         STW,D1   U:MISC,R6
         LI,R6    E:SL              TELL SCHEDULER TO SLEEP
         LI,11    OPNFIL-1          SET THE RETURN
         B        T:REG
         PAGE
******   ALL FILES   *****
*FOR ALL FILES INITIALIZE VARIOUS DCB FIELDS
         SPACE    3
*
*
OPNFIL0  LW,D1    WRDL0,R6          TO SET DEFLTS FOR PYRAMID PARAMETERS
         LI,R0    3                 SET 3 FIELDS OF WRDL0
         LW,R1    =X'00BCFDCD'      RESET EOP,PRIV,HBTD,ASN, ETC.
         STS,R0   ASN,R6
         LI,D2    X'FF'
         CW,D1    D2
         BANZ     %+2               FIELD ALREADY SET
         LS,D1    DFRDL0
         SLS,D2   8
         BDR,R0   %-4
         LW,R1    Y00FE
         STS,R0   TYC,R6            ZERO TYC
         STS,R0   OVC,R6            CLEAR # VOLS OPEN
W14      EQU      14
         STW,R0   W14,R6
         STW,R0   FLD,R6            IN CASE IT'S SCRATCH
         STW,R0   BCDA,R6
         LW,R1    Y006
         STS,R0   DESC,R6           NOT SYNON
         STW,D1   WRDL0,R6
         LW,R1    L(X'FFF3FFFF')
         STS,R0   16,R6             CLEAR UNUSED FIELD
         LI,R1    X'1FFFF'
         STS,R0   CFU,R6            CLR THE CFU FIELD
         STW,R0   J:BASE+7           AND THE TCFU
         LW,R1    L(X'FF007FFF')
         STS,R0   BUFX,R6           NO BUFFERS
         LI,R1    BANRA
         LB,D1    *R6,R1
         BNEZ     %+2
         STB,R1   *R6,R1            GUARANTEE RETRIES
         LI,R1    X'C'
         LB,D1    JB:PRIV
         CI,D1    X'C0'             IF PRIV < X'C0', RESET
         BGE      %+2                 SPECIAL PRIVATE PACK
         STS,R0   ACS,R6              ACCESS FLAGS
         BAL,D2   GETFUNA
         BAZ      29W               IT'S IN OR UPDATE
         LI,R1    X'40000'          NO
         STS,R0   NXTA,R6            NEXTS
         LW,R1    Y01                 FORR
         STS,R0   NXTF,R6              OUTS
         LW,R1    FIL1,R6           CHK SAVE
         BLZ      29W
         LI,SR3   X'1400'**-1+7
         CI,D1    X'40000'          CHK FOR OUT
         BANZ     9H38               IT IS, BAD NEWS
*E*      ERROR:   14-07
*E*      DESCRIPTION  ATTEMPTING TO OPEN FILE DCB OUT WITH REL
         LI,R0    X'1FFFF'          ARE THERE
         AND,R0   FLP,R6             ANY VLP'S?
         BNEZ     29W2              SKIP IF THERE ARE
         LI,R5    29W1              SET RETURN
         B        OFRS              FOR RESOURCE TYPR
*
29W      RES      0
         SPACE    3
******   ALL NON SCRATCH FILES   *****
* CHKFLACN VERIFIES THAT THE NAME & ACCOUNT ENTRIES
* IN THE DCB VLP ARE CORRECT.  SINCE SCRATCH FILES HAVE
* NO ID, THIS EFFORT IS NOT MADE FOR THEM.
         BAL,R0   CHKFLACN
         SPACE    3
******   ALL FILES   *****
* THE FOLLOWING CODE CHECKS TO SEE IF A PRIVATE PACK IS
* BEING USED; IF SO, IT GETS THE PACK(S) MOUNTED.  ALSO,
* ANY DEVICE SPECIFICATION IS ESTABLISHED IN RNDEV.
*
29W2     LI,D1    X'FFF07'          WAS INSN SPECIFIED
         LI,SR3   X'1400'**-1+8     14-08 ABNORMAL CODE
         BAL,R5   LOCCODEA
         B        OFIL1A                NO
*                                       YES,PRIVATE FILE
         LW,R0    *R7,R3            ARE THERE ANY REAL SN'S?
         BEZ      OFIL1A            NOPE
         OPEN     PRIV
         SREF     PRIV              # PRIV PACK SPINDLES IN SYSTEM
         LI,R0    PRIV
         CLOSE    PRIV
         BEZ      9H38              ERROR IF NO PRIV VOLS AT ALL
*E*  ERROR:        14-08
*E*  DESCRIPTION:  ATTEMPT TO OPEN TO PRIVATE PACK IN SYSTEM
*E*                THAT HAS NO PRIVATE PACKS
         BAL,R5   OFRS              TEST RESOURCE TYPE
         LW,9     YC                CHK FOR JOB FILE
         CS,9     FIL1,R6
         BNE      %+2               SKIP IF NOT JOB
         AWM,9    FIL1,R6           RESET JOB TO SAVE
         LW,9     3                 SAVE SERIAL #
         OVERLAY  MULSEG,OPV#
         PULL     R3                RESTORE RETURN PARAMETER
         BDR,R3   OFIL1B            BR IF NO ERROR
         B        OPER              ERROR
*
OFRS     EQU      %                 CHECK RESOURCE TYPE
*E*  ERROR:        14-08
*E*  DESCRIPTION:  ATTEMPT TO OPEN A DCB TO FILE WITH A
*E*                 DEVICE TYPE THAT IS NOT PACK TYPE
         LI,1     BARNDEV
         LB,4     *6,1              WHAT KIND
         BEZ      OFRS2             NONE - SET TO DEFAULT
         CI,4     TYPMNSZ
         BGE      OFRS4             ILLEGAL VALUE
         LB,4     TB:FLGS,4         GET TYPE
         CI,4     X'C0'             TEST FOR DC OR DP
         BL       OFRS4             NOT PACK OR RAD
         BG       0,R5              RETURN ITS PACK
OFRS2    AI,0     0                 TEST FOR PRIVATE
         BE       0,5               OK--NOT PRIVATE
OFRS4    AI,0     0
         BE       DFDK              PUBLIC - CHANGE TO DEFAULT
         AI,4     0
         BNE      9H38              PRIV MUST BE ZERO OR LEGAL RNDEV
DFDK     EQU      %
         LI,4     SV:DFDK           GET DEFAULT
         STB,4    *6,1              GIVE IT TO HIM
         B        0,R5              RETURN
*
OFIL1A   AI,D1    X'10001'          TRY OUTSN
         BCS,8    LOCCODEA          ONLY IF CARRY
         LI,0     0                 FOR PUBLIC
         BAL,R5   OFRS              TEST RESOURCE TYPE
         SPACE    2
OFIL1B   LW,R0    FLD,R6            CHK FOR SCRATCH
         BEZ      29W1              BRANCH IF SCRATCH
         LI,R3    X'40000'
         CW,R3    NXTA,R6           CHK FOR NEXT ACCOUNT
         BAZ      NONXTA
         LI,R2    DCBPRIVBIT
         STS,R2   NXTA,R6           RESET NEXT ACCOUNT FLAG
         CW,R2    PRIV,R6
         BANZ     NONXTACN          IF PRIV, SAY NO MORE ACCOUNTS
         SPACE    3
*****    OPEN NEXT ACCOUNT   *****
* THE FOLLOWING CODE PROCESSES OPEN NEXT ACCOUNT REQUESTS.
*
         LI,SR3   X'52'
         LB,R3    JB:PRIV
         CI,R3    X'80'             NEED 80 PRIVLEGE FOR NEXT ACCOUNT
         BL       OPER
*E*      ERROR:   52-00
*E*      DESCRIPTION:  INSUFFICIENT PRIVILEGE FOR NXTA OPTION
         BAL,R0   FINDFIL1
4B0      RES      0  THIS CALL ON FINDFIL1 MUST HAVE THE LOWEST ADDRESS
*                    OF ALL SUCH CALLS FOR THE TEST AT END OF FINDFIL1.
         B        OPNXTA2
         STW,R0   FILCFU+ACNDISP
         BAL,R0   GETCMD
         AI,R3    X'10'             GET NEXT ENTRY
OPNXTA3  EQU      %
         BAL,SR4  FNDKY
         B        NONXTACN          NO MORE THERE
OPNXTA1  BAL,R0   EOFMITST          IF FALL HERE ALWAYS NO EOF
         B        NONXTACN          NO FIND AND NO MORE
         BAL,R0   GETACNADR
         AI,R3    1
         BAL,R0   PULLFOUR          MOVE ACCT TO USER
         STW,D1   0,R7
         BAL,R0   PULLFOUR
         STW,D1   1,R7
NONXTA   EQU      %
*
         LW,D1    Y01
         AND,D1   NXTF,R6
         BEZ      OPNFIL1           NOT WANTED
         SPACE    3
*****    OPEN NEXT FILE   *****
* THE FOLLOWING CODE PROCESSES OPEN NEXT FILE REQUESTS.
*
         BAL,R0   FINDFIL1
         B        OPNEOF            NO FILES--GIVE END FILE INDICATOR
         BAL,R0   FINDFIL
         B        OPNNXT
OPNNXT2  EQU      %
         BAL,SR4  1A7               GET NEXT ENTRY IN DRCTRY
         B        OPNEOF            LAST KEY--RETURN EOF
OPNNXT1  EQU      %
         BAL,R0   GETCMD
         CI,R3    MIDIS
         BL       OPNEOF            EMPTY DIRECTORY
         LW,SR4   DESC,R6           SEARCH OPEN MASK
         AND,SR4  =X'9FFFFF'
         BEZ      OPNNXT1A          0=NONE
         LI,R0    DCBPRIVBIT
         CW,R0    PRIV,R6
         BANZ     OPNNXT1A
         AI,R3    FNEMAX+4          POINT AT DESCRIPTORS
         BAL,R0   PULLFOUR          GET DESCRIPTORS
         AI,R3    -FNEMAX-8         RESET POINTER
         CW,SR4   D1                COMPARE DESCRIPTORS TO MASK
         BAZ      OPNNXT2           NO MATCH - GET NEXT FILE
OPNNXT1A EQU      %
         BAL,R0   PULLFOUR
         AI,R3    -4
         LH,D1    D1
         AI,D1    -X'100'
         BLEZ     OPNNXT2
         BAL,R5   TFCHKOPNA         MOVE THE NAME
         BAL,0    GETCMD            FIND POS'N
         LW,D3    FILCFU+CDAM
         STW,D3   CDA,R6            MOVE FD DISC ADDR FOR DELAA
         LI,D3    BUFF2
         BAL,SR1  FPTFTST           FPARAM & TEST FILE CHECK
         BAL,R0   GETFI
         LI,R4    OP3A              TEST OPEN PATH
         CW,R1    Y002              GETFI LEFT DESC IN R1
         BAZ      OPNFIL1C          IT'S NOT SYNON
         SPACE    3
*****    SYNONYMOUS FILE ENCOUNTERED ON OPEN NEXT FILE  *****
* THE FOLLOWING CODE CONSTRUCTS THE PSEUDO FIT FOR A
* SYNONYMOUS FILE ENCOUNTERED ON AN OPEN NEXT REQUEST.
* AN I/O ERROR 08 WILL RESULT.
*
         LW,SR2   =X'0B010808'      SYNON NAME VLP CTL WD
         STW,SR2  9,R5
         BAL,R0   GETFILADR         SYNON NAME LOC IN DCB
         LCI      8                 MOVE
         LM,SR2   0,R5               MAIN
         STM,SR2  10,R5               NAME
         LM,SR2   0,R7                 & SYNON
         STM,SR2  0,R5                  NAME
         LI,SR3   8
         LI,SR1   OPER
*E*      ERROR:   08-00
*E*      DESCRIPTION  SYNONYMOUS FILE ENCOUNTERED ON OPEN NEXT FILE
         B        TRNINFO
         SPACE    3
TFCHKOPNA EQU     %
*                 MOVE NAME F/ FD TO DCB FOR TEST FILE W/NXTF& W/O FPAR
*                   D3,R3=FILENAME ADDRESS IN FD
         BAL,R0   GETFILADR
         LI,R0    (FNEMAX+3)/4      WDS IN MAX FNAME
         LI,R2    -2
         STB,R0   *R7,R2            SET WORDS USED IN VLP
         LW,R2    R7
         SLS,R2   2
         LB,R0    BUFF2,R3
         AI,R0    1
         STB,R0   R2
         XW,R2    R3
         MBS,R2   BUFF2**2
         LI,R3    0
MOVNME   LW,R2    KBUF,R6
         STW,R2   KAD,R6
         LW,R0    *R7,R3
         SLS,R0   2
         AW,R0    Y1
         LC       R0
         LM,SR2   *R7,R3
         STM,SR2  0,R2
         B        0,R5
         SPACE    2
NONXTACN LI,SR3   X'0202'**-1       0201
         B        9H38
*E*      ERROR:   02-01
*E*      DESCRIPTION  NO MORE ACCOUNTS ON OPEN NEXT ACCOUNT
OPNXTA2  BAL,R0   GETCMD
         BNEZ     OPNXTA1
         LI,R3    MIDIS
         B        OPNXTA3
         PAGE
*****    STAR FILES   *****
* THE FOLLOWING CODE PROCESSES STAR FILE OPENS.
*
OPNFIL1E SLS,R0   -8                USER #
         INT,D2   J:JIT+SYSID       JIT USER #
         AI,D2    X'30000'          NAME LENGTH
         CW,D2    R0                CHK IT
         BNE      OPNFIL1C          NOT A *
         LI,D2    X'20000'
         LI,D1    0
         STS,D1   SHARE,R6          NO SHARE FOR * FILES
         LI,D2    X'40000'          SET NXTA FOR
         STS,D2   NXTA,R6            *FILES
         LB,R3    STRTBL,R3         * FILE INDEX
         CI,R3    6                 IS IT *N
         BNE      3B1               BR IF NOT
         LC       J:STAR+5          CHK FOR LNKTRC&ACCTSUM
         BCR,4    ER1400            ABNORMAL 14-00 IF NOT
         STB,D2   J:STAR+5          RESET THE HIT BIT
3B1      BAL,D2   GETFUNA
         LW,R0    J:STAR-1,R3       DOES FILE EXIST?
         BAZ      OPNFIL1Z
         BEZ      OPNFIL1Y
OPNFIL1Z RES      0
         BEZ      OPENER
         LI,R4    OP3AM1            TEST PATH, EXISTS
         LW,SR1   J:STAR-1,R3
         BAL,SR4  FMCHKDA
         BCS,15   OPNFIL1Y
         LI,SR1   0
         STW,SR1  J:STAR-1,R3
         B        3B1
OPNFIL1Y RES      0
         STB,R3   R0                SAVE * POSITION
         STW,R0   W14,6             SET FIT LOC
         B        OPNFIL1C
STARTBL  DATA,1   0
         DATA,1   'B'
         DATA,1   'D'
         DATA,1   'G'
         DATA,1   'L'
         DATA,1   'T'
         DATA,1   'N'
NSTARF   EQU      BA(%)-BA(STARTBL)-1
         BOUND    4
STRTBL   DATA,1   0
         DATA,1   1 B
         DATA,1   2 D
         DATA,1   3 G
         DATA,1   4 L
         DATA,1   5 T
         DATA,1   6 N
         BOUND    4
*
         SPACE    3
* THE FOLLOWING CODE MOVES THE DESCRIPTORS FROM THE
* FILE DIRECTORY TO THE DCB AND CHECKS FOR TEST OPEN
* WITH NO FPARAM REQUEST. IF SO, THE FIT NEED NOT BE READ.
*
FPTFTST  EQU     %
*        EXITS SKIPPING IF FPARAM SET OR NOT TEST FILE
         LI,R0    0
         STW,R0   W14,R6            NOT * OR FAST OPEN
         LI,R0    DCBPRIVBIT
         CW,R0    PRIV,R6
         BANZ     5B1
         AI,R3    FNEMAX+4          SAVE DESCRIPTORS IN DCB
         BAL,R0   PULLFOUR          GET DESCRIPTORS
         AI,R3    -FNEMAX-8
         SCS,D1   8                 NOACUP TO BIT 5
         LW,D2    Y04
         STS,D1   NOACUP,R6
         SCS,D1   16
         LW,D2    =X'9FFFFF'
         STS,D1   DESC,R6
5B1      RES      0
         LW,R0    Y0008
         AND,R0   TSTF,R6           BIT 12 IS TEST FILE FLAG
         BEZ      *SR1              BRANCH IF NOT A TEST
         LI,R0    X'1FFFF'
         AND,R0   FPARAM,R6
         BNEZ     *SR1
******    TEST FILE OPENS  *****
*  FINISH UP THE PROCESSING OF TEST FILE OPENS.
*
*        SET DESCRIPTORS VLP IN DCB FOR TEST FILE
TFCHK    RES      0
         LI,R3    DCBPRIVBIT
         CW,R3    PRIV,R6
         BANZ     SETOPN1A
         LW,R2    M24
         AND,R2   DESC,R6
         LI,R7    22
         AW,R7    R6
         LI,D1    17                DESCRIPTORS VLP
         BAL,R4   LOCCODE
         B        SETOPN1A          NO VLP IN DCB
         STW,R2   *R7,R3            SET DESCRIPTORS IN VLP
         SLS,R3   2
         AI,R3    KN2
         LI,R2    1
         STB,R2   *R7,R3            DATA WORDS = 1
         B        SETOPN1A
         PAGE
*****    ALL NON-SCRATCH OPENS WITHOUT A NEXT SPECIFICATION *****
*
OPNFIL1  EQU      %
         AI,R3    -X'40000'         CHK FOR NEXT ACCOUNT
         BNE      OPNERX            BRANCH IF NEXT ACCOUNT
         BAL,R0   GETFILADR         FILE NAME IN VLP OF DCB
         LW,D3    R7
         BAL,R1   KEYTRAN           MOVE NAME TO KBUF
         LI,R4    OP15              TEST OPEN PATH
         LI,SR4   DCBPRIVBIT+K4000
         CW,SR4   0,R6
         BANZ     OPNFIL1C          NO * ON PRIVATE
         LI,R3    NSTARF            # OF * FILES
         LW,R0    0,R7              FIRST WORD OF FILE NAME
         CB,0     STARTBL,R3
         BE       OPNFIL1E          IT'S A POSSIBLE
         BDR,R3   %-2
OPNFIL1C RES      0
         LW,SR4   Y0008             CHK FOR TEST
         CW,SR4   TSTF,R6
         BANZ     0,R4              BRANCH IF TEST FILE OPEN
*****    GET A NEW CFU   ******
*
OPNFIL2M RES      0
OP91     RES      0
         DO       CFUDCB=1
         CI,R6    J:JIT+512
         BL       GCFU1M1           JIT OR LOCORE DCB
         LW,R1    W14,R6            CHK FOR *
         BNEZ     %+3               GOT ONE
         LW,R1    FLD,R6            CHK FOR SCRATCH
         BNEZ     GCFU1M1           NEITHER * NOR SCRATCH
         BAL,R4   ORGCHK            IF RANDOM, USE REAL CFU
         BE       GCFU1M1           IN CASE CLEANING OCCURS
         LW,R5    J:DCBLINK
         BEZ      GCFU1M1           NO CFU DCB
         LW,R1    1,R5
         CW,R1    TXTCFU
         BNE      GCFU1M1           NO CFU DCB
         LW,R0    Y00FE
         LW,R1    2,R5
         AI,R1    1                 1ST CFU LOC
         LI,R4    5                 THERE ARE 5 HERE
OP91B    LC       *R1               IS IT AVAILABLE
         BCS,KF   OP91A             NOPE
         CW,R0    0,R1              CHECK IF ANY USERS
         BAZ      GCFU21            NO - MUST BE OK
OP91A    AI,R1    CFUSIZE           TRY THE NEXT
         BDR,R4   OP91B               IF THERE IS ONE
GCFU1M1  RES      0
         FIN
         LI,R2    GCFUEX            SET THE RETURN
*
GCFU3    RES      0
         LI,R1    BGRCFU
         LI,R0    X'E0000'
GCFU1    EQU      %
         CW,R0    0,R1              CHECK FOR ANY USERS
         BAZ      GCFU1B            NONE - RETURN SKIPPING
GCFU1A   AI,R1    CFUSIZE           CHECK NEXT CFU
         CW,R1    ACNCFU+13
         BL       GCFU1
         LI,R0    GARB1
         PUSH     R2                SAVE LINK
         BAL,SR2  GARBCFU
         PULL     R2
         LI,SR3   X'55'
         LW,R1    J:BASE+9
         BEZ      0,R2              NONE AVAILABLE
         LI,R0    0
         STW,R0   SCFU,R1           ZAP THE SCFU FIELD
GCFU1B   MTW,1    C:CFU             COUNT AN ACTIVE CFU
         B        1,R2              RETURN WITH CFU FOUND
*E*      ERROR:   55-00
*E*      DESCRIPTION  INSUFFICIENT CFU SPACE FOR THIS OPEN
GCFUER   EQU      OPER
GCFUEX   B        GCFUER            NONE AVAILABLE
* INITIALIZE NEWLY OBTAINED CFU
*
GCFU21   LI,R5    X'1FFFF'
         LW,R4    R1
         STS,R4   CFU,R6            SET CFU ADDRESS
         STW,R1   J:BASE+7          SET TCFU
*
         LI,R4    DCBPRIVBIT        GET
         AND,R4   PRIV,R6            PRIVATE FLAG
         SLS,R4   5                 POSITION FOR CFU
         AW,R4    =X'40020000'      SET ACTIVE & NOU=1
         STW,R4   0,R1
HOOKUP   LW,D1    FUN,R6
         SLS,D1   -9                ALIGN FOR CFU
         LI,D2    X'F00'            4 BITS WORTH
         STS,D1   0,R1              SET FUNCTION
         CI,D1    X'A00'
         BAZ      HOOKUP1
         BIR,R5   6R1A              FINAL WRAPUP
HOOKK1   RES      0
         LD,R2    DOUBLEZERO
         LCI      2
         STM,R2   1,R1
         STM,R2   3,R1
         STM,R2   5,R1
         STW,R2   7,R1
         OPEN     CDAM
CDAM     SET      TDA
OP93     RES      0
         BIR,R5   6R1B              OTHER INIT IS DONE
         LW,D1    FLD,R6
         BEZ      6R1A              SCRATCH FILE
         LW,R0    W14,R6
         BEZ      5H4               BR IF NOT A * FILE
         LW,R7    KBUF,R6
         LW,D1    0,R7
         STW,D1   FILDISP,R1
         B        OPNFIL2
HOOKUP1  EQU      %
*
* MOVE FIT INFO INTO THE NEW CFU
*                                   SET UP MI ADDRESSES
         BAL,R0   SETVAR
         B        HOOKK1            FIT NOT IN
         LI,D1    12                DISC INFO CODE
         BAL,R4   LOCCODE
         B        FNERR3
         LW,R4    SCFU,R1
         LCI      7
         LM,R7    *R7,R3
         LCI      5
         STM,SR2  GAVAL,R1          MOVE FILE INFO TO CFU
         STW,R7   FDA,R1
         STW,SR1  TDA,R1
         LI,R2    9                 HA(SCFU)
         STH,R4   *R1,R2            REESTABLISH THE SCFU
3H2      RES      0
         LW,R7    D3                RESTORE FIT ADDR
         LI,D1    9                 IF RANDOM SET SIZE
         BAL,R4   LOCCODE
         B        FNERR3
         LW,D1    *R7,R3
         MTB,-2   D1                ZAP SLIDES FOR ALL BUT KEYED FILES
         BEZ      3H3               KEYED
         BNC      3H4               NO CARRY IS CONSEC
         LI,D1    KD
         BAL,R4   LOCCODE
         B        FNERR3
         LW,SR1   *R7,R3
         STW,SR1  CDAM,R1
3H4      EQU      %
         LW,SR1   FDA,R1            CHECK
         BAL,R7   CHKVLD             VARIOUS
         LW,SR1   SREC,R1               IF APPLICABLE
         BAL,R7   CHKVLD
         LW,SR1   GAVAL,R1
         LI,R7    OP93              SET RETURN
*   FALL INTO CHKVLD
CHKVLD   EQU      %
         AND,SR1  M24
         BEZ      0,R7
         BAL,SR4  FMCHKDA
         BCS,15   0,R7
         SPACE    3
*  CFU RELEASED IN OBSE
*
         SPACE    3
* THE FIT IS NOT CORRECT. REPORT A 75-03 ERROR.
*
FNERR3   LI,R2    100               FLAG TO LOG 75 ERROR IN ERRLOG
FNERR3A  LI,SR3   0                 REMOVE FIT POINTER
         LI,SR4   X'1FFFF'
         STS,SR3  QBUF,R6
         LW,SR3   W14,R6
         BNEZ     FNERR2
         LW,R3    OPNCLSUS
         CW,R3    S:CUN
         BNE      OP15M ERROR ON SHORT ROUTE, TRY LONG WAY.
         BDR,R2   9H37              LOG 75 ERROR AND EXIT TO USER
         LI,SR1   3                 ALREADY LOGGED THE ERROR - EXIT
         B        9H374               TO USER WITH 75-03
*
FNERR2   RES      0
         LI,R0    0
         STW,R0   W14,R6            BLITZ THE DISK ADDR
         LB,R3    SR3               * FILE POSITION
         BEZ      OP15M             USE LONG ROUTE
         STW,R0   J:STAR-1,R3       BLITZ THE FIT POINTER
         B        9H371
*
3H3      LI,SR4   X'FF'             SET
         STS,SR3  0,R1               SLIDES
         LW,SR1   TDA,R1            IS THERE A MULTI
         BEZ      3H4               SKIP IF NONE
         LW,SR4   Y2                SET THE
         STS,SR4  0,R1               O BIT
         LI,R7    3H4               SET THE RETURN
         B        CHKVLD            VERIFY THE TOP DISK ADDRESS
         SPACE    3
         SPACE    3
OPNFIL3A CW,SR4   M24
         BANZ     OPNFIL1B          FILE EXISTS
         B        29W1              CREATE NEW * FILE
         SPACE    3
5H4      BAL,R0   CFUINIT           INITIALIZE THE CFU
5H4A     B        GCFUER            ERROR - NOT ENOUGH ROOM FOR NAME/ACCT
         LW,D3    DESC,R6
         CW,D3    Y006
         BANZ     TFCHKOPN          SYNON - RESCAN CFUS
*
OPNFIL2  RES      0
         SPACE    3
* FOR NON-TEST, NON-SCRATCH OPENS, SCAN THE CFU'S
* TO SEE IF WE CAN TAKE A SHORT ROUTE TO OPEN WITHOUT
* A DIRECTORY SCAN.
*
         BAL,R5   SCANCFU3D  CHK IF ALREADY OPN
* NO OPEN CFU EXISTS.
         LW,SR4   W14,R6            CHK FOR *
         BNEZ     OPNFIL3A          IT'S A *
         LW,R3    Y01
         AND,R3   NXTF,R6
         BNEZ     OP3AQ             IT'S A NEXT FILE
         CW,R6    J:BASE+8
         BNE      HOOK1FST A RECENTLY CLOSED CFU HAS BEEN
* FOUND. WE CAN OPEN WITHOUT A DIRECTORY SCAN.
         SPACE    3
OP15M    RES      0
* THE SHORT ROUTE HAS BEEN ABORTED.
* TRY TO OPEN VIA A DIRECTORY SEARCH.
*
OP15     RES      0
         SPACE    3
* NORMAL DIRECTORY SEARCH OPEN PATH.
*
         BAL,R0   FINDFIL1
         B        OP1               ACCN DOESNT EXIST
         BAL,R0   FINDFIL
         B        OP2               FILN DOESNT EXIST
         SPACE    3
*****    A FILE WITH THE SAME ID AS THE CURRENT DCB HAS BEEN FOUND  ***
OP3B     RES      0
         BAL,SR1  FPTFTST           FPARAM & TEST FILE CHECK
OPNFIL1B BAL,R0   GETFI             READ THE FIT
         BAL,D2   GETFUNA
         BAZ      OP3               BR IF NOT OUTPUT
         SPACE    3
*****    OUTPUT   *****
*  CHK REPLACE CONSEC/KEYED BY RANDOM OR VICE-VERSA
*  GETFI HAS LOADED SR1.
         SCS,SR1  12                ALIGN FIT ORGANIZATION
         LI,R1    X'30'
         AND,SR1  R1                EXTRACT ORG
         AND,R1   ORG,R6
         BNEZ     3D1
         CI,SR1   X'30'  DEFAULT FOR EXISTING RANDOM IS RANDOM
         BNE      3D2
         AWM,SR1  ORG,R6
         B        OP3
3D2      LI,R1    X'10'             MAKE IT EXPLICIT CONSEC
3D1      RES      0
         CW,SR1   R1
         BE       OP3  ORIGINAL & NEW FILES HAVE SAME ORG
*   ORIGINAL FILE AND NEW FILE HAVE DIFFERENT ORGANIZATIONS
         BANZ     ER1400            ERROR, ONE FILE IS RANDOM
         BAL,R0   PRIVDCB
         BANZ     ER1400            ERROR, PRIVATE
OP3AM1   EQU      OPNFIL1B
OP3A     EQU      %
OP3      EQU      %
         SPACE    3
*****    ALL OPENS WHEN A FILE OF THE SAME ID EXISTS  *****
* SECCHK VERIFIES THAT THE CURRENT USER HAS ACCESS TO
* THE FILE REQUESTED, VERIFYING PASSWORD & ACCESS ACCOUNT
* SPECIFICATIONS
*
         BAL,SR1  SECCHK
EXTCHK   BAL,D2   GETFUNA
         BAZ      OP8
         SPACE    3
*****  OUTPUT   *****
* PERFORM PROCESSING FOR FILE EXTENSION
*
         BAL,SR4  DCBNCHK
         B        OP8               NOT M:OPLBL
         CW,D2    J:CPPO
         BAZ      OP8M1
         CI,SR1   1                 FNE VLP IN FPT
         BE       OP8M1
         CI,R0    9H17
         BNE      EXT1
* IF ABOVE BRANCH IS TAKEN, FILE WILL BE OPENED WITH EXTENSION.
* IF BRANCH IS NOT TAKEN, JIT IS CONDTIONED SO THAT A DEFAULT
* REOPEN AFTER THIS CURRENT OPEN IS CLOSED WILL RESULT IN
* FILE EXTENSION.
*
OP8M1    STS,D2   J:CPPO
         SPACE    3
*****   INPUT & OUTPUT  *****
* SET ACCESS & ORGANIZATION.
*
OP8      LW,R0    S:CUN
         SW,R0    OPNCLSUS
         BNEZ     %+2               WE AREN'T OPEN/CLOSE USER
         BAL,SR4  T:UBLKOCU         RELEASE IN CASE SETACOG CAUSES MOUNTS
         BAL,R0   SETVAR
         NOP
         BAL,SR4  SETACOG           SET ACCESS AND ORG
         LI,R1    X'1FFFF'
         AND,R1   CFU,R6
         CI,R1    BGRCFU
         BL       TFCHK             BR IF TEST OPEN
         LW,D3    FDA,R1            IS IT INITIALIZED?
         BNEZ     6R1A              YUP
         LI,R5    X'80000'          NO SCFU & OUT FLAG
         B        HOOKUP            PUT IN THE DISK ADDRESSES
         PAGE
*  SCAN THE CFUS TO SEE IF THE FILE IS ALREADY OPEN.
*
TFCHKOPN EQU      %
*  REENTRY INTO OPEN LOGIC FOR SYNON OPENS--DO CFU SCAN.
         LI,R5    6R1A              SET RETURN ADDRESS
SCANCFU3D EQU     %
         STW,R6   J:BASE+8          SET CFU=DCB
         BIR,R0   0,R5              NO SCAN IF NEW NAME OR ACCT
         LI,R3    X'1FFFF'
         LW,R0    2,R1              ID WD IN CFU
         SPACE    3
*  TO SCAN FOR * FILES
         DO       CFUDCB=1
         LW,D3    W14,R6
         BEZ      2S2               NOT A * FILE
         LW,R7    J:DCBLINK
         BEZ      2S1               NO DCBS AT ALL
         LW,D3    1,R7
         CW,D3    TXTCFU
         BNE      2S1               NO CFU DCB
         LW,R2    2,R7              START OF CFU DCB
         LI,R7    5                 5 CFU'S IN THE DCB AREA
         AI,R2    1                 1ST WORD IS ZEROS
4C1      CW,R0    2,R2              NAME IN WORD 2
         BNE      %+2               NO MATCH
         BAL,R4   SCANCFU7          CHECK IT OUT
         AI,R2    CFUSIZE           TRY THE NEXT CFU
         BDR,R7   4C1               IF THERE'S ONE
2S1      RES      0
         FIN
         SPACE    3
*  TO SCAN NON * FILES
2S2      RES      0
         LI,R4    SCANCFU1          SET RETURN FOR SCANCFU7
         LW,R7    ACNCFU+13
         AI,R7    2-BGRCFU
         SLS,R7   -3                # POSSIBLE CFU BLOCKS
         LI,R2    BGRCFU            START OF CFUS
SCANCFUP CW,R0    2,R2              CHK THE ID
         BNE      SCANCFU1          BR IF NO HIT
         SPACE    3
*
*  A CFU WITH THE SAME ID AS THE CURRENT DCB HAS BEEN FOUND
*
SCANCFU7 CS,R2    CFU,R6            SEE IF IT'S OURSELF
         BE       0,R4              YUP - IT IS
         LW,D3    R2
         LW,R1    0,R2
         CW,R1    Y00FE             ARE THERE ANY USERS?
         BANZ     SCANCFUH          YUP
         LC       R1
         BCR,15   SCANCFUD          NOT IN USE
         CI,R1    X'C000'           CHK 4 SHARED OR RANDOM
         BANZ     SCANCFUH          BRANCH IF EITHER
SCANCFUM LI,R1    X'14000'          PRIV & RANDOM
         AND,R1   0,R2
         AI,R1    X'60BAD'          MAKE IT A BAD GUY
         STW,R1   0,R2
SCANCFUH AND,R1   XF00
         CI,R1    X'B00'
         BGE      0,R4              IT'S A BAD GUY
         LC       *D3
         BCS,4    CHKSHARE          GOT A REAL HIT
         B        SCANCFUM          MARK IT BAD
*
SCANCFU1 RES      0
         AI,R2    CFUSIZE           TRY NEXT CFU
         BDR,R7   SCANCFUP          BR IF THERE IS ONE
         B        0,R5              EXIT NOT FOUND
         SPACE    3
SCANCFUD STW,D3   J:BASE+8          RECENTLY CLOSED
         STW,R4   2,R2              BLITZ THE NAME
         B        0,R5              TAKE NOT FOUND EXIT
XF00     DATA     X'F00'
         PAGE
CFUINIT  PUSH     R0
*
*
* INITIALIZE THE NAME AND ACCOUNT ENTRIES FOR THE CFU
*
*  ACCOUNT OR DCT INDEX FIRST
         LI,R3    CFUPRIVBIT        IS THE CFU PRIVATE
         CW,R3    0,R1
         BAZ      5G1
         LW,R3    PAT,R6
         LW,R3    1,R3
         LH,R2    R3                DCTX OF PRIMARY
         OR,R2    =X'3C00'          SPECIAL PRIV INDICATOR
         B        5G2
5G1      BAL,R0   GETACNADR
         LW,D1    0,R7
         LW,D2    1,R7
         LI,R2    1                 CFU ACCT POINTER INIT
         LW,R3    ACNCFU+13         ACCT TABLE POINTER
         SLS,R3   -1                DBLWD ALIGN
         AI,R3    1                 INDEX FOR 1ST ACCT
         LH,SR4   ACNCFU+14         # OF ACCTS
5G3      CD,D1    0,R3              CHK THIS ENTRY
         BNE      %+2               NO HIT
         B        5G2               REUSE THIS ENTRY
         AD,R2    DOUBLEONE         NEXT POSITION
         BDR,SR4  5G3               TRY AGAIN IF THERE'S ANOTHER
         SLS,R3   1                 WORD ALIGN
         SW,R3    ACNCFU+15         START OF NAMES
         BIR,R3   5G4               BR IF WE CAN INSERT AT END
*  TRY THE GARBAGE COLLECTOR.
         LI,0     GARB2
         BAL,SR2  GARBCFU
         LW,R2    J:BASE+9
         BEZ      PULLEXIT          OUT OF SPACE
5G4      STD,D1   *ACNCFU+13,2      NEW ACCT ENTRY
         STH,R2   ACNCFU+14
         MTB,-8   *TSTACK           SET NO SCAN NECESSARY
5G2      LI,R3    4                 HA(ACCT LOC)
         STH,R2   *J:BASE+7,R3      ACCT LOC OR DCTX
*  NOW FOR THE NAME
5G6      LI,R0    X'1FFFF'
         AND,R0   KBUF,R6           NEW NAME LOC
         STW,R0   J:BASE+6          SAVE IT
         LI,SR4   0                 TO CLEAR OUT THE
         LB,R3    *J:BASE+6           TRAILING BYTES
         B        %+2                   OF THE NEW NAME
         STB,SR4  *J:BASE+6,R3      ZAP A BYTE
         AI,R3    1                 NEXT BYTE
         CI,R3    3                 IS IT A NEW WORD?
         BANZ     %-3               CONTINUE TO ZAP
         SLS,R3   -2                # OF WORDS IN NEW NAME
         STW,R3   J:BASE+9          SAVE IT
         LW,R3    ACNCFU+15         START OF CUREENT CFU WORD LIST
         B        5G63              ENTER LOOP
*  CHK TO SEE IF NEW NAME IS ALREADY AVAILABLE IN THE CFU AREA
5G6A     LW,SR4   J:BASE+9          # WDS IN NEW NAME
         STW,R3   J:BASE+8          SAVE CUUR POSN IN NAME LIST
5G61     LW,SR3   0,R3              WORD FROM CFU NAME LIST
         CW,SR3   0,R2              CORRESPONDING WORD FROM NEW NAME
         BNE      5G62              NO HIT, EXIT LOOP
         AD,R2    DOUBLEONE         TRY NEXT WORD
         BDR,SR4  5G61               IF THERE IS ONE
*  THE NEW NAME ALREADY EXISTS IN THE CFU NAME AREA.
         LW,R3    J:BASE+8          GET ITS POSITION
         B        5G7               TO INSERT THE POINTER
*
5G62     LB,R3    *J:BASE+8         # BYTES IN LAST NAME
         AI,R3    4
         SLS,R3   -2                # OF WORDS IN LAST NAME
         AW,R3    J:BASE+8          NEXT NAME POSITION
5G63     LW,R2    J:BASE+6          NEW NAME LOC
         CW,R3    ACNCFU+16         IS THERE ANOTHER NAME
         BL       5G6A              BR IF THERE IS
*  NEW NAME IS NOT AVAILABLE IN THE CFU NAME AREA.
         AW,R3    J:BASE+9          NEW END OF NAME AREA
         CI,R3    LASTCFU+19        WILL NAME FIT
         BLE      5G5               BR IF IT WILL
*  TRY THE GARBAGE COLLECTOR.
         BAL,SR2  GARBCFU
         B        5G8
*
*
5G5      XW,R3    ACNCFU+16
5G8      LW,D3    J:BASE+9          NAME LENGTH OR GARB FLAG
         BEZ      PULLEXIT          BAD NEWS
         SCS,D3   -4                ALIGN FOR LC
         LC       D3                # OF WORDS TO MOVE
         LM,R7    0,R2
         STM,R7   0,R3              MOVE NAME TO CFU AREA
         MTB,-8   *TSTACK           SET NO SCAN NECESSARY
5G7      LI,R2    5
         STH,R3   *J:BASE+7,R2      INSERT NAME POINTER
*
         B        PULLEXIT1         NORMAL EXIT
GARBCFU  MTW,3    GARBING           SET THE COLLECTOR FLAG
         BAL,SR4  CFUGARB
         LI,SR4   0                 RESET
         STW,SR4  GARBING            THE COLLECTOR FLAG
         B        *SR2
         PAGE
*****    FILE EXTENSION   *****
* THE CURRENT DCB WILL BE OPENED WITH FILE EXTENSION.
* SET THE EXTENSION BIT AND CHANGE THE FUNCTION TO UPDATE.
*
EXT1     LI,R1    X'10000'
         STS,R1   EXT,R6
         LI,D1    K4
         LI,R0    OP8
SETFUNCN LI,D2    KF
         SLD,D1   17
         STS,D1   FUN,R6
         B        *R0
         PAGE
*****    REOPEN   *****
* AN ACTIVE CFU WITH THE SAME ID    AS THE CURRENT DCB
* HAS BEEN FOUND.
*
CHKSHARE LW,R2    *D3               CFU FUN
         LW,R1    W14,R6
         BNEZ     ER1401            NO SHARE FOR * FILES
         LI,R1    X'FFFF'           MASK FOR SCFU FIELD
*  NOTE THAT SCFU IS RESTRICTRED TO A 16 BIT ADDRESS
         LI,R3    SCFU
         BAL,D2   GETFUN            DCB FUN
         LW,D2    SHARE,R6
         SLS,D2   -2
         EOR,D2   R2                SHARES MUST EQUAL
         AND,D2   X8000
         BNEZ     ER1401            SHARES ARE NOT EQUAL
         CI,R2    X'C000'           INCLUDE SHARE ALSO
         BANZ     RANDSHAR          IT'S A RANDOM FILE
         SPACE    3
*  A CONSECUTIVE OR NON-SHARED KEYED FILE IS BEING REOPENED.
*
         CI,D1    X'E'
         BANZ     ER1401            DCB FUN MUST BE IN
         CI,R2    X'400'
         BANZ     ER1401            CFU FUN = INOUT
         CI,R2    X'100'
         BANZ     HOOK1             CFU FUN = IN
         CI,R2    X'1000'           IS IT A COMMON JOURNAL
         BANZ     ER1401            BAD NEWS IF SO
         AND,R1   *D3,R3            IS THERE ANOTHER CFU
         BEZ      OP61              NO, USE THE ONE GOTTEN
         LW,D3    0,R1              CHK FOR CLOSE IN PROGRESS
         CI,D3    X'1E00'           IF ANYTHING BUT IN,
         BANZ     ER1401             WE MUST BE CLOSING
HOOK1M1  LW,D3    R1                YES, USE IT
HOOK1    RES      0
         LW,R2    CFU,R6            RELEASE THE CFU PREV GOTTEN
         LI,D4    0
         STW,D4   0,R2
         STW,D4   2,R2
         MTW,-1   C:CFU             DECR # ACTIVE CFUS
         LI,D4    X'1FFFF'
         STS,D3   CFU,R6            CORRECT THE CFU POINTER
         LI,R2    1                 BA(NOU)
         MTB,2    *D3,R2            INCREMENT # OF USERS
         BNC      OPNF41            IT'S OK
         MTB,1    *D3               OBSE WILL FIX
         LI,SR3   X'0E'             ERROR CODE
         B        OPER
*E*  ERROR:        0E-00
*E*  DESCRIPTION:  MORE THAN 127 USERS OF ONE FILE
OPNF41   LW,R3    Y006
         CW,R3    DESC,R6
         BAZ      OPNF4             NOT A SYNON
*
6R1A     RES      0
         SPACE    3
* FINAL WRAPUP TO OPEN. SET THE FINAL ENTRIES IN THE DCB & CFU
*
         LW,R1    CFU,R6
         LW,R2    ORG,R6
         LI,R3    0                 ASSUME NO SHARE
         CI,R2    X'20'             CHK RANDOM OR KEYED
         BANZ     NOTCON            IT IS
         STW,R3   19,R6             CLR SKIPS
         LI,D2    0                 TO CLEAR RECORD #
         B        6W1
*
6R1B     LW,R4    Y006
         CW,R4    DESC,R6
         BAZ      6R1A              NOT SYNONYMOUS
         LI,R0    5H4A
         PUSH     R0
         B        5G6               INSERT MASTER NAME IN CFU
*
NOTCON   LI,R4    X'20000'
         CW,R4    SHARE,R6
         BAZ      %+2               NOT SHARE
         AI,R3    X'8000'           SAHRE BIT FOR CFU
         CI,R2    X'10'             CHK FOR RANDOM
         BAZ      KEYED             IT'S KEYED
*
*        IT'S RANDOM
*
         LW,D1    Y004
         CW,D1    DESC,R6
         BANZ     OPENER            NO SYNONS FOR RANDOMS
         AI,R3    X'4000'           RANDOM BIT FOR CFU
         STS,R3   0,R1
         BAL,D2   GETFUNA
         BAZ      SETOPNC
         SPACE    3
* ALLOCATE THE GRANULES FOR A NEW RANDOM FILE.
*
         B        GRAND:
*
RAND31   PULL     SR3               COMPLETION CODE
         BIR,SR3  SETOPND           BR IF OK
         SLS,SR3  -1                ALIGN
         B        9H38              REPORT ERROR
*
SETOPND  LW,R1    CFU,R6
         LW,D2    CDA,R6
         STW,D2   FDA,R1
         LW,D2    M24
         AND,D2   CLK,R6
         STW,D2   CDAM,R1           SET SIZE IN CFU
SETOPNC  RES      0
         LW,D1    CDAM,R1
         STW,D1   RSTORE,R6
         STW,D1   CLK,R6
         AND,D1   Y00FF
         BEZ      %+2
         OR,D1    Y08
         LW,D2    Y08FF
         STS,D1   NLR,R6
         CLOSE    CDAM
         LI,R4    BARNDEV           MOVE DEV TYPE TO KEYM
         LB,SR2   *R6,R4            SO CLS WILL PUT IN FIT
         LI,R4    BAKEYM
         STB,SR2  *R6,R4
         B        SETOPNB
         SPACE    3
KEYED    RES      0
         OPEN     IMT
IMT      EQU      14
         LW,D2    SCR,R6
         LB,D2    D2
         AI,D2    13
6W1      RES      0
         STW,D2   IMT,R6
         LW,D1    Y008
         LW,D2    M24
         STS,D1   CLK,R6            START GRANULE COUNT
         LI,D2    X'FF'
         LI,R2    BANLR
         STB,D2   *R6,R2            ASSUME NO READ AHEAD
         BAL,D2   GETFUNA
         BANZ     INITMI
         STS,R3   0,R1              SET SHARE BIT
         CI,D1    X'20000'          CHK FOR IN
         LW,D1    ACS,R6            ORG ALSO
         BAZ      6R2               IT'S UPDATE
         CI,D1    2
         BANZ     6R2               IT'S DIRECT
         MTB,1    *R6,R2            ENABLE READ AHEAD
6R2      CI,R3    X'8000'
         BAZ      6R21
         LI,SR4   X'FFFF'
         AND,SR4  SCFU,R1
         BNEZ     SETOPN1A
         BAL,R2   GCFU3             ALLOCATE A CFU
         B        GCFUER            NONE AVAILABLE
6R22     LW,R2    CFU,R6
         LCI      7
         LM,SR2   1,R2              LAST 7 WORDS
         STM,SR2  1,R1               ARE THE SAME
         LI,R3    X'FFFF'
         STS,R2   SCFU,R1
         AWM,R1   SCFU,R2
         LI,SR2   X'20500'
         EOR,SR2  0,R2
         STW,SR2  0,R1              NO USERS & INVERTED FUN
         CI,SR2   X'400'
         BANZ     %+2
         LW,R2    R1                SELECT INPUT CFU
         LW,R3    Y008
         STW,R3   SREC,R2           GRANULE COUNT = 0
*
SETOPNB  RES      0
SETOPN1A BAL,SR4  TRUNC
         LI,R0    0
DCDAM6   RES      0
         STW,R0   DCBCDAM,R6
SAV2     RES      0
         STW,R0   BCDA,R6
SAV2P1   RES      0
         LW,R1    KBUF,R6
         STW,R0   0,R1
         STW,R0   KAD,R6
         STW,R0   CDA,R6
         LW,R1    CFU,R6
         LW,R2    TSTF,R6
         AND,R2   Y0008
         BNEZ     OPNERX            IT'S ONLY A TEST
         LW,R4    2,R1              CFU NAME & ACCT
         AI,R4    -X'10000'
         CI,R4    X'F0000'
         BANZ     SETOPEN           NOT :SYS
         LW,D1    0,R4              1ST 4 BYTES OF NAME
         CLM,D1   ACTUSR
         BCR,12   %+2               IT'S ACCTLG
         BCS,3    SETOPEN           NOT :USERS
         LW,R4    S:CUN
         LH,D1    UH:FLG,R4
         OR,D1    BT31TO0+3         SET SIGNIF FILE OPN BIT
         STH,D1   UH:FLG,R4
         SPACE    3
*
*  SET DCB OPEN, DO FILE EXTENSION IF NECESSARY
*
SETOPEN  RES      0
         LW,D1    Y002              FCD BIT
         LW,D2    =X'002C3000'      TO CLEAR THE LEFT OVERS
         STS,D1   FCD,R6            MARK IT OPEN
         BAL,R0   SETTYC            RESET TYC
         LI,D2    X'F0000'
         STS,D1   20,R6             CLR CMD
         LW,D2    Y02               RESET
         STS,D1   TRN,R6             TRN BIT
         LW,D2    EXT,R6            FOR EXTENSION &
         CI,D2    X'10100'           EXECUTE ONLY CHECKS
         BAZ      OPNX              WE'RE DONE IF NEITHER
         LW,SR3   =X'28000014'      14 - 14 ABNORMAL
         CI,D2    X'100'            CHK FOR EXECUTE ONLY ONLY
         BANZ     OERX              THAT'S WHAT IT IS
*E*      ERROR:   14-14
*E*      DESCRIPTION  EXECUTE PROTECTED FILE SUCCESSFULLY OPENED
         SPACE    2
***************   FILE EXTENSION HAS BEEN INVOKED   ************
         OVERTO   MISOVSEG,PEOF#
         SPACE    3
6R21     LW,SR4   M24
         AND,SR4  FDA,R1            FDA LESS EMPTY BIT
         CW,SR4   BCDA,R6           GRAN IN FIT BUFFER
         BNE      SETOPN1A
         STW,SR4  DCBCDAM,R6
         LI,R0    0
         CI,D1    X'20'             CHK 4 KEYED
         BANZ     SAV2              IT IS
         BAL,R0   CLRBBUF           TRUNC IF WE GOT ONE
         LI,10    BUF2MSK
         AND,10   BUFX,R6
         SLS,10   -5
         LI,11    X'7FFF'
         STS,10   BUFX,R6
         LI,D3    BUFF1
         BAL,2    T:SBUF
6R3      LI,R0    0
         B        SAV2P1
         SPACE    3
*****    NEWLY CREATED KEYED OR CONSECUTIVE FILE   *****
* ENTER THE FIT GRANULE INTO THE FILE & MARK AS EMPTY.
*
INITMI   BAL,SR4  ENTERO
         LW,R0    Y00FE
         AND,R0   TYC,R6            CHK 4 OUT OF GRANS
         CW,R0    Y0014
         BNE      6R3               IT'S OK
         LI,SR3   X'57'             ERROR CODE
         B        OPER
*E*      ERROR:   57-00
*E*      DESCRIPTION  INSUFFICIENT GRANULE SPACE TO ALLOCATE FIT
         PAGE
* A RANDOM OR SHARED KEYED CFU IS BEING REOPENED.
*
RANDSHAR CI,D1    X'A'
         BANZ     ER1401            DCB FUN NOT IN OR INOUT
         CI,R2    X'A00'
         BANZ     ER1401            DITTO FOR CFU FUN
         CI,D1    1
         BANZ     4D1               INS ARE OK
         CI,R2    X'8000'
         BANZ     4D1               SHARES ARE OK
         CI,R2    X'100'
         LW,D4    R2
         BAZ      4D2               IT'S AN UPDATE CFU
         AND,R1   *D3,R3            GET SCFU
         BEZ      4D1               BR IF NONE
         LW,D4    0,R1
4D2      CW,D4    Y00FE             ARE THERE ANY UPDATE USERS
         BANZ     ER1401            NO SHARED UPDATE
4D1      RES      0
         LW,D4    Y004
         CW,D4    DESC,R6
         BANZ     ER1401  NO NEW SYNON IN SHARED CASE
         SLS,D1   8
         AND,D1   R2
         BNEZ     HOOK1             FUNS ARE EQUAL
         AND,R1   *D3,R3            IS THERE AN SCFU
         BNEZ     HOOK1M1           TUP, USE IT
* A FILE IS BEING REOPENED WITH A DIFFERENT FUNCTION
* THAN THAT WHICH EXISTS IN A CFU WITH THE SAME ID.
*  IT'S A SHARED KEYED OR RANDOM OPEN.
         LW,R2    D3                OLD CFU
OP62     LI,R1    X'1FFFF'          CFUMASK
         AND,R1   CFU,R6            NEW CFU
         LW,R3    R1
         OR,R3    R2
         CI,R3    X'10000'          CAN'T USE HI CFUS
         BANZ     ER1401            BAD NEWS
         AWM,R1   SCFU,R2           SET THE SECONDARY
         LI,R3    X'FFFF'           AND THE SECONDARY'S
         STS,R2   SCFU,R1            SECONDARY
         SPACE    3
         SPACE    3
OPNF4    RES      0
         LW,R3    Y01
         AND,R3   NXTF,R6
         BNEZ     OP3AQ  FIT ALREADY READ FOR NEXT FILE OPEN
         LI,R3    X'1FFFF'
         AND,R3   CFU,R6            SET TCFU
         STW,R3   J:BASE+7
         SPACE    3
*****    REOPEN   *****
* AN INACTICE CFU WITH THE SAME ID AS THE CURRENT DCB
* HAS BEEN FOUND.
*
HOOK1FST RES      0
         LI,R3    X'4000'
         LI,R2    SREC
         CW,R3    *D3
         BANZ     OPNF3
         LI,R2    FDA
OPNF3    RES      0
         LW,0     *D3,R2
         AND,R0   M24
         STW,R0   W14,R6
         BNEZ     OPNFIL1B          TO SET FIT LOC
         B        OP15M             NO HIT ON PRESCAN
         SPACE    3
*  IT'S A NON SHARED OPEN OF AN INPUT FILE WHICH IS
*  ALREADY OPEN OUT.
OP61     RES      0
         LW,R2    D3
         LW,D3    CFU,R6            IT'S NOT THE SAME FILE
         B        OP62
         PAGE
OP2      EQU      %                 FILE DOESNT EXIST
*
         LW,D1    FUN,R6
         CW,D1    Y0008
         BAZ      OP1               NOT UPDATE
         LI,D1    X'20000'          CHK FOR SHARE
         CW,D1    SHARE,R6
         BANZ     OPENER            BAD NEWS
*                                   FUNCTION IS UPDATE--CHECK FOR
*                                   SYNON.
         LI,D1    11
         BAL,R5   LOCCODEA
         B        OPENER
         SPACE    3
*****    NEW SYNONYMOUS FILE BEING CREATED   *****
*
         BAL,R5   MOVNME
         BAL,R0   FINDFIL2          LOOK FOR BASE NAME
         B        OPENER
         LW,R1    J:BASE+7          CFU ADDRESS
         MTB,2    *R1               MARK WRITE OCCURRED
         LW,R1    Y004              SET NEW SYNON
         STS,1    DESC,6
         B        OP3B              READ THE FIT
OP1      EQU      %                 ACN DOESNT EXIST--FUNCTION MUST
         BAL,D2   GETFUNA
         BAZ      OPENER
         BAL,R0   CLRBFUB           TRUNC IF WE GOT ONE
         LW,D1    J:BASE+7          CFU ADDRESS
         LI,D2    X'1FFFF'
         STS,D1   CFU,R6
         SPACE    3
*****    OUTPUT   *****
* OPEN AN OUTPUT DCB FOR A FILE FOR WHICH NO CURRENT
* VERSION EXISTS.
*
*                                   WHEN CREATING NEW FILE, USER MUST
*                                   OWN IT
         LI,D1    0
         STW,D1   W14,R6            NOT * OR SHARED
OP71     RES      0
         LB,D1    JB:PRIV           ALLOW C0 PRIV TO CREATE FILES
         CI,D1    X'C0'             IN OTHERS ACCOUNT.
         BGE      OP99
         LI,D1    K4000
         AND,D1   USR,R6
         BNEZ     ER1400            NO WRITE ACCESS
OP99     EQU      %
29W1     RES      0
         BAL,R4   ORGCHK
         BNE      29W3
         LW,R0    FLD,R6
         BNEZ     6R1A              NOT SCRATCH
         B        OP91
*  NOT RANDOM
29W3     RES      0
         LI,SR4   OP91
         LW,0     FLD,R6
         BEZ      SETACOG
         BAL,R0   EXTCHK
9H17     RES      0
*
         SPACE    3
******   VARIOUS ABNORMAL AND ERROR SITUATIONS  *****
OPNNXT   EQU      %
         BAL,R4   GETTYC
         CI,R3    K7                EOF COD
         BNE      OPNNXT1           NOT EOF - GET NEXT
OPNEOF   EQU      %
         LI,SR3   K2                   NO MORE FILES
         B        OPER
*E*      ERROR:   02-00
*E*      DESCRIPTION  NO MORE FILES IN DIRECTORY ON OPEN NEXT FILE
*
OPENER   EQU      %
         LI,SR3   K3
         B        OPER
*E*      ERROR:   03-00
*E*      DESCRIPTION  IN OR INOUT FILE DOES NOT EXIST
*
OPNERX   LI,SR3   0                 EXIT WITH NO ERROR
         B        OPER
*
ER1401   LI,SR3   X'1400'**-1+1     14-01 ABNORMAL CODE
         B        9H38
*E*      ERROR:   14-01
*E*      DESCRIPTION  FILE ACCESS DENIED - FILE IS OPEN THROUGH
*E*               ANOTHER DCB IN A CONFLICTING MODE.
         PAGE
*D*      NAME:    FINDFIL
*D*      DESCRIPTION  SEARCH FILE DIRECTORY FOR FILE NAME.
*D*               FILCFU MUST ALREADY BE INITIALIZED WITH POINTERS
*D*               TO THE CORRECT FILE DIRECTORY.
*
FINDFIL  EQU      %
*                                   LOCATE FILE IN MASTER FILE INDEX
*
         INT,R3   FLD,R6
         AW,R3    FLP,R6
FINDFIL3 STW,R3   KAD,R6
FINDFIL2 EQU      %
         PUSH     1,R0
*                                   ADR OF FILE CFU
*
         BAL,R0   CLRBFUB           WRITE OUT AD IF UPDATED
         BAL,R0   SETCMD
         LI,R2    FILCFU            ADR OF FILE CFU
         LI,R3    K1FFFF
         STS,R2   CFU,R6
         LI,R3    FNEMAX
         BAL,R0   SETSCR
         LI,R0    X'29'  FILE DIRECTORY ENTRY LENGTH
         STW,R0   W14,R6
         BAL,R0   GETFILADR
         LW,D1    FILCFU+FDA
         LI,D2    0
         LB,R2    *R7               CHK NAME LENGTH
         BEZ      COMOPN
         LI,R2    X'FF00'
         AND,R2   -1,R7
         BEZ      COMOPN            NO NAME SPEC'D
         LC       ACNCFU+11
         BNE      COMOPN            ACCT CHANGED
         LW,D1    FILCFU+CDAM
         LW,D2    FILCFU+16         BLINK SAVED BY REDSEC
COMOPN   EQU      %
         BAL,R0   REDSECL           READ SECTOR WITH LINK CHECK
         LI,SR4   X'100'            SPECIAL FLAG
         CW,SR4   J:CLS
         BAZ      FIND1             BR IF OK ON READ
         STW,SR4  FILCFU+ACNDISP    NO ACCOUNT EQUALS
         LI,SR4   -X'100'           RESET IT
         AWM,SR4  J:CLS
         LW,SR4   KAD,R6            FILE NAME POINTER
         PUSH     SR4               SAVE IT
         BAL,R0   FINDFIL1          SRCH ACCT DIRECTRY
         B        PULLEXIT
         PULL     SR4
         STW,SR4  KAD,R6            RESTORE POINTER
DFDA     EQU      8                 DUAL FDA LOCATION
         LW,SR4   FILCFU+DFDA       MAKE SURE WE GOT THE DUAL
         BNEZ     FINDFIL2+1        OK, TRY THE DUAL
         MTW,-1   FILCFU+DFDA       MAKE A BAD DU AL
         B        FINDFIL2+1        TRY FOR PRIMARY AGAIN
*
FIND1    RES      0
         LC       ACNCFU+11
         BE       COMOPN2
         LI,R3    BUFF2+WXBUFSIZ-5
         LI,R0    X'4000'           HALF/FULL GRANULE FLAG
         CW,R0    BUFF2+NAVX
         BANZ     %+2
         AI,R3    -X'100'           HALF GRANULE
         LCI      4
         LM,SR1   0,R3
         STW,SR3  FILCFU+GAVAL
         STW,SR4  FILCFU+FSP
         LW,SR4   Y8
         AI,SR1   0
         BGEZ     %+2
         STS,SR4  FILCFU+FDA        TRANSFER EMPTY FILE FLAG
         AND,SR1  M24
         STW,SR1  CYLFLG
COMOPN2  EQU      %
         LI,R3    MIDIS
         LI,SR4   %+2
         BDR,R2   SETUPUB
         B        PULLEXIT          DIDNT FIND
*
         LW,R0    FILCFU+CDAM       CURRENT FD SECTOR
         STW,R0   CDA,R6            IN CASE DEL NEEDS IT
         B        PULLEXIT1         FOUND
         PAGE
FINDFIL1 EQU      %
         SPACE    3
*D*      NAME:    FINDFIL1
*D*      DESCRIPTION  SEARCH THE ACCOUNT DIRECTORY FOR THE ACCOUNT
*D*               SPECIFIED IN THE DCB.  IF FILCFU ALREADY POINTS
*D*               TO THE DESIRED ACCOUNT, NOTHING IS READ.
*D*               OTHERWISE, SELECT AN APPROPRIATE DISC ADDRESS
*D*               FROM ACNTBL (OR AD FDA IF NO ACNTBL ENTRIES)
*D*               AND READ IT.  SEARCH FOR THE ACCOUNT STARTING
*D*               WITH THAT GRANULE.
*D*               USER WILL BE OPEN/CLOSE USER UPON EXIT.
*
*
         PUSH     1,R0
         LW,4     6                 SAVE DCB ADDR
1F1      DISABLE
         LW,2     S:CUN
         LW,0     OPNCLSUS
         BEZ      1F2
         CW,2     OPNCLSUS
         BE       1F2
         LI,6     E:OCR
         LI,11    1F1
         B        T:REG
         SPACE    3
1F2      RES      0
         LW,6     4
         STW,2    OPNCLSUS
         LH,4     UH:FLG,2
         OR,4     BT31TO0+4         SET OPNCLS USER BIT
         STH,4    UH:FLG,2
         ENABLE
         BAL,R0   CLRBFUB
         BAL,R0   GETACNADR
         LI,R4    4B0
         SW,R4    *TSTACK
         BNE      OFILE61           NOT NXTA
*
*  NEXT ACCOUNT PROCESSING HAS BEEN REQUESTED.
*
         LI,R5    X'4000'           RESET
         LI,R2    X'FF00'
         CW,R2    -1,R7
         BANZ     OFILE62           ACCT WAS SPECIFIED
         LI,R2    X'0200'           ACTIVATE 2 WORDS
         AWM,R2   -1,R7
         STW,R4   0,R7              ZAP ACCT
OFILE62  RES      0
         STS,R5   USR,R6             USR
         STW,R5   FILCFU+ACNDISP
         STW,R4   J:FDDA
OFILE61  RES      0
         LCI      2
         LM,R2    0,R7
         LM,R4    FILCFU+ACNDISP
         LI,D2    DCBPRIVBIT
         LI,D1    DCBPRIVBIT
         AND,D1   PRIV,R6
         SLD,D1   5
         BNEZ     OFIL61
         CD,R2    R4
         BNE      OFIL61
         CS,D1    FILCFU
OFIL61   STCF     ACNCFU+11
         BE       PULLEXIT1
*  TAKE THE ABOVE BRANCH IF FILE CFU ALREADY SET UP FOR
*  DESIRED ACCOUNT.
*
         LI,R5    X'1FFFF'
         STM,R2   FILCFU+ACNDISP
         STS,D1   FILCFU
         AI,D1    0
         BEZ      NEWACCT           BR IF PUBLIC
         STW,R5   FILCFU+CDAM       CLOBBER TO FORCE READ
         LI,D1    DPFDFDA           PRIVATE FILE,D1=FD DISC ADR
OLDA     STW,D1   FILCFU+FDA
         LW,0     J:FDDA
         BGEZ     PULLEXIT1         GOT IT
         BAL,0    TESTFDDA
         BEZ      PULLEXIT1         GOT ZEROED
         STW,12   J:FDDA            SET IT UP
         B        PULLEXIT1
NEWACCT  EQU      %
         LW,R4    KBUF,R6
         SCD,R2   24
         LW,R1    M24
         AND,R1   R3
         OR,R1    Y08
         LCI      3
         STM,R1   0,R4
         STS,R4   KAD,R6
         LI,R4    ACNCFU
         STS,R4   CFU,R6
         LM,R2    FILCFU+ACNDISP
         LI,D1    0                 ZAP THE DUAL POINTER
         STW,D1   FILCFU+DFDA
         CD,R2    SYSACCT
         BNE      4B2               NOT :SYS
         LW,D1    SYSACTL
         BNEZ     9H50              SET :SYS FILE DRCTORY
4B2      STCF     ACNCFU+12
         CW,R2    J:ACCN
         BNE      NEWA2
         CW,R3    J:ACCN+1
         BNE      NEWA2             NO
         BAL,0    TESTFDDA
         BEZ      NEWA2             GOT ZEROED
         LW,12    J:FDDA
         BNEZ     OLDACCT
         MTW,-1   J:FDDA
         SPACE    3
*  SEARCH THE ACCOUNT TABLE IN MONITOR DATA TO GET THE
*  BEST STARTING GRANULE FOR THE ACCOUNT DIRECTORY SEARCH.
*
NEWA2    EQU      %
         SLD,2    -1                MAKE ACCT NAME POSITIVE
         LI,4     -1000             NO ACTION YET FLAG
         LD,0     DOUBLEZERO        NO DISK & START SRCH
         B        3A4               ENTER SEARCH
         SPACE    3
3A0      LW,12    ACNTBL+1,1        MSH
         LW,13    ACNTBL+2,1        LSH
         SD,12    2                 WHAT'S THE DIFFERENCE
         BLZ      3A1               GOT A GOOD ONE
         BGZ      3A3               NO GOOD
         LW,0     ACNTBL+3,1        DISK ADDR
         LW,SR1   ACNTBL+4,1        DUAL
         B        3A6               WE LUCKED OUT
3A1      AI,4     0                 IS THIS THE 1ST GOOD ONE
         BLZ      3A2               YUP
         CD,10    12                CHK WITH PREV GOOD ONE
         BGE      3A3               OLD ONE IS BEST
3A2      LW,4     1                 SAVE POSITION
         LD,10    12                SAVE DIFFERENCE
3A3      AI,1     4                 NXT TABLE ENTRY
3A4      CW,1     ACNTBL            CHK END OF TABLE
         BL       3A0               NOT THE END
         BIR,4    3A6               BRNCH IF NOTHING FOUND
         LW,0     ACNTBL+2,4        DISK ADDR
         LW,SR1   ACNTBL+3,4        DUAL
3A6      STW,0    ACNCFU+CDAM       SET SECTOR ADDR
         STW,SR1  ACNCFU+4          STORE DUAL
         LW,SR1   ACNCFU+CDAM
         BEZ      3A7
         BAL,SR4  FMCHKDA           VERIFY
         BCS,15   3A7               OK
         LI,0     0
         STW,0    ACNTBL            ERASE TABLE
         B        3A6               USE FDA
3A7      RES      0
ACNSCR   EQU      9                 SCR FOR ACCT DIRECTORY
         LI,R3    ACNSCR
         BAL,R0   SETSCR
         LI,SR4   X'10'  ACCT DIRECTORY ENTRY LENGTH
         STW,SR4  W14,R6
         LI,SR1   0
         LW,SR4   ACNCFU+CDAM
         CW,SR4   ACNCFU+FDA
         BNE      %+2               NOT THE FIRST
         STW,SR1  ACNCFU+CDAM       TO GET LINK CHK & DUAL
         BAL,SR4  SETUPUB
         B        CLRFDDA
         AI,R3    ACNSCR+3
         BAL,R0   PULLFOUR          GET DUAL FDA
         SLS,D1   -8                MAKE IT A DA
         LW,SR1   D1
         BAL,SR4  FMCHKDA
         BCR,15   %+2               BR IF BAD
         STW,D1   FILCFU+DFDA
         AI,R3    -7                 ACK UP TO MAIN FDA
         BAL,R0   PULLFOUR
         SLS,D1   -8                MAKE IT A DA
         LW,SR1   D1
         BAL,SR4  FMCHKDA           VALIDATE DISC ADR OF FD
         BCS,15   OLDACCT           GO IF DISC ADR CHECK OK
         MTW,1    J:FDDA
         BEZ      %+2               CLEARED FLG
         MTW,-1   J:FDDA            RESTORE VALUE
         LW,SR3   ACNCFU+CDAM       DISK ADDRESS
         LI,SR1   5                 75-05
         B        9H372
9H37     LW,SR3   FILCFU+SREC       DISK ADDR
9H371    LI,SR1   3                 75-03
9H372    BAL,SR4  ERFILDA           LOG THE ERROR
*E*      ERROR:   75-03
*E*      DESCRIPTION:  FIT DISC ADDRESS IN FILE DIRECTORY IS BAD
9H374    LW,R2    SR1               SAVE ERROR SUB-CODE
         BAL,R0   CLRBFUB
         LI,SR3   X'7500'**-1
         AW,SR3   R2
9H38     RES      0
         SCS,SR3  -7
         B        OPER
9H50     LW,SR1   D1
         BAL,SR4  FMCHKDA
         BCS,15   4B1
         LI,D1    0
         STW,D1   SYSACTL
         B        4B2
4B1      LI,R0    4B0+1             CHK FOR NEXT ACCOUNT
         SW,R0    *TSTACK
         BGZ      4B2               BRANCH IF NEXT ACCOUNT
OLDACCT  LC       ACNCFU+12
         BNE      OLDA              NOT :SYS
         STW,D1   SYSACTL
         B        OLDA
         SPACE    3
OP3AQ    LI,R0    OP3A-1            FOR NEXT FILES
*****************  FALL INTO SETVAR  *******************
* LOCATE THE START OF THE VLP IN THE FIT.
*
SETVAR   EQU      %
*                                   GET TO FILE INFO
         LI,R7    X'1FFFF'
         AND,R7   QBUF,R6
         BEZ      *R0
         AI,R0    1                 FIT EXISTS RETURN
         LW,D3    2,R7
         AI,R7    (8+MIDIS+FNEMAX)/4
         CI,D3    X'8000'
         BAZ      1C1               IT'S CONSEC
         AI,R7    NWFITST-(4+MIDIS)/4
         CI,D3    X'4000'
         BANZ     1C1
         AI,R7    -(WXBUFSIZ/2)     IT'S A HALF GRANULE
1C1      LW,D3    R7
         B        *R0
         PAGE
*D*      NAME:    GETFI
*D*      DESCRIPTION  READ THE FIT.  FILE NAME IN FIT AND DCB
*D*               MUST MATCH UNLESS # SYNONYMOUS FILES IN FIT
*D*               X'09' VLP > 0.  REPORTS 75-03 IF ERROR READING
*D*               FIT OR IF NAMES DON'T MATCH.
*
GETFI    EQU      %
         PUSH     1,R0
         LW,R5    =X'7D0100'        REPORT 75-7D IF BAD FIT ON FAST OPEN
         LW,D1    W14,6
         ANLZ,R4  DCDAM6            DCBCDAM,R6
         AND,D1   M24
         BNEZ     8B3               * FILE OR QUICK OPEN
         AI,3     FNEMAX+5          2ND BYTE OF BLK
         LB,R0    BUFF2,R3
         AI,3     -5
         CI,0     X'40'
         BAZ      GETFI11           IT'S NOT SYNON
         LI,SR3   X'C'              ERROR CODE
         BAL,D2   GETFUNA
         BANZ     OPER
*E*      ERROR:   0C-00
*E*      DESCRIPTION:  AN ATTEMPT IS MADE TO OPEN A SYNONYMOUS FILE
*E*               IN THE OUT OR OUTIN MODE.
*E*
         LW,D2    Y002
         STS,D2   DESC,R6           SET SYNON BEING PROCESSED
GETFI11  RES      0
         BAL,R0   PULLFOUR
         BAL,R0   CLRBFUB           GET RID OF FD GRANULE
         LI,R4    FITCFU            SET DCB:CFU FOR READING FIT
         LI,R5    X'1FFFF'
         STS,R4   CFU,R6
         LI,R4    FILCFU+CDAM
8B67     LI,R5    X'100'            RETURN HERE IF ERROR
8B3      STS,R5   J:CLS
         LW,R2    0,R4
         BAL,R0   REDSEC
         STW,R2   0,R4
         STW,D1   BCDA,R6
         LW,R2    BUFF2             WAS IT A GOOD READ
         BGEZ     8B4
FNERR    LI,R3    X'1FFFF'
         LW,R2    J:BASE+7          TCFU ADDR
         STS,R2   CFU,R6            CHANGE CFU ADDR TO USER CFU
         LW,R2    BUFF2
         BLZ      %+2               IF NEG, REDSEC REPORTED ERROR
         LI,R2    100               ELSE REPORT ERROR AT FNERR3A
         BAL,D2   GETFUNA
         STW,D2   BUFF2             ZAP BUFFER TO MAKE IT LOOK BAD
         BAZ      FNERR3A           NOT OUTPUT
         PULL     R0
         B        OP71
8B4      LI,R5    BUFF2+4           CONSEC FIT POSITION
         LW,R2    BUFF2+2
         CI,R2    X'8000'
         BAZ      8B21              IT MAY BE CONSEC
         AI,R5    NWFITST-4         KEYED FILE FIT POSITION
         CI,R2    X'4000'
         BANZ     8B2               BRANCH IF FULL GRANULE
         AI,R5    -(WXBUFSIZ/2)
8B2      LB,R0    *R5               NAME LENGTH
         BEZ      FNERR
         CI,R0    31                MAX NAME LENGTH
         BG       FNERR
         LW,R7    R5
         AI,R7    9                 1ST VLP CTL WD
         LI,D1    9                 FIND THE 09 ENTRY
         BAL,R4   LOCCODE
         B        FNERR             IT'S NOT A FIT
         LW,SR1   *R7,R3  FOR ORGANIZATION CHECKS AT OPNFIL1B
         AI,R3    2                 # SYNONS
         LW,R2    *R7,R3             & DESCRIPTORS
         LW,R4    KBUF,R6
         LW,R1    DESC,R6
         CW,R1    Y002              CHK FOR SYNON
         BAZ      GETFI21           BRANCH IF NOT
         CI,R2    X'F0000'          ARE THERE ANY SYNONS?
         BAZ      FNERR
         LCI      8                 MOVE
         LM,SR2   0,R5               MASTER NAME
         STM,SR2  0,R4                TO KEY BUFFER
         B        GETXIT
8B21     CW,R2    Y3FFF
         BAZ      8B2               IT'S CONSEC
         LW,D1    BUFF2+1           IT'S KEYED & FIT
         B        8B67
GETFI21  SLD,R4   2                 BYTE ALIGN
         AI,R0    1                 INCLUDE LAST BYTE OF NAME
         STB,R0   R5                INSERT LENGTH
         CBS,R4   0                 CHK FOR NAME MATCH
         BNE      FNERR             NAMES DON'T MATCH
         LW,R0    W14,R6
         BEZ      GETXIT            DESC ALREADY IN
         LI,R3    DCBPRIVBIT
         CW,R3    PRIV,R6
         BANZ     8B5               SKIP IF PRIVATE
         LI,R3    X'9FFF'           STORE MASK
         SLD,R2   8                 POSITION
         STS,R2   DESC,R6           DESCRIPTORS TO DCB
         LI,R3    X'400'            STORE MASK
         SLD,R2   16                ALIGN
         STS,R2   NOACUP,R6
8B5      AND,R0   YFF
         BNEZ     8B6               SKIP IF IT'S A *
         STW,R0   W14,R6            ZAP THE DA
8B6      RES      0
GETXIT   LI,R3    X'1FFFF'
         LW,R2    J:BASE+7          RESTORE
         STS,R2   CFU,R6             CFU POINTER
         LI,R2    BUFF2             SET FIT EXISTS FLAG
         STS,R2   QBUF,R6
         B        PULLEXIT
         PAGE
         SPACE    2
*  PROVIDE SOME FUNCTIONS FOR CHANGING A FILE NAME AT CLOSE TIME
         SPACE    1
         OPEN     TCFU
TCFU     EQU      X'0D'
         SPACE    1
CHNGNAM  LW,D1    J:BASE+8          SAVE ADDRESS OF NEW NAME
         PUSH     2,SR4
         BAL,R2   GCFU3             ALLOCATE 8 WORD CFU BLOCK
         B        CHNGER5M          NONE AVAILABLE
*
         LW,R4    TCFU,R6           USER CFU ADDR
         LCI      8
         LM,SR1   0,R4
         STM,SR1  0,R1              MOVE OLD CFU CONTENTS TO NEW
         STW,R1   SCFU,R4           SAVE SECOND CFU ADDR
         STW,R4   SCFU,R1           LINK BOTH TOGETHER
         STW,R1   J:BASE+7
         LI,R5    BUF1MSK
         AND,R5   BUFX,R6           SAVE THE INDEX OF THE BUFFER
         STW,R5   6,R1                CONTAINING THE FIT
         LI,R4    0
         STS,R4   BUFX,R6           REMOVE POINTER FROM DCB
*
         PULL     R7                ADDRESS OF NEW NAME
         LW,R5    KBUF,R6
         LCI      8
         LM,D1    0,R7
         STM,D1   0,R5              MOVE NEW NAME TO KBUF
         LW,R1    J:BASE+7          ADDRESS OF SECOND CFU
*
         BAL,R0   CFUINIT           FILL IN NAME/ACCOUNT POINTERS
         B        CHNGER55          NOT ENOUGH CFU SPACE
*
         LW,R1    J:BASE+7
         LW,R2    2,R1              NEW NAME/ACCT POINTERS
         LI,R4    BGRCFU
CHNG30   CW,R2    2,R4              CHECK IF OTHER USER HAS NEW FILE OPEN
         BNE      CHNG32
         CW,R4    J:BASE+7          IS THIS OURSELF
         BNE      CHNGER09          NO - ERROR 0A-09
CHNG32   AI,R4    CFUSIZE
         CW,R4    ACNCFU+13
         BL       CHNG30            NOT DONE YET
*
         LI,D1    2
         LI,R2    HAACD
CHNG35   BAL,R4   LOCCODEB          SET UP ACD AND HAFLD
         NOP
         STH,R3   *R6,R2
         AI,R2    1
         BDR,D1   CHNG35
*
         BAL,R0   FINDFIL1
         B        CHNGER09          SOMEBODY SNUCK IN
         LW,R3    KBUF,R6
         BAL,R0   FINDFIL3          SEARCH FD FOR NEW NAME
         B        %+3               OK IF NOT THERE
CHNGER09 LW,SR4   =X'1200000A'      0A-09
         B        CHNGXIT
*
         LW,R5    TCFU,R6           PUT
         LW,R5    SCFU,R5            NEW
         INT,R5   2,R5                NAME
         LW,R4    KBUF,R6              BACK
         LCI      8                     INTO
         LM,SR1   0,R5                   KEY
         STM,SR1  0,R4                    BUFFER
         LW,D1    BCDA,R6           ADDRESS OF FIT
         BAL,R0   EPWRT1            ENTER NEW NAME IN FD
         B        CHNGER57          NOT ENOUGH DISK SPACE
*
         LW,R5    TCFU,R6
         LW,R5    SCFU,R5
         LI,D2    0
         XW,D2    6,R5              ERASE THE POINTER
         STS,D2   BUFX,R6           REMAP THE BUFFER
         BAL,R0   MAPBUFS
         LI,R7    BUFF1+8+5         ASSUME CONSEC
         LW,R3    BUFF1+NAVX
         CI,R3    X'8000'
         BAZ      CHNG40            CORRECT
         AI,R7    NWFITST-4         KEYED OR RANDOM
         CI,R3    X'4000'
         BANZ     CHNG40            FULL GRANULE
         AI,R7    -(WXBUFSIZ/2)     HALF
CHNG40   LW,R3    KBUF,R6
         LW,R1    TCFU,R6
         LI,R4    X'FFFF'
         AND,R4   2,R1              ADDRESS OF OLD NAME
         LCI      8
         LM,SR4   0,R3              MOVE NEW NAME TO FIT
         STM,SR4  -9,R7
         LM,SR4   0,R4
         STM,SR4  0,R3              MOVE OLD NAME TO KBUF
         LW,SR4   Y004              SET BUF1
         STS,SR4  BBUD,R6            UPDATED
         BAL,R0   FINDFIL3          LOCATE OLD NAME
         B        CHNGER09
         BAL,R0   SETCMD1
         LI,SR4   0                 NO ERROR
CHNGXIT  XW,SR4   *TSTACK           SET CONDITION OF RETURN & GET LINK
         B        *SR4
*
*E*  ERROR:        0A-09
*E*  DESCRIPTION:  ATTEMPT TO CHANGE FILE NAME AND EITHER NEW NAME
*E*                ALREADY EXISTS IN DIRECTORY, OR THERE IS A DCB
*E*                OPENED OUT TO THAT NAME.
CHNGER5M PULL     SR4               BALANCE STACK
CHNGER55 LI,SR4   X'55'             OUT OF CFU SPACE
         B        CHNGXIT
*E*  ERROR:        55-00
*E*  DESCRIPTION:  NOT ENOUGH CFU SPACE TO CHANGE FILE NAME
CHNGER57 LI,SR4   X'57'
         B        CHNGXIT
*E*  ERROR:        57-00
*E*  DESCRIPTION:  NOT ENOUGH DISK SPACE AVAILABLE TO ADD NEW NAME
         SPACE    1
         CLOSE    TCFU
         PAGE
CLRFDDA  EQU      %
         STW,SR4  FILCFU+ACNDISP
         LW,0     J:FDDA
         BGEZ     PULLEXIT
         MTW,1    J:FDDA
         B        PULLEXIT
TESTFDDA EQU      %
         LW,4     S:CUN
         LH,4     UH:FLG,4
         CI,4     SJAC
         BCS,4    TFDDA2
         LB,4     JB:PRIV
         CI,4     X'C0'
         BL       *0
TFDDA2   EQU      %
         LI,4     0
         STW,4    J:FDDA            0 FOR SJAC OR C0 PRIV
         B        *0
         SPACE    3
Y08FF    GEN,8,8,16 8,X'FF',0
DFRDL0   DATA,1   0,254,3,1  254 SLIDES,2 CONSEC, 1 BYTE SPARE
         END
