*M*      ANSL     SUBROUTINES TO WRITE ANS TAPE LABELS AND OTHER ANS
*,*               RELATED SUBROUTINES
*P*      NAME:    ANSL
*,*      PURPOSE  WRITES ANS TAPE LABELS AND CONTAINS OTHER SUBROUTINES
*,*               NEEDED IN SUPPORT OF ANS TAPE
*,*      DESCRIPTION THE VARIOUS PIECES OF INFORMATION NEEDED FOR ANS
*,*               LABELS ARE FETCHED FROM THE DCB AND AVR TABLES,
*,*               CONVERTED TO EBCDIC CHARACTERS, AND SET INTO THE
*,*               THE LABELS AND WRITTEN TO THE TAPE. BUFFERS ARE OBTAINED
*,*               AND RELEASED AS REQUIRED.
*,*      REFERENCE FORMATS OF LABELS ARE ACCORDING TO ANSI X3.27-1969
ANSPROC  SET      1
MONPROC  SET      1
         SYSTEM   UTS
ANSL:    RES
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
**********************  REF  ***********************
**************CONSTANTS*************
         REF      BATAPE
         REF      BLANK
         REF      E:SL
         REF      LOCCODE1          COMPUTE BYTE ADDRESS F/*R7,R3
         REF      M24
         REF      XA
         REF      Y0A
         REF      Y01
         REF      Y02
         REF      Y03
         REF      Y04
         REF      Y05
         REF      Y06
         REF      Y4
         SPACE    3
**************VARIABLES*************
         REF      AVRSID            INPUT;
         REF      DATE              INPUT;
         REF      S:CUN             INPUT;
         REF      AVRFLGS           INPUT;  USED FOR DDS FLAG ONLY HERE
         REF      TB:FLGS1          INPUT;  USED FOR POTT OR DD ID
         REF      U:MISC            OUTPUT;
         SPACE    3
*************ROUTINES***********
         REF      GMB               GET MONITOR BUFFER FOR ANS LABELS
         REF      GSBUF             GET FM BUFFER
         REF      IOSPIN            WAIT FOR I/O COMPLETE
         REF      LOCCODEA          FIND VLP WITH DATA
         REF      OERX              OPEN OVERLAY ERROR EXIT
         REF      PULLEXIT          EXIT VIA TSTACK
         REF      PUTSZBF           SET UP DCB FOR QUEUE I/O
         REF      RLSBF
         REF      T:REG             BRIEF SLEEP
         REF      WRTTPE            WRITE ANS LABELS
         SPACE    5
******************  DEF  ***************
*
************CONSTANTS************
         DEF      ACCESS            ACCESS CODE FOR ANS LABEL
         DEF      BAQBUF            ANLZ OBJECT...BA FROM D3
         DEF      FORMAT            CONVERT DCB:FMT TO FORMAT CHAR
         DEF      HDR1              C'HDR1'
         DEF      #FORMATS          # ENTRIES FOR FORMAT
         SPACE    3
*************ROUTINES***********
         DEF      ABNRLSBF          RELEASE BUFFER AND REPORT ABNORMAL
         DEF      ABN3005           SET ABN 30 05 AND EXIT TOABNRMB
         DEF      ANSL:             PATCHING DEF
         DEF      CNVBIN            CONVERT BINARY TO DECIMAL EBCDIC
         DEF      CNVDEC            CONVERT EBCDIC DECIMAL TO BINARY
         DEF      CNVJULIAN         :ACN EXPIRATION DATE TO JULIAN FORMAT
         DEF      JULIAN            CONVERT EBCDIC MO,DAY,YR TO JULIAN
         DEF      SIXBACK           UNPACK ANS SN TO 6 CHARACTERS
         DEF      WRTANSLBL         INITIALIZE AND WRITE ANS LABELS
         DEF      WRTANSLBL1        WRITE ANS LABELS
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
1600BPI  DATA,1   '3'
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
*F*      NAME:    WRTANSLBL
*,*      PURPOSE  WRITES ANS TAPE LABELS AND CONTAINS OTHER SUBROUTINES
*,*               NEEDED IN SUPPORT OF ANS TAPE
*,*      DESCRIPTION THE VARIOUS PIECES OF INFORMATION NEEDED FOR ANS
*,*               LABELS ARE FETCHED FROM THE DCB AND AVR TABLES,
*,*               CONVERTED TO EBCDIC CHARACTERS, AND SET INTO THE
*,*               THE LABELS AND WRITTEN TO THE TAPE. BUFFERS ARE OBTAINED
*,*               AND RELEASED AS REQUIRED.
*,*      REFERENCE FORMATS OF LABELS ARE ACCORDING TO ANSI X3.27-1969
         SPACE    2
*D*      NAME:    WRTANSLBL
*,*      ENTRY:   WRTANSLBL1
*,*      REGISTERS ALL VOLATILE EXCEPT R6
*,*      CALL     BAL,SR4 WRTANSLBL
*,*               BAL,SR4 WRTANSLBL1
*,*      INTERFACE ANSLINIT CALLS GMB, T:REG, PUTSZBF
*,*               WRTANSLBL1 CALLS SIXBACK, CNVDEC, JULIAN, LOCCODEA,
*,*                  CNVBIN, WRTTPE, IOSPIN, RMB
*,*      INPUT    R6=DCB ADDRESS
*,*               R7=1ST 4 CHARACTERS OF 1ST LABEL TO BE WRITTEN
*,*      OUTPUT   ANS FILE HEADER LABELS WRITTEN TO TAPE
*,*      DESCRIPTION WRTANSLBL CALLS ANSLINIT AND WRTANSLBL1 TO PERFORM
*,*               THE FUNCTION.
*,*               WRTANSLBL1 INITIALIZES THE BUFFER TO BLANKS AND PUTS
*,*               THE LABEL IDENTIFIER FROM R7 INTO THE 1ST 4 POSITIONS
*,*               OF THE LABEL. THE INFORMATION FOR THE VARIOUS FIELDS
*,*               OF HDR1/EOF1/EOV1 ARE OBTAINED FROM THE DCB CONVERTED
*,*               TO PROPER FORMAT AND PLACED IN THE LABEL IMAGE.
*,*               THE LABEL IS THEN WRITTEN TO TAPE.  THE 4TH CHARACTER IS
*,*               THEN CHANGED TO '2' (HDR2/EOF2/EOV2) AND THE 2ND
*,*               LABEL IS BUILT IN THE SAME MANNER AS THE FIRST.
*,*               THE BUFFER IS RELEASED AND THE ROUTINE EXITS.
         PUSH     SR4               SAVE RETURN ADDRESS.
         BAL,SR4  GSBUF             GET FM BUFFER FOR LABEL.
         LI,R2    80                SIZE = 80 BYTES.
         BAL,SR4  PUTSZBF           PUT BUFFER INFO INTO DCB.
         B        WRTANSLBL1+1
*
WRTANSLBL1 EQU    %
         PUSH     SR4
         LI,R1    BUFF2**2
         OR,R1    Y50
         MBS,R0   BA(BLANK)
         STW,SR2  BUFF2             PUT LABEL TYPE
         LI,R3    BUFF2**2+4        SET MBS POINTER
         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
*E*      ERROR:   30 - 03  THE SPECIFIED ANS FILE NAME IS
*,*                        EITHER 0 OR >17 CHARACTERS IN LENGTH
         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    %
         LW,R2    VSETID,R6         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
*
*E*      ERROR:   30 - 04  NEVER SPECIFIED AS EXPIRATION DATE ON
*,*                        ANS TAPE 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
         LI,R1    X'80'
         CW,R1    ORG,R6
         BAZ      %+2               NOT ASCII, SO NOT STRICT ANS
         LI,R2    BA(BLANK)         STRICT ANS HAS BLANK IN 54
         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
*E*      ERROR:   30 - 05  SPECIFIED FORMAT CODE IS ILLEGAL
         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
         LW,D4    R1                SAVE FOR 'BLOCKED' TEST
         LW,D3    D4
         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    U**4
         BE       WRTANSLBL8        U FORMAT MUST BE LRECL=0 FOR IBM-OS
         CI,R2    F**4              FIXED
         BNE      WRTANSLBL6
WRTANSLBL7 EQU    %
         LW,R1    BLKSZ,R6          DEFAULT BLOCK SIZE
         SLS,R1   -17
WRTANSLBL6 EQU    %
         LW,D3    R1                SAVE FOR 'BLOCKED' TEST
WRTANSLBL8 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)
         BAL,9    TBFLG1%TO%CC      GET TBFLG1 INTO CONDITION CODES
         BCS,10   %+2               THEY'RE WORTH LOOKING AT
         B        ASSUME%800        NOT WORTH IT, ASSUME 800 BPI
         BCS,2    ASSUME%1600       POTTER FLAG, ASSUME 1600
         LI,1     BADSI
         LB,1     *6,1              DCT INDEX
         AI,1     -BATAPE           TO TAPE TABLE INDEX
         LC       AVRFLGS,1         PICK UP 1ST FOUR AVR FLAGS
         BCR,8    ASSUME%800        NOT ON, DD DRIVE IS 800
ASSUME%1600 RES   0
         LI,2     BA(1600BPI)
ASSUME%800 RES    0
         OR,R3    Y02               1 BYTE +1BYTE
         MBS,R2   0
         AI,R3    21                21 BLANKS   18-38
*                      CHECK FOR BLOCKED
         CW,D3    D4
         BGE      %+3
         LI,D3    'B'
         STB,D3   0,R3              REC<BLOCK--SO SET BLOCKED
         AI,R3    12                BLK/SPAN+11 BLANKS  39-50
         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
         BAL,SR4  RLSBF             GIVE BACK BUFFER.
         B        PULLEXIT
*
*
*E*      ERROR:   30-03             INVALID FILE NAME LENGTH
*,*      DESCRIPTION: LENGTH IS ZERO OR GREATER THAN 17 CHARS
*
ABN3003  EQU      %                 ANS COUNT = 0 | > 17 CHARACTERS
         BAL,SR3  ABNRLSBF
         DATA     X'30'+X'03'**25
*
*E*      ERROR:   30-04             CAN'T SPECIFY (EXPIRE,NEVER)
*,*      DESCRIPTION: USER SPECIFIED (EXPIRE,NEVER)
*
ABN3004  EQU      %                 ILLEGAL EXPIRATION
         BAL,SR3  ABNRLSBF
         DATA     X'30'+X'04'**25
*
*E*      ERROR:   30-05             ILLEGAL FORMAT CODE
*,*      DESCRIPTION: SPECIFIED FORMAT CODE IS UNKNOWN
*
ABN3005  EQU      %                 ILLEGAL TAPE FORMAT
*D*      NAME:    ABN3005
*,*      CALL     B ABN3005
*,*      INTERFACE: CALLS ABNRLSBF
*,*      DESCRIPTION: REPORTS ABN 30-05 AND TRANSFERS TO ABNRLSBF
*,*               TO RELEASE FM BUFFER.
         BAL,SR3  ABNRLSBF
         DATA     X'30'+X'05'**25
*
ABNRLSBF EQU      %
*D*      NAME:    ABNRLSBF
*,*      CALL:    BAL,SR3  ABNRLSBF
*,*               DATA  X'AA'+X'SS'**25
*,*               WHERE AA IS THE ABNORMAL CODE AND SS IS THE SUBCODE.
*,*      INTERFACE: EXITS TO OERX AFTER CALLING RLSBF
*,*      DESCRIPTION: RELEASES FM BUFFER (DESCRIBED BY DCB) AND
*,*               EXITS TO OERX WHICH EXITS THE OPEN OVERLAY.
*
         LW,SR3   *SR3              GET CODE AND SUBCODE IN SR3.
         LI,SR4   OERX              PASS ADDRESS OF RETURN
         B        RLSBF               AND RELEASE BUFFER.
*
TBFLG1%TO%CC RES  0
         LI,1     X'3F00'           TYPE MASK
         AND,1    DSI,6             TYPE TO 1
         SLS,1    -8                TO WORD
         LC       TB:FLGS1,1        PICK UP CCS
         B        *9                AND EXIT
         PAGE
JULIAN   EQU      %
*D*      NAME:    JULIAN
*,*      ENTRY    CNVJULIAN
*,*      REGISTERS R0-R2 VOLATILE
*,*      CALL     BAL,SR4 JULIAN
*,*               BAL,SR4 CNVJULIAN
*,*      INTERFACE CALLS CNVBIN, CNVDEC
*,*      INPUT    ENTRY AT CNVJULIAN, R5=WA(GREGORIAN DATE) 2 WORDS:
*,*                  MMDD HHYY
*,*      OUTPUT   SR1-SR2=JULIAN DATE, 2 WORDS:
*,*                  000Y YDDD
*,*      DESCRIPTION MONTH IS CONVERTED TO BINARY VALUE TO INDEX TABLE
*,*               OF DAYS. THIS VALUE IS ADDED TO DAY OF MONTH.
*,*               IF DAY IS AFTER DAY 60 AND YEAR IS LEAP YEAR, 1 IS
*,*               ADDED TO DAY FOR FEB 29. DAY IS THEN CONVERTED TO 3
*,*               CHARACTERS AND COMBINED WITH YEAR.
*,*               ENTRY AT JULIAN FORCES THE INPUT POINTER TO THE MONITOR
*,*               CELL CONTAINING THE CURRENT DATE.
         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
SIXBACK  EQU      %
*D*      NAME:    SIXBACK
*,*      REGISTERS R2      VOLATILE
*,*      CALL     BAL,SR4 SIXBACK
*,*      INPUT    SR1-SR2=EBCDIC SIX CHARACTER SN, LEFT JUSTIFIED
*,*      OUTPUT   R2=HASHED SN
*,*      DESCRIPTION THE LO ORDER 20 BITS ARE CONVERTED FROM BINARY TO
*,*               DECIMAL, EACH DIGIT FORMING THE LO ORDER DIGIT OF
*,*               SUCCESSIVE CHARACTERS. THE HI ORDER 12 BITS OF INPUT
*,*               ARE TAKEN 2 BITS AT A TIME AS BITS 2-3 OF EACH BYTE,
*,*               AND ONES ARE FORCED AS BITS 0-1 OF EACH OUTPUT
*,*               CHARACTER TO CREATE THE ORIGINAL SN.
         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
         PAGE
CNVBIN   EQU      %
*D*      NAME:    CNVBIN
*,*      REGISTERS NONE VOLATILE
*,*      CALL     BAL,SR4 CNVBIN
*,*      INPUT    R0-R1=EBCDIC FOR DECIMAL EQUIVALENT OF INPUT
*,*      OUTPUT   R1=BINARY NUMBER
*,*      DESCRIPTION CONVERTS 6 CHARACTER EBCDIC DECIMAL NUMBER TO BINARY.
         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
         PAGE
CNVDEC   EQU      %
*D*      NAME:    CNVDEC
*,*      REGISTERS R0-R2 VOLATILE
*,*      CALL     BAL,SR4 CNVDEC
*,*      INPUT    R1=BINARY NUMBER
*,*               R2=NUMBER OF CHARACTERS TO CONVERT
*,*      OUTPUT   SR1-SR2=EBCDIC DECIMAL NUMBER, LEFT JUSTIFIED.
*,*      DESCRIPTION FOR THE NUMBER OF ITERATIONS IN R2, THE INPUT IS
*,*               DIVIDED BY 10 AND THE REMAINDER CONVERTED TO AN EBCDIC
*,*               CHARACTER AND ACCUMULATED IN THE LEFT END OF THE SR1-SR2
*,*               DOUBLE REGISTER.
         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

