MONPROC  SET      1
ANSPROC  SET      1
         SYSTEM   UTS
         PCC      0
SYN      SET      1
         DEF      OPNF
OPNF     EQU      %
         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'
K10000   EQU      X'10000'
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
         SPACE    2
         DEF      OPNER
         SPACE    3
FITSIZE  EQU      80
NWFITST  EQU      WXBUFSIZ-FITSIZE
         SPACE    1
         SPACE    2
         REF      ACNCFU
         REF      BGRCFU
         REF      CFUSIZE
         REF      DELSEG
         REF      DOUBLEZERO
         REF      FILCFU
         REF      FNDKY
         REF      GETCMD
         REF      GETFUN
         REF      GETTYC
         REF      CFUGARB
GARB1    EQU      -1
GARB2    EQU      0
         REF      DELO#,DELAA#,OPV#
         REF      ERFILDA
         REF      LASTCFU
         REF      PULLEXIT,PULLEXIT1
         REF      PULLFOUR
         REF      REDSEC
         REF      SETUPUB
         REF      Y02
         REF      Y01
         REF      Y002
         REF      OPNX
         REF      OPENER03
         REF      SETACOG
         REF      SECCHK
         REF      CHKFLACN
         REF      GETACNADR,GETFILADR
         REF      MSRMOVE
         OPEN     TDA
TDA      EQU      5
         REF      LOCCODEA,LOCCODE
         REF      SETSCR
         REF      OPER
         REF      Y04
         REF      J:FDDA,J:ACCN
NFD      EQU      FILCFU+FILDISP+6
NFIT     EQU      NFD
NFSP     EQU      NFD+1
         REF      SETCMD
         REF      J:CPPO
         REF      Y00FF
         REF      Y00FE,Y08
         REF      Y004
         REF      Y0008
         REF      REDSECL
         REF      T:REG
         REF      E:OCR
         REF      M24
         REF      S:CUN,OPNCLSUS,OPNCLSTK
         REF      Y2,JB:PRIV
         REF      FMCHKDA
         REF      CLSVNO
         REF      PRIVDCB
         REF      TB:FLGS,UH:FLG
         REF      J:DCBLINK
         BOUND    8
ACTUSR   DATA     X'077AC1C3',X'067AE4E2' :ACCTLG,:USERS
         SPACE    3
         DEF      OPNCOR
OPNCOR   EQU      %
OPNFIL   EQU      %                 ASSIGNMENT IS FILE
         DEF      OPNFIL
         PAGE
******   ALL FILES   *****
*FOR ALL FILES INITIALIZE VARIOUS DCB FIELDS
         SPACE    3
*
*
         LW,D1    WRDL0,R6          SET UP DEFAULTS FOR PYRAMID PARAMET-
         LI,0     X'B0200'  RESET EOP=READ,PRIV & BTD
         AND,0    0,6               RESET SWXV & XUP
         AI,0     1                 SET ASN = FIL
         STW,0    0,6
         LI,R0    3
         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
W14      EQU      14
         STW,R0   W14,R6
         STW,R0   FLD,R6            IN CASE IT'S SCRATCH
         STW,R0   BCDA,R6
         DO       SYN=1
         REF      Y006
         LW,R1    Y006
         STS,R0   DESC,R6           NOT SYNON
         FIN
         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
         LW,R1    Y00FE
         STS,R0   OVC,R6            CLEAR # VOLS OPEN
         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
         CI,D1    X'40000'          CHK FOR OUT
         BAZ      29W2              IT'S OUTIN
         B        OPENER03
*
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
29W2     RES      0
         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.
*
         LI,D1    X'FFF07'          WAS INSN SPECIFIED
         BAL,R5   LOCCODEA
         B        OFIL1A                NO
*                                       YES,PRIVATE FILE
         LW,0     *R7,R3            ARE THERE REAL SN'S
         BEZ      OFIL1A            NOPE
         BAL,R5   OFRS              TEST RESOURCE TYPE
         LW,9     3                 SAVE SERIAL #
         OVERLAY  MULSEG,OPV#
         PULL     R3                RESTORE RETURN PARAMETER
         BDR,R3   NONXTA            NO NXT ACCT 4 PRIVS
         B        OPNER             NO CAN DO
*
OFRS     EQU      %                 CHECK RESOURCE TYPE
         LI,1     BARNDEV
         LB,4     *6,1              WHAT KIND
         BEZ      OFRS2             NONE - SET TO DEFAULT
         LB,4     TB:FLGS,4         GET TYPE
         CI,4     X'C0'             TEST FOR DC OR DP
         BL       DFDK              ERROR GIVE HIM DEFAULT
         BG       0,R5              RETURN ITS PACK
OFRS2    AI,0     0                 TEST FOR PRIVATE
         BE       0,5               OK--NOT PRIVATE
DFDK     EQU      %
         REF      SV:DFDK
         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
         LI,R0    X'40000'
         CW,R0    NXTA,R6           WAS IT REQ'D
         BAZ      NONXTA
         SPACE    3
*****    OPEN NEXT ACCOUNT   *****
* THE FOLLOWING CODE PROCESSES OPEN NEXT ACCOUNT REQUESTS.
*
         BAL,R0   FINDFIL1
4B0      RES      0
         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
         REF      EOFMITST
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
         LI,SR4   OPNX
         LW,D1    Y01
         AND,D1   NXTF,R6
         REF      OPERC
OPER1    EQU      OPERC
         BEZ      OPER1
NONXTA   EQU      %
*
         LW,D1    Y01
         LI,D2    X'40000'          RESET NXTA NOW
         STS,D1   NXTA,R6
*****    SCRATCH FILE OPENS DUCK OUT HERE.
         LW,R0    FLD,R6            TEST FOR SCRATCH
         BEZ      29W1              YUP
         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      %
         REF      1A7
         BAL,SR4  1A7               GET NEXT ENTRY IN DRCTRY
         B        OPNEOF            LAST KEY--RETURN EOF
OPNNXT1  EQU      %
         BAL,R0   GETCMD
         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
         AI,D1    -X'1F00'
         BGEZ     OPNNXT2
         BAL,SR1  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
         DO       SYN=1
         LW,0     Y002
         CW,0     DESC,R6
         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.
*
         LI,3     4+9
         LW,2     BUFF2+2
         CI,2     X'8000'
         BAZ      8B1               IT'S CONSEC
         LI,3     NWFITST+9         IT'S NOT CONSEC
         CI,2     X'4000'
         BANZ     8B1               FULL GRANULE
         AI,3     -(WXBUFSIZ/2)
8B1      RES      0
         LW,8     =X'0B010808'
         STW,8    BUFF2,3
         LI,8     8
         BAL,R0   GETFILADR
8A3      LW,0     0,7
         AI,3     -9
         XW,0     BUFF2,R3
         AI,3     10
         STW,0    BUFF2,R3
         AI,7     1
         BDR,8    8A3
         LI,SR3   8
         LI,SR1   OPNER
         B        TRNINFO
         REF      TRNINFO
         FIN
         SPACE    3
TRNABRT  LI,SR3   X'1404'**-1       1402 ERROR
         B        9H38
         DEF      TRNABRT
         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
         AI,R3    BUFF2**2
         LB,R0    0,R3
         AI,R0    1
         STB,R0   R2
         XW,R2    R3
         MBS,R2   0
         LI,R3    0
MOVNME   LW,D3    KBUF,R6
         LW,R0    *R7,R3
         SLS,R0   -26
         AI,R0    1
         STW,D3   KAD,R6
         LI,R2    0
         B        MSRMOVE
         PAGE
*****    STAR FILES   *****
* THE FOLLOWING CODE PROCESSES STAR FILE OPENS.
*
OPNFIL1E SLS,0    -8                USER #
         INT,D2   J:JIT+SYSID       JIT USER #
         AI,D2    X'30000'          NAME LENGTH
         CW,D2    0                 CHK IT
         BNE      OPNFIL1C          NOT A *
         LI,D2    X'20000'
         CW,D2    SHARE,R6
         BANZ     OPENER03          NO SHARE FOR * FILES
         LI,D2    X'40000'          SET NXTA FOR
         STS,D2   NXTA,R6            *FILES
         LB,3     STRTBL,3          * FILE INDEX
         CI,3     6                 IS IT *N
         BNE      3B1               BR IF NOT
         LC       J:STAR+5          CHK FOR LNKTRC&ACCTSUM
         BCR,4    OPENER03          ABNORMAL IF NOT
         STB,D2   J:STAR+5          RESET THE HIT BIT
3B1      BAL,D2   GETFUNA
         LW,R0    J:STAR-1,3        DOES FILE EXIST?
         BAZ      OPNFIL1Z
         BEZ      OPNFIL1Y
OPNFIL1Z RES      0
         BEZ      OPENER
         LI,R4    OP3AM1            TEST PATH, EXISTS
         LW,SR1   J:STAR-1,3
         BAL,SR4  FMCHKDA
         BCS,15   OPNFIL1Y
         LI,SR1   0
         STW,SR1  J:STAR-1,3
         B        3B1
OPNFIL1Y RES      0
         STB,3    0                 SAVE * POSITION
         STW,0    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
         DO       SYN=1
         LW,D2    =X'9FFFFF'
         ELSE
         LW,D2    M24
         FIN
         STS,D1   DESC,R6
5B1      RES      0
         LW,R0    Y0008
         AND,R0   TSTF,R6           BIT 12 IS TEST FILE FLAG
         BEZ      FPTFTST1
         LI,R0    X'1FFFF'
         AND,R0   FPARAM,R6
         BEZ      TFCHK
FPTFTST1 EQU      %
         B        *SR1
NONXTACN LI,SR3   X'0202'**-1       0201
         B        9H38
OPNXTA2  BAL,R0   GETCMD
         BNEZ     OPNXTA1
         LI,R3    MIDIS
         B        OPNXTA3
         PAGE
*****    ALL NON-SCRATCH OPENS WITHOUT A NEXT SPECIFICATION *****
*
OPNFIL1  EQU      %
         BAL,R0   GETFILADR
         LW,D3    R7
         LI,R3    0
         BAL,R1   KEYTRAN           MOVE NAME TO KBUF
         REF      KEYTRAN
         REF      SYSID,J:STAR
         LH,R3    *R7               FIRST 2 BYTES OF FILE NAME
         CI,R3    X'0100'
         BNE      OPNFIL1A          NOT SPECIAL FILE
         LB,R3    JB:PRIV
         CI,R3    X'C0'
         BL       OPENER03          DON'T ALLOW IT UNLESS
         BAL,D2   GETFUNA             USER HAS C0 PRIVILEGE
         BANZ     OPENER03            AND FUNCTION=IN OR INOUT
*
OPNFIL1A EQU      %
         LI,R4    OP15              TEST OPEN PATH
         LI,11    DCBPRIVBIT+K4000
         CW,11    0,R6
         BANZ     OPNFIL1C          NO * ON PRIVATE
         LI,3     NSTARF            # OF * FILES
         LW,R0    0,R7              FIRST WORD OF FILE NAME
         CB,0     STARTBL,3
         BE       OPNFIL1E          IT'S A POSSIBLE
         BDR,3    %-2
OPNFIL1C RES      0
         LW,SR4   Y0008             CHK FOR TEST
         CW,SR4   TSTF,R6
         BAZ      OPNFIL2M          NOT A TEST
         B        0,R4              TEST FILE PATH
         SPACE    3
OPNFIL3A CW,SR4   M24
         BANZ     OPNFIL1B          FILE EXISTS
         B        29W1              CREATE NEW * FILE
         SPACE    3
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.
*
         LW,R1    CFU,R6
         LI,D3    0
         STW,D3   FDA,R1            NO REOPEN
         STW,D3   SREC,R1
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 D1
         SLS,SR4  -20               ALIGN FIT ORG
         LI,R1    X'30'
         AND,SR4  R1
         AND,R1   ORG,R6
         BNEZ     3D1
         CI,SR4   X'30'  DEFAULT FOR EXISTING RANDOM IS RANDOM
         BNE      3D2
         AWM,SR4  ORG,R6
         B        OP3
3D2      LI,R1    X'10'             MAKE IT EXPLICIT CONSEC
3D1      RES      0
         CW,SR4   R1
         BE       OP3  ORIGINAL & NEW FILES HAVE SAME ORG
*   ORIGINAL FILE AND NEW FILE HAVE DIFFERENT ORGANIZATIONS
         BANZ     OPENER03   ERROR,ONE OF THE FILES HAS RANDOM ORG
         BAL,R0   PRIVDCB
         BANZ     OPENER03   ERROR,PRIVATE FILE
OP3AM1   EQU      OPNFIL1B
OP3A     EQU      %
OP3      EQU      %
         REF      DOUBLEONE
         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
*
         LW,D3    R7                SET FIT POINTER
         BAL,R0   SECCHK
         B        OPENER03          DOESNT CHECK
         LI,SR1   0
         STB,SR1  J:STAR            RESET FETCH FLAG
         BAL,SR1  TRNINFO
EXTCHK   BAL,D2   GETFUNA
         BAZ      OP8
         SPACE    3
*****  OUTPUT   *****
* PERFORM PROCESSING FOR FILE EXTENSION
*
         BAL,SR4  DCBNCHK
         REF      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      EQU      %
         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
         LI,R3    X'1FFFF'
         LW,R0    2,R1              ID WD IN CFU
         SPACE    3
*  TO SCAN FOR * FILES
CFUDCB   EQU      1
         DO       CFUDCB=1
         LW,D3    W14,R6
         BEZ      2S2               NOT A * FILE
         REF      TXTCFU
         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
         OPEN     FILDISP
FILDISP  EQU      2
         SPACE    3
*  TO SCAN NON * FILES
2S2      RES      0
         LI,R4    SCANCFU1          SET RETURN FOR SCANCFU7
         LW,R7    ACNCFU+13
         AI,R7    -BGRCFU-8
         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
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
5H4      RES      0
*
*
* 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,SR4  CFUGARB
         LW,R2    J:BASE+9
         BEZ      GCFUER            OUT OF CFU'S
5G4      STD,D1   *ACNCFU+13,2      NEW ACCT ENTRY
         STH,R2   ACNCFU+14
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,SR4  CFUGARB
         B        5G8
*
*
5G5      XW,R3    ACNCFU+16
5G8      LW,D3    J:BASE+9          NAME LENGTH OR GARB FLAG
         BEZ      GCFUER            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
5G7      LI,R2    5
         STH,R3   *J:BASE+7,R2      INSERT NAME POINTER
*
         LW,D3    DESC,R6
         CW,D3    Y006
         BAZ      OPNFIL2           NORMAL CASE
         B        TFCHKOPN  IT'S A SYNON, RESCAN THE CFUS
         PAGE
******    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
* INITIALIZE NEWLY OBTAINED CFU
*
GCFU2    LW,R0    Y00FE
         CW,R0    0,R1              CHK USERS
         BANZ     0,R5              PROBABLY BAD
GCFU21   LI,R5    X'1FFFF'
         AND,R5   CFU,R6
         BNEZ     6R22   IT'S A SHARED KEYED OPEN
         AWM,R1   CFU,R6            SET CFU ADDRESS
         STW,R1   J:BASE+7          SET TCFU
*
         LW,R4    Y02
         LI,R5    DCBPRIVBIT        CFU:PRIV = DCB:PRIV
         LS,R4    PRIV,R6
         SCD,R4   5
         OR,R4    BT31TO0+18  X20000 SET 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,1
         STM,R2   3,1
         STM,R2   5,1
         STW,R2   7,1
         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,6
         BEZ      5H4
         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,SR4   X'FF'
         STS,SR3  0,R1
         LW,SR4   Y2
         LI,R2    9                 HA(SCFU)
         STH,R4   *R1,R2            REESTABLISH THE SCFU
         CI,SR3   X'8000'           O BIT CHK
         BAZ      3H2               NOT ON
         STS,SR4  0,R1              SET THE O BIT IN CFU
3H2      RES      0
         LW,7     14                RESTORE FIT ADDR
         LI,12    9                 IF RANDOM SET SIZE
         BAL,4    LOCCODE
         B        FNERR3
         LW,12    *7,3
         MTB,-2   12                ZAP SLIDES FOR ALL BUT KEYED FILES
         BEZ      3H4               KEYED
         SLS,12   8                 SHIFT OUT 1 OR 8 BITS
         LI,13    X'FF'
         STS,12   0,R1
         BEV      3H4               8 BITS IS CONSEC
         LI,D1    KD
         BAL,4    LOCCODE
         B        FNERR3
         LW,8     *7,3
         STW,8    CDAM,1
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
FNERR3   RES      0
*  CFU RELEASED IN OBSE
*
         SPACE    3
* THE FIT IS NOT CORRECT. REPORT A 75-03 ERROR.
*
         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.
*
         LI,SR4   9H37
         REMEMBER
         PUSH     1,SR4             TO BALANCE DELX PULL
*                                   FD SECTOR IS IN DCB CDA
         OVERTO   DELSEG,DELO#      DELETE FD ENTRY - DON'T TOUCH FIT
*
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
         SPACE    3
         DEF      SETFUNCN
SHARE    EQU      7
EXT1     EQU      %
         SPACE    3
*****    FILE EXTENSION   *****
* THE CURRENT DCB WILL BE OPENED WITH FILE EXTENSION.
* SET THE EXTENSION BIT AND CHANGE THE FUNCTION TO UPDATE.
*
         LI,R1    K10000
         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
         LI,R1    X'FFFF'           MASK FOR SCFU FIELD
*  NOTE THAT SCFU IS RESTRICTRED TO A 16 BIT ADDRESS
         LI,R3    SCFU
         LW,SR3   Y02000014         1401 ERROR CODE
         BAL,D2   GETFUN            DCB FUN
         LW,D2    SHARE,R6
         SLS,D2   -2
         EOR,D2   R2                SHARES MUST EQUAL
         AND,D2   X8000
         REF      X8000,ER1401
         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
         AND,R1   *D3,R3            IS THERE ANOTHER CFU
         BEZ      OP61              NO, USE THE ONE GOTTEN
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
         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        OPNER             WRAP IT UP
         DO       SYN=1
OPNF41   LW,R3    Y006
         CW,R3    DESC,R6
         BAZ      OPNF4             NOT A SYNON
         B        6R1A              IT'S A SYNON
         FIN
         PAGE
6R1B     LW,R4    Y006
         CW,R4    DESC,R6
         BANZ     5G6               INSERT MASTER NAME IN CFU
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
*
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
*
         DO       SYN=1
         LW,D1    Y004
         CW,D1    DESC,R6
         BANZ     OPENER            NO SYNONS FOR RANDOMS
         FIN
         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             ALLOCATE THE GRANULES
         REF      GRAND
         DEF      RAND31
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
         REF      Y008
         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
         B        GCFU3  SHARED NEEDS 2 CFUS
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
         REF      CLRBBUF
         LI,10    BUF2MSK
         AND,10   BUFX,R6
         SLS,10   -5
         LI,11    X'7FFF'
         STS,10   BUFX,R6
         LI,D3    BUFF1
         REF      T:SBUF
         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
         REF      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        OPNER
         SPACE    3
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,SR3  SREC,R2           GRANULE COUNT
*
SETOPNB  RES      0
SETOPN1A BAL,SR4  OPER1
         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
*PUT SECTOR CNT INTO DCB LAST WDS OF KEY BUF
         LW,4     NFSP
         LB,2     NFD
         LW,3     M24
         AND,3    NFIT
         LCI      3
         STM,2    5,1
         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     4A2               NOT :SYS
         LW,D1    0,R4              1ST 4 BYTES OF NAME
         CLM,D1   ACTUSR
         BCR,12   %+2               IT'S ACCTLG
         BCS,3    4A2               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
4A2      RES      0
         SPACE    3
         BAL,R0   SETOPN            SET FCD, RESET TYC
         REF      SETOPN
         LI,D2    X'F0000'
         STS,D1   20,R6             CLR CMD
         LW,D2    Y02               RESET
         STS,D1   TRN,R6             TRN BIT
         LI,D2    X'100'            EXECUTE ONLY CHK
         CW,D2    0,R6
         BAZ      %+3               NORMAL OPEN
         REF      OERX
         LW,SR3   =X'28000014'      14 - 14 ABNORMAL
         B        OERX
         LI,D2    K10000
         CW,D2    EXT,R6
         BAZ      OPNX
         REF      PEOF#,MISOVSEG
         OVERTO   MISOVSEG,PEOF#
         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'
         BAZ      ER1401            NO SHRED UPDATE
         CW,R1    *D3,R3
         BANZ     ER1401            NO SHARED UPDATE
4D1      RES      0
         DO       SYN=1
         LW,D4    Y004
         CW,D4    DESC,R6
         BANZ     ER1401  NO NEW SYNON IN SHARED CASE
         FIN
         SLS,D1   8
         AND,D1   R2
         BNEZ     HOOK1             FUNS ARE EQUAL
         AND,D1   *D3,R3            IS THERE A 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,R5    D3                OLD CFU
OP62     LI,R1    X'1FFFF'          CFUMASK
         AND,R1   CFU,R6            NEW CFU
         LW,R3    R1
         OR,R3    R5
         CI,R3    X'10000'          CAN'T USE HI CFUS
         BANZ     ER1401            BAD NEWS
         AWM,R1   SCFU,R5           SET THE SECONDARY
         AWM,R5   SCFU,R1           AND THE SECONARY'S 2NDARY
         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,R5    D3
         LW,D3    CFU,R6            IT'S NOT THE SAME FILE
         B        OP62
         PAGE
OP2      EQU      %                 FILE DOESNT EXIST
*
         DO       SYN=1
         LW,D1    FUN,R6
         CW,D1    Y0008
         BAZ      OP1               NOT UPDATE
*                                   FUNCTION IS UPDATE--CHECK FOR
*                                   SYNON.
         LI,D1    11
         BAL,R5   LOCCODEA
         B        OPENER
         SPACE    3
*****    NEW SYNONYMOUS FILE BEING CREATED   *****
*
         BAL,SR1  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
         FIN
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     OPENER03
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  *****
*
OPNEOF   EQU      %
         LI,SR3   K2                   NO MORE FILES
         B        OPNER
OPNNXT   EQU      %
         BAL,R4   GETTYC
         CI,R3    K7                EOF COD
         BNE      OPNNXT1           NOT EOF - GET NEXT
         B        OPNEOF            GIVE EOF CODE TO USER
*
OPENER   EQU      %
         LI,SR3   K3
OPNER    LI,9     OPER              SET RETURN
OPNER1   BAL,0    PRIVDCB           ARE WE PRIVATE
         BAZ      *9                NO
         BAL,11   CLSVNO            YES, REMOVE ALL ALLOCATED SPINDLES
         B        *9                RETURN
OPNERX   LI,9     OPNX              RETURN FROM OPNER1
         B        OPNER1            DEALLOCATE TEST SPINDLES
         PAGE
*****    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
         LW,R5    J:DCBLINK
         BEZ      GCFU1M1           NO CFU DCB
         LW,R1    1,R5
         CW,R1    TXTCFU
         BNE      GCFU1M1           NO CFU DCB
         LW,R1    2,R5
         AI,R1    1                 1ST CFU LOC
         LI,R4    5                 THERE ARE 5 HERE
         LC       *R1               IS IT AVAILABLE
         BCS,KF   %+2               NOPE
         BAL,R5   GCFU2             TRY FOR IT
         AI,R1    CFUSIZE           TRY THE NEXT
         BDR,R4   %-4                IF THERE IS ONE
GCFU1M1  RES      0
         FIN
GCFU3    RES      0
         LI,R1    BGRCFU
GCFU1    EQU      %
         LC       *R1
         BCS,KF   %+2               NOT FREE
         BAL,R5   GCFU2             TRY FOR IT
         AI,R1    CFUSIZE
         CW,R1    ACNCFU+13
         BL       GCFU1
         LI,0     GARB1
         BAL,SR4  CFUGARB
         LW,R1    J:BASE+9
         BNEZ     GCFU22            WE GOT ONE
GCFUER   LI,SR3   K55
         B        OPNER
*
GCFU22   LI,R0    0
         STW,R0   SCFU,R1           ASSURE NO 2NDARY
         B        GCFU21
*
         REF      ORGCHK            NOW IN OBSE
         PAGE
*****    SEARCH THE FILE DIRECTORY     *****
*
FINDFIL  EQU      %
*                                   LOCATE FILE IN MASTER FILE INDEX
*
         INT,R3   FLD,R6
         AW,R3    FLP,R6
         STW,R3   KAD,R6
FINDFIL2 EQU      %
         PUSH     1,R0
*                                   ADR OF FILE CFU
*
         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
         REF      SYSACCT,SYSACTL
         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
         LW,SR4   Y008
         STS,SR4  FUN,R6            SET FD PRESENT
         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
         STW,SR2  NFSP
         STW,SR1  NFIT
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
*****    SEARCH THE ACCOUNT DIRECTORY   *****
*****    OBTAIN OPEN-CLOSE-USER PRIVILEGE    *****
*
*
         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
         LW,R2    TSTACK
         AI,R2    -2
         STW,R2   OPNCLSTK
         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
         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
         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     3                 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
3A6      STW,0    ACNCFU+CDAM       SET SECTOR ADDR
         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
         REF      ACNTBL
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
         STW,SR1  ACNCFU+4          BLITZ THE DUAL
         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
         LI,SR4   0
DFDA     EQU      8                 DUAL FDA LOCATION
         STW,SR4  FILCFU+DFDA       RESET DUAL FDA
         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
         OVERLAY  DELSEG,DELAA#     DELETE THE ENTRY
         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
         LW,R2    SR1
         BAL,R0   CLRBFUB
         REF      CLRBFUB
         LI,SR3   X'7500'**-1
         AW,SR3   R2
9H38     RES      0
         SCS,SR3  -7
         B        OPNER
9H50     LW,SR1   D1
         BAL,SR4  FMCHKDA
         BCS,15   4B1
         LI,D1    0
         STW,D1   SYSACTL
         B        4B2
4B1      LI,0     X'40000'
         CW,0     NXTA,6
         BANZ     4B2
OLDACCT  LC       ACNCFU+12
         BNE      OLDA              NOT :SYS
         STW,D1   SYSACTL
         B        OLDA
*
OP3AQ    LI,R0    OP3A-1            FOR NEXT FILES
         PAGE
* LOCATE THE START OF THE VLP IN THE FIT.
*
SETVAR   EQU      %
         DEF      SETVAR
*                                   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
*****    READ IN THE FIT    ******
*
GETFI    EQU      %
         PUSH     1,R0
         REF      J:BASE
         REF      J:CLS
         LI,0     X'100'
         STW,0    J:CLS             SPECIAL FLAG FOR REDSEC
         LW,D1    W14,6
         ANLZ,R4  DCDAM6            DCBCDAM,R6
         AND,D1   M24
         BNEZ     8B3               * FILE OR QUICK OPEN
         DO       SYN=1
         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     OPNER             NO OUT 4 SYNONS
         LW,D2    Y002
         STS,D2   DESC,R6           SET SYNON BEING PROCESSED
GETFI11  RES      0
         ELSE
         AI,3     FNEMAX
         FIN
         BAL,R0   PULLFOUR
         STW,D1   FILCFU+SREC
         LW,R3    ACNCFU+4          SAVE FD DUAL
         LI,R4    FILCFU+CDAM
8B3      RES      0
         LW,R2    0,R4
         BAL,R0   REDSEC
         STW,R2   0,R4
         CI,R4    FILCFU+CDAM
         BNE      %+2
         STW,R3   ACNCFU+4          RESTORE FD DUAL
         STW,D1   BCDA,R6
         LW,D1    J:BASE+7          CFU ADDRESS
         LI,D2    X'1FFFF'
         STS,D1   CFU,R6            RESTORE CFU ADDR
8B67     LW,R2    BUFF2
         BGEZ     8B4
8B66     BAL,D2   GETFUNA
         BAZ      FNERR3            NOT OUTPUT
         OPEN     FNERR
FNERR    SET      8B66
         PULL     R0
         B        OP71
8B4      RES      0
         LI,2     BUFF2+4           CONSEC FIT POSITION
         LW,3     BUFF2+2
         CI,3     X'8000'
         BAZ      8B21              MAYBE CONSEC
         AI,2     NWFITST-4
         CI,3     X'4000'
         BANZ     8B2               FULL GRANULE
         AI,2     -(WXBUFSIZ/2)
8B2      RES      0
         LB,0     *2                NAME LENGTH
         BEZ      FNERR
         CI,0     31
         BG       FNERR
         LW,7     2
         AI,7     9
         LI,D1    9
         BAL,4    LOCCODE           FIND 09 ENTRY
         B        FNERR
         LW,SR4   *R7,R3  FOR ORG CHKS AT OPNFIL1B
         AI,3     2                 # SYNS & DESC
         LW,4     *7,3
         LW,3     KBUF,6
         LW,1     Y002
         CW,1     DESC,6
         BAZ      GETFI21           NOT SYNON
         LI,0     8
         LW,1     0,2
         STW,1    0,3               FIX UP KBUF FOR SCANCFU
         AD,2     DOUBLEONE
         BDR,0    %-3
         CI,4     X'F0000'          ARE THERE ANY SYNS?
         BANZ     GETXIT            OK
         B        FNERR             NOT MASTER OF ANY SYNS
8B21     CW,3     Y3FFF
         BAZ      8B2               IT'S CONSEC
         LW,D1    BUFF2+1           IT'S KEYED & FIT
         LW,R2    0,R4
         LI,D2    X'100'
         STS,D2   J:CLS
         BAL,R0   REDSEC            FLINK AHEAD
         STW,R2   0,R4
         STW,D1   BCDA,R6
         B        8B67
         REF      Y3FFF
GETFI21  SLS,2    2
         SLS,3    2                 BYTE ALIGN
         AI,0     1                 GET LAST BYTE
         STB,0    3                 INSERT LENGTH
         CBS,2    0                 CHK 4 NAME MATCH
         BNE      FNERR             NAMES DON'T MATCH
         LW,R0    W14,R6
         BEZ      GETXIT            DESC ALREADY IN
         LI,R5    DCBPRIVBIT
         CW,R5    PRIV,R6
         BANZ     %+4
         LI,R5    X'9FFF'
         SLD,4    8
         STS,4    DESC,R6
         REF      YFF
         AND,R0   YFF
         BNEZ     GETXIT            IT'S A *
         STW,R0   W14,R6            ZAP THE DA
         LI,R5    4
         SLD,R4   24
         STS,R4   NOACUP,R6
GETXIT   LI,R4    BUFF2             SET FIT EXISTS
         LI,R5    X'1FFFF'
         STS,R4   QBUF,R6
         B        PULLEXIT
         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
         REF      MULSEG,J:JIT
         REF      GETFUNA           NOW IN OBSE
         REF      Y0014
         SPACE    3
Y02000014 DATA    X'02000014'
Y08FF    GEN,8,8,16 8,X'FF',0
DFRDL0   DATA,1   0,254,3,102       254 SLIDES,2 CONSEC,102 BYTES SPARE
         END

