* 02/04/76 -- 13:00
* MODULE NAME: CMPRSS
* NUMBER: 28
* PURPOSE: COMPRESS AND DE-COMPRESS TEXT
*
*        ENTRY POINTS:
*
         DEF      S28CMPR           COMPRESS TEXT
         DEF      S28DCMPR          DECOMPRESS TEXT
*
         SYSTEM   TEXTDEF
         SYSTEM   ITEMDEF
*
         DEF      28P,28D
*
28P      EQU      %
         DATA     X'28'             MODULE NUMBER
         DATA     X'020476'         DATE
         DATA     X'0700'
*
*
         TITLE    '** CMPRSS(28) **'
*
*        TABLE TO TRANSLATE FROM EBCDIC TO COMPRESSED
*
S28CTAB  EQU      %
*        CODES 0 - F
         DATA,8   X'FFFFFFFFF4F5FFFF',X'F6FFFFFFFFF7FFFF'
*        CODES 10 - 1F
         DATA,8   X'FFFFFFFFFFF8FFFF',X'FFFFFFFFFFFFF9FF'
*        CODES 20 - 2F
         DATA,8   X'FFFFFFFFFFFFFFFF',X'FFFFFFFFFFFDFFFF'
*        CODES 30 - 3F
         DATA,8   X'FFFFFFFFFFFFFFFF',X'FFFFFFFFFFFFFFFF'
*        CODES 40 - 4F
         DATA,8   X'00FFFFFCFFFFFFFF',X'FFFFD8D9DADBDCDD'
*        CODES 50 - 5F
         DATA,8   X'D5FFFFFFFFFFFFFF',X'FFFFDEDFE0E1E2E3'
         PAGE
*        CODES 60 - 6F
         DATA,8   X'D6D7FFFFFFFFFFFF',X'FFFFFCE4E5E6E7E8'
*        CODES 70 - 7F
         DATA,8   X'FFFFFFFFFFFFFFFF',X'FFFFE9EAEBECEDEE'
*        CODES 80 - 8F
         DATA,8   X'FF03A0A1A201A3A4',X'0906FFFFFFFFFFFF'
*        CODES 90 - 9F
         DATA,8   X'FFA5A6A7A80504A9',X'AA08FFFFFFFFFFFF'
*        CODES A0 - AF
         DATA,8   X'FFFF0702ABACADAE',X'AFB0FFFFFFFFFFFF'
*        CODES B0 - BF
         DATA,8   X'FFEFF0F1F2F3FFFF',X'FFFFFFFFFFFFFFFF'
         PAGE
*        CODES C0 - CF
         DATA,8   X'FFB1B2B3B4B5B6B7',X'B8B9FFFFFFFFFFFF'
*        CODES D0 - DF
         DATA,8   X'FFBABBBCBDBEBFC0',X'C1C2FFFFFFFFFFFF'
*        CODES E0 - EF
         DATA,8   X'FFFFC3C4C5C6C7C8',X'C9CAFFFFFFFFFFFF'
*        CODES F0 - FF
         DATA,8   X'CBCCCDCECFD0D1D2',X'D3D4FFFFFFFFFFFF'
         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 COMPRESSION SUBROUTINE
*        ENTRY:   BUF2 - BYTE ADDRESS OF TEXT LINE
*                 AC1 - NO. OF CHARACTERS IN LINE
*        BAL,SRTN S28CMPR
*        RETURN:  BUF3 - BYTE ADDRESS OF COMPRESSED TEXT
*                 AC1 - NO. OF BYTES IN COMPRESSED TEXT
*
*
*        REGISTERS  X1, X2, AC1, AC2 AND AC3 ARE CHANGED
*
*
*        ENTRY POINT FOR COMPRESSION
*
S28CMPR  EQU      %
         SAVRTN                     SAVE RETURN ADDRESS
         LW,X3    BUF2              ADDRESS OF NEXT BYTE
         LI,X4    0                 OUTPUT INDEX (NIBBLE)
         AW,AC1   BUF2              ADDRESS OF LAST+1 BYTE
         STW,AC1  LASTB
         STW,X4   REPEAT            INITIALIZE REPEAT COUNT
         STW,X4   LASTCH              AND LAST CHARACTER
*
S28CA    EQU      %
         CW,X3    LASTB             ARE THERE MORE BYTES TO COMPRESS
         BGE      S28CX             NO, TERMINATE
*
         LB,X1    0,X3              GET NEXT BYTE
*
*        TEST FOR REPEATED CHARACTERS
*
         CB,X1    LASTCH            IS IT THE SAME AS THE LAST CHAR
         BNE      S28CAA            NOT SAME, CHECK FOR REPEAT
         MTW,1    REPEAT            SAME, COUNT AND CONTINUE
         B        S28CAX
*
         PAGE
*
S28CAA   EQU      %
         LW,AC1   REPEAT            GET REPEAT COUNT
         CI,AC1   3                 IS IT WORTH COMPRESSING
         BL       S28CAQ            NO, EXIT
         LB,X2    LASTCH            MAYBE, TEST FOR LENGTH OF CHAR
         LB,X2    S28CTAB,X2
         CI,X2    X'FF'             CAN CHAR BE COMPRESSED?
         BE       S28CAQ            IF NOT THEN DON'T USE REPEAT
         CI,X2    X'F0'             IS IT A 4 OR 8 BIT CODE
         BANZ     S28CAC            8 BIT, COMPRESS IT
         CI,AC1   5                 4 BIT, IS IT WORTH COMPRESSING
         BL       S28CAQ            NO, EXIT
*                                   YES, COMPRESS 4 BIT CODE
         SW,X4    REPEAT            SET OUT, PTR. TO BEGINNING OF STRING
S28CAB   EQU      %
         BAL,SRTN SETREP            SETUP ENTRY
         LW,AC1   X2                STORE THE CHARACTER
         BAL,SRTN STNIBBLE
         LW,AC1   REPEAT            IS COUNT EXHAUSTED
         BNEZ     S28CAB            NO, STORE NEXT
         B        S28CAQ            FINISHED WITH 4 BIT CODE
*
S28CAC   EQU      %                 COMPRESS 8 BIT CODE
         SLS,AC1  1                 MULTIPLY COUNT BY 2 FOR NIB CT
         SW,X4    AC1               RESET OUT. PTR TO START OF STRING
S28CAD   EQU      %
         BAL,SRTN SETREP            SETUP ENTRY
         LW,AC1   X2                STORE THE CHARACTER
         SLS,AC1  -4
         BAL,SRTN STNIBBLE
         LW,AC1   X2
         AND,AC1  =X'F'
         BAL,SRTN STNIBBLE
         LW,AC1   REPEAT            IS COUNT EXHAUSTED
         BNEZ     S28CAD            NO, STORE NEXT
*
         PAGE
*
S28CAQ   EQU      %                 PREPARE TO EXIT
         LB,X1    0,X3              GET NEXT BYTE AGAIN
         STB,X1   LASTCH            SAVE IT
         LI,AC1   1                 SET COUNT TO 1
         STW,AC1  REPEAT
*                                   EXIT
S28CAX   EQU      %
         AI,X3    1                 INCREMENT POINTER
         LB,AC1   S28CTAB,X1        CONVERT TO COMPRESSED CODE
         CI,AC1   X'FF'             CHECK FOR NON-CONVERTABLE
         BNE      S28CB             OK, SKIP ERROR PRINT
         LW,AC3   X1                SAVE ORIGINAL CHARACTER
         LI,AC1   X'F'              STORE X'FE' AS CODE TO MEAN NEXT 2
         BAL,SRTN STNIBBLE          NIBBLES ARE A LITERAL (UNCOMPRESSED)
         LI,AC1   X'E'              CHARACTER
         BAL,SRTN STNIBBLE
         LW,AC1   AC3               GET UNCOMPRESSED CHARACTER
         B        S28CSL            NOW GO STORE IT
*
S28CB    EQU      %
         CI,AC1   X'F0'             ARE HIGH ORDER BITS = 0
         BAZ      S28CD             YES, STORE NIBBLE (4 BIT FORMAT)
*
         LW,AC3   AC1               NO, STORE BYTE
S28CSL   EQU      %
         SLS,AC1  -4                SHIFT H.O. BITS TO NIBBLE POSITION
         BAL,SRTN STNIBBLE          STORE THE NIBBLE
         LW,AC1   AC3
         AND,AC1  =X'F'             ISOLATE L.O. NIBBLE
*
         PAGE
*
S28CD    EQU      %
         BAL,SRTN STNIBBLE          STORE THE NIBBLE
         B        S28CA             GO BACK FOR MORE CHARACTERS
*
*        COMPRESSION IS FINISHED, CLEANUP AND EXIT
*
S28CX    EQU      %
         CI,X4    1                 IS NIBBLE INDEX ODD
         BAZ      S28CY             NO
         LI,AC1   X'F'              YES, STORE DUMMY TO FILL BYTE
         BAL,SRTN STNIBBLE
S28CY    EQU      %
         SLS,X4   -1                CONVERT TO BYTE COUNT
         LW,AC1   X4                PUT COUNT IN RETURN REGISTER
         LI,BUF3  BA(BUFFER)        GET ADDRESS OF BUFFER
         RETURN                     EXIT
*
         PAGE
*
*        SUBROUTINE TO STORE REPEAT CODE AND COUNT IN BUFFER
*        ENTRY:
*        BAL,SRTN SETREP
*
SETREP   EQU      %
         SAVRTN
         LI,AC1   X'F'              STORE REPEAT CODE
         BAL,SRTN STNIBBLE
         LI,AC1   X'F'
         BAL,SRTN STNIBBLE
*
         LW,AC1   REPEAT            SETUP COUNT
         CI,AC1   16                IS IT .GT. 16
         BG       SETREPB           YES
         LI,X1    0                 NO, NORMAL
         STW,X1   REPEAT
         AI,AC1   -1                DECREMENT COUNT FOR EFFICIENCY
SETREPA  EQU      %
         BAL,SRTN STNIBBLE
         RETURN                     EXIT
*
SETREPB  EQU      %
         AI,AC1   -16               DECREMENT COUNT BY 16
         STW,AC1  REPEAT
         LI,AC1   15                COUNT - 1
         B        SETREPA
         PAGE
*        INTERNAL SUBROUTINE TO STORE A NIBBLE (HALF BYTE)
*
*        ENTRY:   X4 - OUTPUT INDEX (NO OF NIBBLES IN BUFFER)
*                 AC1 - THE NIBBLE TO BE STORED
*                 NIBBLE IS ALWAYS STORED IN 'BUFFER' (280 BYTES MAX)
*        BAL,SRTN STNIBBLE
*        REGISTERS X1, AC1 AND AC2 ARE CHANGED
*        REGISTER  X4 IS INCREMENTED
*
STNIBBLE EQU      %
         LW,X1    X4                COPY NIBBLE INDEX
         SLS,X1   -1                CONVERT TO BYTE INDEX
*
         CI,X4    1                 IS NIB. INDEX ODD
         BAZ      STNIBC            NO
*
         LB,AC2   BUFFER,X1         YES, MERGE NIB WITH ITS BYTE MATE
         OR,AC1   AC2               MERGE
STNIBA   EQU      %
         STB,AC1  BUFFER,X1         AND STORE
*
         AI,X4    1                 INCREMENT NIBBLE INDEX
         B        *SRTN             RETURN
*
STNIBC   EQU      %                 STORE THE EVEN NIBBLE (HAS NO MATE)
         SLS,AC1  4
         B        STNIBA            GO STORE IT
         PAGE
*        TEXT DECOMPRESSION SUBROUTINE
*        ENTRY:   BUF2 - BYTE ADDRESS OF COMPRESSED TEXT
*                 AC1 - NO. OF BYTES IN COMPRESSED TEXT
*        BAL,SRTN S28DCMPR
*        RETURN:  BUF2 - BYTE ADDRESS OF TEXT LINE
*                 AC1 - NO. OF BYTES IN TEXT LINE
*
*        REGISTERS  X1, X3, X4, AND AC2 ARE CHANGED
*
*        ENTRY POINT FOR DECOMPRESSION
*
S28DCMPR EQU      %
         SAVRTN                     SAVE RETURN ADDRESS
         LI,X4    0                 OUTPUT INDEX
         STW,X4   REPEAT            SET REPEAT COUNT TO ZERO
         LW,X3    BUF2              SETUP INPUT INDEX (NIBBLE RES)
         SLS,X3   1
         AW,AC1   BUF2              CALCULATE ADDRESS        OF LAST+1
         STW,AC1  LASTB
*
S28DA    EQU      %
         BAL,SRTN LDNIBBLE          LOAD NIBBLE
         AI,AC2   0                 SET RETURN CODE
         BNEZ     S28DX             NO MORE NIBBLES, PREPARE TO EXIT
*
         CI,X1    10                FIND PROPER TABLE
         BGE      S28DF             NOT TABLE 0
         LB,AC1   S28DTAB0,X1       GET EBCDIC BYTE
         B        S28DM             GO STORE IT
*
         PAGE
*
S28DF    EQU      %
         AI,X1    -10               GET TABLE ADDRESS
         LW,AC3   S28DTABA,X1
         BAL,SRTN LDNIBBLE          GET NEXT NIBBLE
         AI,AC2   0                 SET RETURN CODE
         BNEZ     S28DX             NO MORE, EXIT
         LB,AC1   *AC3,X1           GET EBCDIC BYTE
*
         CI,AC1   X'FF'             IS IT A REPEAT
         BE       S28DR             PROCESS REPEAT
         CI,AC1   X'FE'             IS THIS LITERAL (UNCOMPRESSED) CHAR?
         BNE      S28DM             BRANCH IF NOT
         BAL,SRTN LDNIBBLE          YES.  GET 1ST 4 BITS OF CHARACTER.
         AI,AC2   0                 END OF INPUT HIT?
         BNEZ     S28DX             BRANCH IF YES.
         LW,AC1   X1                POSITION 1ST 4 BITS.
         SLS,AC1  4
         BAL,SRTN LDNIBBLE          GET 2ND 4 BITS
         AI,AC2   0                 END OF INPUT HIT?
         BNEZ     S28DX             BRANCH IF YES.
         OR,AC1   X1                FORM COMPLETE CHARACTER.
*
S28DM    EQU      %
         STB,AC1  BUFFER,X4         STORE BYTE
         AI,X4    1                 INCREMENT COUNT
         MTW,-1   REPEAT            TEST REPEAT COUNT
         BGZ      S28DM             STORE THE BYTE AGAIN
         B        S28DA             GO GET NEXT NIBBLE
*
S28DR    EQU      %
         BAL,SRTN LDNIBBLE          GET COUNT OF REPEAT
         AI,AC2   0                 TEST FOR END OF BUFFER
         BNEZ     S28DX             END, EXIT
         AI,X1    1                 INCREMENT COUNT
         STW,X1   REPEAT            SAVE COUNT
         B        S28DA             GO GET CHARACTER TO REPEAT
*
S28DX    EQU      %
         LI,BUF2  BA(BUFFER)        SETUP BUFFER ADDRESS
         LW,AC1   X4                SETUP COUNT
         RETURN
         PAGE
*        SUBROUTINE TO LOAD A NIBBLE (HALF-BYTE)
*
*        ENTRY:   X3 INPUT INDEX - NIBBLE-ADDRESS OF NEXT NIBBLE
*        BAL,SRTN LDNIBBLE
*        RETURN:  X1  - NIBBLE
*                 AC2 - 0 FOR NORMAL LOAD; 1 FOR NO MORE TO LOAD
*        REGISTER X3 IS INCREMENTED
*
LDNIBBLE EQU      %
         LW,X1    X3                COPY NIBBLE INDEX
         SLS,X1   -1                CONVERT TO BYTE INDEX
         CW,X1    LASTB             HAVE WE LOADED ALL NIBBLES
         BGE      LDNIBE            YES, EXIT
         LB,X1    0,X1              GET BYTE CONTAINING THE NIBBLE
*
         CI,X3    1                 IS NIB INDEX ODD
         BAZ      LDNIBA            NO
         AND,X1   =X'F'             YES, USE LO 4 BITS
         B        LDNIBB
*
LDNIBA   EQU      %
         SLS,X1   -4                USE HO 4 BITS
*
LDNIBB   EQU      %
         AI,X3    1                 INCREMENT
         LI,AC2   0                 LOAD NORMAL CODE
LDNIBX   EQU      %
         B        *SRTN             RETURN
*
LDNIBE   EQU      %
         LI,AC2   1                 LOAD ERROR CODE
         B        LDNIBX            EXIT
*
         PAGE
*
* USE STDX1BUF FOR COMPRESS/DECOMPRESS BUFFER
*
BUFFER   EQU      STDX1BUF+1
*
* 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
*
*
         USECT    #PLOC
         END
