ANSPROC,MONPROC SET 1
         SYSTEM   UTS
ANSL     EQU      %
         DEF      ANSL
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
         REF      AVRSID
         REF      BATAPE
         REF      BLANK
         REF      DATE
         REF      GMB
         REF      IOSPIN
         REF      LOCCODEA
         REF      LOCCODE1
         REF      MSR01EXIT
         REF      M24
         REF      PULLEXIT
         REF      PUTSZBF
         REF      RMB
         REF      XA
         REF      WRTTPE
         REF      Y0A
         REF      Y01,Y02,Y03,Y04,Y05,Y06,Y07
         REF      Y4
         PAGE
         DEF      ACCESS
         DEF      BAQBUF
         DEF      HDR1
         DEF      FORMAT
         DEF      #FORMATS
BAQBUF   STB,0    *D3               FOR ANLZ
FORMAT   DATA,1   'F','F','D','V','U'
#FORMATS EQU      BA(%)-BA(FORMAT)-1
F0F0     DATA,2   '00'
F0F4     DATA,2   '04'              BUFFER OFFSET FORMAT 'V'
ACCESS   EQU      F0
800BPI   DATA,1   '2'
F0       DATA,1   X'F0'
UTS      TEXT     'XEROX/CP-V'
         BOUND    4
Y50      DATA     X'50000000'
Y4C      DATA     X'4C000000'
X16D     DATA     365
HDR1     TEXT     'HDR1'
WRTANSLBL EQU     %                 WRITE HDR1 | EOF1 | EOV1
         LI,0     WRTANSLBL1
ANSLINIT EQU      %
         DEF      ANSLINIT
         DEF      WRTANSLBL1,WRTANSLBL
         PUSH     R0
         PUSH     SR4
WRTANSL1 EQU      %
         BAL,SR4  GMB               GET MONITOR BUFFER
         BNEZ     WRTANSL2
         PUSH     R6
         LI,R6    1
         LW,R2    S:CUN
         STW,R6   U:MISC,R2
         LI,R6    E:SL
         BAL,SR4  T:REG
         PULL     R6
         B        WRTANSL1
WRTANSL2 EQU      %
         LI,R2    80                ANS LABELS ARE 80 BYTES
         BAL,SR4  PUTSZBF           BLK=R2,QBUF=D3
         PULL     SR4
         B        PULLEXIT
WRTANSLBL1 EQU    %
         PUSH     SR4
         ANLZ,R1  BAQBUF
         OR,R1    Y50
         MBS,R0   BA(BLANK)
         ANLZ,R3  BAQBUF            BYTE ADDRESS OF QBUF
         LI,R2    R7**2             BYTE ADDRESS R7
         OR,R3    Y04               MOVE 4 BYTES
         MBS,R2   0                  POS 1-4
         LI,R7    HAFLD             FILE NAME
         LH,R2    *R6,R7
         AW,R2    FLP,R6
         LB,R7    *R2               COUNT
         BEZ      ABN3003           FILE NAME=0 CHARACTERS
         CI,R7    ANSFNMAX          MAX FILE NAME LENGTH
         BG       ABN3003           FILE NAME>17 CHARACTERS
         SLS,R2   2                 BYTE ADDRESS
         STB,R7   R3
         MBS,R2   1                  POS 5-21
         AI,R7    -ANSFNMAX
         LAW,R7   R7
         AW,R3    R7                TO POS 22
WRTANSLBL2 EQU    %
         LI,R2    BADSI
         LB,R2    *R6,R2            DCTX
         AI,R2    -BATAPE           RELATIVE TO AVR TABLES
         LW,R2    AVRSID,R2         SET ID
         BAL,SR4  SIXBACK           DE-HASH SERIAL NUMBER
         LI,R2    SR1**2            BYTE ADDRESS OF SR1
         OR,R3    Y06               MOVE 6 BYTES
         MBS,R2   0                  POS 22-27
         LI,R7    BACVO             VOLUME SEQUENCE NUMBER
         LB,R1    *R6,R7
         LI,R2    4                 CONVERT 4 POSITIONS
         BAL,SR4  CNVDEC            CONVERT TO DECIMAL
         LI,R2    SR1**2            BYTE ADDRESS OF SR1
         OR,R3    Y04               MOVE 4 BYTES
         MBS,R2   0                  POS 28-31
         LI,R1    X'1FFFF'
         LS,R1    FSN,R6            FILE SEQUENCE #
         LI,R2    4                 CONVERT 4 POSITIONS
         BAL,SR4  CNVDEC            CONVERT TO DECIMAL
         LI,R2    SR1**2            BYTE ADDRESS OF SR1
         OR,R3    Y04               MOVE 4 BYTES
         MBS,R2   0                  POS 32-35
         AI,R3    6                 POS 36-41 BLANK
         BAL,SR4  JULIAN            RETURN JULIAN DATE IN SR1-SR2
         AI,SR1   X'4000'           LEADING BLANK
         LI,R2    SR1**2            BYTE ADDRESS OF SR1
         OR,R3    Y06               MOVE 6 BYTES
         MBS,R2   2                  POS 42-47
         LI,D1    4                 EXPIRE VLP CODE
         PUSH     R3
         BAL,R5   LOCCODEA
         B        WRTANSLBL4        NOT SPECIFIED
         ANLZ,R5  LOCCODE1
         PULL     R3
         LB,R0    *R5
         CI,R0    'N'               'NEVER' EXPIRATION IS ILLEGAL
         BE       ABN3004
         CI,R0    ' '               BLANK = RETENTION
         BNE      WRTANSLBL5
         LW,R0    0,R5              RETENTION PERIOD
         SLS,R0   8
         BAL,SR4  CNVBIN            CONVERT TO BINARY
         STW,R1   D2
         BAL,SR4  JULIAN            JULIAN DATE (000YYDDD)
         SCD,SR1  -24               DDD000YY
         STW,SR1  R0                DAYS
         BAL,SR4  CNVBIN            CONVERT TO BINARY
         AW,D2    R1                TOTAL DAYS
         LI,D1    0                 CLEAR R
         DW,D1    X16D              R=DAYS,RU1=YEARS
         LI,R0    0
         STH,SR2  R0                YEARS
         BAL,SR4  CNVBIN            CONVERT TO BINARY
         AW,R1    D2                YEAR(S)
         LI,R2    2                 CONVERT 2 POSITIONS
         BAL,SR4  CNVDEC            CONVERT TO DECIMAL
         SLS,SR1  -8
         OR,SR1   Y4                LEADING BLANK
         LI,R2    SR1**2            BYTE ADDRESS SR1
         OR,R3    Y03               MOVE 3 BYTES
         MBS,R2   0                  POS 48-50
         LW,R1    D1                DAYS
         LI,R2    3                 CONVERT 3 POSITIONS
         BAL,SR4  CNVDEC            CONVERT TO DECIMAL
         LI,R2    SR1**2            BYTE ADDRESS SR1
         OR,R3    Y03
         MBS,R2   0                  POS 51-53
         B        WRTANSLBL3
WRTANSLBL4 EQU    %
         PULL     R3
         LI,R5    DATE
WRTANSLBL5 EQU    %
         BAL,SR4  CNVJULIAN
         AI,SR1   X'4000'           LEADING BLANK
         LI,R2    SR1**2            BYTE ADDRESS OF SR1
         OR,R3    Y06               MOVE 6 BYTES
         MBS,R2   2                  POS 48-53
WRTANSLBL3 EQU    %
         LI,R2    BA(ACCESS)        SEQURITY
         OR,R3    Y01               MOVE 1 BYTE
         MBS,R2   0                  POS 54
         LW,R1    M24
         LS,R1    BLKCNT,R6         BLOCK COUNT
         LI,R2    6                 CONVERT 6 POSITIONS
         BAL,SR4  CNVDEC
         LI,R2    SR1**2            BYTE ADDRESS OF SR1
         OR,R3    Y06               MOVE 6 BYTES
         MBS,R2   0                  POS 55-60
         LI,R2    BA(UTS)
         OR,R3    Y0A               MOVE 10 BYTES
         MBS,R2   0                  POS 61-70
         LW,R0    VERSION           VERSION, E.G., C01
         SCS,R0   12
         LI,R1    X'F'
         LS,R1    R0
         AI,R1    'A'-1             MAKE EBCDIC
         LI,R2    R1**2             BYTE ADDRESS OF R1
         OR,R3    Y01
         MBS,R2  3                   POS 71
         SCS,R0   4
         LI,R1    X'F'
         LS,R1    R0                NUMERIC
         AI,R1    '00'
         LI,R2    R1**2             BYTE ADDRESS OF SR1
         OR,R3    Y02               MOVE 2 BYTES
         MBS,R2   2                  POS 72-73
*                      7 BLANKS  POS 74-80
         BAL,SR2  WRTTPE            WRITE LABEL
         BAL,SR4  IOSPIN
* CONSTRUCT & WRITE HDR2 | EOF2 | EOV2
         LW,D3    QBUF,R6           BEFFER ADDRESS
         MTW,1    *D3
         ANLZ,R3  BAQBUF
         AI,R3    4
         LW,R1    Y4C
         AW,R1    R3
         MBS,R0   BA(BLANK)         INITIALIZE TO BLANKS
         LI,R1    X'70'
         LS,R1    FMT,R6            FORMAT
         SLS,R1   -4
         CI,R1    #FORMATS          KNOWN FORMAT CODE
         BG       ABN3005           ILLEGAL FORMAT
         LB,R1    FORMAT,R1         RECORD FORMAT (DEFAULT 'F')
         STB,R1   0,R3              POS 5
         AI,R3    1                 ONE BYTE
         LW,R1    BLKSZ,R6          BLOCK SIZE
         SLS,R1   -17               RIGHT JUSITFY
         LI,R2    5                 CONVERT 5 POSITIONS
         BAL,SR4  CNVDEC            CONVERT TO DECIMAL
         LI,R2    SR1**2            BYTE ADDRESS OF SR1
         OR,R3    Y05               MOVE 5 BYTES
         MBS,R2   0                 POS 6-10
         LW,R1    LRCSZ,R6          LOGICAL RECORD SIZE
         SLS,R1   -17
         CI,R1    0                 NONE SPECIFIED
         BNEZ     WRTANSLBL6
         LI,R2    X'F0'
         AND,R2   FMT,R6            RECFM
         BEZ      WRTANSLBL7
         CI,R2    F**4              FIXED
         BNE      WRTANSLBL6
WRTANSLBL7 EQU    %
         LW,R1    BLKSZ,R6          DEFAULT BLOCK SIZE
         SLS,R1   -17
WRTANSLBL6 EQU    %
         LI,R2    5                 CONVERT 5 POSITIONS
         BAL,SR4  CNVDEC            CONVERT TO DECIMAL
         LI,R2    SR1**2            BYTE ADDRESS OF SR1
         OR,R3    Y05               MOVE 5 BYTES
         MBS,R2   0                 POS 11-15
         LI,R2    BA(800BPI)        RECORDING DENISITY (800 BPI)
         OR,R3    Y02               1 BYTE +1BYTE
         MBS,R2   0
         AI,R3    33                33 BLANKS
         LI,R1    X'70'
         LI,R2    BA(F0F4)
         LS,R1    FMT,R6            FORMAT
         CI,R1    V**4              'V' IS SPECIAL CASE
         BE       %+2
         LI,R2    BA(F0F0)
         OR,R3    Y02
         MBS,R2   0
*                                   28 BLANKS
         BAL,SR2  WRTTPE            WRITE LABEL
         BAL,SR4  IOSPIN
         LW,D3    QBUF,R6           MONITION BUFFER
         BAL,SR4  RMB               GIVE IT BACK
         B        PULLEXIT
*
         DEF      ABNRMB
ABN3003  EQU      %                 ANS COUNT = 0 | > 17 CHARACTERS
         LW,SR3   %+2
         B        ABNRMB
         ERRABNCD X'30',3
ABN3004  EQU      %                 ILLEGAL EXPIRATION
         LW,SR3   %+2
         B        ABNRMB
         ERRABNCD X'30',4
ABN3005  EQU      %                 ILLEGAL TAPE FORMAT
         DEF      ABN3005
         LW,SR3   %+2
         B        ABNRMB
         ERRABNCD X'30',5
ABNRMB   EQU      %
         LW,D3    QBUF,R6
         LI,SR4   MSR01EXIT
         B        RMB
         DEF      JULIAN
         DEF      CNVBIN,CNVDEC
         PAGE
* CONVERT GREGORIAN DATE TO JULIAN (COMPUTER OR DCB)
* FORMAT IN SR1-SR2  000000FYFYFDFDFD
*
JULIAN   EQU      %
         LI,R5    DATE
CNVJULIAN EQU     %
         PUSH     SR4               SAVE LINK SO WE CAN GO HOME
         LH,R0    *R5               MONTH
         SLS,R0   16                LEFT JUSTIFY
         BAL,SR4  CNVBIN
         LH,R2    DAYS,R1           ACCUMULATED DAYS TO THIS MONTH
         CI,R2    31+29             JAN OR FEB
         BLE      NOLEAP            YES- NO LEAP YEAR PROBLEM
         LW,R0    1,R5              YEAR
         SLS,R0   16                LEFT JUSTIFY
         BAL,SR4  CNVBIN
         CI,R1    3
         BANZ     NOLEAP            NOT LEAP YEAR
         AI,R2    1                 LEAP YEAR
NOLEAP   EQU      %
         LW,R0    *R5               TODAY
         SLS,R0   16                LEFT JUSTIFY
         BAL,SR4  CNVBIN            BINARY
         AW,R1    R2
         LI,R2    3                 CONVET 3 POSITIONS
         BAL,SR4  CNVDEC
         SLD,SR1  -16
         LW,R1    1,R5
         STH,R1   SR1
         SLD,SR1  -24
         B        PULLEXIT
*
DAYS     DAYS
         PAGE
         REF      U:MISC,E:SL,S:CUN,T:REG
* SIXBACK RETURNS A SIX CHARACTER SERIAL #
* R2=HASHED SERIAL #
* SR1-SR2=EBCDIC SIX CHARACTER SERIAL # LEFT JUSTIFIED
* CALL: BAL,SR4   SIXPACK
*
SIXBACK  EQU      %
         DEF      SIXBACK
         PUSH      4,R3
         SLD,R2   -20
         SLS,R3   -12
         LW,R5    R3
         LI,R6    6
SIXBACK1 EQU      %
         SLD,R2   -2
         SLS,R3   -26
         LI,R4    0
         DW,R4    XA
         OR,R3    R4
         BEZ      %+2
         AI,R3    X'80'
         AI,R3    X'40'
         SLD,SR1  -8
         STB,R3   SR1
         BDR,R6   SIXBACK1
         PULL     4,R3
         B        *SR4
* CONVERT BINARY TO EBCDIC
* R0-R1=EBCDIC NUMBER
* R1=BINARY NUMBER
*
CNVBIN   EQU      %
         PUSH     2,R3
         LI,R3    0
CNVBIN0  EQU      %
         LB,R4    R0                EBCDIC DIGIT
         BEZ      CNVBINX           DONE ON ZERO
         AI,R4    -'0'              STRIP ZONE
         MI,R3    10
         AW,R3    R4
         SLD,R0   8                 POSITION NEXT DIGIT
         B        CNVBIN0
CNVBINX  EQU      %
         STW,R3   R1
         PULL     2,R3
         B        *SR4
*
*CONVERT BINARY TO EBCDIC DECIMAL
* INPUT R1; # POSITIONS R2;  OUTPUT SR1-SR2
* CALL BAL,SR4 CVNDEC
*
CNVDEC   EQU      %
         LI,R0    0                 CLEAR R
         DW,R0    XA                /10
         AI,R0    '0'               EBCDIC
         SLD,SR1  -8
         STB,R0   SR1
         BDR,R2   CNVDEC
         B        *SR4
         END

