;========================================================================
;=									=
;=	Programmer:	Hunter Goatley					=
;=	Program:	ENTAB.MAR					=
;=	Language:	VAX-11 MACRO32					=
;=	Purpose:	Replace blanks with ASCII TABs			=
;=	System:		VAX 11/785  VAX/VMS v4.2			=
;=	Shop:		WKU/ACRS					=
;=	Date:		May 18, 1986					=
;=									=
;========================================================================
;=									=
;=	ENTAB replaces ASCII blanks and TABs in a file with a single	=
;=	ASCII TAB to space to the next tab stop.			=
;=									=
;=	ENTAB will work only on sequential files;  the record format	=
;=	and attributes are not changed.					=
;=									=
;=	The tab stops are fixed at every 8 positions.			=
;=									=
;=	ENTAB should be defined as a foreign command -- the input file	=
;=	should be specified on the command line.			=
;=									=
;========================================================================
;
	.PSECT	DATA,NOEXE,LONG
	.SUBTITLE	Macro definitions
CR=13
LF=10
TAB=9
TABCOL = 8
;
	$RMSDEF				; RMS symbols
	$FABDEF				; FAB symbols
	$RABDEF				; RAB symbols
;
;========================================================================
;=									=
;=	D E S C   M A C R O  ->  Macro to create a string descriptor	=
;=									=
;========================================================================
;
	.MACRO	DESC	LEN,ADDR
	.WORD	LEN			; The length of the string
	.BYTE	DSC$K_DTYPE_T		; The type (character)
	.BYTE	DSC$K_CLASS_S		; The class (string)
	.ADDRESS ADDR			; The address of the string
	.ENDM
;
	.MACRO	ON_ERR	WHERE,?LABEL
	BLBS	R0,LABEL
	BRW	WHERE
LABEL:	.ENDM	ON_ERR
;
	.SUBTITLE	FABs and RABs
	.ALIGN	LONG
;
;***  File Access Block for input
;
INFAB: $FAB	FAC=GET, -		; File Access (GET only)
		SHR=<GET>		; Sharing => allow others to read also
;
;***  Record Access Block for input
;
INRAB:
	$RAB	FAB=INFAB, -		; The File Access Block
		RAC=SEQ, -		; Record Access is sequential
		UBF=INREC, -		; Input buffer address
		USZ=512			; The max size of an input record
;
;
;***  File Access Block for output
;
OUTFAB: $FAB	FAC=PUT, -		; File Access (GET only)
		FOP=MXV, -		; Maximize Version number
		RFM=VAR, -		; VARiable length records
		MRS=512, -		; Maximum record size
		RAT=CR, -		; Carriage Return format
		ORG=SEQ			; SEQuential organization
;
;***  Record Access Block for output
;
OUTRAB:
	$RAB	FAB=OUTFAB, -		; The File Access Block
		RAC=SEQ, -		; Record Access is sequential
		RBF=OUTREC		; The record buffer address
;
	.ALIGN	LONG
INREC:	.=.+512				; Input buffer
OUTREC:	.=.+512				; Output buffer

FOR_DESC:				; Descriptor for command line buffer
	DESC	80,FOR_BUFF
FOR_BUFF:				; Command line buffer
	.BLKB	80
FOR_LEN:
	.BLKW	1			; Length of FOREIGN string returned
;
FOR_PROMPT:				; Prompt used if file is not specified
	.ASCID	/_File: /
;
;===============================================================================
;
	.SUBTITLE	Main routine
	.PSECT	ENTAB,EXE,NOWRT
;
	.ENTRY	ENTAB,^M<>
	PUSHAW	FOR_LEN			; Set up call to retrieve command line
	PUSHAQ	FOR_PROMPT		; Prompt if file is not specified
	PUSHAQ	FOR_DESC		; ...
	CALLS	#3,G^LIB$GET_FOREIGN	; ...
	MOVZWL	FOR_LEN,R0		; Move the length to register 0
	BNEQU	5$			; Was a filename specified?
	BRW	BYE			; No -- die
5$:	MOVAB	INFAB,R2		; Move addr to register for efficiency
	MOVAB	OUTFAB,R3		; ...
	MOVAB	INRAB,R4		; ...
	MOVAB	OUTRAB,R5		; ...
	$FAB_STORE -			; Store the filename in the FAB
		FAB=(R2), -
		FNA=FOR_BUFF, -
		FNS=R0
	$FAB_STORE -			; Store the filename in the FAB
		FAB=(R3), -
		FNA=FOR_BUFF, -
		FNS=R0
;
	$OPEN	FAB=(R2)		; Open the input file for reading
	ON_ERR	ERR_BYE			; .... Error?  Go report it
	CMPB	#FAB$C_SEQ,FAB$B_ORG(R2)
					; Is it a sequential file?
	BEQLU	7$			; Yes -- continue
	MOVL	#RMS$_IOP,R0		; No -- move error code to R0
	BRW	ERR_BYE			; ... and EXIT
7$:	$CONNECT RAB=(R4)		; Connect
	ON_ERR	ERR_BYE			; .... Error?  Go report it
;
	MOVB	FAB$B_RAT(R2),FAB$B_RAT(R3)
					; Make the Record Attributes the same
	MOVB	FAB$B_RFM(R2),FAB$B_RFM(R3)
					; Make the Record Formats the same
	$CREATE	FAB=(R3)		; Open the same file for output
	ON_ERR	ERR_BYE			; .... Error?  Go report it
	$CONNECT RAB=(R5)		; Connect
	ON_ERR	ERR_BYE			; .... Error?  Go report it
;
;=====	Initialize registers and read in a record
;
START:
10$:	CLRL	R7			; Clear the end address
	MOVAB	INREC,R6		; Move the address to reg for efficiency
	MOVL	R6,R9			; Make a copy in the SAVE INREC addr reg
	MOVAB	OUTREC,R8		; Move addr to reg
;
	$GET	RAB=(R4)		; Read a record from ACTDAT
	CMPL	R0,#RMS$_EOF		; End of file?
	BNEQU	15$			; No -- continue
	BRW	FIN			; Yes --- go back
15$:	ON_ERR	ERR_BYE			; Error?  Report and die
	ADDW3	RAB$W_RSZ(R4),R6,R7	; Get the addr of end of record read
;
;=====	Trim any blanks and tabs off the end of the record
;
20$:	CMPB	#^A/ /,-1(R7)		; Is the last character a blank?
	BLSSU	SCAN_LOOP		; No -- greater than blank -- skip rest
	BNEQU	25$			; No -- less than a blank -- check TAB
	DECL	R7			; Decrement the pointer into the buffer
	BRB	20$			; Go check the next character
25$:	CMPB	#TAB,-1(R7)		; Is the character a TAB?
	BNEQU	SCAN_LOOP		; No -- go process the record
	DECL	R7			; Decrement the pointer into the buffer
	BRB	20$			; Go check next character
;
;=====	Begin looking for a TAB (tab fields are 8 characters wide)
;
SCAN_LOOP:
	MOVL	R9,R6			; Restore the SAVEd address
	CMPL	R6,R7			; Reached the end of the record yet?
	BNEQU	5$			; No -- keep processing
;
	SUBL2	#OUTREC,R8		; Yes -- get the length to write
	MOVW	R8,RAB$W_RSZ(R5)	; Move it to the OUTRAB
	$PUT	RAB=(R5)		; Write the modified record out
	BRB	START			; Go get next record and process it
;
5$:	SUBL3	R6,R7,R10		; Get the remaining length of the record
	CMPL	#TABCOL,R10		; Is it < TABCOL?
	BGEQU	10$			; Yes -- use it as the substring length
	MOVL	#TABCOL,R10		; No -- substring length is TABCOL
10$:	LOCC	#^A/'/,R10,(R6)		; Is there a quote in this substring?
	BNEQU	YES_QUOTE		; Yes - do not process the rest of INREC
	LOCC	#^A/"/,R10,(R6)		; Is there a quote in this substring?
	BNEQU	YES_QUOTE		; Yes - do not process the rest of INREC
	LOCC	#TAB,R10,(R6)		; Is there a TAB in the substring?
	BEQLU	NO_TAB			; No -- go to NO_TAB and process the sub
;
;  Here if a TAB was found in the substring.  If the first byte of the substring
;  is a TAB, move it to OUTREC and check the next field starting with next byte
;  after the TAB.  If the first is not a TAB, scan backwards over any blanks
;  immediately preceding the TAB; replace the blank(s)/TAB combo with a TAB.
;
	MOVL	R1,R9			; Yes-Save the position immed after TAB
	INCL	R9			; ...
	SUBL3	R6,R1,R0		; Get the length of the substring - TAB
	BNEQU	15$			; Is it only one byte (a TAB)? No - 15$
	MOVB	(R6)+,(R8)+		; Move it to output buffer
	BRB	SCAN_LOOP		; Go check next field
;
15$:	CMPB	#^A/ /,-(R1)		; Scan backwards over any blanks
	BNEQU	20$			; ... until a non-blank is found
	SOBGTR	R0,15$			; ... or the beginning of the substring
	MOVB	#TAB,(R8)+		; Move a TAB to the output buffer
	BRB	SCAN_LOOP		; GO check next field
20$:	SUBL2	R6,R1			; Get the length of the non-blank field
25$:	MOVB	(R6)+,(R8)+		; Move the non-blanks to the output buff
	SOBGEQ	R1,25$			; ...
	MOVB	#TAB,(R8)+		; Move a TAB to the output buffer
	BRB	SCAN_LOOP		; GO check next field
;
;  Here if no TAB was found in the substring.  Scan backwards over any blanks
;  in the substring and replace them with a TAB (unless there is only one
;  blank).
;
NO_TAB:	ADDL2	R10,R9			; Bump up SAVE address to next tab field
	MOVL	R10,R0			; Copy the substring length to R0
5$:	CMPB	#^A/ /,-(R1)		; Scan backwards over any blanks
	BNEQU	10$			; ... until a non-blank is found
	SOBGTR	R0,5$			; ... or the beginning of the substring
	MOVB	#TAB,(R8)+		; Here -- substring was all blanks --
	BRB	SCAN_LOOP		; ...  Move TAB to OUTREC and check next
10$:	SUBL2	R6,R1			; Here -- possibly some blanks (get new
					; ... non-blank substring length)
15$:	MOVB	(R6)+,(R8)+		; Copy each non-blank byte from INREC
	SOBGEQ	R1,15$			; ...  to OUTREC
	CMPL	R10,R0			; Were there any blanks in substring?
	BNEQU	20$			; No -- don't move a TAB into OUTREC
	BRW	SCAN_LOOP		; ...
;
;  Do not replace only one blank with a TAB
;
20$:	CMPL	#TABCOL-1,R0		; Was there only one blank? (byte 7)
	BNEQU	25$			; No -- more than one -- go move TAB
	MOVB	(R6)+,(R8)+		; Yes -- move that one blank to OUTREC
	BRB	30$			; ... & check the next field)
25$:	MOVB	#TAB,(R8)+		; Move a TAB to the output buffer
30$:	BRW	SCAN_LOOP		; GO check next field
;
;  If a ' or " is found, forget the rest of the record - it's easier to just
;  write the rest of it out!
;
YES_QUOTE:
	SUBL3	R9,R7,R0		; Get the remaining string length
10$:	MOVB	(R9)+,(R8)+		; Move each byte in the rest of the rec
	SOBGTR	R0,10$			; ...  to OUTREC
	BRW	SCAN_LOOP		; Go write the record out
;
;  Here to close files and exit to VMS
;
FIN:
	$CLOSE	FAB=(R2)		; Close input file
	$CLOSE	FAB=(R3)		; Close output file
BYE:	$EXIT_S				; Return to VMS
ERR_BYE:
	$EXIT_S	CODE=R0			; Return to VMS with error code
	.END	ENTAB