*
*T*      COPYRIGHT, (C) HONEYWELL INFORMATION SYSTEMS INC., 1979.
*
* MODULE NAME: DECOMP
* PURPOSE:  DE-COMPRESS TEXT
*
*   Copyright text
*
COPYRITE DSECT   0
         TEXT 'COPYRIGHT, (C) HONEYWELL INFORMATION SYSTEMS INC., 1979.'
         CSECT
*
*        ENTRY POINTS:
*
         DEF      DECOMP          DECOMPRESS TEXT
         DEF      PACK              PACK TEXT
         DEF      UNPACK            UNPACK TEXT
         DEF      TOP1,TOP2
*
*
         DEF      BUFFER
BUFFER   RES      60
*
28P      EQU      %
         DATA     X'28'             MODULE NUMBER
         DATA     X'020476'         DATE
         DATA     X'0700'
*
*
         TITLE    '** DECOMPRESSION **'
SAVRTN1  RES      1
SAVRTN2  RES      1
SAVRTN3  RES      1
*
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
*
*
*        TABLE TO TRANSLATE FROM EBCDIC TO COMPRESSED
*
         PAGE
*
*        TABLE OF TABLE ADDRESSES
*
S28DTABA EQU      %
         DATA     S28DTAB1          TABLE 1 FOR CODE 10
         DATA     S28DTAB2          TABLE 2 FOR CODE 11
         DATA     S28DTAB3          TABLE 3 FOR CODE 12
         DATA     S28DTAB4          TABLE 4 FOR CODE 13
         DATA     S28DTAB5          TABLE 5 FOR CODE 14
         DATA     S28DTAB6          TABLE 6 FOR CODE 15
*
*        TABLES TO TRANSLATE COMPRESSED TO EBCDIC
*
S28DTAB0 EQU      %                 TABLE 0 VALUES (LC = LOWER CASE)
         DATA,1   X'40'             0 - BLANK
         DATA,1   X'85'             1 - LC E
         DATA,1   X'A3'             2 - LC T
         DATA,1   X'81'             3 - LC A
         DATA,1   X'96'             4 - LC O
         DATA,1   X'95'             5 - LC N
         DATA,1   X'89'             6 - LC I
         DATA,1   X'A2'             7 - LC S
         DATA,1   X'99'             8 - LC R
         DATA,1   X'88'             9 - LC H
*
         BOUND    4
S28DTAB1 EQU      %                 TABLE 1 VALUES
         DATA,2   X'8283'           0 - LC B    1 - LC C
         DATA,2   X'8486'           2 - LC D    3 - LC F
         DATA,2   X'8791'           4 - LC G    5 - LC J
         DATA,2   X'9293'           6 - LC K    7 - LC L
         DATA,2   X'9497'           8 - LC M    9 - LC P
         DATA,2   X'98A4'           A - LC Q    B - LC U
         DATA,2   X'A5A6'           C - LC V    D - LC W
         DATA,2   X'A7A8'           E - LC X    F - LC Y
         PAGE
*
         BOUND    4
S28DTAB2 EQU      %                 TABLE 2 VALUES
         DATA,1   X'A9'             0 - LC Z
         DATA     'ABCD'            1 - A    2 - B    3 - C    4 - D
         DATA     'EFGH'            5 - E    6 - F    7 - G    8 - H
         DATA     'IJKL'            9 - I    A - J    B - K    C - L
         DATA,3   'MNO'             D - M    E - N    F - O
*
         BOUND    4
S28DTAB3 EQU      %                 TABLE 3 VALUES
         DATA     'PQRS'            0 - P    1 - Q    2 - R    3 - S
         DATA     'TUVW'            4 - T    5 - U    6 - V    7 - W
         DATA     'XYZ0'            8 - X    9 - Y    A - Z    B - 0
         DATA     '1234'            C - 1    D - 2    E - 3    F - 4
*
         BOUND    4
S28DTAB4 EQU      %                 TABLE 4 VALUES
         DATA     '5678'            0 - 5    1 - 6    2 - 7    3 - 8
         DATA     '9&-/'            4 - 9    5 - &    6 - -    7 - /
         DATA     '`.<('            8 - CENT 9 - .    A - <    B - (
         DATA     '+|!%'            C - +    D - VERT E -EX PT F - %
         PAGE
*
         BOUND    4
S28DTAB5 EQU      %                 TABLE 5 VALUES
         DATA     '*);~'            0 - *    1 - )    2 - ;    3 - NOT
         DATA     ',%>'            4 - ,    5 - %    6 - UNDL 7 - >
         DATA     '?:#@'            8 - QEST 9 - :    A - #    B - @
         DATA,3   '''="'            C - '    D - =    E - DBL QT
         DATA,1   X'B1'             F - BACKSLASH
*
         BOUND    4
S28DTAB6 EQU      %                 TABLE 6 VALUES
         DATA,2   X'B2B3'           0 - L BRACE   1 - R BRACE
         DATA,2   X'B4B5'           2 - L BRKT    3 - R BRKT
         DATA,2   X'0405'           4 - ATTN      5 - HT
         DATA,2   X'080D'           6 - BS        7 - CR
         DATA,2   X'151E'           8 - NL        9 - RS
         DATA,2   X'4040'           A - SPARE     B - SPARE
         DATA,2   X'6A2D'           C - X'6A'(^)  D - X'2D'(STOP)
         DATA,2   X'FEFF'           E - LITERAL CHAR   F - REPEAT
         PAGE
*        TEXT DECOMPRESSION SUBROUTINE
*        ENTRY:   R2   - BYTE ADDRESS OF COMPRESSED TEXT
*                 R12 - NO. OF BYTES IN COMPRESSED TEXT
*        BAL,R15  DECOMP
*        RETURN:  R2   - BYTE ADDRESS OF TEXT LINE
*                 R12 - NO. OF BYTES IN TEXT LINE
*
*        REGISTERS  R4, R6, R7, AND R13 ARE CHANGED
*
*        ENTRY POINT FOR DECOMPRESSION
*
*
         PAGE
         BOUND    4
         REF      SCNDAT
IOBUF    EQU      SCNDAT
         REF      RECLEN
DECOMP   EQU      %
         STW,15   SAVRTN3           SAVE RETURN ADDRESS
*
*
         LW,R12   RECLEN
         LI,R2    IOBUF
         SLS,R2   2
         AI,R2    1
         LI,R7    0                 OUTPUT INDEX
         STW,R7   REPEAT            SET REPEAT COUNT TO ZERO
         LW,R6    R2                SETUP INPUT INDEX (NIBBLE RES)
         SLS,R6   1
         AW,R12   R2                CALCULATE ADDRESS        OF LAST+1
         STW,R12  LASTB
*
S28DA    EQU      %
         BAL,R15  LDNIBBLE          LOAD NIBBLE
         AI,R13   0                 SET RETURN CODE
         BNEZ     S28DX             NO MORE NIBBLES, PREPARE TO EXIT
*
         CI,R4    10                FIND PROPER TABLE
         BGE      S28DF             NOT TABLE 0
         LB,R12   S28DTAB0,R4       GET EBCDIC BYTE
         B        S28DM             GO STORE IT
*
         PAGE
*
S28DF    EQU      %
         AI,R4    -10               GET TABLE ADDRESS
         LW,R14   S28DTABA,R4
         BAL,R15  LDNIBBLE          GET NEXT NIBBLE
         AI,R13   0                 SET RETURN CODE
         BNEZ     S28DX             NO MORE, EXIT
         LB,R12   *R14,R4           GET EBCDIC BYTE
*
         CI,R12   X'FF'             IS IT A REPEAT
         BE       S28DR             PROCESS REPEAT
         CI,R12   X'FE'             IS THIS LITERAL (UNCOMPRESSED) CHAR?
         BNE      S28DM             BRANCH IF NOT
         BAL,R15  LDNIBBLE          YES.  GET 1ST 4 BITS OF CHARACTER.
         AI,R13   0                 END OF INPUT HIT?
         BNEZ     S28DX             BRANCH IF YES.
         LW,R12   R4                POSITION 1ST 4 BITS.
         SLS,R12  4
         BAL,R15  LDNIBBLE          GET 2ND 4 BITS
         AI,R13   0                 END OF INPUT HIT?
         BNEZ     S28DX             BRANCH IF YES.
         OR,R12   R4                FORM COMPLETE CHARACTER.
*
S28DM    EQU      %
         STB,R12  BUFFER,R7         STORE BYTE
         AI,R7    1                 INCREMENT COUNT
         CI,R12   X'0D'
         BE       S28DX
         LW,R10   REPEAT
         AI,R10   -1
         STW,R10  REPEAT
         BGZ      S28DM             STORE THE BYTE AGAIN
         B        S28DA             GO GET NEXT NIBBLE
         PAGE
S28DR    EQU      %
         BAL,R15  LDNIBBLE          GET COUNT OF REPEAT
         AI,R13   0                 TEST FOR END OF BUFFER
         BNEZ     S28DX             END, EXIT
         AI,R4    1                 INCREMENT COUNT
         STW,R4   REPEAT            SAVE COUNT
         B        S28DA             GO GET CHARACTER TO REPEAT
*
S28DX    EQU      %
         LW,R12   R7                SETUP COUNT
         STW,R12  RECLEN
         SLS,R12  -2
         STW,R12  R3
         LW,R4    BUFFER
         STW,R4   IOBUF
S3DDX    EQU      %
         LW,R4    BUFFER,R3
         STW,R4   IOBUF,R3
         BDR,R3   S3DDX
         B        *SAVRTN3
         PAGE
*        SUBROUTINE TO LOAD A NIBBLE (HALF-BYTE)
*
*        ENTRY:   R6 INPUT INDEX - NIBBLE-ADDRESS OF NEXT NIBBLE
*        BAL,R15  LDNIBBLE
*        RETURN:  R4  - NIBBLE
*                 R13 - 0 FOR NORMAL LOAD; 1 FOR NO MORE TO LOAD
*        REGISTER R6 IS INCREMENTED
*
LDNIBBLE EQU      %
         LW,R4    R6                COPY NIBBLE INDEX
         SLS,R4   -1                CONVERT TO BYTE INDEX
         CW,R4    LASTB             HAVE WE LOADED ALL NIBBLES
         BGE      LDNIBE            YES, EXIT
         LB,R4    0,R4              GET BYTE CONTAINING THE NIBBLE
*
         CI,R6    1
         BAZ      LDNIBA
         AND,R4   =X'F'             YES, USE LO 4 BITS
         B        LDNIBB
*
LDNIBA   EQU      %
         SLS,R4   -4                USE HO 4 BITS
*
LDNIBB   EQU      %
         AI,R6    1                 INCREMENT
         LI,R13   0                 LOAD NORMAL CODE
LDNIBX   EQU      %
         B        *R15              RETURN
*
LDNIBE   EQU      %
         LI,R13   1                 LOAD ERROR CODE
         B        LDNIBX            EXIT
*
         PAGE
*                 SUBROUTINE FOR PACKING TEXT INTO
*        THE FORM THAT IS EXPECTED BY THE DECOMPRESSION ROUTINE.
*
*
PACK     EQU      %
         LW,R9    RECLEN
         LI,R7    0
TOP1     EQU      %
         LW,R8    IOBUF,R7
         STB,R8   IOBUF,R7
         AI,R7    1
         BDR,R9   TOP1
         B        *R15
UNPACK   EQU      %
         LW,R7    RECLEN
         AI,R7    -1
         LI,R3    0
         LB,R4    IOBUF,R3
TOP2     EQU      %
         LB,R9    IOBUF,R7
         STW,R9   IOBUF,R7
         BDR,R7   TOP2
         STW,R4   IOBUF,R3
         B        *R15
         PAGE
* USE STDX1BUF FOR COMPRESS/DECOMPRESS BUFFER
*
*
* LOCALS FOR COMPRESS/DECOMPRESS
*
28D      CSECT    0                 START OF LOCALS
*
LASTB    RES      1                 ADDR OF LAST+1 BYTE
REPEAT   RES      1                 NUMBER OF REPEAT CHARS
LASTCH   RES      1                 LAST CHAR ENCOUNTERED
*
*
         END
