.TITLE	CVL - CHANGE VOLUME LABEL
	.IDENT	/01.30/
	.LIST	MEB
;
; AUTHOR:	H. L. COLEMAN
;		MILLIKEN AND COMPANY
;		P. O. BOX 1926
;		MAIL STOP M-103
;		SPARTANBURG, S. C. 29304
;		(803)573-2556
;
; DATE:		16-OCT-78
;
; MODIFIED:
;		J. DOWNWARD
;		KMS FUSION, INC
;		3941 RESEARCH PARK DR
;		ANN ARBOR, MICH. 48104
;		(313)769-8500
;
;		JGD01 -	ADDED SUPPORT FOR /VI, /LRU, /WINDOW, /MAXEXT, /MXF
;			SWITCHES.  DISPLAY VOLUME CREATION DATE.
;
;		JGD02 - ADDED SUPORT FOR /FPRO=[RWED,RWED,RWED] AS IN INI
;
; FUNCTION:	READ THE DISK LABEL BLOCK AND CHANGE THE LABEL TO THAT
;		SPECIFIED IN THE MCR COMMAND.  IF NO MCR COMMMAND IS
;		AVAILABLE, THE OPERATOR IS PROMPTED FOR COMMANDS.
;
; INPUT:
;
;		MCR COMMAND OF THE FORM:
;
;			CVL DDU:LABEL/SW1/SW2/SW3....
;		WHERE  SW1,..SWN CAN BE ANY OF
;		/VI 	- DISPLAY VOLUME INFORMATION BUT DON'T CHANGE ANYTHING
;		/MAXEXT = NN	- CHANGE THE DEFAULT FILE EXTENSION TO THE NEW VALUE NNN
;		/WINDOW = NN	- CHANGE THE DEFAULT NUMBER OF WINDOWS TO NNN
;		/LRU	= NN	- CHANGE THE DEFAULT LRU THE VOLUME WILL BE MOUNTED WITH
;		/MXF	= NNN	- CHANGE THE MAXIMUM NUMBER OF FILES ALLOWED ON A VOLUME
;				  (ONLY INCREASES UPWARD ARE ALLOWED)
;				  (NN IS IN DECIMAL IN ALL CASES)
;		/FPRO	= [RWED,RWED,RWED,RWED]   WHERE  RWED  DOES THE SAME THING AS IN INI
;				   AND THE SWITCH CHANGES THE VOLUME DEFAULT FILE PROTECTION
;				   FOR  [SYSTEM,OWNER,GROUP,WORLD] TO THE NEWLY SPECIFIED
;				   DEFAULT PROTECTION.
;		CREATION DATE	  AS AN ADDED BONUS, THE DATE THE DISK WAS CREATED IS
;				  DISPLAYED.  THIS MAY BE USEFUL IN DETERMINING HOW LONG
;				  IT HAS BEEN SINCE THE DISK WAS 'BADDED', FORMATTED, ETC.
;
; OUTPUT:
;
;		THE SPECIFIED DISK LABEL BLOCK IS MODIFIED.
;

;
; LOCAL MACROS
;
	.MACRO	MSGN$S PFX,SEV,MSG,REP,LEN,ERR
 
	JSR	R5,$MSGEN		; GO TO MESSAGE GEN ROUTINE
	.IIF  B <PFX>	.WORD	0	;NO PREFIX
	.IIF NB <PFX>	.WORD	PFX	;A(MESSAGE PREFIX)
	.IIF  B <SEV>	.WORD	0	;SEVERITY LEVEL 0
	.IF  NB <SEV>
	.IF  GT SEV-3
	.ERROR	SEV			;SEVERITY LEVEL TOO BIG
	.ENDC				;.IF  GT SEV0-3
	.IF  LT SEV
	.ERROR	SEV			;SEVERITY LEVEL NEGATIVE
	.ENDC				;.IF  LT SEV
	.WORD	SEV			;SEVERITY LEVEL
	.ENDC				;.IF  NB <SEV>
	.IIF  B <MSG>	.WORD	0	;NO MESSAGE TEXT
	.IIF NB <MSG>	.WORD	MSG	;A(MESSAGE TEXT)
	.IIF  B <REP>	.WORD	0,0	;NO REPLY
	.IF  NB <REP>
	.IF   B <LEN>
	.ERROR				;REPLY LENGTH NOT SPECIFIED
	.ENDC				;.IF   B <LEN>
	.WORD	REP			;A(REPLY BUFFER)
	.WORD	LEN			;REPLY LENGTH
	.ENDC				;.IF  NB <REP>
	.IIF NB <ERR>	.MCALL	ERR$
	.IIF NB <ERR>	ERR$	ERR
	.ENDM

	.PAGE
	.MCALL	QIOW$S,WSIG$S,GMCR$,EXIT$S,DIR$
	.MCALL	ALUN$S
	.MCALL	TCBDF$,LCBDF$,DCBDF$,UCBDF$,HMBOF$
	TCBDF$	<:>,<=>		;DEFINE TCB OFFSETS
	UCBDF$	<:>,<=>		;DEFINE UCB OFFSETS
	DCBDF$	<:>,<=>		;DEFINE DCB OFFSETS
	LCBDF$	<:>,<=>		;DEFINE LCB OFFSETS
	HMBOF$			;DEFINE HOME BLOCK OFFSETS
	.PSECT	CVL
	.PAGE
; MESSAGES - ERROR AND OTHERWISE
;
; ALL MESSAGES PRINTED BY MSGTRP UTILITY ROUTINE
;
PFX:	.BYTE	PRMT-PFX-1		;MESSAGE PREFIX
	.ASCII	/CVL -/
PRMT:	.BYTE	M001-PRMT-1		;PROMPT PREFIX
	.ASCII	/CVL>/
M001:	.BYTE	M002-M001-1
	.ASCII	/PRIVLEDGE VIOLATION/
M002:	.BYTE	M003-M002-1
	.ASCII	/SYNTAX ERROR/
M003:	.BYTE	M004-M003-1
	.ASCII	/INVALID DEVICE/
M004:	.BYTE	M005-M004-1
	.ASCII	/DEVICE NOT MOUNTED/
M005:	.BYTE	M006-M005-1
	.ASCII	/HEADER BLOCK READ ERROR /
HBREC:	.ASCII	/       /
M006:	.BYTE	M007-M006-1
	.ASCII	/HEADER BLOCK WRITE ERROR /
HBWEC:	.ASCII	/       /
M007:	.BYTE	M008-M007-1
	.ASCII	/VOLUME NAME CHANGED FROM /
OLDLBL:	.ASCII	/            /
	.ASCII	/ TO /
NEWLBL:	.ASCII	/            /
	.ASCII	<15><12>/	MAXEXT =/					; JGD01
MAXEXT:	.ASCII	/     /								; JGD01
	.ASCII	<15><12>/	LRU =/						; JGD01
LRU:	.ASCII	/     /								; JGD01
	.ASCII	<15><12>/	WINDOWS =/					; JGD01
WIN:	.ASCII	/     /								; JGD01
	.ASCII	<15><12>/	MAXFILES=/					; JGD01
MAXFIL:	.ASCII	/     /								; JGD01
M008:	.BYTE	M009-M008-1							; JGD01
	.ASCII	/        FPRO=/						; JGD02
PROTCT:	.ASCII	/[                    /						; JGD02
	.ASCII	<15><12>/	CREATION DATE: /				; JGD01
DATE:	.ASCII	/DD-MMM-YY/							; JGD01
M009:	.BYTE	M010-M009-1							; JGD01
	.ASCII	/ILLEGAL SWITCH VALUE/						; JGD01
M010:	.BYTE	M011-M010-1							; JGD01
	.ASCII	/NON NUMERIC INPUT CHARACTER/					; JGD01
M011:	.BYTE	0								; JGD01
	.EVEN

	.PAGE
; CONSTANTS AND WORK AREAS.
;
MCRLIN:	GMCR$			;MCR COMMAND BUFFER
	.WORD	0		;BUFFER PAD
DEV:	.ASCII	/  /		;DEVICE NAME
UNIT:	.WORD	0		;UNIT NUMBER
EXTFLG:	.WORD	0		; /MAXEXT=NNN SEEN				; JGD01
WINFLG:	.WORD	0		; /WINDOW=NNN SEEN (=1)				; JGD01
LRUFLG:	.WORD	0		; /LRU=NNN SEEN(=1)				; JGD01
MAXFLG:	.WORD	0		; /MXF=NNNNN SEEN? (=1)				; JGD01
PROFLG:	.WORD	0		; /FPRO =[RWED,...] SEEN? (=1)			; JGD02
PROWRD:	.WORD	-1		; DEFAULT FILE PROTECTION MASK			; JGD02
SKPFLG:	.WORD	0		;  /VI  SEEN, DISPLAY DATA BUT DO NOT CHANGE	; JGD01
NUMFIL:	.WORD	0		; TEMP STORAGE FOR USE WITH /MXF=NNN		; JGD01
IOSB:	.WORD	0,0		;IOSB FOR DISK I/O
PRFLG:	.WORD	0		;PROMPT MODE FLAG
LBN:	.WORD	0,0		;DISK LOGICAL BLOCK NUMBER
HDRBUF:	.BLKW	256.		;DISK HEADER BUFFER

	.PAGE
CVL::	MOV	$TKTCB,R1	;R1 = A(MY TCB)
	MOV	T.UCB(R1),R0	;R0 = A(TI: UCB)
	BIT	#U2.PRV,U.CW2(R0) ;IS USER PRIVLEDGED?
	BNE	1100$		;IF NE, YES - CONTINUE
	MSGN$S	PFX,3,M001,,,ABORT ;PRIVLEDGE VIOLATION!
1000$:	EXIT$S			;EXIT
1100$:	DIR$	#MCRLIN		;GET MCR COMMAND LINE
	BCC	1300$		;IF CC, GOT ONE - GO PROCESS IT
1200$:	MOV	#1,PRFLG	;INDICATE PROMPT MODE
	MOV	#"CV,MCRLIN+2	;MAKE IT LOOK LIKE MCR COMMAND
	MOV	#"L ,MCRLIN+4
	MSGN$S	PRMT,0,,MCRLIN+6,74.,ABORT ;PROMPT
	CMPB	#IE.EOF,$TIOSB	;CTRL/Z?
	BEQ	1000$		;IF EQ, YES - EXIT
	MOV	$TIOSB+2,R0	;GET LENGTH READ
	BEQ	1200$		;IF EQ, NO DATA READ - PROMPT AGAIN
	ADD	#MCRLIN+6,R0	;R0 = A(EOL)
	CLRB	(R0)		;TERMINATE INPUT LINE
1300$:	MOV	#MCRLIN+2,R1	;R1 = A(COMMAND)
	CLR	LBN		;SET BEGINNING LBN
	MOV	#1,LBN+2
	MOV	#NEWLBL+12.,R4	;R4 = A(END OF NEW NAME FIELD)
	MOV	#12.,R0		;R0 = COUNT
1350$:	CLRB	-(R4)		;CLEAR AREA
	SOB	R0,1350$	;LOOP UNTIL DONE
				;R4 = A(NEW NAME AREA)
	CLR	R3		;R3 = 0
1400$:	CALL	GETNXT		;GET NEXT CHARACTER IN BUFFER
	BCS	1600$		;IF CS, EOL - SYNTAX ERROR
	BVC	1400$		;IF VC, NO BLANK SEEN - KEEP LOOKING
	MOV	R1,R2		;R2 = A(NEXT CHARACTER)
	DEC	R2		;R2 = A(DEVICE SPECIFIER)
1500$:	CMPB	#':,R0		;COLON?
	BNE	1700$		;IF NE, NO - CHECK FURTHER
	TST	R3		;COLON ALREADY SEEN?
	BNE	1600$		;IF NE, YES - SYNTAX ERROR
	MOV	R1,R3		;R3 = A(LABEL FIELD)
	BR	1800$		;KEEP SCANNING
1600$:	MSGN$S	PFX,3,M002,,,ABORT ;SYNTAX ERROR
	BR	1200$		;FORCE PROMPT MODE
1700$:	TST	R3		;COLON ALREADY SEEN?
	BEQ	1800$		;IF EQ, NO - KEEP SCANNING
	CMP	R4,#NEWLBL+12.	;LABEL TOO LONG?
	BHIS	1600$		;IF LOS, YES - SYNTAX ERROR
	MOVB	R0,(R4)+	;PUT CHARACTER IN LABEL AREA
1800$:	CALL	GETNXT		;GET NEXT CHARACTER FROM BUFFER
	BCS	1850$		; CARRY SET, EOL SEEN				; JGD01
	CMPB	#'/,R0		;IF A '/' SEEN, GO DECODE SWITCHES		; JGD01
	BNE	1500$		; ELSE CHECK FOR EOL				; JGD01
	CALL	DECODE		; GO DECODE SWITCHES				; JGD01
1850$:	MOV	R2,R0		;R0 = A(DEVICE SPECIFIER)
	MOV	#DEV,R3		;R3 = A(DEVICE ID BUFFER)
	CALL	$FDLOG		;PARSE DEVICE (MCR PARSER)
	BCC	2000$		;IF CC, DEVICE OK SO FAR
	TST	R3		;WHAT TYPE OF ERROR WAS IT
	BEQ	1600$		;IF EQ, SYNTAX ERROR
1900$:	MSGN$S	PFX,3,M003,,,ABORT ;INVALID DEVICE
	BR	1200$		;FORCE PROMPT MODE
2000$:	CALL	$SWSTK,2040$	;SWITCH TO SYSTEM STACK
2020$:	MOV	U.RED(R1),R1	;FOLLOW REDIRECT CHAIN
	CMP	U.RED(R1),R1	;END OF CHAIN?
	BNE	2020$		;IF NE, NO - KEEP LOOKING
	MOV	R1,4(SP)	;SET R1 IN SAVED R1 ON STACK
	RETURN			;RETURN TO USER STATE
2040$:	BIT	#DV.F11,U.CW1(R1) ;FILES 11 DEVICE?
	BEQ	1900$		  ;IF EQ, NO - INVALID DEVICE
	BITB	#US.MNT,U.STS(R1) ;IS IT MOUNTED?
	BEQ	2100$		  ;IF EQ, YES - ALL OK
	MSGN$S	PFX,3,M004,,,ABORT ;DEVICE NOT MOUNTED
2080$:	JMP	1200$		;FORCE PROMPT MODE
2100$:	ALUN$S	#2,DEV,UNIT	;ASSIGN LUN 2 TO DEVICE
	BCC	2200$		;IF CC, LUN ASSIGNED
	CALL	ABORT		;ABORT TASK
2200$:	QIOW$S	#IO.RLB,#2,#1,,#IOSB,,<#HDRBUF,#512.,,LBN,LBN+2> 
	BCC	2400$		;IF CC, NO DIRECTIVE ERROR - CHECK I/O
	CMP	#IE.UPN,$DSW	;INSUFFICIENT DYNAMIC MEMORY?
	BEQ	2300$		;IF EQ, YES - TRY AGAIN
	CALL	ABORT		;ABORT TASK
2300$:	WSIG$S			;GIVE SYSTEM A CHANCE TO FREESOME DSR
	BR	2200$		;TRY AGAIN
2400$:	CMPB	#IS.SUC,IOSB	;READ SUCESSFULL?
	BEQ	2500$		;IF EQ, YES - GO CHANGE LABEL
	MOV	#HBREC,R0	;R0 = A(ERROR CODE FIELD)
	MOV	IOSB,R1		;R1 = ERROR CODE
	MOV	R0,R2		;NO ZERO SUPRESSION
	CALL	$CBOMG		;INSERT ERROR CODE IN MESSAGE
	MSGN$S	PFX,3,M005,,,ABORT ;HEADER BLOCK READ ERROR
	BR	2080$		;FORCE PROMPT MODE
2500$:	MOV	#HDRBUF,R0	;R0 = A(HEADER BUFFER)
	MOV	#H.CHK1/2,R1	;R1 = COUNT OF WORDS TO CHECKSUM
	CALL	CHKSUM		;COMPUTE CHECKSUM
	CMP	R1,(R0)		;DOES IT MATCH HOME BLOCK?
	BNE	2520$		;IF NE, NO - MUST NOT BE HOME BLOCK
	MOV	#HDRBUF,R0	;R0 = A(HOME BLOCK)
	MOV	#H.CHK2/2,R1	;R1 = COUNT OF WORDS TO CHECKSUM
	CALL	CHKSUM		;COMPUTE CHECKSUM
	CMP	R1,(R0)		;DOES IT MATCH HOME BLOCK?
	BEQ	2540$		;IF EQ, YES - THIS MUST BE HOME BLOCK
2520$:	BIC	#377,LBN+2	;MAKE MULTIPLE OF 256.
	ADD	#256.,LBN+2	;BUMP TO NEXT MULTIPLE OF 256.
	ADC	LBN		;DOUBLE PRECISION
	BR	2200$		;TRY AGAIN
2540$:	MOV	#HDRBUF+H.VNAM,R0 ;R0 = A(VOLUME NAME)
	MOV	#NEWLBL,R1	;R1 = A(NEW NAME)
	MOV	#OLDLBL,R2	;R2 = A(OLD NAME FIELD)
	MOV	#12.,R3		;R3 = COUNT
2600$:	MOVB	(R0),(R2)+	;COPY OLD NAME
	MOVB	(R1)+,(R0)+	;INSERT NEW NAME
	SOB	R3,2600$	;LOOP UNTIL DONE
	CALL	DSPVAL		; SET MAXEXT AND LRU				; JGD01
	MOV	#HDRBUF,R0	;R0 = A(HOME BLOCK)
	MOV	#H.CHK1/2,R1	;R1 = COUNT OF WORDS TO CHECKSUM
	CALL 	CHKSUM		;COMPUTE CHECKSUM
	MOV	R1,(R0)		;SET NEW CHECKSUM
	MOV	#HDRBUF,R0	;R0 = A(HOME BLOCK)
	MOV	#H.CHK2/2,R1	;R1 = COUNT OF WORDS TO CHECKSUM
	CALL	CHKSUM		;COMPUTE CHECKSUM
	MOV	R1,(R0)		;SET NEW CHECKSUM
2700$:	TST	SKPFLG		; SHOULD WE SKIP WRITING OUT NEW DATA(DISPLAY ONLY)	; JGD01
	BNE	3000$		; IF SKPFLG SET, ONLY DISPLAY DATA, DON'T TWIDDLE DISK	; JGD01
	QIOW$S	#IO.WLB,#2,#1,,#IOSB,,<#HDRBUF,#512.,,LBN,LBN+2> 
	BCC	2900$		;IF CC, NO DIRECTIVE ERROR
	CMP	#IE.UPN,$DSW	;INSUFFICIENT DYNAMIC MEMORY?
	BEQ	2800$		;IF EQ, YES - TRY AGAIN
	CALL	ABORT		;ABORT TASK
2800$:	WSIG$S			;GIVE SYSTEM A CHANCE TO FREE SOME DSR
	BR	2700$		;GO TRY AGAIN
2900$:	CMPB	#IS.SUC,IOSB	;WRITE SUCESSFULL?
	BEQ	3000$		;IF EQ, YES - GO SEE IF MORE TO DO
	MOV	#HBWEC,R0	;R0 = A(ERROR CODE FIELD)
	MOV	IOSB,R1		;R1 = ERROR CODE
	MOV	R0,R2		;NO ZERO SUPRESSION
	CALL	$CBOMG		;INSERT ERROR CODE
	MSGN$S	PFX,3,M006,,,ABORT ;HEADER BLOCK WRITE ERROR
2950$:	JMP	1200$		;FORCE PROMPT MODE
3000$:	MSGN$S	PFX,0,M007,,,ABORT ;VOLUME NAME CHANGED FROM - TO
	CLR	BUF		; REMOVE <CR><LF> FROM PRINTOUT
	MSGN$S	,0,M008,,,ABORT	; FINISH UP DISPLAY OF INFORMATION			; JGD01
;	TST	PRFLG		;PROMPT MODE?
;	BNE	2950$		;IF NE, YES - GO PROMPT AGAIN
EXIT:	EXIT$S			;EXIT
ABORT:	BPT			;ABORT TASK
	.PAGE
; GETNXT
;
; FUNCTION:	SUBROUTINE TO GET NEXT NON-BLANK CHARACTER FROM THE
;		MCR COMMAND BUFFER.
;
; INPUT:
;
;	R1 = A(NEXT CHARACTER TO SCAN)
;
; OUTPUT:
;
;	R0 = NEXT NON-BLANK CHARACTER
;	R1 = A(NEXT CHARACTER TO SCAN)
;	CC - R0 CONTAINS CHARACTER
;	CS - END OF LINE REACHED
;	VC - NO BLANKS SKIPPED
;	VS - AT LEAST ONE BLANK SKIPPED
;
GETNXT:	CLR	-(SP)		;CLEAR BLANK COUNT
1000$:	MOVB	(R1)+,R0	;R0 = NEXT CHARACTER
	BEQ	1300$		;IF EQ, EOL - GO SET CARRY
	CMPB	#' ,R0		;IS IT A BLANK?
	BNE	1100$		;IF NE, NO - CHECK FURTHER
	INC	(SP)		;BUMP BLANK COUNT
	BR	1000$		;GO GET NEXT CHARACTER
1100$:	CMPB	#15,R0		;CARRIAGE RETURN?
	BEQ	1300$		;IF EQ, YES - GO SET CARRY
	CMPB	#33,R0		;ESCAPE?
	BEQ	1300$		;IF EQ, YES - GO SET CARRY
	CMPB	#' ,R0		;LEGAL CHARACTER?
	BHI	1000$		;IF HI, NO - GO GET ANOTHER ONE
	CMPB	#172,R0		;LEGAL CHARACTER?
	BLO	1000$		;IF LO, NO - GO GET ANOTHER ONE
1200$:	TST	(SP)+		;DID WE SEE A BLANK
	BEQ	1250$		;IF EQ, NO - LEAVE VC
	SEV			;SET OVERFLOW
1250$:	RTS	PC		;RETURN TO CALLER
1300$:	TST	(SP)+		;DID WE SEE ANY BLANKS?
	BEQ	1400$		;IF EQ, NO - LEAVE VC
	SEV			;SET OVERFLOW
1400$:	SEC			;SET CARRY
	RTS	PC		;RETURN TO CALLER
	.PAGE
; CHKSUM
;
; FUNCTION:		SUBROUTINE TO FORM A CHECKSUM OF A VARIABLE NUMBER OF
;			WORDS.  THE CHECKSUM IS COMPATIABLE WITH THAT USED IN
;			FILES 11 HOME BLOCKS.
;
; INPUT:
;
;	R0 = A(AREA TO CHECKSUM)
;
;	R1 = COUNT OF WORDS TO CHECKSUM
;
; OUTPUT:
;
;	R0 = A(NEXT WORD AFTER AREA CHECKSUMMED)
;
;	R1 = COMPUTED CHECKSUM
;
CHKSUM:	CLR	-(SP)		;INITILIZE CHECKSUM
1000$:	ADD	(R0)+,(SP)	;ADD NEXT WORD
	SOB	R1,1000$	;LOOP UNTIL DONE
	MOV	(SP)+,R1	;R1 = COMPUTED CHECKSUM
	RETURN			;RETURN TO CALLER
 

;+										; JGD01
; VALERR- AN ILLEGAL SWITCH NUMERIC VALUE FOUND					; JGD01
;-										; JGD01
VALERR:	MSGN$S	PFX,3,M009,,,ABORT; ILLEGAL SWITCH VALUE FOUND			; JGD01
	JMP	EXIT		; 						; JGD01
 
 
;+										; JGD01
; DSPVAL -- SET LRU ,MAXEXT, WINDOW, FPRO					; JGD02
;										; JGD01
;-										; JGD01
DSPVAL:	MOV	#HDRBUF+H.FIEX,R4; ADRESS OF WHERE MAXEXT BYTE SITS		; JGD01
	TST	EXTFLG		; SHOULD WE INSERT A NEW MAXEXT VALUE		; JGD01
	BEQ	10$		; NO, SKIP OVER					; JGD01
	MOV	#MAXEXT,R0	; GET ADDRESS OF ASCII VALUE			; JGD01
	CALL	$CDTB		; CONVERT TO BINARY, LEAVE RESULT IN R1		; JGD01
	MOVB	R1,(R4)		; INSERT NEW VALUE				; JGD01
	BR	20$		; SKIP ENCODING THE ASCII MAXEXT		; JGD01
10$:	MOV	R4,R0		; RESTORE ADDRESS				; JGD01
	MOVB	(R0),R1		; INSERT MAXEXT BYTE				; JGD01
	MOV	#MAXEXT,R0	; ADDRESS OF WHERE TO STUFF DATA		; JGD01
	CLR	R2		; SUPRESS LEADING ZEROS				; JGD01
	CALL	$CBDMG		; CONVERT TO DECIMAL				; JGD01
 
20$:	MOV	#HDRBUF+H.LRUC,R4 ; ADDRESS OF LRU ENTRY(BYTE)			; JGD01
	TST	LRUFLG		; SHOULD WE INSERT A NEW LRU VALUE		; JGD01
	BEQ	30$		; NO, SKIP OVER					; JGD01
	MOV	#LRU,R0		; ADDRESS OF ASCII LRU VALUE			; JGD01
	CALL	$CDTB		; CONVERT TO BINARY NUMBER			; JGD01
	MOVB	R1,(R4)		; INSERT A NEW VALUE				; JGD01
	BR	40$		; SKIP ENCODING THE ASCII LRU VALUE		; JGD01
30$:	MOV	R4,R0		; RESTORE ADDRESS				; JGD01
	MOVB	(R0),R1		; INSERT LRU BYTE				; JGD01
	MOV	#LRU,R0		; ADDRESS OF WHERE TO STUF DATA			; JGD01
	CLR	R2		; SUPRESS LEADING ZEROS				; JGD01
	CALL	$CBDMG		; CONVERT TO DECIMAL				; JGD01
 
40$:	MOV	#HDRBUF+H.WISZ,R4 ; ADDRESS OF NUMBER OF WINDOW POINTERS	; JGD01
	TST	WINFLG		; SHOULD WE INSERT A NEW WINDOW VALUE		; JGD01
	BEQ	50$		; NO, SKIP OVER					; JGD01
	MOV	#WIN,R0		; GET ADDRESS OF ASCII VALUE			; JGD01
	CALL	$CDTB		; CONVERT TO BINARY, LEAVE RESULT IN R1		; JGD01
	MOVB	R1,(R4)		; INSERT NEW VALUE				; JGD01
	BR	60$		; SKIP ENCODING ASCII WINDOW			; JGD01
50$:	MOV	R4,R0		; RESTORE ADDRESS				; JGD01
	MOVB	(R0),R1		; INSERT DEFAULT WINDOW COUNT			; JGD01
	MOV	#WIN,R0		; ADDRESS OF WHERE TO STUFF DATA		; JGD01
	CLR	R2		; SUPRESS LEADING ZEROS				; JGD01
	CALL	$CBDMG		; CONVERT TO DECIMAL				; JGD01
 
60$:	TST	SKPFLG		; IS THIS A /VI COMMAND				; JGD01
	BEQ	100$		; NO SO EXIT					; JGD01
	MOV	#M007+1+12.,R0	; ADDRESS OF WHERE TO START NULLING OUT		; JGD01
	MOV	#13.,R2		; NUMBER OF SPACES TO NULL OUT			; JGD01
70$:	CLRB	(R0)+		; INSERT A NULL					; JGD01
	SOB	R2,70$		; LOOP UNTIL DONE				; JGD01
	MOV	#OLDLBL+13.,R0	; NULL OUT THE 'TO'				; JGD01
	CLRB	(R0)+		; FIRST CHARACTER				; JGD01
	CLRB	(R0)		; SECOND CHARACTER				; JGD01
	MOV	#NEWLBL,R0	; ZIP OUT ANY NEW LABLE				; JGD01
	MOV	#12.,R2		; 12 CHARACTERS TO REMOVE			; JGD01
80$:	CLRB	(R0)+		; NULL OUT, ONE BYTE AT A TIME			; JGD01
	SOB	R2,80$		; LOOP						; JGD01
	
100$:	MOV	#HDRBUF+H.FMAX,R4; ADDRESS OF MAXIMUM FILES ALLOWED		; JGD01
	MOV	(R4),NUMFIL	; SAVE INITIAL VALUE FOR LATER TESTS		; JGD01
	TST	MAXFLG		; SHOULD WE INSERT A NEW MAX FILE VALUE?	; JGD01
	BEQ	150$		; NO, SKIP OVER					; JGD01
	MOV	#MAXFIL,R0	; ADDRESS  OF ASCII VALUE			; JGD01
	CALL	$CDTB		; CONVERT DECIMAL ASCII TO BINARY IN R1		; JGD01
	CMP	R1,#65535	; IF MXF>65535, ILLEGAL SWITCH VALUE		; JGD01
	BGT	VALERR		; IF GT, ILLEGAL SWITCH VALUE			; JGD01
	CMP	R1,NUMFIL	;  THE NUMBER OF FILES CAN NEVER DECREASE 	; JGD01
	BLT	VALERR		; IF LT, ILLEGAL SWITCH VALUE			; JGD01
	MOV	#HDRBUF+H.IBSZ,R0 ; GET ADDRESS OF SIZE OF BITMAP		; JGD01
	MOV	(R0),R0		; GET SIZE OF BITMAP				; JGD01
	SWAB	R0		; MULTIPLY BY 256				; JGD01
	ASH	#4,R0		; MULTIPLY BY 16				; JGD01
	CMP	R1,R0		; WILL WE BE PAST END OF BITMAP			; JGD01
	BGT	VALERR		; IF GT, YES, ILLEGAL SWITCH VALUE		; JGD01
	MOV	R1,(R4)		; INSERT NEW VALUE				; JGD01
150$:	MOV	R4,R0		; RESTORE R0					; JGD01
	MOV	(R0),R1		; INSERT MAXFIL WORD				; JGD01
	MOV	#MAXFIL,R0	; ADDRESS OF WHERE TO STUFF DATA		; JGD01
	CLR	R2		; SUPRESS LEADING ZEROS				; JGD01
	CALL	$CBDMG		; CONVERT TO DECIMAL				; JGD01
 
200$:	MOV	#HDRBUF+H.VDAT,R0 ; ADDRESS OF VOLUME CREATION DATE		; JGD01
	MOV	#DATE,R1	; ADDRESS OF DATE STRING FOR PRINTING		; JGD01
	MOVB	(R0)+,(R1)+	; MOVE IN THE DAY				; JGD01
	MOVB	(R0)+,(R1)+	; ""    "" "   "				; JGD01
	INC	R1		; BUMP OVER '-'					; JGD01
	MOVB	(R0)+,(R1)+	; NOW MOVE IN THE MONTH				; JGD01
	MOVB	(R0)+,(R1)+	;  "   "    "  "    "				; JGD01
	MOVB	(R0)+,(R1)+	;  "   "    "  "    "				; JGD01
	INC	R1		; BUMP PAST THE '-'				; JGD01
	MOVB	(R0)+,(R1)+	; AND FINALLY GET THE YEAR			; JGD01
	MOVB	(R0)+,(R1)	;  "	"      "   "    "			; JGD01
;300$:	RETURN			; ALL DONE					; JGD01

300$:	MOV	#HDRBUF+H.DFPR,R0 ; GET DEFAULT FILE PROTECTION WORD ADR	; JGD02
	TST	PROFLG		; JUST TO BE SAFE ONLY TWIDDLE IF/FPRO SEEN	; JGD02
	BEQ	305$		; NOT SEEN, SKIP OVER				; JGD02
	MOV	PROWRD,(R0)	; INSERT NEW DEFAULT FILE PROTECTION WORD	; JGD02
305$:	MOV	(R0),R0		; GET DEFAULT FILE PROTECTION WORD		; JGD02
	MOV	#PROTCT,R1	; WHERE WE PUT ASCII STRING			; JGD02
	INC	R1		; BUMP PAST '['					; JGD02
	CALL	SHOWPR		; SHOW SYSTEM PRIVLEGES				; JGD02
	MOVB	#',,(R1)+	; PUT IN COMMA					; JGD02
	CALL	SHOWPR		; SHOW OWNER PRIVLEGES				; JGD02
	MOVB	#',,(R1)+	; PUT IN COMMA					; JGD02
	CALL	SHOWPR		; SHOW GROUP PRIVLEGES				; JGD02
	MOVB	#',,(R1)+	; PUT IN COMMA					; JGD02
	CALL	SHOWPR		; PUT IN WORLD PRIVLEGES			; JGD02
	MOVB	#'],(R1)	; FINALLY CLOSE LINE				; JGD02
	RETURN			; ALL DONE FOR NOW				; JGD02
 
 
 
;+										; JGD02
; SHOWPR - CREATE PROTECTION WORD IN ASCII FROM BINARY VALUE			; JGD02
;										; JGD02
; INPUT: R0 PROTECTION WORD(ONE OF 4 QUADRENTS)					; JGD02
;	 ONLY LOWER 4 BITS SCANNED AT A TIME					; JGD02
; OUTPUT: SHOVES R,W,E,D AS REQUIRED INTO (R1)					; JGD02
; FORMAT  OF DEFAULT FILE PROTECTION WORD					; JGD02
;										; JGD02
;	  WORLD    GROUP    OWNER    SYSTEM					; JGD02
;	------------------------------------					; JGD02
;	!D!E!W!R! D!E!W!R! D!E!W!R! D!E!W!R! 					; JGD02
;       ------------------------------------					; JGD02
; IN EACH CASE AIF A BIT IS SET ACCESS IS DENIED FOR THAT PRIVLEGE		; JGD02
; HENCE PROWRD=0 >[RWED,RWED,RWED,RWED] ACCESS					; JGD02
;       PROWRD=-1 > [,,,,] ACCESS						; JGD02
;-										; JGD02
 
SHOWPR:	BIT	#1,R0		; SEE IF READ ACCESS				; JGD02
	BNE	5$		; IF NE, NO					; JGD02
	MOVB	#'R,(R1)+	; SHOW READ ACCESS				; JGD02
5$:	ROR	R0		; MOVE TO NEXT BIT				; JGD02
	BIT	#1,R0		; IS THERE WRITE ACCESS				; JGD02
	BNE	10$		; IF NE, NO					; JGD02
	MOVB	#'W,(R1)+	; SHOW WRITE ACCESS				; JGD02
10$:	ROR	R0		; NEXT BIT PLEASE				; JGD02
	BIT	#1,R0		; IS THERE EXTEND ACCESS			; JGD02
	BNE	15$		; IF NE, NO					; JGD02
	MOVB	#'E,(R1)+	; SHOW EXTEND ACCESS				; JGD02
15$:	ROR	R0		; NEXT, PLEASE					; JGD02
	BIT	#1,R0		; IS THERE DELETE ACCESS			; JGD02
	BNE	20$		; IF NE, NO, RETURN				; JGD02
	MOVB	#'D,(R1)+	; SHOW DELETE ACCESS				; JGD02
20$:	ROR	R0		; MAKE THINGS EASY FOR NEXT TIME, ROTATE 	; JGD02
	RETURN			; BACK TO MAINLINE				; JGD02

;+										; JGD01
; DECODE - DECODE SWITCHES AFTER TITLE FOUND					; JGD01
;   SUPPORTED SWITCHES								; JGD01
;	/VI	DISPLAY VOLUME CHARACTERISTICS					; JGD01
;	/LRU=NN.	SET NEW VOLUME LRU=NN.					; JGD01
;	/MAXEXT=NN.	SET NEW VOLUME DEFAULT EXTENSION			; JGD01
;	/WINDOW=NN.	SET NEW VOLUME WINDOW					; JGD01
;	/FPRO=[RWED,RWED,RWED,RWED]  DEFAULT FILE PROTECTION WORD		; JGD02
;			SAME USAGE AS WITH INI.TSK				; JGD02
;										; JGD01
;   THE FUNTION OF THIS ROUTINE IS TO SET THE APPROPRIATE FLAG 			; JGD01
;   ( IF A SWITCH IS FOUND) AND THE SYNTAX IS OK.				; JGD01
;   THEN FOR THE NUMERIC SWITCHES, IT PUTS THE ASCII NUMERIC			; JGD01
;   INTO TEMPORARY STORAGE TO AWAIT FOR CONVERSION TO A BINARY BYTE LATER	; JGD01
;										; JGD01
;	FLAGS USED:	SKPFLG	- /VI SWITCH FOUND DO NOT WRITE OUT HOMEBLOCK	; JGD01
;			LRUFLG	- /LRU SWITCH SEEN, MODIFY LRU FOR VOLUME	; JGD01
;			EXTFLG	- /MAXEXT SWITCH SEEN, MODIFY MAXEXT FOR VOLUME	; JGD01
;			WINFLG	- /WINDOW SWITCH SEEN				; JGD01
;			PROFLG  - /FPRO SWITCH SEEN				; JGD02
;										; JGD01
;   THE SWITCH DECODING IS RATHER PRIMATIVE, ONLY THE FIRST TWO LETTERS 	; JGD01
;   ARE CHECKED FOR A MATCH.  IN MOST CASES THIS IS ADEQUATE			; JGD01
;										; JGD02
; INPUT:	R0 - ADDRESS OF NEXT CHARACTER TO BE EXAMINED			; JGD02
;		R1 - MODIFIED BY CALL TO GETNXT					; JGD02
;										; JGD01
;-										; JGD01
DECODE:	CALL	GETNXT		; GET NEXT CHARACTER				; JGD01
	BCS	SYNERR		; CS=> EOL FOUND, SYNTAX ERROR			; JGD01
	CMPB	#'V,R0		; IS THE COMMAND /VI				; JGD01
	BNE	100$		; NO, CHECK AGAIN				; JGD01
	CALL	GETNXT		; LETS SEE IF WE HAVE A /VI			; JGD01
	BCS	SYNERR		; CS=>EOL, EOL HERE IS BAD			; JGD01
	CMPB	#'I,R0		; IS IT AN 'I'					; JGD01
	BNE	SYNERR		; IF NE, NO, SYNTAX ERROR			; JGD01
	INC	SKPFLG		; YES, DON'T TWIDDLE WITH HOME BLOCK		; JGD01
	CALL	GETNXT		; GET CHARACTER					; JGD01
	BCS	40$		; CS=> EOL, ALL SWITCHES FOUND, SO EXIT		; JGD01
	CMPB	#'/,R0		; MAYBE MORE SWITCHES FOLLOW, IF SO NEED A '/'	; JGD01
	BNE	SYNERR		; IF NE, BAD SYNTAX, SWITCHES NEED A  '/'	; JGD01
	BR	DECODE		; AND CONTINUE TO DECODE THE LINE		; JGD01
40$:	RETURN			; CS=> EOL RETURN TO CALLER			; JGD01
100$:	CMPB	#'L,R0		; IS IT AN 'L', (MAYBE LRU?)			; JGD01
	BNE	200$		; NO, CHECK FOR MAXEXT=				; JGD01
	CALL	GETNXT		; CHECK FOR 'R' IN 'LRU'			; JGD01
	CMPB	#'R,R0		; IS IT AN 'R'					; JGD01
	BNE	SYNERR		; NO, SYNTAX ERROR				; JGD01
	MOV	#2,R3		; ONLY GET TWO DIGITS				; JGD01
	MOV	#LRU,R4		; ADDRESS OF WHERE TO PUT DATA			; JGD01
	INC	LRUFLG		; SHOW /LRU= SEEN				; JGD01
	BR	1000$		; LOOP THROUGH COMMON CODE			; JGD01
200$:	CMPB	#'M,R0		; IS IT AN 'M', (MAXEXT MAYBE)			; JGD01
	BNE	300$		; IF NE, NO, CHECK FOR /WINDOW			; JGD01
	CALL	GETNXT		; CHECK FOR 'A'					; JGD01
	CMPB	#'A,R0		; IS IT AN 'A',(IN MAXEXT)?			; JGD01
	BNE	400$		; NO, CHECK FOR /MXF 				; JGD01
	MOV	#2,R3		; ONLY ALLOW FOR TWO DECIMAL DIGITS		; JGD01
	MOV	#MAXEXT,R4	; ADDRESS OF WHERE TO PUT DATA			; JGD01
	INC	EXTFLG		; SHOW /MAXEXT=SEEN				; JGD01
	BR	1000$		; LOOP THROUGH COMMON CODE			; JGD01
300$:	CMPB	#'W,R0		; IS IT A 'W' (MAYBE WINDOW)			; JGD01
;	BNE	SYNERR		; NO, SYNTAX ERROR				; JGD01
	BNE	500$		; CHECK FOR /FPRO				; JGD02
	CALL	GETNXT		; CHECK FOR SPELLING				; JGD01
	CMPB	#'I,R0		; IS IT AN 'I' (IN WINDOW)			; JGD01
	BNE	SYNERR		; NO, SYNTAX ERROR				; JGD01
	MOV	#2,R3		; ALLOW ONLY TWO CHARACTERS			; JGD01
	MOV	#WIN,R4		; ADDRESS OF WERE TO PUT DATA			; JGD01
	INC	WINFLG		; SHOW WE HAVE SEEN /WINDOW=			; JGD01
	BR	1000$		; AND LOOP THROUGH COMMON CODE			; JGD01
 

400$:	CMPB	#'X,R0		; IS IT /MXF?					; JGD01
	BNE	SYNERR		; IF NE, NO, BAD SYNTAX				; JGD01
	MOV	#5,R3		; ONLY ALOW FOR FIVE DECIMAL DIGITS		; JGD01
	MOV	#MAXFIL,R4	; ADDRESS OF WHERE TO PUT DATA			; JGD01
	INC	MAXFLG		; SHOW /MXF SEEN				; JGD01
	BR	1000$		; LOOP THROUGH COMMON CODE			; JGD01
 
500$:	CMPB	#'F,R0		; MAYBE ITS /FPRO				; JGD02
	BNE	SYNERR		; IF NE, NO, SYNTAX ERROR(SINCE LAST IN LIST)	; JGD02
	CALL	GETNXT		; GET NEXT CHARACTER				; GJD02
	CMPB	#'P,R0		; IS IT /FPRO?					; JGD02
	BNE	SYNERR		; IF NE, NO, SYNTAX ERROR			; JGD02
	INC	PROFLG		; SHOW /FPRO SWITCH SEEN			; JGD02
	CALL	STUFIT		; INSERT [RWED,......] IF SEEN			; JGD02
	CALL	GETNXT		; GET ANOTHER CHARACTER				; JGD02
	BCS	550$		; EOL HERE IS OK, RETURN			; JGD02
	CMPB	#'/,R0		; IS THERE ANOTHER SWITCH			; JGD02
	BNE	SYNERR		; IF NE, SYNTAX ERROR				; JGD02
	JMP	DECODE		; ELSE BACK FOR MORE				; JGD02
550$:	RETURN			; ALL DONE					; JGD02
 
1000$:	CALL	GETNUM		; GET NUMBER AND CONVERT IT			; JGD01
	BCS	40$		; EOL HERE OK, RETURN				; JGD01
	CMPB	#'/,R0		; MAYBE ANOTHER SWITCH				; JGD01
	BNE	SYNERR		; NO SYNTAX ERROR				; JGD01
	JMP	DECODE		; YES, SCAN FOR MORE				; JGD01
 
 
SYNERR:	MSGN$S	PFX,3,M002,,,ABORT; SYNTAX ERROR				; JGD01
	JMP	EXIT		; AND EXIT					; JGD01
 
;
GETNUM:	CALL	GETNXT		; GET ANOTHER CHARACTER				; JGD01
	BCS	SYNERR		; EOL HERE IS SYNTAX ERROR			; JGD01
	CMPB	#'/,R0		; IS IT '/'					; JGD01
	BEQ	SYNERR		; IF EQ SYNTAX ERROR				; JGD01
	CMPB	#'=,R0		; FOUND '=' YET					; JGD01
	BNE	GETNUM		; NO, TRY AGAIN					; JGD01
	CALL	GETNXT		; GET ONE MORE CHARACTER			; JGD01
	BCS	SYNERR		; EOL HERE (AFTER =) IS SYNTAX ERROR		; JGD01
10$:	MOVB	R0,(R4)+	; INSERT 1ST CHARACTER(LATER CHECK FOR  #'S)	; JGD01
	CMPB	R0,#48.		; CHECK TO BE SURE INPUT IS NUMERIC		; JGD01
	BLT	NUMERR		; IF LT, NON NUMERIC ASCII CHARACTER FOUND	; JGD01
	CMPB	R0,#57.		; MAYBE ITS>9					; JGD01
	BGT	NUMERR		; IF GT, ERROR INPUT CHARACTER >9		; JGD01
	CALL	GETNXT		; TRY FOR ANOTHER CHARACTER( EOL OK NOW)	; JGD01
	BCS	20$		; ANOTHER CHARACTER OK, GET OUT OF LOOP		; JGD01
	CMPB	#'/,R0		; HAVE WE RUN INTO ANOTHER 			; JDG01
	BEQ	20$		; IF EQ, YES, GO TRY AND DECODE MORE		; JGD01
	SOB	R3,10$		; DECREMENT CHARACTER COUNTAND LOOP TILL DONE	; JGD01
	CALL	GETNXT		; CHECK TO SEE IF AT END OF LINE YET		; JGD01
20$:	RETURN			; ONE WAY OR OTHER ARE DONE			; JGD01
 
;+
; NUMERR - NON NUMERIC ASCII CHARACTER DETECTED					; JGD01
;-										; JGD01
NUMERR:	MSGN$S	PFX,3,M010,,,ABORT ; ILLEGAL CHARACTER DETECTED			; JGD01
	JMP	EXIT		; 						; JGD01
 
 
;+										; JGD02
; STUFIT									; JGD02
; CHECK FOR SYNTAX IN [RWED,RWED,RWED,RWED] AND INSERT IT INTO PROWRD		; JGD02
;-										; JGD02
STUFIT:										; JGD02
	CLR	R3		; USE R4 TO COUNT # OF ROR'S			; JGD02
10$:	CALL	GETNXT		; NEXT CHARACTER				; JGD02
	BCS	SYNERR		; EOL, A SYNTAX ERROR HERE			; JGD02
	CMPB	#'/,R0		; A '/' IS ALSO SYNTAX ERROR HERE		; JGD02
	BEQ	SYNERR		; IF EQ, ERROR					; JGD02
	CMPB	#'[,R0		; HAVE WE FOUND '[' YET				; JGD02
	BNE	10$		; IF NE, NO, TRY AGAIN				; JGD02
15$:	CALL	GETNXT		; NEXT CHARACTER				; JGD02
	BCS	SYNERR		; EOL IS SYNTAX ERROR UNTIL ] FOUND		; JGD02
	CMPB	#'/,R0		; NO BACK SLASHES UNTIL ] FOUND			; JGD02
	BEQ	SYNERR		; IF EQ, SYNTAX ERROR				; JGD02
	CMPB	#'R,R0		; AN 'R'					; JGD02
	BNE 	20$		; IF NE,NO					; JGD02
	BIC	#1,PROWRD	; SET BIT TO SHOW FOUND				; JGD02
	BR	15$		; ENCODE SOME MORE				; JGD02
20$:				; REF LABLE					; JGD02
	CMPB	#'W,R0		; WRITE ACCESS					; JGD02
	BNE	30$		; NO						; JGD02
	BIC	#2,PROWRD	; SO SET BIT TO SHOW 				; JGD02
	BR	15$		; ENCODE SOME MORE				; JGD02
30$:				; REF LABLE					; JGD02
	CMPB	#'E,R0		; IS IT EXTEND					; JGD02
	BNE	40$		; IF NE ,CHECK FOR DELETE			; JGD02
	BIC	#4,PROWRD	; SHOW EXTEND PRIVLEGE				; JGD02
	BR	15$		; ENCODE SOME MORE				; JGD02
40$:				; REF LABLE					; JGD02
	CMPB	#'D,R0		; DELETE ACCESS?				; JGD02
	BNE	50$		; NO CHECK FOR COMMA				; JGD02
	BIC	#10,PROWRD	; SHOW DELETE ACCESS				; JGD02
	BR	15$		; ENCODE SOME MORE				; JGD02
50$:	CMPB	#',,R0		; IS IT ','					; JGD02
	BEQ	60$		; ',' AND ']' ARE ONLY LEGAL TERMINATORS	; JGD02
	CMPB	#'],R0		; SINCE THEY SIGNIFY MORE OR END OF SCAN	; JGD02
	BEQ	70$		; REQUIRED SYNTAX TO END /FPRO SWITCH		; JGD02
	JMP	SYNERR		; ELSE SYNTAX ERROR				; JGD02
 
60$:				; IF ',' FOUND, PLACE LOW ORDER 4 BITS INTO THE ; JGD02
				; UPPER 4 BITS OF PROWRD			; JGD02
	MOV	#4,R4		; SET UP FOR 4 SHIFTS				; JGD02
63$:	CLC			; FISRT CLEAR CARRY				; JGD02
	BIT	#1,PROWRD	; SHOULD WE COPY LOW BIT TO CARRY		; JGD02
	BEQ	65$		; LOW BIT A ZERO, DON'T NEED TO SET CARRY	; JGD02
	SEC			; LOW BIT A 1, MUST SET CARRY			; JGD02
65$:	ROR	PROWRD		; SHIFT ONCE					; JGD02
	SOB	R4,63$		; DO 4 TIMES					; JGD02
	INC	R3		; KEEP TRACK OF # OF COMMAS FOUND		; JGD02
	JMP	15$		; AND LOOK FOR MORE				; JGD02
 
70$:				; FOR LAST TIME PLACE LOW ORDER 4 BITS INTO	; JGD02
				; HIGH ORDER 4 BITS OF PROWRD			; JGD02
	CMP	#3,R3		; MUST HAVE 3 COMMAS				; JGD02
	BEQ	71$		; IF EQ, SYNTAX OK				; JGD02
	JMP	SYNERR		; ELSE SYNTAX ERROR				; JGD02
71$:	MOV	#4,R4		; SET FOR 4 SHIFTS				; JGD02
73$:	CLC			; FIRST CLEAR CARRY				; JGD02
	BIT	#1,PROWRD	; SHOULD WE COPY LOW BIT TO CARRY?		; JGD02
	BEQ	75$		; LOW BIT A ZERO, DON'T NEED TO CARRY		; JGD02
	SEC 			; LOW BIT A 1, MUST SET CARRY			; JGD02
75$:	ROR	PROWRD		; SHIFT ONCE					; JGD02
	SOB	R4,73$		; DO IT 4 TIMES					; JGD02
	RETURN			; AND GO BACK					; JGD02

	.SBTTL	MSGGEN - MESSAGE TRAP ROUTINE
	.PSECT	MSGGEN
;+
; AUTHOR:	H. L. COLEMAN
;		MILLIKEN AND COMPANY
;		P. O. BOX 1926
;		MAIL STOP M-103
;		SPARTANBURG, S. C. 29304
;		(803)573-2556
;
; DATE:		23-JAN-78
;
; VERSION:	02.00
;
; MODIFIED:
;
; FUNCTION:	THIS ROUTINE IS CALLED TO CONSTRUCT A MESSAGE FROM
;		SEVERAL NON CONTIGUOUS PIECES, PRINT THE MESSAGE ON
;		THE TERMINAL SPECIFIED, AND OPTIONALLY READ A RESPONSE
;		FROM THAT TERMINAL. THE FORMAT OF THE MESSAGE IS:
;
;		PREFIX < !WARNING!SERIOUS! FATAL !>TEXT [RESPONSE]
;
;		EACH MESSAGE IS PRECEEDED BY A CARRIAGE RETURN LINE
;		FEED, AND THE MESSAGE (OR RESPONSE) IS FOLLOWED BY
;		A CARRIAGE RETURN LINE FEED.  THE TERMINAL IS ATTACHED
;		BEFORE THE MESSAGE IS WRITTEN AND DETACHED AFTER THE
;		RETURNING TO THE USER IF IT WAS NOT ATTACHED PRIOR TO
;		ENTRY.  IF A REPLY IS REQUESTED, THE READ AFTER PROMPT
;		I/O FUNCTION IS USED.
;
;		TWO MACROS ARE PROVIDED TO INTERFACE WITH THIS ROUTINE.
;		THE FIRST IS USED TO INITILIZE THIS ROUTINE OR TO CHANGE
;		THE INITILIZATION PARAMETERS. THE FORMAT OF THIS MACRO
;		IS:
;
;		MINIT$S	LUN,EFN
;
;		EXPANSION:
;
;		MOV	LUN,$TMLUN	;SET LUN
;		MOV	EFN,$TMEFN	;SET EFN
;
;		WHERE:
;
;		LUN IS THE LOGICAL UNIT NUMBER WHICH IS ASSIGNED TO
;		TO THE TERMINAL DEVICE ON WHICH MESSAGES ARE TO
;		APPEAR.
;
;			DEFAULT:	5
;
;
;		EFN IS AN EVENT FLAG NUMBER WHICH MAY BE USED BY THIS
;		ROUTINE.
;
;			DEFAULT:	24.
;
;		IF THE DEFAULTS FOR LUN AND EFN ARE ACCEPTABLE, THE
;		MINIT$ MACRO DOES NOT HAVE TO BE ISSUED.
;
;
;		THE SECOND MACRO IS USED TO ISSUE THE TRAP INSTRUCTION
;		AND GENERATE THE APPROPRIATE PARAMETER LIST.
;		THE FORMAT OF THIS MACRO IS:
;
;		MSGN$S	[PFX],[SEV],[MSG],[REP],[LEN],[ERR]
;
;		EXPANSION:
;
;		JSR	R5,$MSGEN	;GO TO MESSAGE GEN ROUTINE
;		.WORD	PFX		;A(MESSAGE PREFIX)
;		.WORD	SEV		;SEVERITY CODE
;		.WORD	MSG		;A(MESSAGE TEXT)
;		.WORD	REP		;A(REPLY AREA)
;		.WORD	LEN		;REPLY LENGTH
;		BCC	.+N		;BRANCH IF NO ERRORS
;		CALL	ERR		;CALL USER ERROR ROUTINE
;
;		WHERE:
;
;		PFX IS THE ADDRESS OF THE MESSAGE PREFIX. THE FORMAT
;		OF THE MESSAGE PREFIX IS:
;
;		.BYTE	LEN	;LENGTH OF MESSAGE
;		.ASCII	/MESSAGE TEXT/
;
;		SEV IS THE SEVERITY LEVEL OF THIS MESSAGE. SEV MUST BE
;		IN THE RANGE 0-3.  THE VARIOUS SEVERITY LEVELS AND THEIR
;		MEANINGS ARE:
;
;		0 -	NO SEVERITY TEXT APPEARS IN MESSAGE.
;		1 -	"WARNING", APPEARS IN MESSAGE.
;		2 -	"SERIOUS" APPEARS IN MESSAGE
;		3 -	"FATAL" APPEARS IN MESSAGE.
;
;		MSG IS THE ADDRESS OF THE MESSAGE TEXT PROPER.  THE
;		FORMAT OF THE MESSAGE TEXT IS IDENTICAL TO THE MESSAGE
;		PREFIX.
;
;		REP IS THE ADDRESS OF THE REPLY BUFFER.  IF REP IS
;		SPECIFIED, THEN LEN MUST BE SPECIFIED, AND BE GREATER
;		THAN ZERO. REP MUST BE ONE BYTE LONGER THAN LEN TO ALLOW
;		FOR THE TERMINATOR (BINARY ZERO).
;
;		LEN IS THE REPLY LENGTH.
;
;	
;		ERR IS THE ADDRESS OF THE ROUTINE TO BE GIVEN CONTROL
;		IF ANY ERROR (RETURN WITH CS) IS DETECTED.  IF NOT
;		SPECIFIED, RETURN IS IN LINE.
;
	.PAGE
	.MCALL	WSIG$S,QIOW$S,QIO$S
$TMLUN::.WORD	5		;LUN
LUN=$TMLUN
$TMEFN::.WORD	24.		;EVENT FLAG
EFN=$TMEFN
$TIOSB::.WORD	0,0		;IOSB FOR TERMINAL I/O
ATTFLG:	.WORD	0		;ATTACH FLAG
BUF:	.ASCII	<15><12>	;MESSAGE BUFFER
BUF1:	.BLKW	66.
WARN:	.ASCII	/WARNING /
	.ASCII	/SERIOUS /
	.ASCII	/*FATAL* /
	.PAGE
;
; MSGGEN ROUTINE
;
; FUNCTION:	GENERATE AND PRINT THE MESSAGE, AND OPTIONALLY READ A
;		RESPONSE.
;
; INPUT:
;
;	R5+ 0 = A(PREFIX)
;	R5+ 2 = SEVERITY CODE
;	R5+ 4 = MESSAGE TEXT
;	R5+ 6 = A(REPLY BUFFER)
;	R5+10 = REPLY LENGTH
;
; OUTPUT:
;
;	MESSAGE IS PRINTED, AND REPLY READ IF REQUESTED.
;
;	IF CC, NO ERRORS DETECTED, $TIOSB CONTAINS STATUS OF IO.WLB
;	OR IO.RPR.
;
;	IF CS, ERROR DETECTED, $DSW OR $TIOSB CONTAINS ERROR STATUS.
$MSGEN::CLR	-(SP)		;CLEAR ERROR INDICATOR
	MOV	R0,-(SP)	;SAVE REGISTERS
	MOV	R1,-(SP)
	MOV	R2,-(SP)
	MOV	R3,-(SP)
	MOV	R4,-(SP)
	MOV	#BUF1,R0	;R0 = A(MESSAGE BUFFER)
	MOV	(R5)+,R1	;R1 = A(MESSAGE PREFIX)
	BEQ	1200$		;IF EQ, NO PREFIX
	MOVB	(R1)+,R2	;R2 = PREFIX LENGTH
1100$:	MOVB	(R1)+,(R0)+	;MOVE PREFIX
	SOB	R2,1100$	;LOOP UNTIL DONE
	MOVB	#' ,(R0)+	;INSERT BLANK
1200$:	MOV	(R5)+,R1	;R1 = SEVERITY LEVEL
	BEQ	1400$		;IF EQ, LEVEL ZERO - NOTHING TO DO
	DEC	R1		;MINUS ONE
	ASL	R1		;TIMES 2
	ASL	R1		;TIMES 4
	ASL	R1		;TIMES 8
	ADD	#WARN,R1	;R1 = A(SEVERITY TEXT)
	MOV	#7,R2		;R2 = COUNT
1300$:	MOVB	(R1)+,(R0)+	;MOVE SEVERITY TEXT
	SOB	R2,1300$	;LOOP UNTIL DONE
	MOVB	#' ,(R0)+	;INSERT BLANK
1400$:	MOV	(R5)+,R1	;R1 = A(MESSAGE TEXT)
	BEQ	1600$		;IF EQ, NO TEXT
	MOVB	(R1)+,R2	;R2 = LENGTH
1500$:	MOVB	(R1)+,(R0)+	;COPY MESSAGE TEXT
	SOB	R2,1500$	;LOOP UNTIL DONE
1600$:	MOV	(R5)+,R1	;R1 = A(REPLY BUFFER)
	MOV	(R5)+,R2	;R2 = REPLY LENGTH
	SUB	#BUF,R0		;R0 = MESSAGE LENGTH
	QIOW$S	#IO.ATT,LUN,EFN,,#$TIOSB ;ATTACH TERMINAL
	CLR	ATTFLG		;CLEAR FLAG
	CMPB	#IE.DAA,$TIOSB	;DEVICE ALREADY ATTACHED?
	BEQ	1700$		;IF EQ, YES - DON'T DETACH WHEN THROUGH
	DEC	ATTFLG		;SET FLAG
1700$:	TST	R1		;REPLY REQUESTED?
	BNE	2000$		;IF NE, YES - GO DO IT
	QIOW$S	#IO.WVB,LUN,EFN,,#$TIOSB,,<#BUF,R0> ;SEND MSG.
1800$:	BCC	2100$		;IF CC, NO DIRECTIVE ERROR
	CMP	#IE.UPN,$DSW	;INSUFFICIENT DYNAMIC MEMORY?
	BEQ	1900$		;IE EQ, YES - TRY AGAIN
	BIS	#1,10.(SP)	;SET CARRY IN RETURN PS
	BR	2300$		;EXIT
1900$:	WSIG$S			;REST A SECOND
	BR	1700$		;TRY AGAIN
2000$:	QIOW$S	#IO.RPR,LUN,EFN,,#$TIOSB,,<R1,R2,,#BUF,R0> ;SEND MSG.
	BR	1800$		;GO CHECK STATUS
2100$:	TSTB	$TIOSB		;SUCESSFULL?
	BPL	2200$		;IF PL, YES - LEAVE CARRY CLEAR
	CMPB	#IE.EOF,$TIOSB	;CTRL/Z ENTERED?
	BEQ	2200$		;IF EQ, YES - CONSIDER SUCESSFULL
	BIS	#1,10.(SP)	;SET CARRY IN RETURN PS
2200$:	QIO$S	#IO.WVB,LUN,,,,,<#BUF,#2> ;SEND CR/LF
	TST	R1		;REPLY REQUESTED?
	BEQ	2300$		;IF EQ, NO
	ADD	$TIOSB+2,R1	;R1 = A(OF TERMINATOR)
	CLRB	(R1)		;INSERT TERMINATOR
	INC	$TIOSB+2	;ACCOUNT FOR TERMINATOR IN LENGTH
2300$:	QIOW$S	#IO.DET,LUN,EFN	;DETACH TERMINAL
	MOV	(SP)+,R4
	MOV	(SP)+,R3
	MOV	(SP)+,R2
	MOV	(SP)+,R1
	MOV	(SP)+,R0
	ROR	(SP)+		;SET CARRY IF ERROR OCCURED
	RTS	R5		;RETURN TO USER
	.END	CVL