*
***************************************************************
* HONEYWELL  CORRECT TAPE CONTROLLER CONVERSION PROGRAM
***************************************************************
*
* GUNTER T. ULSCHMID, LADC 781026
*
         SYSTEM   SIG7
         REF      M:SI,M:LL,M:LO
         REF      M:EI,M:EO
         DEF      BEGIN,PATCH
*
R0       EQU      0
R1       EQU      1
R2       EQU      2
R3       EQU      3
R4       EQU      4
R5       EQU      5
R6       EQU      6
R7       EQU      7
R8       EQU      8
R9       EQU      9
R10      EQU      10
R11      EQU      11
R12      EQU      12
R13      EQU      13
R14      EQU      14
R15      EQU      15
*
:        CNAME
         PROC
LF       EQU      %
         DISP     LF
         PEND
*
*
***************************************************************
*        INITIALIZE PROGRAM
***************************************************************
*
         CSECT    1
BEGIN    :
         CAL1,1   CMP:HERE          PRINT HERE MESSAGE
         LI,R0    0
         STW,0    R:COUNT
*
***************************************************************
*        READ RECORD AND ANALYZE
***************************************************************
RDREC    :                          READ RECORD
         LI,R0    0
         LI,R1    1
         LI,R2    2
         LI,R3    3
         LI,R4    0
         LI,R5    0
         MTW,1    R:COUNT
         CAL1,1   RD:EI
         LW,R7    M:EI+4            GET OBSERVED BYTE COUNT
         SLS,R7   -17                 AND SHIFT IN POSITION
         STW,R7   BLB                   THEN SAVE IT
*
CODE     :
         LB,R7    IBUF,R4           GET CHARACTER FROM INPUT BUFFER
         LB,R7    EBCDIC,R7         CONVERT IN UPPER CASE
         STB,R7   OBUF,R4           STORE IN OUTPUT BUFFER
         AI,R4    1
         CW,R4    BLB               CHECK FOR END OF RECORD
         BL       CODE
*
WRITE    :
         CAL1,1   WR:EO
         B        RDREC
*
*
*
***************************************************************
*        SUBROUTINES
***************************************************************
*
*
************************************************************
*        *** CONVERSION TO EBCDIC DECIMAL ***
************************************************************
*
*        REGISTER INPUT:
*
*        R5 = BINARY NUMBER
*
*        REGISTERS USAGE:
*
*        R5 = INDEX REG.
*        R6 = POINTER TO RESULT BUFFER
*        R7 = RETURN ADDRESS
*        R12,R13 = RESULT BUFFER
*        R14,R15 = CALCULATION BUFFER
*
*        REGISTER OUTPUT:
*
*        R12,R13 = EBCDIC NUMBER LEFT ALIGNED
*
*
DEC      EQU      %
         LW,R13   4BLANK            CLEAR REG. D2
         LI,R6    54
         LW,R15   R5                GET BINARY NUMBER
         LI,R5    7                 SET INDEX FOR LOOPING
DEC2     LI,R14   0                 CLEAR D3
         DW,R14   K10               DIVIDE NUMBER BY 10
         AI,R14   '0'               FORM EBCDIC NUMBER FROM REMAINDER
         STB,R14  0,R6                AND SAVE IN RESULT BUFFER
         AI,R6    -1                DECREMENT POINTER
         BDR,R5   DEC2              LOOP
         B        *R7
*
*
*
*
***************************************************************
*        CONVERTION TABLE
***************************************************************
*
EBCDIC   :
         DATA,8   X'00010203040506FF'
         DATA,8   X'08090A0B0C0D0E0F'
         DATA,8   X'1011121314150817'
         DATA,8   X'18191A1B1C1D1E1F'
         DATA,8   X'202122232415171B'
         DATA,8   X'28292A2B2C090607'
         DATA,8   X'3031163334353604'
         DATA,8   X'38393A3B140A3E1A'
         DATA,8   X'4041424344454647'
         DATA,8   X'4849B44B4C4D4E5A'
         DATA,8   X'5051525354555657'
         DATA,8   X'5859B55B5C5D5E6A'
         DATA,8   X'6061626364656667'
         DATA,8   X'68694F6B6C6D6E6F'
         DATA,8   X'7071727374757677'
         DATA,8   X'784A7A7B7C7D7E7F'
         DATA,8   X'8081828384858687'
         DATA,8   X'88898A8B8C8D8E8F'
         DATA,8   X'9091929394959697'
         DATA,8   X'98999A9B9C9D9E9F'
         DATA,8   X'A05FA2A3A4A5A6A7'
         DATA,8   X'A8A9AAABACADAEAF'
         DATA,8   X'B0B1B2B3B4B5B6B7'
         DATA,8   X'B8B9BABBBCBDBEBF'
         DATA,8   X'B2C1C2C3C4C5C6C7'
         DATA,8   X'C8C9CACBCCCDCECF'
         DATA,8   X'B3D1D2D3D4D5D6D7'
         DATA,8   X'D8D9DADBDCDDDEDF'
         DATA,8   X'B1E1E2E3E4E5E6E7'
         DATA,8   X'E8E9EAEBECEDEEEF'
         DATA,8   X'F0F1F2F3F4F5F6F7'
         DATA,8   X'F8F9FAFBFCFDFEFF'
*
*
***************************************************************
*        PRINT ERROR MESSAGES
***************************************************************
*
ERR      :
         LW,R5    R:COUNT           GET RECORD COUNT
         BAL,R7   DEC
         STW,R12  EMSG2+1
         STW,R13  EMSG2+2           STORE EBCDIC VALUES
         LI,R10   EMSG2
         CAL1,2   PRINT
         B        WRITE
*
*
*
*
***************************************************************
*        ABNORMAL READ ROUTINE
***************************************************************
*
*
ABNRD    LB,R10   R10
         CI,R10   6
         BE       ABNRD1
         CI,R10   5
         BE       ABNRD1
         CAL1,2   MERC
         B        TERM
ABNRD1   :
         LW,R15   M:EI              CHECK FOR TYPE OF FILE
         AND,R15  =X'F'
         CI,R15   1                 IF DC FILE, THEN
         BNE      RDREC                CLOSE M:EO, ELSE GO ON
TERM     :
         CAL1,1   CLOSE:EO
         CAL1,9   1
*
*
*
***************************************************************
*        MESSAGES
***************************************************************
*
         CSECT    0
EMSG2    TEXTC    '#            RECORD LENGTH > 123'
*
*
*
***************************************************************
*        FUNCTION PARAMETER TABLES
***************************************************************
*
CLO:EO:R GEN,8,24 X'15',M:EO
         PZE      *0
         DATA     1
*
CLOSE:EO GEN,8,24 X'15',M:EO
         PZE      *0
         DATA     2
*
WR:EO  GEN,8,24 17,M:EO
         GEN,4,28 3,0
         DATA     OBUF
         PZE      *R4
*
WR:EO2 GEN,8,24 17,M:EO
         GEN,4,28 3,0
         DATA     CBUF
         PZE      *R5
*
WR:EO3 GEN,8,24 17,M:EO
         GEN,4,28 3,0
         DATA     OBUF2
         PZE      *R5
*
WR:LL  GEN,8,24 17,M:LL
         GEN,4,28 3,0
         DATA     OBUF
         PZE      *R4
*
PRINT    GEN,8,24 1,0
         PZE      *0
         PZE      *R10
RD:EI    GEN,8,24 16,M:EI
         GEN,4,28 7,0
         DATA     ABNRD,IBUF,1600
*
PFIL:EI  GEN,8,24 X'1C',M:EI
         DATA     0
*
REW:EI   GEN,8,24 X'01',M:EI
REW:EO   GEN,8,24 X'01',M:EO
*
CVOL:EI  GEN,8,24 X'03',M:EI
*
MERC     GEN,8,24 X'10',0
*
OPN:EO   GEN,8,24 X'14',M:EO
         DATA     X'01000008'
         DATA     X'2'
         DATA     X'01010303'
OPN:EON  DATA     0,0,0
*
*
SETVFC   GEN,8,24 5,M:EO
         DATA     X'10'
*
*
CMP:HERE  GEN,8,7,17 X'11',0,M:LL
         DATA     X'34000000'
         DATA     %+3
         DATA     14
         DATA     0
         TEXT     'CTCC A00 HERE   '
*
*
***************************************************************
*        VARIABLE DATA AND BUFFERS
***************************************************************
         BOUND    8
*
BLB      RES      1                 BLOCK LENGTH IN BYTES
BCNT     RES      1                 LEADING BYTE COUNT
R:COUNT  RES      1                 RECORD COUNT
4BLANK     DATA '    '
K10        DATA 10
*
PATCH    RES      20
*
*
         BOUND    8
IBUF     RES      400
CBUF     RES      100
OBUF     RES      100
OBUF2    RES      100               OUTPUT BUFFER 2
*
         CSECT    1
         END      BEGIN
