.TITLE	STR_SQUEEZE to squeeze spaces/tabs from a string
	.IDENT	/V01.01/

;++STRSQUEEZ.MAR
;
; Facility: 
;	Fermilab Accelerator Control System (ACNET) General Routines
;
; Abstract:
;	Remove spaces and tabs from a string (in place).
;
; Environment:
;	Module stored in FERMILIB.OLB and linked in users' programs.
;
;--
;
; Modification History:
;
; Author: F. Nagy			Creation date: 31-Dec-82
;
; V01.00  31-Dec-82	FJN	Created for eventual use in AEOLUS
; V01.01  15-Apr-83	FJN	Standardizing help comments
;
	.PAGE
	.SUBTITLE	Declarations

;
; Include Files:
;
	.LIBRARY  "FERMI$LIB:FERMILIB.MLB"	;Our own macros
;
; Library Macros:
;
	.NOCROSS
	$DSCDEF				;Descriptor definitions
	.CROSS
;
; Local Macros:
;
;	NONE
;
; Equated Symbols:
;
string = 4				;Offset to address of input/output
					; string descriptor argument
mode = 8				;Offset to value argument determining
					; string white space squeezing mode
outlen = 12				;Offset to address of word to return
					; output string length
TAB = ^A/	/			;ASCII code for TAB character
SPACE = ^A/ /				;ASCII code for SPACE character
;
; Program section for code
;
	.PSECT	_STR_CODE,PIC,USR,CON,REL,LCL,SHR,EXE,NOWRT,RD
	.SHOW	BINARY

	.PAGE
	.SUBTITLE  White space squeezer for strings

;+0STR_SQUEEZE
;
; Functional Description:
;	Convert all tabs in a string to spaces and either eliminate all spaces
;	(including those converted from tabs) or replace multiple spaces by a
;	single space.  All trailing spaces and tabs are truncated from the
;	string.
;
; Calling Sequence:
;	CALL STR_SQUEEZE(string [,mode] [,outlen])
;
; Input Parameters:
;	string - address of string descriptor of input string
;	mode - optional argument determines operational mode.  If low bit is 0
;	       (or if argument is defaulted or not given) then multiple spaces
;	       are replaced by single spaces.  If low bit is 1, then all spaces
;	       are removed from the string.
;
; Implicit Inputs:
;	NONE
;
; Output Parameters:
;	string - address of string descriptor for output string (overwrites the
;		 input string).
;	outlen - optional address of a word in which the length of the output
;		 string (minus any padding spaces) is returned.
;
; Implicit Outputs:
;	NONE
;
; Condition Codes (signalled):
;	STR$_ILLSTRCLA	Invalid descriptor class found.
;
; Side Effects:
;	NONE
;
;-
;+ STR_SQUEEZE
; Squeeze spaces and tabs from a string.  All tabs are converted to
; spaces and all trailing spaces (except for padding in fixed-length
; strings) are removed.  
;
; CALL STR_SQUEEZE( string.mt.dx [,mode.rlu.v] [,outlen.ww.r])
;
;  string    the input and output strings.  Passed by descriptor.
;
;  mode      optional mode control.  If low bit is 0 (or if the
;            argument is defaulted) then multiple spaces are replaced
;            by single spaces.  If low bit is 1 then all spaces are
;            removed.  Passed by value.
;
;  outlen    (optional) word in which the length of the output string
;            is returned (not including padding blanks).  Passed by
;            reference.
;-
;!+
;   CALL STR_SQUEEZE(strdx,mode,outlen)
;
; Algorithm:
;
;   JSB  STR$ANALYZE_SDESC_R1(strdx,len,txt)
;   IF len=0 THEN
;	IF nargs>=3 AND outlen<>0 THEN outlen <= 0 ENDIF
;	RETURN
;	ENDIF
;   WHILE (Located TAB character {loc <= pointer to TAB}) DO
;	(loc) <= SPACE
;	ENDWHILE
;   IF NOT (Located SPACE {loc <= pointer to TAB}) THEN
;	IF nargs>=3 AND outlen<>0 THEN outlen <= len ENDIF
;	RETURN
;	ENDIF
;   dest <= loc
;   IF nargs>=2 THEN
;	imode <= mode
;	ELSE
;	imode <= 0
;	ENDIF
;   WHILE (len<>0) DO
;	IF NOT (Located non-SPACE character {loc <= pointer to non-SPACE}) THEN
;	    EXITLOOP
;	    ENDIF
;	src <= loc
;	IF NOT imode THEN dest <= dest + 1 ENDIF
;	Locate SPACE character {loc <= pointer to SPACE}
;	IF dest=src THEN
;	    dest <= loc
;	    ELSE
;	    Move (loc-src) characters from (src) to (dest).
;	    ENDIF
;	ENDWHILE
;   len = loc-str
;   IF len=0 AND NOT imode THEN len <= 1 ENDIF
;   CASE class(strdx) OF
;UNSPECIFIED:
;STATIC:
;	Pad string with blanks from (dest) to end of string.
;	EXITCASE
;DYNAMIC:
;	length(strdx) <= len
;	EXITCASE
;VARYING:
;	@pointer(strdx) <= len
;	ENDCASE
;   IF nargs>=3 AND outlen<>0 THEN outlen <= len ENDIF
;   RETURN
;!-

	.ENTRY	STR_SQUEEZE,^M<R2,R3,R4,R5,R6,R11>
	MOVAQ	@string(AP),R0		;Get address of string descriptor
	JSB	G^STR$ANALYZE_SDESC_R1	;Analyze the string descriptor
					;Return R0=length,R1=text pointer
;
; First replace all tab characters by single spaces.
;
	MOVQ	R0,R2			;Save string length and pointer
	TSTL	R0			;Check for null input string
	BEQL	33$			;If so, exit setting outlen parameter
10$:	LOCC	#TAB,R0,(R1)		;Locate TAB character
	BEQL	19$			;If none, exit TAB replacement loop
	MOVB	#SPACE,(R1)		;Replace TAB by a SPACE
	BRB	10$			;Loop to scan entire string
;
; Each TAB has been replaced by a SPACE, at this point the register contents
; are:
;	R2 = length of input string
;	R3 = pointer to start of text of input string
;
; Setup for big loop by locating first SPACE character
;
19$:	LOCC	#SPACE,R2,(R3)		;Locate first SPACE
	BEQL	40$			;If no SPACE's return full input len.
;
; Have now found first SPACE finsh preparation for the big loop in which the
; register usage will be:
;
;	R0 = remaining (to be scanned) length of input string
;	R1 = current input string pointer
;	R3 = destination (output string) append pointer
;	R4 = length of non-blank substring when being moved
;	R5 = pointer to start of non-blank substring (when needed)
;	R6 = original pointer to start of input/output string
;	R11 = mode indicator
;
	MOVL	R3,R6			;Save input string text pointer
	MOVL	R1,R3			;Init output append pointer past any
					; starting non-SPACE characters
	CLRL	R11			;Default mode is multiple=>single
	CMPB	(AP),#mode/4		;Checking for mode parameter
	BLSSU	20$			;If none, use default mode
	MOVL	mode(AP),R11		;Get mode parameter from caller
;
; Start of big loop to scan string, eliminate/squeeze spaces
;
20$:	SKPC	#SPACE,R0,(R1)		;Scan for non-SPACE character
	BEQL	30$			;Exit loop if end of string reached
	BLBS	R11,25$			;Non-SPACE found, if mode=squeeze then
	MOVB	#SPACE,(R3)+		;  save one space in output string
25$:	MOVL	R1,R5			;Set non-SPACE substring start pointer
	LOCC	#SPACE,R0,(R1)		;Scan for next SPACE
	CMPL	R3,R5			;Check source/destination pointers
	BNEQ	27$			;If not equal, must move substring
	MOVL	R1,R3			;No move needed, update dest. pointer
					; to SPACE location or string end
	TSTL	R0			;Check for end of string reached
	BEQL	30$			;Terminate loop at string end!
	BRB	20$			;Continue with loop as more string
;
; In loop: we must now move a substring of non-SPACE characters to "left"
; overwriting one or more SPACE characters by appending to the current portion
; of the output string.
;
27$:	PUSHL	R0			;Save input string count
	SUBL3	R5,R1,R4		;Get count of substring to move
	MOVC3	R4,(R5),(R3)		;Append substring to output
	POPL	R0			;Restore input string count
	BNEQ	20$			;Loop if more to be done
;
; Termination of big loop: output string end now pointed to by R3 get the
; length of the output string into R2 and the address of the string
; descriptor into R1.
;
30$:	SUBL3	R6,R3,R2		;Output string length
	BNEQ	31$			;If input all spaces need special test
	BLBS	R11,31$			;If mode=remove-all then return null
	MOVZBL	#1,R2			;  else return 1 SPACE string
31$:	MOVAQ	@string(AP),R1		;String descriptor pointer
;
; Now check for descriptor CLASS to handle output string correctly
;
	TSTB	DSC$B_CLASS(R1)		;Check for unspecified class
	BEQL	32$			;If so treat as STATIC string
	CMPB	DSC$B_CLASS(R1),-	;Check for STATIC string class
		#DSC$K_CLASS_S
	BNEQ	35$			;If not, do further checks
32$:	SUBW3	R2,DSC$W_LENGTH(R1),R0	;Get remaining STATIC string length
	BEQL	40$			;If none, set outlen and exit
	PUSHL	R2			;Else save output string length
	MOVC5	#0,(R3),#SPACE,R0,(R3)	;Pad string with blanks at end
	POPREG	R2			;Restore output string length
33$:	BRB	40$
;
; Check for DYNAMIC and VARYING strings
;
35$:	CMPB	DSC$B_CLASS(R1),-	;Check for VARYING string class
		#DSC$K_CLASS_VS
	BEQL	37$			;If VARYING set current length
	MOVW	R2,DSC$W_LENGTH(R1)	;Assume DYNAMIC string and store length
					; of output in descriptor itself
	BRB	40$
37$:	MOVW	R2,@DSC$A_POINTER(R1)	;For VARYING string, store length of
					; output into CURLEN position
;
; Check for outlen parameter, if one given store string length (in R2) into it.
;
40$:	CMPB	(AP),#outlen/4		;Check argument count
	BLSSU	49$			;If too few arguments, exit
	TSTL	outlen(AP)		;Check for defaulted argument pointer
	BEQL	49$			;If no pointer, again exit
	MOVW	R2,@outlen(AP)		;Store length into outlen parameter
49$:	RET

	.END