MONPROC  SET      1
ANSPROC  SET      1
         SYSTEM   UTS
         DEF      OPLO
OPLO     EQU      %
         PAGE
         BOUND    8
K2       EQU      2
K0       EQU      X'0'
K1       EQU      X'1'
K3       EQU      X'3'
K4       EQU      4
K5       EQU      X'5'
K6       EQU      X'6'
KA       EQU      X'A'
K4000    EQU      X'4000'
K10000   EQU      X'10000'
K1FFFF   EQU      X'1FFFF'
KN1      EQU      -X'1'
         PAGE
R0       EQU      0
R1       EQU      1
R2       EQU      2
R3       EQU      3
R4       EQU      4
R5       EQU      5
R6       EQU      6
R7       EQU      7
SR1      EQU      8
SR2      EQU      9
SR3      EQU      10
SR4      EQU      11
D1       EQU      12
D2       EQU      13
D3       EQU      14
D4       EQU      15
         PAGE
         DEF      OPNLO,AOPNL1
         PAGE
         REF       AVRTBL
         REF      GSBUF
         REF      BLANK
         REF      DATE
         REF      SIXBACK
         REF      WRTANSLBL1
         REF      Y06,Y45
         REF       Y03
         REF       Y0008
         REF      PLEOFRM#,MISOVSEG
         REF      PUTSZBF
         REF      Y04
         REF      Y4
         REF      Y2
         REF      SAVBLK
         REF      WRTTPE
         REF      IOSPIN
         REF      PULLEXIT
         REF      DOUBLEZERO
         REF      SETBTDQ1
         REF      CHKFLACN
         REF      GETAVR
         REF      SETACOG
         REF      RLSBF
         REF      GETTYC
         REF      TAPECHK
         REF      OPENER03
         REF      OPNX
         REF      CLRMBG
         REF      LOCCODEA
         REF      MSRMOVE
         REF      Y01
         REF      GETFUN
         REF      CPPO
         REF      CHKANS0,CHKANS1
         REF      AVRSID
         REF      ACCESS
         REF      BAQBUF
         REF      ABN3001
         REF      HDR1
         REF      J:ACCN
         REF      VOL1
         REF      80UHL1
         REF      :ACN
         REF      :LBL
*
*
         REF      CBOF
Y09010202  DATA    X'09010202'
         DEF      OPNT2
OPNT2    LI,R1    BACIS
         LB,R0    *R6,R1
         BNEZ     %+2
         MTB,1    *R6,R1
         B        0,R2
         PAGE
OPNLO    EQU      %
*                                   OPEN OUTPUT TAPE
         REF      OPNT9
         LI,5     BACVO
         BAL,4    OPNT9
*
AOPNL1   EQU      %
         BAL,R0   CHKFLACN
         LI,D1    K4000
         AND,D1   USR,R6
         BNEZ     OPENER03
         BAL,R0   CHKANS1
         BAL,SR4  SETACOG
*
         BAL,D4   CLRMBG
         BAL,5    TAPECHK
         BAL,R0   CHKANS1
         B        OPLO2             NOT ANS DCB
         MTW,1    FSN,R6            INCREMENT FILE SEQUENCE #
         LW,3     YFF
         REF      YFF
         AND,3    BLKCNT,R6
         STW,R3   BLKCNT,R6         INITIALIZE BLKCNT
         BAL,R3   GETAVR
         MTW,0    AVRSID,R2
         BNEZ     OPLO2
         LI,R3    X'20000'
         CW,R3    SNFN,R6           SERIAL # OR FILE NAME
         BANZ     OPLOSETID         FILE NAME
         LI,D1    8                 OUTSN FIRST
         BAL,R5   LOCCODEA
         B        OPLOSN            NOT THERE
         LW,R0    *R7,R3            SERIAL # FROM DCB
         B        OPLOSETID
OPLOSN   EQU      %
         AI,D1    -1
         CI,D1    7                 TRY INSN(SN)
         BE       LOCCODEA
OPLOSETID EQU     %
         STW,R0   AVRSID,R2         SETID=SERIAL # FIRST VOLUME
OPLO2    EQU      %
         LI,0     X'F'
         AND,0    ASN,6
         CI,0     2
         BNE      OPLO21
         LC       AVRFLGS,2
         BCS,4    ABN1413           NO CODE CONV FOR LABEL TAPE
         REF      ABN1413
OPLO21   EQU      %
         REF      AVRFLGS
         BAL,SR4  GSBUF
         LI,R2    K0
         BAL,SR4  PUTSZBF
         REF      SETBTDZ
         BAL,D4   SETBTDZ           HSKP HBTD
         BAL,R3   GETAVR
         CW,R1    Y4                IS TAPE AT BEGINNING
         BAZ      OPLO6
*
*
         LW,D1    R1
         AND,R1   YFBFF
YFBFF    EQU      NB31TO0+27
         STD,R0   AVRTBL,R2
         CW,D1    Y04
         BANZ     OPLO7
         BAL,R0   EXTCHK
         B        OPNLBLX1
*
*
        BAL,SR2  SKFILE
OPLO7    EQU      %
         BAL,SR2  SKFILE
         BAL,R0   CHKANS0
         B        WRTHDR1%2
        B        OPNLBLO3
OPLO6   EQU      %
         OR,R1    Y4
         STD,R0   AVRTBL,R2
         CW,R1    Y2                DID AVR RECOGNIZE
         BANZ     OPNLBLO4          YES
*                                   NO WRITE UBL SENTINEL
         BAL,R0   CHKANS0
         B        WRTVOL1L
         BAL,SR4  WRTLBL
         B        OPNLBL01
OPNLBLO4 EQU      %
         BAL,R0   CHKANS0
         B        WRTHDR1%2
         BAL,SR4  WRTACN
OPNLBL01 EQU      %
         BAL,R0   EXTCHK
         B        %+1
*
OPNLBLO3 EQU      %
         BAL,R0   WRTBOF
         BAL,11   RLSBF
*
OPNLBLX  EQU       %
         REF      OPNT3
         BAL,D2   OPNT3
         BAL,R0   CHKANS0
         B        SETOPNA
         B         SETOPN1A
*
*
OPNLBLX1 EQU      %
         LI,R1    K10000
         STS,R1   EXT,R6
         B        OPNLBLX-1
         PAGE
         PAGE
WRTBOF   EQU      %                 WRITE BEGINNING OF FILE SENTINEL
         PUSH     1,R0
         LI,D1    XBUFSIZ
         BAL,R0   SAVBLK
         LW,D3    QBUF,R6
         LW,R0    CBOF              BOF RECORD
         STW,R0   *D3
*                                   ENTER FILE NAME
*
         REF      GETFILADR
         BAL,0    GETFILADR
         LI,R3    K0
         LI,R2    K1
         LI,D1    K1                FILE NAME CODE
         BAL,SR1  SETENTL-1
*                                   ENTER PASSWORD
*                                   GET SYNON ENTRY
         LI,D1    11
         BAL,R5   LOCCODEA
         B        WBOF
         BAL,SR1  SETENTL-1
WBOF     EQU      %
         LI,D1    K3
         BAL,R5   LOCCODEA
         B        WRTBOF1           NONE
         LI,R0    K2
         BAL,SR1  SETENTL
WRTBOF1  EQU      %                 DO READ ACCOUNTS
         LI,D1    K5
WRTBOF3  EQU      %
         BAL,R5   LOCCODEA
         B        WRTBOF2
         LI,R0    X'FF00'
         AND,R0   D2                # OF ACTIVE READ/WRITE ACCOUNTS
         SLS,R0   -8
         BAL,SR1  SETENTL
         LB,D1    D1
WRTBOF2  EQU      %
         AI,D1    K1
         CI,D1    K6                WRITE ACCOUNTS
         BE       WRTBOF3
*
*                                   FIXED ENTRIES
         LW,R0    Y09010202
         STW,R0   *D3,R2
         AI,R2    2
         LW,R0    WRDL0,R6          PUT PYRAMID PARAMS AWAY
         STW,R0   *D3,R2
         AI,R2    -1
         SLS,R2   K2
         LI,R0    X'30'
         AND,R0   ORG,R6
         SLS,R0   -4
         STB,R0   *D3,R2
         AI,R2    K1
*                                   KEY MAX
         LI,R3    BASCR
         LB,R0    *R6,R3
         AI,R0    KN1
         STB,R0   *D3,R2
*                                   CURRENT VOLUMNE
         AI,R2    K1
         LI,R3    BACVO
         LB,R0    *R6,R3
         STB,R0   *D3,R2
*                                   SEE IF USER LABEL IS SPECIFIED
         AI,R2    K2
         LI,R7    K1FFFF            NO LABEL
         AND,R7   TLB,R6
         BEZ      WRTBOF10
         LB,R7    *R7               SIZE OF LABEL
WRTBOF10 EQU      %
         STB,R7   *D3,R2
*                                   WRITE OUT RECORD
         AI,R2    4
         BAL,SR4  PUTSZBF
         BAL,SR2  WRTTPE
*
         LW,D2    R7                WRITE OUT USER LABEL   *******
         BEZ      WRTBOF11
         LW,D3    TLB,R6
         BAL,R2   CHKADR            VALIDATE ADDRESS
         BNE      TRNABRT           BAD ADDRESS, 14 02 EXIT
         REF      TRNABRT
         REF      CHKADR
         LB,R2    *D3
         LW,R7    QBUF,R6
         BAL,SR4  PUTSZBF
         BAL,SR2  WRTBTD1
         LW,D3    R7
         LI,D4    K1FFFF
         STS,D3   QBUF,R6
WRTBOF11 EQU      %
         BAL,SR2  WRTEOF            WRITE END OF FILE
         BAL,SR4  IOSPIN
         BAL,R4   GETTYC
         CI,3     5                 EOT HIT
         BNE      %+3
         LI,11    X'40000'          SET EOT FLAG IN DCB
         STS,11   10,6
         B        PULLEXIT
*
*
         LI,R0    (FNEMAX+3)/4
SETENTL    EQU    %
         SCS,D1   -8
         AW,D1    R0
         LI,R5    K2
         STB,R0   D1,R5
         STW,D1   *D3,R2
         AI,R2    K1
         B        MSRMOVE
         PAGE
         PAGE
WRTVOL1L EQU      %
         BAL,SR4  RLSBF
         BAL,SR4  WRTVOL1
         B        OPNLBLX
WRTHDR1%2 EQU     %
         BAL,SR4  RLSBF
         BAL,R0   ANSLINIT
         LI,SR4   OPNLBLX
         PUSH     SR4
         B        WRTHDR
         PAGE
EXTCHK   EQU      %
         BAL,D2   GETFUN
         CI,D1    KA                MUST BE OUTPUT MODE
         BAZ      EXTCHKX+1
         BAL,SR4  DCBNCHK
         REF      DCBNCHK
         B        EXTCHKX+1
         CW,D2    CPPO,R5
         BAZ      EXTCHKX           EXT FLAG NOT SET
*                                   DID USER SPECIFY FILE NAME
         CI,SR1   1
         BE       EXTCHKX+1
         B        *R0
EXTCHKX  EQU      %
         STS,D2   CPPO,R5
         AI,R0    1
         B        *R0
*
*
         REF      SKFILE1,WRTEOF
SKFILE   EQU      SKFILE1
         PAGE
SETOPN1A BAL,2    SETOPN1
SETOPNA  EQU      %
         BAL,0    SETOPN
         STS,D2   EGV,R6
         LW,D2    Y03               CLEAR NEXT AND TRN
         STS,D1   TRN,R6
         LI,R1    K10000
         CW,R1    EXT,R6
         BAZ      SETO1
         OVERTO   MISOVSEG,PLEOFRM#
SETO1    EQU      %
         LW,D2    Y0008             SET EOP TO WRITE
         STS,D2   EOP,R6
         B        OPNX
         DEF      SETOPN1
SETOPN1  RES      0
*                                   CLEAR PARTS OF DCB FOR FILES
         LD,R0    DOUBLEZERO
         LCI      K2
         STM,R0   BCDA,R6
         STM,R0   KAD,R6
         DEF      SETOPN2
SETOPN2  RES      0
         STW,R0   CMD,R6
         LI,R1    BUF1MSK+BUF2MSK+TOPMSK
         STS,R0   BUFX,R6           CLEAR BUFFER POINTERS
         LW,R1    KBUF,R6
         STW,R0   0,R1
         B        0,2
*
         REF      SETOPN
         PAGE
WRTLBL   EQU      %
         PUSH     SR4
         LI,D1    12                MINIMUM RECORD SIZE
         BAL,R0   SAVBLK
         BAL,R3   GETAVR            GET ENTRY INTO AVR TABLE
         LW,D2    :LBL
         LW,D3    QBUF,R6
         STW,D2   *D3
         LI,R2    K1
         STW,R0   *D3,R2
         BAL,SR2  WRTTPE
         BAL,SR4  IOSPIN
         B        WRTACN+1
WRTACN   EQU      %
         PUSH     SR4
         LI,D1    28
         BAL,R0   SAVBLK
         LW,D3    QBUF,R6
         LW,R0    :ACN
         STW,R0   *D3
         LI,D1    K4                EXPIRATION
         BAL,R5   LOCCODEA
         B        WRTACN1           NOT SPECIFIED
WRTACN2  EQU      %
         LCI      K2
         LM,R2    *R7,R2
         LM,R0    J:ACCN
         LM,R4    DATE
         LI,R7    K1
         LCI      6
         STM,R0   *D3,R7
         BAL,SR2  WRTTPE
         BAL,SR4  IOSPIN
         BAL,SR2  WRTEOF
         B        PULLEXIT
WRTACN1  EQU      %
         LI,R7    DOUBLEZERO
         LI,R3    K0
         B        WRTACN2
         PAGE
WRTVOL1  EQU      %
         BAL,R0   ANSLINIT
         PUSH SR4
         REF      ANSLINIT
         BAL,R3   GETAVR
         ANLZ,R3  BAQBUF            BYTA ADDRESS OF QBUF
         LI,R2    BA(VOL1)
         OR,R3    Y04               MOVE FOUR BYTES
         MBS,R2   0                  POS 1-4
         LW,R2    R0
         BAL,SR4  SIXBACK           DE-HASH SERIAL NUMBER
         LI,R2    SR1**2            BYTE ADDRESS OF SR1
         OR,R3    Y06               MOVE SIX BYTES
         MBS,R2   0                  POS 5-10
         LI,R2    BA(ACCESS)        SEQUIRTY
         OR,R3    Y01               MOVE 1 BYTE
         MBS,R2   0                  POS 11
         LW,R1    R3                CURRENT BYTE ADDRESS
         OR,R1    Y45               BLANK FILL
         MBS,R0   BA(BLANK)          POS 12-80
         BAL,SR2  WRTTPE
         BAL,SR4  IOSPIN
         LW,D3    QBUF,R6
WRTHDR   EQU      %
         LW,R7    HDR1
         BAL,SR4  WRTANSLBL1
         LI,R3    X'1FFFF'
         LS,R2    TLB,R6            USER HEADER LABEL
         BEZ      NOUHL             NOT SPECIFIED
         LW,R0    0,R2              WORD1
         LW,R1    1,R2              WORD2
         SLD,R0   -24
         CD,R0    80UHL1
         BNE      ABN3001           MUST BE 80'UHL1'
         STS,R2   QBUF,R6
         BAL,SR2  WRTBTD1
         BAL,SR4  IOSPIN
NOUHL    EQU      %
         BAL,SR2  WRTEOF            TAPE MARK
         B        PULLEXIT
*
WRTBTD1  LI,0     X'40'             WRT BTD TO 1
         BAL,D4   SETBTDQ1
         B        WRTTPE              AND WRITE
*
         END

