COMPRESS:  PROC(STRING,COMPRESS_CHAR);

/* ROUTINE COMPRESSES STRING BY CHANGING REPEATS OF ONE OR MORE
   COMPRESSION CHARACTERS TO THE CHARACTER FOLLOWED BY A COUNT (1-255)
   IN THE NEXT BYTE
   AUTHOR:  AL JAWORSKI
   DATE:    MARCH 31, 1982 */

%INCLUDE MAXLENGTH;

DCL STRING CHAR(*) VARYING;
DCL (COMPRESS_CHAR,TEST_CHAR) CHAR(1);
DCL (I,J,LENGTH_STRING,COMPR_COUNT) FIXED BINARY(31);
DCL OUT_STRING CHAR(LENGTH(STRING)*2) BASED(P);
DCL P POINTER;

ALLOC OUT_STRING SET(P);

LENGTH_STRING=LENGTH(STRING);
COMPR_COUNT=0;
J=1;

DO I=1 TO LENGTH_STRING;
  TEST_CHAR=SUBSTR(STRING,I,1);
  IF TEST_CHAR=COMPRESS_CHAR THEN COMPR_COUNT=COMPR_COUNT+1;
  ELSE IF COMPR_COUNT>0 THEN DO;
    DO WHILE(COMPR_COUNT>255);
       SUBSTR(OUT_STRING,J,2)=COMPRESS_CHAR||BYTE(255);
       J=J+2;
       COMPR_COUNT=COMPR_COUNT-255;
    END;
    SUBSTR(OUT_STRING,J,3)=COMPRESS_CHAR||BYTE(COMPR_COUNT)||TEST_CHAR;
    J=J+3;
    COMPR_COUNT=0;
  END;
  ELSE DO;
    SUBSTR(OUT_STRING,J,1)=TEST_CHAR;
    J=J+1;
  END;
END;

IF COMPR_COUNT>0 THEN DO;
  DO WHILE(COMPR_COUNT>255);
    SUBSTR(OUT_STRING,J,2)=COMPRESS_CHAR||BYTE(255);
    J=J+2;
    COMPR_COUNT=COMPR_COUNT-255;
  END;
  SUBSTR(OUT_STRING,J,2)=COMPRESS_CHAR||BYTE(COMPR_COUNT);
  J=J+2;
END;

IF J-1>MAXLENGTH(STRING) THEN PUT EDIT(COPY('*',80),
  'String truncated due to degeneration of compression algorithm.',
  'Increase first argument length to at least',
  '1.5*(max uncompressed length).',COPY('*',80))
  (5(SKIP,A));

STRING=SUBSTR(OUT_STRING,1,J-1);
FREE OUT_STRING;
RETURN;

END COMPRESS;