*M*      OPLO     CONTAINS THE OPEN ROUTINES FOR OUTPUT ANS AND LABEL TAPE.
*P*      NAME:    OPLO
*,*      PURPOSE  OPENS OUTPUT ANS AND LABEL TAPE, INCLUDING FOR CVOL.
*,*      DESCRIPTION THE REQUESTED TAPE IS LOCATED(IN THE AVR TABLES),
*,*               OR A MOUNT REQUEST IS SENT TO THE OPERATOR. VOLUME
*,*               LABELS ARE WRITTEN IF NEEDED AND FILE HEADER LABELS
*,*               ARE WRITTEN. THE DCB IS MARKED OPEN.
MONPROC  SET      1
ANSPROC  SET      1
         SYSTEM   UTS
         DEF      OPLO:             PATCHING DEF
OPLO:    RES
         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  *******************
*
***********ROUTINES************
         DEF      AOPNL1            OPEN OUTPUT LABEL TAPE FOR CVOL
         DEF      ABN3001           30-01 ERROR EXIT
         DEF      OPNLO             OPEN OUTPUT LABEL TAPE FOR M:OPEN
         DEF      SETOPN1           CLEANSE AND OPEN XEROX LABEL DCB
         DEF      SETOPN2           CLEANSE AND OPEN ANY DCB
         SPACE    5
******************  REF  *******************
*
***********CONSTANTS***********
         REF      NB31TO0
         REF      ACCESS
         REF      BAQBUF
         REF      BLANK
         REF      CBOF
         REF      DOUBLEZERO
         REF      HDR1
         REF      MISOVSEG
         REF      VOL1
         REF      YFF
         REF      Y0008
         REF      Y01
         REF      Y03
         REF      Y04
         REF      Y06
         REF      Y2
         REF      Y4
         REF      Y45
         REF      80UHL1
         REF      :ACN
         REF      :LBL
         SPACE    2
***********VARIABLES***********
         REF      AVRTBL            INPUT;BITS33,34,37 OUTPUT;BIT33
         REF      CPPO              INPUT; OUTPUT;
         REF      DATE              INPUT;
         REF      JB:PRIV           INPUT
         REF      GETACNADR
         SPACE    2
************ROUTINES************
         REF      ABNRLSBF          ABNORMAL RETURN W/BUFFER RELEASE
         REF      ABN1413           GIVE 14 13 ABN
         REF      CHKADR            VALIDATE USERS TLABEL ADDRESS
         REF      CHKANS0           SKIP IF NOT ANS DCB
         REF      CHKANS1           SKIP IF ANS DCB
         REF      CHKFLACN          CHECK NAME AND ACCOUNT VLP'S
         REF      CLRMBG            RESET DCB:MBG
         REF      MASKS             LO ORDER BIT TABLE
         REF      J:JIT             JOB INFO TABLE
         REF      GETAVR            GET AVRX AND AVR ENTRY
         REF      GETFILADR         GET ADDRESS OF DCB 01 VLP
         REF      GETFUN            GET DCB:FUN
         REF      GETTYC            GET DCB:TYC
         REF      GSBUF             GET BUFFER FOR LABELS
         REF      IOSPIN            WAIT FOR I/O COMPLETE
         REF      LOCCODEA          FIND VARIOUS VLPS IN DCB
         REF      MSRMOVE           MOVE DATA INTO :BOF VLP
         REF      OERX              FOR ERRORS TO EXIT TO
         REF      OPENER03          GIVE 14 00 ERROR
         REF      OPNT3             SET AVRTBL ENTRY BUSY
         REF      OPNT9             DO PRELIMINARY DCB INITIALIZATION
         REF      OPNXTP            SET ANSFLGS IF ANS AND EXIT
         REF      PLEOFRM#          POS TO EOF FOR FILE EXTENSION
         REF      PULLEXIT          EXIT *TSTACK
         REF      PUTSZBF           SAVE BUFFER SIZE AND ADDRESS
         REF      RLSBF             RELEASE BUFFER
         REF      SAVBLK            SET DCB:BLK
         REF      SETACOG           SET DCB:ACS AND DCB:ORG
         REF      SETBTDQ1          SET DCB:HBTD
         REF      SETBTDZ           CLEAR DCB:HBTD
         REF      SETOPN            SET DCB OPEN
         REF      SIXBACK           UNPACK ANS SN FOR LABEL
         REF      SKFILE            SKIP FORWARD OVER TAPE MARK
         REF      TAPECHK           GET/FIND TAPE
         REF      TRNABRT           RELEASE BUFFER AND GIVE 14 02 ERROR
         REF      WRTANSLBL1        WRITE ANS LABELS
         REF      WRTEOF            WRITE TAPE MARK
         REF      WRTTPE            WRITE TAPE PER DCB BUFFER/SIZE
         PAGE
Y09010202  DATA    X'09010202'
         PAGE
OPNLO    EQU      %
*F*      NAME:    OPNLO
*,*      PURPOSE  RECEIVES THE OUTPUT OPEN CAL FOR ANS AND LABEL TAPE.
*,*      DESCRIPTION INITIALIZES THE DCB FOR A TAPE FILE OPEN, THEN
*,*               PROCEEDS TO AOPNL1.
*                                   OPEN OUTPUT TAPE
*D*      NAME:    OPNLO
*,*      ENTRY    AOPNL1
*,*      CALL     OVERTO OPENTPSEG,OPNLO#
*,*               OVERTO OPENTPSEG,AOPNL1#
*,*      INTERFACE OPNT9, CHKFLACN, OPENER03, CHKANS0, SETACOG, CLRMBG
*,*               TAPECHK, CHKANS1, GETAVR, GSBUF, PUTSZBF, SETBTDZ,
*,*               SKFILE, RLSBF, OPNT3, GETFILADR, LOCCODEA, WRTTPE,
*,*               CHKADR, TRNABRT, IOSPIN, GETTYC, MSRMOVE
*,*      DESCRIPTION ENTRY AT OPNLO INITIALIZES THE DCB FOR OPEN AT
*,*               BEGINNING, WHILE ENTRY AT AOPNL1 DOES NOT BEING THE
*,*               CVOL ENTRY. IN ANY EVENT, THE DCB IS CHECKED FOR
*,*               COMPLETENESS AND ADEQUACY AND THE TAPE IS LOCATED/FOUND
*,*               VIA TAPECHK. IF THE TAPE IS AT THE BEGINNING AND HAS
*,*               NOT BEEN AVR'D, THE :LBL-:ACN-TAPE MARK OR THE VOL1
*,*               IS WRITTEN. THEN IF ANS OR IF XEROX AND FILE EXTENSION
*,*               DOES NOT APPLY, THE FILE HEADER LABELS ARE WRITTEN
*,*               AND USER HEADER LABELS IF APPROPRIATE.
*,*               THE DCB IS HOUSEKEPT AND SET OPEN AND THE ROUTINE EXITS
*,*               TO EITHER PLEOFRM IF FILE EXTENSION APPLIES, OR TO
*,*               OPNXTP.
         LI,5     BACVO
         BAL,4    OPNT9
*
AOPNL1   EQU      %
*F*      NAME:    AOPNL1
*,*      PURPOSE  ENTRY POINT FOR OUTPUT CVOL MOUNT NEXT VOLUME, ALSO
*,*               CONTINUATION OF NORMAL OPEN TAPE.
*,*      DESCRIPTION FINDS THE DESIRED TAPE IN THE AVR TABLES, OR REQUESTS
*,*               THE OPERATOR TO MOUNT THE TAPE.
*,*               VOLUME LABELS ARE WRITTEN IF NEEDED AND FILE HEADER
*,*               LABELS ARE WRITTEN. THE DCB IS MARKED OPEN.
         BAL,R0   CHKFLACN
         LB,D1    JB:PRIV
         CI,D1    X'C0'
         BGE      %+4
         LI,D1    K4000
         AND,D1   USR,R6
         BNEZ     OPENER03
         BAL,R0   CHKANS0
         B        AOPNL2
*                        LABEL TAPE ONLY
         BAL,SR4  SETACOG
*                      NO ASCII FOR LABEL TAPE
         LI,SR4   X'80'
         CW,SR4   ORG,R6
         BANZ     ABN1413
*
*E*      ERROR:   14 - 13  ASCII CODE CONVERSION NOT LEGAL ON
*,*                        XEROX LABELED TAPE
*
AOPNL2   RES      0
*
         BAL,D4   CLRMBG
         BAL,5    TAPECHK
         BAL,R0   CHKANS1
         B        OPLO2             NOT ANS DCB
         LW,3     YFF
         AND,3    BLKCNT,R6
         STW,R3   BLKCNT,R6         INITIALIZE BLKCNT
         BAL,R3   GETAVR
         MTW,0    VSETID,R6
         BNEZ     OPLO2
         LI,R3    BACOS             IF FIRST VOL, SET AVRSID F/ AVRTBL
         LB,R3    *6,3
         CI,R3    1
         BE       OPLOSETID
         LW,0     SETID,R6          NOT 1ST VOL, SO WAS SAVED IN SETID
SETID    EQU      19
OPLOSETID EQU     %
         STW,0    VSETID,R6
OPLO2    EQU      %
         BAL,SR4  GSBUF
         LI,R2    80
         BAL,SR4  PUTSZBF
         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
*
OPNLBLX  EQU       %
         BAL,SR4  RLSBF             RELEASE BUFFER.
         BAL,R4   GETTYC
         LI,SR3   X'45'
         CI,R3    8                 IF ERROR, SAY SO
         BGE      OERX
         BAL,D2   OPNT3
         BAL,R0   CHKANS0
         B        SETOPNA
         B         SETOPN1A
*
*
OPNLBLX1 EQU      %
         LI,R1    K10000
         STS,R1   EXT,R6
         B        OPNLBLX
         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
*
         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
*                       DO EXECUTEACCTS/VEHICLE
         CI,D1    X'14'
         BL       WRTBOF2
         CI,D1    X'16'
         BL       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
         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
WRTVOL1L EQU      %
         BAL,SR4  WRTVOL1
         B        OPNLBLX
WRTHDR1%2 EQU     %
         LI,SR4   OPNLBLX
         PUSH     SR4
         B        WRTHDR
         PAGE
EXTCHK   EQU      %
         BAL,D2   GETFUN
         CI,D1    KA                MUST BE OUTPUT MODE
         BAZ      EXTCHKX+1
         LW,R5    TSTACK
         LW,D2    -4,R5             FILE EXTENSION SITUATION
         BEZ      EXTCHKX+1         SKIP IF NOT M:OPLBL
         LB,SR1   D2                WAS NAME SPEC'D
         AND,D2   MASKS+17
         CW,D2    J:JIT+CPPO
         BAZ      EXTCHKX           EXT FLAG NOT SET
*                                   DID USER SPECIFY FILE NAME
         CI,SR1   1
         BE       EXTCHKX+1
         B        *R0
EXTCHKX  EQU      %
         STS,D2   J:JIT+CPPO
         AI,R0    1
         B        *R0
*
*
         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        OPNXTP
SETOPN1  RES      0
*                                   CLEAR PARTS OF DCB FOR FILES
         LD,R0    DOUBLEZERO
         LCI      K2
         STM,R0   BCDA,R6
         STM,R0   KAD,R6
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
*
         PAGE
WRTLBL   EQU      %
*D*      NAME:    WRTLBL
*,*      ENTRY    WRTACN
*,*      DESCRIPTION ENTRY AT WRTLBL SETS UP THE :LBL RECORD AND WRITES
*,*               IT TO TAPE. EITHER ENTRY THEN SETS UP THE :ACN RECORD
*,*               AND WRITES IT TO TAPE FOLLOWED BY A TAPE MARK.
         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      %
         AW,R3    R7
         BAL,R0   GETACNADR
         LCI      K2
         LM,R2    0,R3
         LM,R0    0,R7
         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      %
*D*      NAME:    WRTVOL1
*,*      ENTRY    WRTHDR
*,*      DESCRIPTION ENTRY AT WRTVOL1 SETS UP THE VOL1 RECORD FOR
*,*               ANS TAPE AND WRITES IT TO TAPE. EITHE ENTRY THEN SETS UP
*,*               THE HDR1 AND HDR2 RECORDS AND WRITES THEM TO TAPE
*,*               FOLLOWED BY THE USER LABEL, IF ANY, AND A TAPE MARK.
         PUSH SR4
         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
         LI,R1    X'80'
         CW,R1    ORG,R6            IF IN ASCII....
         BANZ     %+2
         MBS,R2   0                  POS 11
*  ANSI X3.27-1969 SAYS:    COLUMN  EBCDIC  ASCII
*                             11      '0'    ' '
*                             80      ' '    '1'
         LW,R1    R3                CURRENT BYTE ADDRESS
         OR,R1    Y45               BLANK FILL
         MBS,R0   BA(BLANK)          POS 12-80
         LI,R3    '1'               '1' IN COLUMN 80 IF ASCII,
         STB,R3   0,R1                IN COLUMN 81 (IGNORED) IF EBCDIC.
         BAL,SR2  WRTTPE
         BAL,SR4  IOSPIN
         LW,D3    QBUF,R6
WRTHDR   EQU      %
         LW,SR2   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
         BE       ISUHL1            IF NOT,
*
*E*      ERROR: 30-01 USER SUPPLIED ANS TRAILER LABEL
*,*                   DOES NOT CONTAIN X'50','UTL1' IN
*,*                   FIRST TWO WORDS.
*
ABN3001  EQU      %                 ALL 30-01 ERRORS:
         BAL,SR3  ABNRLSBF          REPORT ABN AND RELEASE BUFFER.
         DATA     X'30'+X'01'**25
*
ISUHL1   EQU      %
         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

