.TITLE	COMPRS
	.IDENT	/V01/
	.SBTTL	DESCRIPTION
;
;
;  COMPONENT:	COMPRS
;
;  DATE:	04-JUN-79
;
;  AUTHOR:	GR JOHNSON
;		BATTELLE NORTHWEST
;		P O BOX 999
;		RICHLAND WA 99352
;
;  SOURCE:	MACRO-11
;
;  CALLER:	FORTRAN IV-PLUS
;
;  CALLING SEQUENCE:
;
;		CALL COMPRS(STRING,[ILEN])
;
;		STRING	= ASCII STRING TO BE COMPRESSED.  THE STRING
;			  MUST BE TERMINATED BY AN ASCII NULL CHARACTER.
;
;		ILEN	= INTEGER VARIABLE TO RECEIVE THE LENGTH OF THE
;			  COMPRESSED STRING.
;
;
;  DESCRIPTION:
;
;	"COMPRS" SCANS AN ASCII STRING CONVERTING ALL NON-PRINTING
;  CHARACTERS TO SPACES, CONVERTING MULTIPLE SPACES TO A SINGLE SPACE,
;  AND DELETING LEADING AND TRAILING SPACES.  THE LENGTH OF THE COMPRESSED
;  STRING IS OPTIONALLY RETURNED IN ILEN.
;
;

	.SBTTL	ENTRY POINT -- COMPRESS STRING
;
;
	.PSECT				;
					;
COMPRS::				;
					;
	CLR	R0			; CLEAR CHARACTER COUNT
	MOV	2(R5),R1		; STRING ADDRESS TO R1
	MOV	2(R5),R2		; STRING ADDRESS TO R2
	MOV	#1,R3			; SET LCS (LAST CHARACTER SPACE) FLAG
					;
2$:	TSTB	(R2)			; END-OF-STRING?
	BEQ	14$			; YES, RETURN TO CALLER
	CMPB	#177,(R2)		; DEL?
	BEQ	4$			; YES, CONVERT TO SPACE
	CMPB	#040,(R2)		; NON-PRINTABLE CHARACTER?
	BGT	4$			; YES, CONVERT TO SPACE
	BEQ	6$			; NO, (SPACE), GO TEST LCS FLAG
	CLR	R3			; NO, (PRINTABLE), CLEAR LCS FLAG
	BR	10$			; AND GO COPY CHARACTER
					;
4$:	MOVB	#040,(R2)		; CONVERT TO SPACE
6$:	TST	R3			; LAST-CHARACTER-SPACE?
	BNE	12$			; YES, SKIP COPY
	INC	R3			; NO, SET LCS FLAG
					;
10$:	MOVB	(R2),(R1)+		; COPY TO NEW STRING
	INC	R0			; INCREMENT CHARACTER COUNT
12$:	INC	R2			; INCREMENT POINTER
	BR	2$			; AND CONTINUE SCAN
					;
14$:	TST	R3			; LAST-CHARACTER-SPACE?
	BEQ	16$			; NO, GO TEST FOR EOS
	TST	R0			; ANY CHARACTERS COPIED
	BEQ	16$			; NO, GO TEST FOR EOS
	DEC	R0			; DECREMENT CHARACTER COUNT
	DEC	R1			; AND SKIP BACK OVER TRAILING SPACE
16$:	TSTB	(R1)			; END-OF-STRING?
	BEQ	2$			; YES, RETURN TO CALLER
	CLRB	(R1)+			; NO, CONVERT TRAILING GARBAGE TO NULLS
	BR	RTN			; CONTINUE TO SCAN
					;
RTN:	CMPB	#2,(R5)			; AT LEAST TWO ARGUMENTS?
	BGT	2$			; NO, RETURN TO CALLER
	TST	4(R5)			; NULL ARGUMENT?
	BEQ	2$			; YES, RETURN TO CALLER
	MOV	R0,@4(R5)		; CHARACTER COUNT TO ILEN
2$:	RTS	PC			; RETURN TO CALLER (R0 = ILEN)
	.END				;