.TITLE	CVL - CHANGE VOLUME LABEL
	.IDENT	/01.30/
	.ENABLE	LC
;
; 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
; Modified:	P.A. Stephensen-Payne	SYSTIME	25-Jun-80
;	        c/o Systime Ltd.,
;	        Concourse Computer Centre,
;	        432 Dewsbury Road,
;	        LEEDS LS11 7DF,
;	        England.
;

;
;		Made non-privileged to avoid need to rebuild every SYSGEN.
;		Tidied up User Interface
;		Fixed /MXF switch to work meaningfully
;
; 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	= NNNN	- CHANGE THE MAXIMUM NUMBER OF FILES ALLOWED ON A VOLUME
;			  (ONLY INCREASES UPWARD ARE ALLOWED - to a Maximum
;			  of 4096 * Number of Blocks in Bitmap File)
;			  (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$,MRKT$S,CMKT$S
	.MCALL	ALUN$S,GLUN$S,SPWN$,WTSE$S
	.MCALL	HMBOF$,UCBDF$
	UCBDF$			; Define UCB offsets
	HMBOF$			;DEFINE HOME BLOCK OFFSETS
	.NLIST	BEX
	.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	/PRIVILEGE 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 =/			
MAXEXT:	.ASCII	/     /						
	.ASCII	<15><12>/	LRU =/				
LRU:	.ASCII	/     /						
	.ASCII	<15><12>/	WINDOWS =/			
WIN:	.ASCII	/     /						
	.ASCII	<15><12>/	MAXFILES=/			
MAXFIL:	.ASCII	/     /						
M008:	.BYTE	M009-M008-1					
	.ASCII	/        FPRO=/				
PROTCT:	.ASCII	/[                    /				
	.ASCII	<15><12>/	CREATION DATE: /		
DATE:	.ASCII	/DD-MMM-YY/					
M009:	.BYTE	M010-M009-1					
	.ASCII	/ILLEGAL SWITCH VALUE/				
M010:	.BYTE	M011-M010-1					
	.ASCII	/NON NUMERIC INPUT CHARACTER/			
M011:	.BYTE	0						
	.EVEN
	.PAGE
	.LIST	BEX
; CONSTANTS AND WORK AREAS.
;
MCRLIN:	GMCR$			;MCR COMMAND BUFFER
	.WORD	0		;BUFFER PAD
LUNBUF:	.BLKW	6		; GLUN$ Buffer
DEV:	.ASCII	/  /		;DEVICE NAME
UNIT:	.WORD	0		;UNIT NUMBER
EXTFLG:	.WORD	0		; /MAXEXT=NNN SEEN		
WINFLG:	.WORD	0		; /WINDOW=NNN SEEN (=1)		
LRUFLG:	.WORD	0		; /LRU=NNN SEEN(=1)		
MAXFLG:	.WORD	0		; /MXF=NNNNN SEEN? (=1)		
PROFLG:	.WORD	0		; /FPRO =[RWED,...] SEEN? (=1)	
PROWRD:	.WORD	-1		; DEFAULT FILE PROTECTION MASK	
SKPFLG:	.WORD	0		;  /VI  SEEN, DISPLAY DATA BUT DO NOT CHANGE
NUMFIL:	.WORD	0		; TEMP STORAGE FOR USE WITH /MXF=NNN
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
HLSPWN:	SPWN$	MCR...,,,,,1,,,HELCMD,HELCML
HELCMD:	.ASCII	/HELP CVL/
HELCML=.-HELCMD
	.EVEN
	.PAGE
	.ENABLE	LSB
CVL:
	ALUN$S	#1,#"TI,#0	; Assign LUN 1 to TI:
	GLUN$S	#1,#LUNBUF	; Get information about it
	BIT	#U2.PRV,LUNBUF+6	; Terminal privileged?
;***	MOV	$TKTCB,R1	;R1 = A(MY TCB)
;***	MOV	T.UCB(R1),R0	;R0 = A(TI: UCB)
;***	BIT	#U2.PRV,U.CW2(R0) ;IS USER PRIVILEGED?
	BNE	1100$		;IF NE, YES - CONTINUE
	MSGN$S	PFX,3,M001,,,ABORT ;PRIVILEGE 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
	CMP	R0,#1		; Just the terminator?
	BEQ	1200$		;IF EQ, NO DATA READ - PROMPT AGAIN
	MOV	#MCRLIN+6,R1	; Get address of input
;
1250$:
	CMPB	(R1),#141	; Is it lower-case Alphabetic?
	BLT	1260$		; If LT no - check next
	CMPB	(R1),#172	; Sure?
	BGT	1260$		; If GT no - check next
	BICB	#40,(R1)	; Yes - set to upper case
;
1260$:
	INC	R1		; set to next char
	SOB	R0,1250$	; and check it
	CLRB	(R1)		;TERMINATE INPUT LINE
	MOV	#MCRLIN+6,R1	; Omit the prompt
	BR	1320$		; and parse the rest
1300$:
	MOV	#MCRLIN+2,R1	;R1 = A(COMMAND)
	MOV	$DSW,R0		; Get number of chars
;
1310$:
	CMPB	(R1)+,#40	; A blank?
	BEQ	1320$		; If eq yes - carry on
	SOB	R0,1310$	; No - keep going
	BR	1200$		; Just the name - do a prompt
;
1320$:
	DEC	R1		;Point to a blank
	CLR	EXTFLG		; Clear all the flags
	CLR	WINFLG		;
	CLR	LRUFLG		;
	CLR	MAXFLG		;
	CLR	PROFLG		;
	CLR	SKPFLG		;
	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
	BEQ	1600$		;IF EQ, 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)
	CMPB	#'/,R0		; / already? (/HE)
	BEQ	1825$		; yes - decode it
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
1650$:
NEXT:
	TST	PRFLG		; Prompting?
	BNE	1200$		; If NE yes - get the next line
	BR	1000$		; No - exit
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
	BEQ	1850$		; ZERO SET, EOL SEEN		
	CMPB	#'/,R0		;IF A '/' SEEN, GO DECODE SWITCHES
	BNE	1500$		; ELSE CHECK FOR EOL		
;
1825$:
	CALL	DECODE		; GO DECODE SWITCHES		
	BCC	1850$		; If CC OK - Carry on
	JMP	1650$		; Else reprompt or exit
1850$:	MOV	R2,R0		;R0 = A(DEVICE SPECIFIER)
	MOV	#DEV,R3		;R3 = A(DEVICE ID BUFFER)
	MOVB	(R0)+,(R3)+	; Insert the device name
	MOVB	(R0)+,(R3)+	;
	CALL	$COTB		; Convert Unit Number
	MOV	R1,(R3)+	; Store it
;***	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
	CMP	R2,#':		; Did it stop at the right place?
	BEQ	2100$		; If eq yes - OK
1900$:	MSGN$S	PFX,3,M003,,,ABORT ;INVALID DEVICE
	BR	1650$		;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	1650$		;FORCE PROMPT MODE
2100$:
	ALUN$S	#2,DEV,UNIT	;ASSIGN LUN 2 TO DEVICE
	BCS	1900$		; If CS error - invalid device
;
2200$:
	GLUN$S	#2,#LUNBUF	; Get some information about the LUN
	BIT	#40000,LUNBUF+4	; Device mountable as a Files-11 Device?
	BEQ	1900$		; If EQ no - error
	MRKT$S	#1,#5,#2	; Mark Time (to kill attach)
	QIOW$S	#IO.ATT,#2,#1,,#IOSB	; Try to attach the device
	CMPB	IOSB,#IE.PRI	; Was the I/O rejected?
	BEQ	2250$		; If EQ yes - OK
	CMKT$S			; No - cancel the Mark Time
	MSGN$S	PFX,3,M004,,,ABORT	; Device not Mounted
	BR	1650$		;
;
2250$:
	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
	JMP	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		
	BCC	2650$		; If CC OK - Carry on
	JMP	1650$		; Else re-prompt
;
2650$:
	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)
	BNE	3000$	; IF SKPFLG SET, ONLY DISPLAY DATA, DON'T TWIDDLE DISK
	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	1650$		;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	
	BR	2950$		;IF NE, YES - GO PROMPT AGAIN
ABORT:	BPT			;ABORT TASK
	.DSABL	LSB
	.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)
;	ZC - R0 CONTAINS CHARACTER
;	ZS - 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 ZERO
	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 ZERO
	CMPB	#33,R0		;ESCAPE?
	BEQ	1300$		;IF EQ, YES - GO SET ZERO
	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$:	CLZ			; Clear Zero
	RTS	PC		;RETURN TO CALLER
1300$:	TST	(SP)+		;DID WE SEE ANY BLANKS?
	BEQ	1400$		;IF EQ, NO - LEAVE VC
	SEV			;SET OVERFLOW
1400$:	SEZ			;SET ZERO
	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
 
;+								
; DSPVAL -- SET LRU ,MAXEXT, WINDOW, FPRO			
;								
;-								
DSPVAL:	MOV	#HDRBUF+H.FIEX,R4; ADRESS OF WHERE MAXEXT BYTE SITS
	TST	EXTFLG		; SHOULD WE INSERT A NEW MAXEXT VALUE
	BEQ	10$		; NO, SKIP OVER			
	MOV	#MAXEXT,R0	; GET ADDRESS OF ASCII VALUE	
	CALL	$CDTB		; CONVERT TO BINARY, LEAVE RESULT IN R1
	MOVB	R1,(R4)		; INSERT NEW VALUE		
	BR	20$		; SKIP ENCODING THE ASCII MAXEXT
10$:	MOV	R4,R0		; RESTORE ADDRESS		
	MOVB	(R0),R1		; INSERT MAXEXT BYTE		
	MOV	#MAXEXT,R0	; ADDRESS OF WHERE TO STUFF DATA
	CLR	R2		; SUPRESS LEADING ZEROS		
	CALL	$CBDMG		; CONVERT TO DECIMAL		
 
20$:	MOV	#HDRBUF+H.LRUC,R4 ; ADDRESS OF LRU ENTRY(BYTE)	
	TST	LRUFLG		; SHOULD WE INSERT A NEW LRU VALUE
	BEQ	30$		; NO, SKIP OVER			
	MOV	#LRU,R0		; ADDRESS OF ASCII LRU VALUE	
	CALL	$CDTB		; CONVERT TO BINARY NUMBER	
	MOVB	R1,(R4)		; INSERT A NEW VALUE		
	BR	40$		; SKIP ENCODING THE ASCII LRU VALUE
30$:	MOV	R4,R0		; RESTORE ADDRESS		
	MOVB	(R0),R1		; INSERT LRU BYTE		
	MOV	#LRU,R0		; ADDRESS OF WHERE TO STUF DATA	
	CLR	R2		; SUPRESS LEADING ZEROS		
	CALL	$CBDMG		; CONVERT TO DECIMAL		
 
40$:	MOV	#HDRBUF+H.WISZ,R4 ; ADDRESS OF NUMBER OF WINDOW POINTERS
	TST	WINFLG		; SHOULD WE INSERT A NEW WINDOW VALUE
	BEQ	50$		; NO, SKIP OVER			
	MOV	#WIN,R0		; GET ADDRESS OF ASCII VALUE	
	CALL	$CDTB		; CONVERT TO BINARY, LEAVE RESULT IN R1
	MOVB	R1,(R4)		; INSERT NEW VALUE		
	BR	60$		; SKIP ENCODING ASCII WINDOW	
50$:	MOV	R4,R0		; RESTORE ADDRESS		
	MOVB	(R0),R1		; INSERT DEFAULT WINDOW COUNT	
	MOV	#WIN,R0		; ADDRESS OF WHERE TO STUFF DATA
	CLR	R2		; SUPRESS LEADING ZEROS		
	CALL	$CBDMG		; CONVERT TO DECIMAL		
 
60$:	TST	SKPFLG		; IS THIS A /VI COMMAND		
	BEQ	100$		; NO SO EXIT			
	MOV	#M007+1+12.,R0	; ADDRESS OF WHERE TO START NULLING OUT
	MOV	#13.,R2		; NUMBER OF SPACES TO NULL OUT	
70$:	CLRB	(R0)+		; INSERT A NULL			
	SOB	R2,70$		; LOOP UNTIL DONE		
	MOV	#OLDLBL+13.,R0	; NULL OUT THE 'TO'		
	CLRB	(R0)+		; FIRST CHARACTER		
	CLRB	(R0)		; SECOND CHARACTER		
	MOV	#NEWLBL,R0	; ZIP OUT ANY NEW LABLE		
	MOV	#12.,R2		; 12 CHARACTERS TO REMOVE	
80$:	CLRB	(R0)+		; NULL OUT, ONE BYTE AT A TIME	
	SOB	R2,80$		; LOOP				
	
100$:	MOV	#HDRBUF+H.FMAX,R4; ADDRESS OF MAXIMUM FILES ALLOWED
	MOV	(R4),NUMFIL	; SAVE INITIAL VALUE FOR LATER TESTS
	TST	MAXFLG		; SHOULD WE INSERT A NEW MAX FILE VALUE?
	BEQ	150$		; NO, SKIP OVER			
	MOV	#MAXFIL,R0	; ADDRESS  OF ASCII VALUE	
	CALL	$CDTB		; CONVERT DECIMAL ASCII TO BINARY IN R1
	CMP	R1,#65535	; IF MXF>65535, ILLEGAL SWITCH VALUE
	BHI	VALERR		; IF HI, ILLEGAL SWITCH VALUE	
	CMP	R1,NUMFIL	;  THE NUMBER OF FILES CAN NEVER DECREASE 
	BLO	VALERR		; IF LO, ILLEGAL SWITCH VALUE	
	MOV	#HDRBUF+H.IBSZ,R0 ; GET ADDRESS OF SIZE OF BITMAP
	MOV	(R0),R0		; GET SIZE OF BITMAP		
	SWAB	R0		; MULTIPLY BY 256		
	ASH	#4,R0		; MULTIPLY BY 16		
	CMP	R1,R0		; WILL WE BE PAST END OF BITMAP	
	BHI	VALERR		; IF HI, YES, ILLEGAL SWITCH VALUE
	MOV	R1,(R4)		; INSERT NEW VALUE		
150$:	MOV	R4,R0		; RESTORE R0			
	MOV	(R0),R1		; INSERT MAXFIL WORD		
	MOV	#MAXFIL,R0	; ADDRESS OF WHERE TO STUFF DATA
	CLR	R2		; SUPRESS LEADING ZEROS		
	CALL	$CBDMG		; CONVERT TO DECIMAL		
 
200$:	MOV	#HDRBUF+H.VDAT,R0 ; ADDRESS OF VOLUME CREATION DATE
	MOV	#DATE,R1	; ADDRESS OF DATE STRING FOR PRINTING
	MOVB	(R0)+,(R1)+	; MOVE IN THE DAY		
	MOVB	(R0)+,(R1)+	; ""    "" "   "		
	INC	R1		; BUMP OVER '-'			
	MOVB	(R0)+,(R1)+	; NOW MOVE IN THE MONTH		
	MOVB	(R0)+,(R1)+	;  "   "    "  "    "		
	MOVB	(R0)+,(R1)+	;  "   "    "  "    "		
	INC	R1		; BUMP PAST THE '-'		
	MOVB	(R0)+,(R1)+	; AND FINALLY GET THE YEAR	
	MOVB	(R0)+,(R1)	;  "	"      "   "    "	
;300$:	RETURN			; ALL DONE			
300$:	MOV	#HDRBUF+H.DFPR,R0 ; GET DEFAULT FILE PROTECTION WORD ADR
	TST	PROFLG		; JUST TO BE SAFE ONLY TWIDDLE IF/FPRO SEEN
	BEQ	305$		; NOT SEEN, SKIP OVER		
	MOV	PROWRD,(R0)	; INSERT NEW DEFAULT FILE PROTECTION WORD
305$:	MOV	(R0),R0		; GET DEFAULT FILE PROTECTION WORD
	MOV	#PROTCT,R1	; WHERE WE PUT ASCII STRING	
	INC	R1		; BUMP PAST '['			
	CALL	SHOWPR		; SHOW SYSTEM PRIVILEGES		
	MOVB	#',,(R1)+	; PUT IN COMMA			
	CALL	SHOWPR		; SHOW OWNER PRIVILEGES		
	MOVB	#',,(R1)+	; PUT IN COMMA			
	CALL	SHOWPR		; SHOW GROUP PRIVILEGES		
	MOVB	#',,(R1)+	; PUT IN COMMA			
	CALL	SHOWPR		; PUT IN WORLD PRIVILEGES	
	MOVB	#'],(R1)	; FINALLY CLOSE LINE		
	CLC			; Show Success
	RETURN			; ALL DONE FOR NOW		
;+								
; VALERR- AN ILLEGAL SWITCH NUMERIC VALUE FOUND			
;-								
VALERR:	MSGN$S	PFX,3,M009,,,ABORT; ILLEGAL SWITCH VALUE FOUND	
	SEC			; Show failure
	RETURN
 
 
 
;+								
; SHOWPR - CREATE PROTECTION WORD IN ASCII FROM BINARY VALUE	
;								
; INPUT: R0 PROTECTION WORD(ONE OF 4 QUADRENTS)			
;	 ONLY LOWER 4 BITS SCANNED AT A TIME			
; OUTPUT: SHOVES R,W,E,D AS REQUIRED INTO (R1)			
; FORMAT  OF DEFAULT FILE PROTECTION WORD			
;								
;	  WORLD    GROUP    OWNER    SYSTEM			
;	------------------------------------			
;	!D!E!W!R! D!E!W!R! D!E!W!R! D!E!W!R! 			
;       ------------------------------------			
; IN EACH CASE AIF A BIT IS SET ACCESS IS DENIED FOR THAT PRIVILEGE
; HENCE PROWRD=0 >[RWED,RWED,RWED,RWED] ACCESS			
;       PROWRD=-1 > [,,,,] ACCESS				
;-								
 
SHOWPR:	BIT	#1,R0		; SEE IF READ ACCESS		
	BNE	5$		; IF NE, NO			
	MOVB	#'R,(R1)+	; SHOW READ ACCESS		
5$:	ROR	R0		; MOVE TO NEXT BIT		
	BIT	#1,R0		; IS THERE WRITE ACCESS		
	BNE	10$		; IF NE, NO			
	MOVB	#'W,(R1)+	; SHOW WRITE ACCESS		
10$:	ROR	R0		; NEXT BIT PLEASE		
	BIT	#1,R0		; IS THERE EXTEND ACCESS	
	BNE	15$		; IF NE, NO			
	MOVB	#'E,(R1)+	; SHOW EXTEND ACCESS		
15$:	ROR	R0		; NEXT, PLEASE			
	BIT	#1,R0		; IS THERE DELETE ACCESS	
	BNE	20$		; IF NE, NO, RETURN		
	MOVB	#'D,(R1)+	; SHOW DELETE ACCESS		
20$:	ROR	R0		; MAKE THINGS EASY FOR NEXT TIME, ROTATE 
	RETURN			; BACK TO MAINLINE		
;+								
; DECODE - DECODE SWITCHES AFTER TITLE FOUND			
;   SUPPORTED SWITCHES						
;	/VI	DISPLAY VOLUME CHARACTERISTICS			
;	/LRU=NN.	SET NEW VOLUME LRU=NN.			
;	/MAXEXT=NN.	SET NEW VOLUME DEFAULT EXTENSION	
;	/WINDOW=NN.	SET NEW VOLUME WINDOW			
;	/FPRO=[RWED,RWED,RWED,RWED]  DEFAULT FILE PROTECTION WORD
;			SAME USAGE AS WITH INI.TSK		
;								
;   THE FUNTION OF THIS ROUTINE IS TO SET THE APPROPRIATE FLAG 	
;   ( IF A SWITCH IS FOUND) AND THE SYNTAX IS OK.		
;   THEN FOR THE NUMERIC SWITCHES, IT PUTS THE ASCII NUMERIC	
;   INTO TEMPORARY STORAGE TO AWAIT FOR CONVERSION TO A BINARY BYTE LATER
;								
;	FLAGS USED:	SKPFLG	- /VI SWITCH FOUND DO NOT WRITE OUT HOMEBLOCK
;			LRUFLG	- /LRU SWITCH SEEN, MODIFY LRU FOR VOLUME
;			EXTFLG	- /MAXEXT SWITCH SEEN, MODIFY MAXEXT FOR VOLUME
;			WINFLG	- /WINDOW SWITCH SEEN		
;			PROFLG  - /FPRO SWITCH SEEN		
;								
;   THE SWITCH DECODING IS RATHER PRIMATIVE, ONLY THE FIRST TWO LETTERS 
;   ARE CHECKED FOR A MATCH.  IN MOST CASES THIS IS ADEQUATE	
;								
; INPUT:	R0 - ADDRESS OF NEXT CHARACTER TO BE EXAMINED	
;		R1 - MODIFIED BY CALL TO GETNXT			
;								
;-								
DECODE:	CALL	GETNXT		; GET NEXT CHARACTER		
	BEQ	SYNERR		; EQ=> EOL FOUND, SYNTAX ERROR	
	CMPB	#'H,R0		; IS THE COMMAND /HE		
	BNE	10$		; NO, CHECK AGAIN		
	CALL	GETNXT		; LETS SEE IF WE HAVE A /HE	
	BEQ	SYNERR		; EQ=>EOL, EOL HERE IS BAD	
	CMPB	#'E,R0		; IS IT AN 'E'			
	BNE	SYNERR		; IF NE, NO, SYNTAX ERROR	
	DIR$	#HLSPWN		; Yes - ask for help
	WTSE$S	#1		; Wait for it to finish
	TST	(SP)+		; Throw away return address
	JMP	NEXT		;
;
10$:
	CMPB	#'V,R0		; IS THE COMMAND /VI		
	BNE	100$		; NO, CHECK AGAIN		
	CALL	GETNXT		; LETS SEE IF WE HAVE A /VI	
	BEQ	SYNERR		; EQ=>EOL, EOL HERE IS BAD	
	CMPB	#'I,R0		; IS IT AN 'I'			
	BNE	SYNERR		; IF NE, NO, SYNTAX ERROR	
	INC	SKPFLG		; YES, DON'T TWIDDLE WITH HOME BLOCK
	CALL	GETNXT		; GET CHARACTER			
	BEQ	40$		; EQ=> EOL, ALL SWITCHES FOUND, SO EXIT
	CMPB	#'/,R0		; MAYBE MORE SWITCHES FOLLOW, IF SO NEED A '/'
	BNE	SYNERR		; IF NE, BAD SYNTAX, SWITCHES NEED A  '/'
	BR	DECODE		; AND CONTINUE TO DECODE THE LINE
40$:
	CLC			; Show Success
	RETURN			; CS=> EOL RETURN TO CALLER	
100$:	CMPB	#'L,R0		; IS IT AN 'L', (MAYBE LRU?)	
	BNE	200$		; NO, CHECK FOR MAXEXT=		
	CALL	GETNXT		; CHECK FOR 'R' IN 'LRU'	
	CMPB	#'R,R0		; IS IT AN 'R'			
	BNE	SYNERR		; NO, SYNTAX ERROR		
	MOV	#2,R3		; ONLY GET TWO DIGITS		
	MOV	#LRU,R4		; ADDRESS OF WHERE TO PUT DATA	
	INC	LRUFLG		; SHOW /LRU= SEEN		
	BR	1000$		; LOOP THROUGH COMMON CODE	
200$:	CMPB	#'M,R0		; IS IT AN 'M', (MAXEXT MAYBE)	
	BNE	300$		; IF NE, NO, CHECK FOR /WINDOW	
	CALL	GETNXT		; CHECK FOR 'A'			
	CMPB	#'A,R0		; IS IT AN 'A',(IN MAXEXT)?	
	BNE	400$		; NO, CHECK FOR /MXF 		
	MOV	#2,R3		; ONLY ALLOW FOR TWO DECIMAL DIGITS
	MOV	#MAXEXT,R4	; ADDRESS OF WHERE TO PUT DATA	
	INC	EXTFLG		; SHOW /MAXEXT=SEEN		
	BR	1000$		; LOOP THROUGH COMMON CODE	
300$:	CMPB	#'W,R0		; IS IT A 'W' (MAYBE WINDOW)	
;	BNE	SYNERR		; NO, SYNTAX ERROR		
	BNE	500$		; CHECK FOR /FPRO		
	CALL	GETNXT		; CHECK FOR SPELLING		
	CMPB	#'I,R0		; IS IT AN 'I' (IN WINDOW)	
	BNE	SYNERR		; NO, SYNTAX ERROR		
	MOV	#2,R3		; ALLOW ONLY TWO CHARACTERS	
	MOV	#WIN,R4		; ADDRESS OF WERE TO PUT DATA	
	INC	WINFLG		; SHOW WE HAVE SEEN /WINDOW=	
	BR	1000$		; AND LOOP THROUGH COMMON CODE	
 
400$:	CMPB	#'X,R0		; IS IT /MXF?			
	BNE	SYNERR		; IF NE, NO, BAD SYNTAX		
	MOV	#5,R3		; ONLY ALOW FOR FIVE DECIMAL DIGITS
	MOV	#MAXFIL,R4	; ADDRESS OF WHERE TO PUT DATA	
	INC	MAXFLG		; SHOW /MXF SEEN		
	BR	1000$		; LOOP THROUGH COMMON CODE	
 
500$:	CMPB	#'F,R0		; MAYBE ITS /FPRO		
	BNE	SYNERR		; IF NE, NO, SYNTAX ERROR(SINCE LAST IN LIST)
	CALL	GETNXT		; GET NEXT CHARACTER		
	CMPB	#'P,R0		; IS IT /FPRO?			
	BNE	SYNERR		; IF NE, NO, SYNTAX ERROR	
	INC	PROFLG		; SHOW /FPRO SWITCH SEEN	
	CALL	STUFIT		; INSERT [RWED,......] IF SEEN	
	BCS	560$		; If CS error - Exit at once
	CALL	GETNXT		; GET ANOTHER CHARACTER		
	BEQ	550$		; EOL HERE IS OK, RETURN	
	CMPB	#'/,R0		; IS THERE ANOTHER SWITCH	
	BNE	SYNERR		; IF NE, SYNTAX ERROR		
	JMP	DECODE		; ELSE BACK FOR MORE		
550$:
	CLC			; Show Success
;
560$:
	RETURN			; ALL DONE			
 
1000$:	CALL	GETNUM		; GET NUMBER AND CONVERT IT	
	BCS	560$		; If CS error - exit at once
	BEQ	40$		; EOL HERE OK, RETURN		
	CMPB	#'/,R0		; MAYBE ANOTHER SWITCH		
	BNE	SYNERR		; NO SYNTAX ERROR		
	JMP	DECODE		; YES, SCAN FOR MORE		
 
 
SYNERR:	MSGN$S	PFX,3,M002,,,ABORT; SYNTAX ERROR		
	SEC			; Show Failure
	RETURN
 
;
GETNUM:	CALL	GETNXT		; GET ANOTHER CHARACTER		
	BEQ	SYNERR		; EOL HERE IS SYNTAX ERROR	
	CMPB	#'/,R0		; IS IT '/'			
	BEQ	SYNERR		; IF EQ SYNTAX ERROR		
	CMPB	#'=,R0		; FOUND '=' YET			
	BNE	GETNUM		; NO, TRY AGAIN			
	CALL	GETNXT		; GET ONE MORE CHARACTER	
	BEQ	SYNERR		; EOL HERE (AFTER =) IS SYNTAX ERROR
10$:	MOVB	R0,(R4)+	; INSERT 1ST CHARACTER(LATER CHECK FOR  #'S)
	CMPB	R0,#48.		; CHECK TO BE SURE INPUT IS NUMERIC
	BLT	NUMERR		; IF LT, NON NUMERIC ASCII CHARACTER FOUND
	CMPB	R0,#57.		; MAYBE ITS>9			
	BGT	NUMERR		; IF GT, ERROR INPUT CHARACTER >9
	CALL	GETNXT		; TRY FOR ANOTHER CHARACTER( EOL OK NOW)
	BEQ	20$		; ANOTHER CHARACTER OK, GET OUT OF LOOP
	CMPB	#'/,R0		; HAVE WE RUN INTO ANOTHER
	BEQ	20$		; IF EQ, YES, GO TRY AND DECODE MORE
	SOB	R3,10$		; DECREMENT CHARACTER COUNTAND LOOP TILL DONE
	CALL	GETNXT		; CHECK TO SEE IF AT END OF LINE YET
20$:
	CLC			; Show Success
	RETURN			; ONE WAY OR OTHER ARE DONE	
 
;+
; NUMERR - NON NUMERIC ASCII CHARACTER DETECTED			
;-								
NUMERR:	MSGN$S	PFX,3,M010,,,ABORT ; ILLEGAL CHARACTER DETECTED	
	SEC			; Show failure
	RETURN			;
 
 
;+								
; STUFIT							
; CHECK FOR SYNTAX IN [RWED,RWED,RWED,RWED] AND INSERT IT INTO PROWRD
;-								
STUFIT:								
	CLR	R3		; USE R4 TO COUNT # OF ROR'S	
10$:	CALL	GETNXT		; NEXT CHARACTER		
	BEQ	SYNERR		; EOL, A SYNTAX ERROR HERE	
	CMPB	#'/,R0		; A '/' IS ALSO SYNTAX ERROR HERE
	BEQ	SYNERR		; IF EQ, ERROR			
	CMPB	#'[,R0		; HAVE WE FOUND '[' YET		
	BNE	10$		; IF NE, NO, TRY AGAIN		
15$:	CALL	GETNXT		; NEXT CHARACTER		
	BEQ	SYNERR		; EOL IS SYNTAX ERROR UNTIL ] FOUND
	CMPB	#'/,R0		; NO BACK SLASHES UNTIL ] FOUND	
	BEQ	SYNERR		; IF EQ, SYNTAX ERROR		
	CMPB	#'R,R0		; AN 'R'			
	BNE 	20$		; IF NE,NO			
	BIC	#1,PROWRD	; SET BIT TO SHOW FOUND		
	BR	15$		; ENCODE SOME MORE		
20$:				; REF LABLE			
	CMPB	#'W,R0		; WRITE ACCESS			
	BNE	30$		; NO				
	BIC	#2,PROWRD	; SO SET BIT TO SHOW 		
	BR	15$		; ENCODE SOME MORE		
30$:				; REF LABLE			
	CMPB	#'E,R0		; IS IT EXTEND			
	BNE	40$		; IF NE ,CHECK FOR DELETE	
	BIC	#4,PROWRD	; SHOW EXTEND PRIVILEGE		
	BR	15$		; ENCODE SOME MORE		
40$:				; REF LABLE			
	CMPB	#'D,R0		; DELETE ACCESS?		
	BNE	50$		; NO CHECK FOR COMMA		
	BIC	#10,PROWRD	; SHOW DELETE ACCESS		
	BR	15$		; ENCODE SOME MORE		
50$:	CMPB	#',,R0		; IS IT ','			
	BEQ	60$		; ',' AND ']' ARE ONLY LEGAL TERMINATORS
	CMPB	#'],R0		; SINCE THEY SIGNIFY MORE OR END OF SCAN
	BEQ	70$		; REQUIRED SYNTAX TO END /FPRO SWITCH
	JMP	SYNERR		; ELSE SYNTAX ERROR		
 
60$:				; IF ',' FOUND, PLACE LOW ORDER 4 BITS INTO THE
				; UPPER 4 BITS OF PROWRD	
	MOV	#4,R4		; SET UP FOR 4 SHIFTS		
63$:	CLC			; FISRT CLEAR CARRY		
	BIT	#1,PROWRD	; SHOULD WE COPY LOW BIT TO CARRY
	BEQ	65$		; LOW BIT A ZERO, DON'T NEED TO SET CARRY
	SEC			; LOW BIT A 1, MUST SET CARRY	
65$:	ROR	PROWRD		; SHIFT ONCE			
	SOB	R4,63$		; DO 4 TIMES			
	INC	R3		; KEEP TRACK OF # OF COMMAS FOUND
	JMP	15$		; AND LOOK FOR MORE		
 
70$:				; FOR LAST TIME PLACE LOW ORDER 4 BITS INTO
				; HIGH ORDER 4 BITS OF PROWRD	
	CMP	#3,R3		; MUST HAVE 3 COMMAS		
	BEQ	71$		; IF EQ, SYNTAX OK		
	JMP	SYNERR		; ELSE SYNTAX ERROR		
71$:	MOV	#4,R4		; SET FOR 4 SHIFTS		
73$:	CLC			; FIRST CLEAR CARRY		
	BIT	#1,PROWRD	; SHOULD WE COPY LOW BIT TO CARRY?
	BEQ	75$		; LOW BIT A ZERO, DON'T NEED TO CARRY
	SEC 			; LOW BIT A 1, MUST SET CARRY	
75$:	ROR	PROWRD		; SHIFT ONCE			
	SOB	R4,73$		; DO IT 4 TIMES			
	CLC			; Show Success
	RETURN			; AND GO BACK			
	.PAGE
;		MSGGEN - MESSAGE TRAP ROUTINE
;+
; 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	1		;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,#1> ;SEND CR
	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