;************************************************************************
;*									*
;*  FILE NAME:	OPTCHECK_UTIL.MAR					*
;*									*
;*  AUTHOR:	H. SIEGEL, TRW, 24 MAY 1988				*
;*									*
;*  PURPOSE:	UTILITY ROUTINES FOR OPTCHECK TOOL			*
;*									*
;************************************************************************

	.TITLE	OPTCHECK_UTIL
	.IDENT	/1.0/

;
;
;

	.LIBRARY		/SYS$LIBRARY:LIB/


	$SSDEF
	$FABDEF			; RMS FAB BLOCK FIELD/VALUE DEFINITIONS
	$NAMDEF			; RMS NAM BLOCK FIELD/VALUE DEFINITIONS
	$RABDEF			; RMS RAB BLOCK FIELD/VALUE DEFINITIONS


	.PSECT	$ABS$,ABS


	. = 0
ARGCNT:		.BLKL	1	; ARGUMENT COUNT


	. = 0
		.BLKL	1	; FILL
MSGID:		.BLKL	1	; MESSAGE CODE TO BE SIGNALLED
FABADR:		.BLKL	1	; ADDRESS OF FILE ACCESS BBLOCK
AUXID:		.BLKL	1	; AUXILLIARY MESSAGE CODE TO BE SIGNALLED


	. = 0
		.BLKL	1	; FILL
FUNC:		.BLKL	1	; ADDRESS OF FUNCTION BIT MASK WORD
INSTR:		.BLKL	1	; ADDRESS OF INPUT STRING DESCRIPTOR
OUTSTR:		.BLKL	1	; ADDRESS OF OUTPUT STRING DESCRIPTOR
OUTLEN:		.BLKL	1	; ADDRESS OF OUTPUT LENGTH WORD


	. = 0
ESF_V_COLLAPSE::	.BLKB	1
ESF_V_COMPRESS::	.BLKB	1
ESF_V_TRIM::		.BLKB	1
ESF_V_TRUNCATE::	.BLKB	1
ESF_V_UPCASE::		.BLKB	1
ESF_V_DOWNCASE::	.BLKB	1

	ESF_M_COLLAPSE	== 1@ESF_V_COLLAPSE
	ESF_M_COMPRESS	== 1@ESF_V_COMPRESS
	ESF_M_TRIM	== 1@ESF_V_TRIM
	ESF_M_TRUNCATE	== 1@ESF_V_TRUNCATE
	ESF_M_UPCASE	== 1@ESF_V_UPCASE
	ESF_M_DOWNCASE	== 1@ESF_V_DOWNCASE


	. = 0
ESF_V_WHITE:		.BLKB	1
ESF_V_BLACK:		.BLKB	1

	ESF_M_WHITE	= 1@ESF_V_WHITE
	ESF_M_BLACK	= 1@ESF_V_BLACK


	. = 0
INSTR_DSCR:	.BLKQ	1		; LOCAL DESCRIPTOR FOR INPUT STRING
WRKSTR_DSCR:	.BLKQ	1		; DESCRIPTOR FOR WORKING STRING
OUTSTR_DSCR:	.BLKQ	1		; LOCAL DESCRIPTOR FOR OUTPUT STRING

	LOCAL_DATA_SIZE = .

;
;
;

	.PSECT	OPTCHECK_UTIL,LONG,PIC,SHR,EXE,REL,RD,NOWRT

;
;
;

	.ENTRY	FILE_STATUS,^M<R2,R3,R11>

	CMPB	ARGCNT(AP),#2			; TEST NUMBER OF CALL ARGUMENTS
	BGEQ	100$				; BRANCH IF ENOUGH ARGUMENTS
	JMP	INSUFFICIENT_ARGUMENTS		; ELSE GO PROCESS THE ERROR

100$:	SUBL2	#8,SP				; ADJUST STACK POINTER AND SAVE
	MOVL	SP,R11				; ... BASE ADDR OF LOCAL STORE

	MOVL	FABADR(AP),R2			; GET ADDRESS OF FAB

1000$:	MOVL	FAB$L_NAM(R2),R3		; GET ADDRESS OF NAM
	TSTB	NAM$B_RSL(R3)			; RESULTANT NAME STRING?
	BEQL	1200$				; NO, CONTINUE BELOW
	MOVZBL	NAM$B_RSL(R3),(R11)		; SAVE NAM RSL STRING LENGTH
	MOVL	NAM$L_RSA(R3),4(R11)		; SAVE NAM RSL STRING ADDRESS
	BRW	3000$				; AND CONTINUE BELOW
1200$:	TSTB	NAM$B_ESL(R3)			; EXPANDED NAME STRING?
	BEQL	1400$				; NO, CONTINUE BELOW
	MOVZBL	NAM$B_ESL(R3),(R11)		; SAVE NAM EXP STRING LENGTH
	MOVL	NAM$L_ESA(R3),4(R11)		; SAVE NAM EXP STRING ADDRESS
	BRW	3000$				; AND CONTINUE BELOW
1400$:	MOVZBL	FAB$B_FNS(R2),(R11)		; SAVE FAB FNM STRING LENGTH
	MOVL	FAB$L_FNA(R2),4(R11)		; SAVE FAB FNM STRING ADDRESS

3000$:	CMPB	ARGCNT(AP),#2			; TEST FOR 2 CALLING ARGS
	BGTR	7000$				; BRANCH IF MORE THAN 2 ARGS
3200$:	BLBS	FAB$L_STS(R2),3400$		; SKIP IF NOT FAB ERROR
	MOVL	FAB$L_STS(R2),R0		; SAVE FAB PRIMARY STATUS
	MOVL	FAB$L_STV(R2),R1		; SAVE FAB AUXILLIARY STATUS
	BRW	5000$				; AND CONTINUE BELOW
3400$:	MOVL	FAB$L_CTX(R2),R3		; GET ADDRESS OF RAB
	BEQL	9000$				; BRANCH IF RAB ADDR IS ZERO
	MOVL	RAB$L_STS(R3),R0		; SAVE RAB PRIMARY STATUS
	MOVL	RAB$L_STV(R3),R1		; SAVE RAB AUXILLIARY STATUS

5000$:	PUSHL	R1				; PUSH RMS AUXILLIARY STATUS
	PUSHL	R0				; PUSH RMS PRIMARY STATUS
	PUSHL	R11				; PUSH ADDR OF INSERT
	PUSHL	#1				; PUSH INSERT COUNT
	PUSHL	MSGID(AP)			; PUSH USER MESSAGE ID
	CALLS	#5,G^LIB$SIGNAL			; SIGNAL THE MESSAGE
	RET					; AND RETURN TO CALLER

7000$:  TSTL	AUXID(AP)			; TEST FOR AUXID = 0
	BEQL	8000$				; BRANCH IF IT IS 0
	PUSHL	#0				; PUSH AUX MSG INSERT COUNT
	PUSHL	AUXID(AP)			; PUSH AUX MESSAGE ID
	PUSHL	R11				; PUSH ADDR OF INSERT
	PUSHL	#1				; PUSH INSERT COUNT
	PUSHL	MSGID(AP)			; PUSH USER MESSAGE ID
	CALLS	#5,G^LIB$SIGNAL			; SIGNAL THE MESSAGE
	RET					; AND RETURN TO CALLER

8000$:	PUSHL	R11				; PUSH ADDR OF INSERT
	PUSHL	#1				; PUSH INSERT COUNT
	PUSHL	MSGID(AP)			; PUSH USER MESSAGE ID
	CALLS	#3,G^LIB$SIGNAL			; SIGNAL THE MESSAGE
	RET					; AND RETURN TO CALLER

9000$:	PUSHL	#0				; PUSH INSERT COUNT
	PUSHL	#RMS$_RAB			; PUSH ERROR STATUS
	CALLS	#2,G^LIB$STOP			; AND ABORT IF THERE WAS AN
						;   RMS ERROR NOT ASSOCIATED
						;   WITH THE FAB AND A RAB WAS
						;   NOT PRESENT.

;
;
;

	.ENTRY	EDIT_STRING,^M<R2,R3,R4,R5,R6,R7,R8,R9,R10,R11>


ALLOCATE_LOCAL_STORAGE:

	SUBL2	#LOCAL_DATA_SIZE,SP		; ADJUST STACK POINTER AND...
	MOVL	SP,R11				; ... SAVE ADDR OF LOCAL STORE


CHECK_REQUIRED_ARGUMENTS:

	CMPB	ARGCNT(AP),#4			; TEST ARGUMENT COUNT
	BEQL	1000$				; SKIP IF CORRECT
	JMP	INSUFFICIENT_ARGUMENTS		; ELSE GO PROCESS THE ERROR
1000$:	MOVL	FUNC(AP),R10			; GET ADDRESS OF FUNCTION ARG
	BNEQ	1010$				; SKIP IF ARG PRESENT
	JMP	BAD_ARGUMENT			; ELSE GO PROCESS ERROR
1010$:	MOVZWL	(R10),R10			; GET THE EDIT FUNCTION FLAGS
	TSTL	INSTR(AP)			; CHECK FOR INSTR ARG
	BNEQ	1020$				; SKIP IF ARG PRESENT
	JMP	BAD_ARGUMENT			; ELSE GO PROCESS ERROR
1020$:	TSTL	OUTSTR(AP)			; CHECK FOR OUTSTR ARG
	BNEQ	1099$				; SKIP IF ARG PRESENT
	TSTL	OUTLEN(AP)			; CHECK FOR OUTLEN ARG
	BNEQ	1099$				; SKIP IF ARG PRESENT
	JMP	INSUFFICIENT_ARGUMENTS		; ELSE GO PROCESS ERROR
1099$:	; CONTINUE


CHECK_OPTIONAL_ARGUMENTS:

	MOVL	OUTLEN(AP),R9			; SAVE ADDRESS OF OUTLEN ARG
	BNEQ	1000$				; SKIP IF ADDRESS NOT ZERO
	MOVAW	-(SP),R9			; ELSE PUT TEMP VALUE ON STACK

1000$:	MOVL	INSTR(AP),R6			; GET ADDR OF INSTR DESCRIPTOR
	MOVW	(R6),R0				; GET INSTR ARG LENGTH
	BNEQ	2000$				; SKIP IF INSTR NOT NULL
	CLRW	(R9)				; ELSE SET OUTLEN TO ZERO
	MOVL	OUTSTR(AP),R8			; GET OUTSTR DESCR ADDR
	BEQL	1010$				; SKIP IF NO OUTSTR ARG
	MOVC5	#0,#0,#^A/ /,(R8),@4(R8)	; FILL OUTSTR WITH BLANKS
1010$:	RET					; AND RETURN TO CALLER

2000$:	MOVQ	(R6),INSTR_DSCR(R11)		; CREATE LOCAL INSTR DESCR...
	MOVAQ	INSTR_DSCR(R11),R6		; ... AND POINT TO IT
	MOVL	OUTSTR(AP),R8			; GET OUTSTR DESCR ADDR
	BEQL	3000$				; SKIP IF OUTSTR ARG ABSENT
	TSTW	(R8)				; CHECK OUTSTR ARG LENGTH
	BEQL	2010$				; SKIP IF NULL STRING
	MOVQ	(R8),OUTSTR_DSCR(R11)		; CREATE LOCAL OUTSTR DESCR...
	MOVAQ	OUTSTR_DSCR(R11),R8		; ... AND POINT TO IT
	BRW	4000$				; AND CONTINUE BELOW
2010$:	CLRL	(R9)				; SET OUTLEN TO ZERO
	RET					; AND RETURN TO CALLER

3000$:	MOVZWL	(R6),R0				; GET INSTR ARG LENGTH
	MOVAQ	OUTSTR_DSCR(R11),R8		; GET ADDR OF LOCAL OUTSTR DESCR
	MOVL	R0,(R8)				; SET TEMP OUTSTR LENGTH
	SUBL2	R0,SP				; MAKE ROOM ON THE STACK AND...
	MOVL	SP,4(R8)			; ... SAVE ADDR OF TEMP BUFFER

4000$:	; CONTINUE


TRIM_STRING:

	BITW	#ESF_M_COLLAPSE,R10		; ELSE TEST FOR COLLAPSE FLAG
	BNEQ	1000$				; BRANCH IF COLLAPSE REQUESTED
	BITW	#ESF_M_TRIM,R10			; TEST FOR TRIM FLAG
	BNEQ	1000$				; BRANCH IF TRIM REQUESTED
	BITW	#ESF_M_TRUNCATE,R10		; TEST FOR TRUNCATE FLAG
	BNEQ	2000$				; BRANCH IF TRUNCATE REQUESTED
	BRW	9000$				; ELSE CONTINUE BELOW

1000$:	SCANC	(R6),@4(R6),SCANTBL,-		; SCAN FOR A NON-SPACE
		#ESF_M_BLACK			;   CHARACTER IN THE INSTR
	BNEQ	3000$				; BRANCH IF NON-SPACE CHAR FOUND
	MOVC5	#0,#0,#^A/ /,(R8),@4(R8)	; FILL OUTSTR WITH BLANKS
	CLRW	(R9)				; SET OUTLEN TO ZERO
	RET					; AND RETURN TO CALLER

2000$:	MOVZWL	(R6),R0				; GET INSTR LENGTH
	ADDL3	R0,4(R6),R1			; ADDR OF 1 PAST END OF INSTR
	BRW	5000$				; AND GO TRUNCATE THE STRING

3000$:	MOVL	R1,4(R6)			; SAVE ADJUSTED INSTR ADDRESS
	MOVZWL	R0,R0				; CONVERT LENGTH TO LONGWORD
	ADDL2	R0,R1				; ADDR OF 1 PAST END OF INSTR

5000$:	MOVZBL	-(R1),R2			; GET BYTE FROM END OF STRING
	BITB	#ESF_M_BLACK,L^SCANTBL(R2)	; TEST FOR NON-SPACE CHARACTER
	BNEQ	7000$				; BRANCH IF NON-SPACE CHAR FOUND
	SOBGTR	R0,5000$			; ELSE GO BACK FOR NEXT CHAR

7000$:	MOVW	R0,(R6)				; SAVE ADJUSTED INSTR LENGTH

9000$:	; CONTINUE


ALLOCATE_WORKING_STRING_STORAGE:

	MOVAL	WRKSTR_DSCR(R11),R7		; ADDRESS OF WRKSTR DESCRIPTOR
	MOVZWL	(R6),(R7)			; GET 'ADJUSTED' INSTR LENGTH
	SUBL2	(R7),SP				; ADJUST STACK POINTER AND
	MOVL	SP,4(R7)			; ... SAVE ADDRESS OF WRKSTR


SQUEEZE_STRING:

	BITW	#ESF_M_COLLAPSE,R10		; ELSE TEST FOR COLLAPSE FLAG
	BNEQ	COLLAPSE_STRING			; BRANCH IF COLLAPSE REQUESTED
	BITW	#ESF_M_COMPRESS,R10		; TEST FOR COMPRESS FLAG
	BNEQ	COMPRESS_STRING			; BRANCH IF COMPRESS REQUESTED

COPY_STRING:
	MOVC3	(R7),@4(R6),@4(R7)		; ELSE MOVE INSTR TO WRKSTR
	BRW	SQUOZE_STRING			; AND CONTINUE BELOW

COLLAPSE_STRING:
	MOVZWL	(R6),R0				; GET INSTR LENGTH
	MOVL	4(R6),R1			; GET INSTR ADDRESS
	CLRL	R2				; INITIAL WRKSTR LENGTH
	MOVL	4(R7),R3			; GET WRKSTR ADDRESS
2000$:	MOVZBL	(R1)+,R4			; GET A CHAR FROM INSTR
	BITB	#ESF_M_BLACK,L^SCANTBL(R4)	; TEST FOR NON-SPACE CHARACTER
	BEQL	4000$				; BRANCH IF SPACE CHAR FOUND
	MOVB	R4,(R2)+[R3]			; ELSE MOVE GOOD CHAR TO WRKSTR
4000$:	SOBGTR	R0,2000$			; AND GO BACK FOR NEXT CHAR
	MOVW	R2,(R7)				; SAVE LENGTH OF WRKSTR
	BRW	SQUOZE_STRING			; AND CONTINUE BELOW

COMPRESS_STRING:
	MOVZWL	(R6),R0				; GET INSTR LENGTH
	MOVL	4(R6),R1			; GET INSTR ADDRESS
	CLRL	R2				; INITIAL WRKSTR LENGTH
	MOVL	4(R7),R3			; GET WRKSTR ADDRESS
2000$:	MOVZBL	(R1)+,R4			; GET A CHAR FROM INSTR
	BITB	#ESF_M_BLACK,L^SCANTBL(R4)	; TEST FOR NON-SPACE CHARACTER
	BNEQ	2500$				; BRANCH IF NON-SPACE CHAR FOUND
	MOVB	#^A/ /,(R2)+[R3]		; PUT FIRST SPACE IN WRKSTR
	BRW	4500$				; AND CONTINUE BELOW
2500$:	MOVB	R4,(R2)+[R3]			; ELSE MOVE GOOD CHAR TO WRKSTR
	SOBGTR	R0,2000$			; AND GO BACK FOR NEXT CHAR
	BRW	6000$				; NO MORE CHARS! CONTINUE BELOW
4000$:	MOVZBL	(R1)+,R4			; GET A CHAR FROM INSTR
	BITB	#ESF_M_BLACK,L^SCANTBL(R4)	; TEST FOR NON-SPACE CHARACTER
	BNEQ	2500$				; BRANCH IF NON-SPACE CHAR FOUND
4500$:	SOBGTR	R0,4000$			; AND GO BACK FOR NEXT CHAR
6000$:	MOVW	R2,(R7)				; SAVE LENGTH OF WRKSTR

SQUOZE_STRING:
	; CONTINUE


CHANGE_CASE:
	BITW	#ESF_M_UPCASE,R10		; TEST FOR UPCASE FLAG
	BNEQ	UP_CASE				; BRANCH IF UPCASE REQUESTED
	BITW	#ESF_M_DOWNCASE,R10		; ELSE TEST FOR DOWNCASE FLAG
	BNEQ	DOWN_CASE			; BRANCH IF DOWNCASE REQUESTED


SAME_CASE:
	MOVC5	(R7),@4(R7),#^A/ /,(R8),@4(R8)	; COPY/PAD WRKSTR TO OUTSTR
	BRW	SET_OUTSTR_LENGTH		; AND CONTINUE BELOW


UP_CASE:
	BITW	#ESF_M_DOWNCASE,R10		; ALSO TEST FOR DOWNCASE FLAG
	BNEQ	SAME_CASE			; UP + DOWN =-> SAME_CASE
	MOVTC	(R7),@4(R7),#^A/ /, -		; COPY/XLATE WRKSTR TO OUTSTR
		UPCASE_TABLE,(R8),@4(R8)
	BRW	SET_OUTSTR_LENGTH		; AND CONTINUE BELOW


DOWN_CASE:
	MOVTC	(R7),@4(R7),#^A/ /, -		; COPY/XLATE WRKSTR TO OUTSTR
		DOWNCASE_TABLE,(R8),@4(R8)


SET_OUTSTR_LENGTH:
	BLSSU	5000$				; LEN(WRKSTR) < LEN(OUTSTR) ?
	MOVW	(R8),(R9)			; NO, SET OUTLEN TO LEN(OUTSTR)
	BRB	9000$				; AND CONTINUE BELOW
5000$:	MOVW	(R7),(R9)			; YES, SET OUTLEN TO LEN(WRKSTR)
9000$:	; CONTINUE


ALL_FINISHED:

	RET					; AND RETURN TO CALLER


INSUFFICIENT_ARGUMENTS:

	PUSHL	#SS$_INSFARG			; NOT ENOUGH ARGUMENTS ERROR
	CALLS	#1,G^LIB$STOP			; AND SIGNAL THE ERROR


BAD_ARGUMENT:

	PUSHL	#SS$_BADPARAM			; MISSING ARGUMENT ERROR
	CALLS	#1,G^LIB$STOP			; AND SIGNAL THE ERROR

;
;
;

	.PSECT	OPTCHECK_UTIL_DATA,BYTE,SHR,REL,NOEXE,NOWRT

	TAB	= 9
	SPACE	= 32
	PERIOD	= 46
	CAP_A	= 65
	CAP_Z	= 90
	SMALL_A	= 97
	SMALL_Z = 122
	TILDE	= 126


SCANTBL:

	.BYTE		ESF_M_BLACK[256]

	.SAVE_PSECT

	. = SCANTBL + TAB
	.BYTE		ESF_M_WHITE

	. = SCANTBL + SPACE
	.BYTE		ESF_M_WHITE

	.RESTORE_PSECT

	SCANTBL_LEN = . - SCANTBL

	.IIF	LT SCANTBL_LEN-256, .ERROR ; SCAN TABLE TOO SHORT
	.IIF	GT SCANTBL_LEN-256, .ERROR ; SCAN TABLE TOO LONG


UPCASE_TABLE:

	.REPEAT	256
	.BYTE	. - UPCASE_TABLE
	.ENDR

	.SAVE_PSECT

	. = UPCASE_TABLE + SMALL_A
400$:	.REPEAT	<CAP_Z - CAP_A + 1>
	.BYTE	. - 400$ + CAP_A
	.ENDR

	.RESTORE_PSECT

	TABLE_LEN = . - UPCASE_TABLE

	.IIF	LT TABLE_LEN-256, .ERROR ; UP CASE TABLE TOO SHORT
	.IIF	GT TABLE_LEN-256, .ERROR ; UP CASE TABLE TOO LONG


DOWNCASE_TABLE:

	.REPEAT	256
	.BYTE	. - DOWNCASE_TABLE
	.ENDR

	.SAVE_PSECT

	. = DOWNCASE_TABLE + CAP_A
400$:	.REPEAT	<CAP_Z - CAP_A + 1>
	.BYTE	. - 400$ + SMALL_A
	.ENDR

	.RESTORE_PSECT

	TABLE_LEN = . - DOWNCASE_TABLE

	.IIF	LT TABLE_LEN-256, .ERROR ; DOWN CASE TABLE TOO SHORT
	.IIF	GT TABLE_LEN-256, .ERROR ; DOWN CASE TABLE TOO LONG


END_OF_TABLES:

	.END