.LIST	TTM
	.TITLE	VOL - CHANGE VOLUME LABEL
	.IDENT	/02.00/
	.NLIST	LOC,BIN
;
; 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, /EXT, /MXF
;		SWITCHES.  DISPLAY VOLUME CREATION DATE.
;
;	JGD02 - ADDED SUPORT FOR /FPRO=[RWED,RWED,RWED] AS IN INI
;
;	BRUCE C. WRIGHT
;	DUKE UNIVERSITY MEDICAL CENTER
;	DURHAM, N. C. 27706
;	(919)-684-6804
;
;		MAJOR CLEANUP, OVERHAUL, ETC.  ALSO ADDED SOME OF
;		THE FEATURES OF T. MONTLICK'S "VOL" PROGRAM.
;		ADDED /LI, /UIC, /PRO, AND /CHA SWITCHES.
;		CONDITIONALISED FOR RSX-11D AND IAS.
;
;
; 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:
;
; VOL DDU:LABEL/SW1/SW2/SW3....
;	WHERE  SW1,..SWN CAN BE ANY OF
;	/VI 	- DISPLAY VOLUME INFORMATION BUT DON'T CHANGE ANYTHING
;	/LI	- SYNONYM FOR /VI
;	/EXT=NN	- CHANGE THE DEFAULT FILE EXTENSION TO THE NEW VALUE NN.
;	/WINDOW=NN
;		- CHANGE THE DEFAULT NUMBER OF WINDOWS TO NN.
;	/LRU=NN	- CHANGE THE DEFAULT LRU THE VOLUME WILL BE MOUNTED WITH.
;	/MXF=NN	- CHANGE THE MAXIMUM NUMBER OF FILES ALLOWED ON A
;		  VOLUME (ONLY INCREASES UPWARD ARE ALLOWED)
;		  (NN IS DECIMAL IN ALL CASES)
;	/UIC=[G,P]
;		- CHANGE VOLUME OWNERSHIP TO [G,P].
;	/FPRO=[REWD,REWD,REWD,REWD]
;		- WHERE  REWD  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.
;	/PRO=[REWD,REWD,REWD,REWD]
;		- CHANGES THE VOLUME PROTECTION (SYNTAX AS IN /FPRO).
;	/CHA=[ATCH,DCF]
;		- SPECIFYING THESE IS THE SAME AS IN INI.
;	/NOLABEL
;		- VOLUME LABEL IS TO BE ERASED. (IF A LABEL IS
;		  ALSO SPECIFIED, THE LABEL TAKES PRECEDENCE).
;	CREATION DATE
;		- 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. IT CANNOT BE ALTERED.
;
; OUTPUT:
;
;	THE SPECIFIED DISK LABEL BLOCK IS MODIFIED.
;
	.LIST	LOC,BIN

	.NLIST	LOC,BIN
;
; ASSEMBLY PARAMETERS
;
;R$$11M	=	0	;DEFINE THIS SYMBOL TO ASSEMBLE FOR RSX-11M
R$$11D	=	0	;DEFINE THIS SYMBOL TO ASSEMBLE FOR RSX-11D
;I$$AS	=	0	;DEFINE THIS SYMBOL TO ASSEMBLE FOR IAS
;P$$LIS	=	0	;DEFINE THIS SYMBOL TO MAKE THE /LI AND /VI
			;	COMMANDS PRIVILEGED. IF THIS SYMBOL
			;	IS NOT DEFINED, A NON-PRIVILEGED
			;	USER CAN USE THE /LI AND /VI COMMANDS
			;	(BUT NO OTHERS).
;
; 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
	.LIST	LOC,BIN

	.PAGE
	.MCALL	QIOW$S,WSIG$S,GMCR$,EXIT$S,DIR$
	.MCALL	ALUN$S,HMBOF$
	.MCALL	ISTAT$,TRAN$,STATE$
	HMBOF$	DEF$L	;DEFINE HOME BLOCK OFFSETS
	.IF DF	R$$11M
	.MCALL	TCBDF$,UCBDF$,DCBDF$,LCBDF$
	TCBDF$	<:>,<=>	;DEFINE TCB OFFSETS
	UCBDF$	<:>,<=>	;DEFINE UCB OFFSETS
	DCBDF$	<:>,<=>	;DEFINE DCB OFFSETS
	LCBDF$	<:>,<=>	;DEFINE LCB OFFSETS
	.ENDC	;R$$11M
	.PSECT	VOL
	.PAGE
; MESSAGES - ERROR AND OTHERWISE
;
; ALL MESSAGES PRINTED BY MSGTRP UTILITY ROUTINE
;
	.NLIST	BEX
	.ENABL	LC
PFX:	.BYTE	PRMT-PFX-1	;MESSAGE PREFIX
	.ASCII	/VOL -/
PRMT:	.BYTE	M001-PRMT-1	;PROMPT PREFIX
	.ASCII	/VOL>/
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	M009-M006-1
	.ASCII	/Header Block Write Error /
HBWEC:	.ASCII	/        /
M009:	.BYTE	M011-M009-1
	.ASCII	/Illegal Switch Value/	; JGD01
M011:	.BYTE	0	; JGD01
	.EVEN
CMDSTR:	.ASCII	"%NVolume Label %VE%N"
	.ASCII	"	Ext = %T%N"
	.ASCII	"	Lru = %T%N"
	.ASCII	"	Win = %T%N"
	.ASCII	"	Mxf = %T%N"
	.ASCII	"	Uic = [%O,%O]%N"
	.ASCII	"	Pro = [%VE]%N"
	.ASCII	"	Fpro = [%VE]%N"
	.ASCII	"	Cha = [%VE]%N"
	.ASCIZ	"	Creation date: %9E%N"
	.EVEN
	.LIST	BEX
	.DSABL	LC

	.PAGE
; CONSTANTS AND WORK AREAS.
;
MCRLIN:	GMCR$			;MCR COMMAND BUFFER
	.WORD	0		;BUFFER PAD
	.IF DF	R$$11M
DEVPTR:	.WORD	0		;POINTER TO BEGINNING OF DEVICE NAME
				;IN THE MCR COMMAND LINE
	.ENDC	;R$$11M
DEV:	.ASCII	/  /		;DEVICE NAME
UNIT:	.WORD	0		;UNIT NUMBER
PROWRD:	.WORD	-1		;DEFAULT FILE PROTECTION MASK.
PROVAL:	.WORD	-1		;/PRO= VALUE
FPRVAL:	.WORD	-1		;/FPRO= VALUE.
;
; ARGUMENT BLOCK FOR CALL TO $EDMSG
;
ARGBLK:
	.WORD	0,0		;VOLUME LABEL
	.WORD	EXTVAL		;/EXT=NNN
	.WORD	LRUVAL		;/LRU=NNN
	.WORD	WINVAL		;/WIN=NNN
	.WORD	MXFVAL		;/MXF=NNN
UGCVAL:	.WORD	0		;/UIC=[NN,
UPCVAL:	.WORD	0		;	MMM]
NPRO:	.WORD	0,PROTCT	;/PRO=
NFPRO:	.WORD	0,FPROTCT	;/FPRO=
NCHA:	.WORD	0		;/CHA=
	.WORD	CHABUF		;  "
	.WORD	DATE		;CREATION DATE
;
	.ENABL	LC
LCHMSG:	.ASCII	"Changed From: "
OLDLBL:	.ASCII	"            "
OLDLEN	=	.-OLDLBL
	.ASCII	" to: "
NEWLBL:	.ASCII	"            "
LCHLEN	=	.-LCHMSG
	.DSABL	LC
PROTCT:	.BLKB	20.
FPROTCT:.BLKB	20.
CHABUF:	.BLKB	8.
DATE:	.ASCII	"DD-MMM-YY"
	.EVEN
EXTVAL:	.WORD	0,0		;/EXT=NNN
LRUVAL:	.WORD	0,0		;/LRU=NNN
WINVAL:	.WORD	0,0		;/WINDOW=NNN
MXFVAL:	.WORD	0,0		;/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
OUTBUF:	.BLKW	256.		;TERMINAL OUTPUT BUFFER.
GRCNT:	.WORD	0		;TEMPORARY STORAGE.
VOLCHA:	.WORD	0		;VOLUME CHARACTERISTICS.
;
$FLAGS::.WORD	0		;FLAGS WORD
CV.VI	=	000001		;/VI
CV.EXT	=	000002		;/EXT=
CV.WIN	=	000004		;/WINDOW=
CV.LRU	=	000010		;/LRU=
CV.MXF	=	000020		;/MXF=
CV.UIC	=	000040		;/UIC=
CV.PRO	=	000100		;/PRO=
CV.FPR	=	000200		;/FPRO=
CV.CHA	=	000400		;/CHA=
CV.LAB	=	001000		;LABEL SPECIFIED
;
FP.RDV	=	000001		;READ NOT ALLOWED.
FP.WRV	=	000002		;WRITE NOT ALLOWED.
FP.EXT	=	000004		;EXTEND NOT ALLOWED.
FP.DEL	=	000010		;DELETE NOT ALLOWED.

	.PAGE
VOL::	DIR$	#MCRLIN		;GET MCR COMMAND LINE
	MOV	@#$DSW,$TIOSB+2	;RETURN LENGTH OF LINE.
	BCC	1300$		;IF CC, GOT ONE - GO PROCESS IT
1200$:	MOV	#1,PRFLG	;INDICATE PROMPT MODE
	MOV	#"VO,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?
	BNE	1250$		;IF NE, NO - CONTINUE.
	QIOW$S	#IO.DET,LUN,EFN	;YES, DETACH TERMINAL
	EXIT$S			;EXIT.
1250$:	MOV	$TIOSB+2,R0	;GET LENGTH READ
	BEQ	1200$		;IF EQ, NO DATA READ - PROMPT AGAIN
	ADD	#3.,$TIOSB+2	;COMPUTE "LENGTH" OF READ.
	ADD	#MCRLIN+6,R0	;R0 = A(EOL)
	CLRB	(R0)		;TERMINATE INPUT LINE
1300$:	MOV	#MCRLIN+2,R1	;R1 = A(COMMAND)
	MOV	$TIOSB+2,R2	;GET LENGTH OF COMMAND.
1350$:	CMPB	(R1)+,#140	;IS IT LOWER CASE?
	BLO	1370$		;NO
	BICB	#40,-1(R1)	;YES, MAKE IT UPPER CASE.
1370$:	DEC	R2		;DEC COUNT
	BGT	1350$		;AND LOOP.
	MOV	#MCRLIN+2,R1	;R1 = A(COMMAND)
;
; CLEAR VOLATILE WORDS
;
	CLR	LBN		;SET BEGINNING LBN
	MOV	#1,LBN+2
	CLR	$FLAGS		;CLEAR FLAGS WORD
	MOV	#"  ,DEV	;CLEAR DEVICE FIELD.
	CLR	UNIT		;CLEAR UNIT FIELD.
	CLR	EXTVAL		;CLEAR /EXT= FIELD.
	CLR	EXTVAL+2
	CLR	LRUVAL		;CLEAR /LRU= FIELD.
	CLR	LRUVAL+2	;
	CLR	WINVAL		;CLEAR /WIN= FIELD.
	CLR	WINVAL+2	;
	CLR	MXFVAL		;CLEAR /MXF= FIELD.
	CLR	MXFVAL+2	;
	CLR	VOLCHA		;CLEAR /CHA= FIELD.
	MOV	#NEWLBL+12.,R4	;R4 = A(END OF NEW NAME FIELD)
	MOV	#12.,R0		;R0 = COUNT
1380$:	CLRB	-(R4)		;CLEAR AREA
	SOB	R0,1380$	;LOOP UNTIL DONE
				;R4 = A(NEW NAME AREA)
;
; SET UP FOR CALL TO .TPARS.
;
	CLR	R3		;R3 = 0
	MOV	#1+<2*256.>,R1	; BLANKS ARE SIGNIFICANT, KEYWORDS
				; MUST MATCH TO 2 CHARS.
	MOV	#KEYTBL,R2	; POINT TO .TPARS KEYWORD TABLE.
	MOV	$TIOSB+2,R3	; GET LENGTH OF STRING.
	MOV	#MCRLIN+2,R4	; POINT TO THE STRING TO BE PARSED.
	MOV	#STATBL,R5	; POINT TO INITIAL STATE.
	CALL	.TPARS		; PARSE THE COMMAND LINE.
	BCC	1700$		; SKIP IF NO ERROR.
1600$:	MSGN$S	PFX,3,M002,,,ABORT ;SYNTAX ERROR
	BR	1200$		;FORCE PROMPT MODE
1900$:	MSGN$S	PFX,3,M003,,,ABORT ;INVALID DEVICE
	JMP	1200$		;FORCE PROMPT MODE
1700$:
	.IF DF	R$$11D!I$$AS
	MOV	.CRTSK,R1	;GET OUR ATL NODE.
	MOV	A.TI(R1),R1	;GET OUR PUD ADDRESS.
	BITB	#UT.PR,U.TF(R1)	;ARE WE PRIVILEGED?
	BNE	2000$		;YES -- THEN ANYTHING GOES.
	.ENDC	;R$$11D!I$$AS
	.IF DF	R$$11M
	MOV	$TKTCB,R1	;R1 = A(MY TCB)
	MOV	T.UCB(R1),R1	;R1 = A(TI: UCB)
	BIT	#U2.PRV,U.CW2(R1) ;IS USER PRIVILEGED?
	BNE	2000$		;YES, CONTINUE.
	.ENDC	;R$$11M
	.IF NDF	P$$LIS
	BIT	#^C<CV.VI>,$FLAGS ;WAS USER JUST USING /VI?
	BEQ	2000$		;YES -- THEN IT'S OK.
	.ENDC	;P$$LIS
	MSGN$S	PFX,3,M001,,,ABORT ;PRIVILEGE VIOLATION!
	QIOW$S	#IO.DET,LUN,EFN	;DETACH TERMINAL
	EXIT$S			;AND LEAVE.
2000$:
	.IF DF	R$$11D!I$$AS
	MOV	.PUDBA,R1	;GET TO START OF PUD
2010$:	CMP	DEV,U.DN(R1)	;RIGHT DEVICE?
	BNE	2015$		;NO, LOOP
	CMPB	UNIT,U.UN(R1)	;PROPER UNIT?
	BEQ	2020$		;YES, BRANCH
2015$:	ADD	#U.SZ,R1	;INC PUD POINTER
	CMP	R1,.PUDEA	;AT END?
	BLO	2010$		;NO, LOOP AROUND
	BR	1900$		;INVALID DEVICE
2020$:	MOV	U.RP(R1),R1	;FOLLOW REDIRECT CHAIN
	CMP	U.RP(R1),R1	;END OF CHAIN?
	BNE	2020$		;IF NE, NO - KEEP LOOKING
2040$:	BIT	#UC.F11,U.C1(R1) ;FILES 11 DEVICE?
	BEQ	1900$		  ;IF EQ, NO - INVALID DEVICE
	BITB	#CH.OFF,U.CH(R1) ;IS IT OFFLINE?
	BEQ	2100$		  ;IF EQ - ALL OK
	.ENDC	;R$$11D!I$$AS
	.IF DF	R$$11M
	MOV	DEVPTR,R0	;R0 = A(DEVICE SPECIFIER)
	MOV	#DEV,R3		;R3 = A(DEVICE ID BUFFER)
	CALL	$FDLOG		;PARSE DEVICE.
	BCC	2010$		;IF CC, OK SO FAR.
	TST	R3		;WHAT TYPE OF ERROR WAS IT?
	BEQ	1600$		;IF EQ, SYNTAX ERROR.
	BR	1900$		;IF NE, INVALID DEVICE.
2010$:	CALL	$SWSTK		;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$		;NO -- ILLEGAL DEVICE.
	BITB	#US.MNT,U.STS(R1) ;IS IT MOUNTED?
	BEQ	2100$		;YES -- ALL OK.
	.ENDC	;R$$11M
	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
	BIT	#CV.LAB,$FLAGS	;WAS A NEW LABEL SPECIFIED?
	BEQ	2610$		;NO -- SKIP.
	MOVB	(R1)+,-1(R0)	;INSERT NEW NAME
2610$:	SOB	R3,2600$	;LOOP UNTIL DONE
	CALL	DSPVAL		; SET EXT 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$:	BIT	#^C<CV.VI>,$FLAGS ; SHOULD WE SKIP WRITING OUT NEW DATA?
	BEQ	3000$		; IF NONE OF FLAGS SET, ONLY DISPLAY DATA.
	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$:	MOV	#OUTBUF,R0	;GET OUTPUT BUFFER
	MOV	#CMDSTR,R1	;GET COMMAND STRING
	MOV	#ARGBLK,R2	;AND ARGUMENT BLOCK.
	CALL	$EDMSG		;EDIT OUTPUT STRING.
3005$:	QIOW$S	#IO.WVB,LUN,EFN,,#$TIOSB,,<#OUTBUF,R1>
	BCC	EXIT		;SKIP ON NO ERROR.
	CMP	@#$DSW,#IE.UPN	;NO POOL NODE?
	BEQ	3005$		;YES -- RETRY.
EXIT:	QIOW$S	#IO.DET,LUN,EFN	;DETACH TERMINAL
	EXIT$S			;EXIT
ABORT:	BPT			;ABORT TASK
	.PAGE
	.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
 

;+							
; VALERR- AN ILLEGAL SWITCH NUMERIC VALUE FOUND		
;-							
VALERR:	MSGN$S	PFX,3,M009,,,ABORT; ILLEGAL SWITCH VALUE FOUND
	JMP	EXIT		; 			
 
 
;+							
; DSPVAL -- SET LRU ,EXT, WINDOW, FPRO		
;							
;-							
DSPVAL:	BIT	#CV.EXT,$FLAGS	; WAS /EXT= SPECIFIED?
	BEQ	10$		; NO
	CMP	EXTVAL+2,#255.	; TOO HIGH?
	BHI	VALERR		; YES
	TST	EXTVAL		; HOW ABOUT > 65536?
	BNE	VALERR		; YES -- ERROR.
	MOVB	EXTVAL+2,HDRBUF+H.FIEX ;SET THE NEW EXTEXT.
10$:	MOVB	HDRBUF+H.FIEX,EXTVAL+2 ;GET VALUE TO PRINT.
 
	BIT	#CV.LRU,$FLAGS	; SHOULD WE INSERT A NEW LRU VALUE?
	BEQ	20$		; NO, SKIP OVER
	CMP	LRUVAL+2,#255.	; IS LRU > 255.?
	BHI	VALERR		; YES -- ERROR.
	TST	LRUVAL		; AND HIGH ORDER.
	BNE	VALERR		; YES -- ERROR.
	MOVB	LRUVAL+2,HDRBUF+H.LRUC ; MOVE IN THE NEW VALUE.
20$:	MOVB	HDRBUF+H.LRUC,LRUVAL+2 ; GET VALUE TO PRINT.
 
	BIT	#CV.WIN,$FLAGS	; WAS /WINDOW= SPECIFIED?
	BEQ	30$		; NO -- SKIP.
	CMP	WINVAL+2,#255.	; IS IT OVERSIZE?
	BHI	VALERR		; YES -- ERROR.
	TST	WINVAL		; AND HI ORDER
	BNE	VALERR		; YES -- ERROR.
	MOVB	WINVAL+2,HDRBUF+H.WISZ ; GET THE NEW VALUE.
30$:	MOVB	HDRBUF+H.WISZ,WINVAL+2 ; GET WINDOW VALUE TO PRINT.
 
	BIT	#CV.MXF,$FLAGS	; WAS /MXF= SPECIFIED?
	BEQ	40$		; NO -- SKIP.
	TST	MXFVAL+0	; ILLEGAL VALUE GIVEN FOR /MXF=?
	BNE	VALERR		; YES -- ERROR.
	CMP	MXFVAL+2,HDRBUF+H.FMAX ; CAN'T SET IT TO A SMALLER VALUE.
	BLO	VALERR		; TOO LOW -- ERROR.
	MOV	HDRBUF+H.IBSZ,R0 ; GET THE INDEX FILE BITMAP SIZE.
	ASH	#12.,R0		; MULTIPLY BY (256.*16.)
	CMP	MXFVAL+2,R0	; WILL IT BE > THE INDEX FILE BITMAP?
	BHI	VALERR		; YES, ERROR.
	MOV	MXFVAL+2,HDRBUF+H.FMAX ; SET THE NEW MAX FILE COUNT.
40$:	MOV	HDRBUF+H.FMAX,MXFVAL+2 ; SET MAX FILE COUNT TO PRINT
 
	BIT	#CV.UIC,$FLAGS	; WAS /UIC= SPECIFIED?
	BEQ	50$		; NO
	MOVB	UGCVAL,HDRBUF+H.VOWN+1 ; SET VOLUME GROUP OWNER.
	MOVB	UPCVAL,HDRBUF+H.VOWN ; SET VOLUME PROGRAMMER OWNER.
50$:	MOVB	HDRBUF+H.VOWN,UPCVAL ; RETURN VALUES
	MOVB	HDRBUF+H.VOWN+1,UGCVAL ; ... TO PRINT.
 
	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	
	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$:	BIT	#CV.FPR,$FLAGS	; WAS /FPRO= SPECIFIED?
	BEQ	305$		; NOT SEEN, SKIP OVER	
	MOV	FPRVAL,HDRBUF+H.DFPR ; INSERT NEW DEFAULT FILE PROTECTION WORD	; JGD02
305$:	MOV	HDRBUF+H.DFPR,R0 ; GET DEFAULT FILE PROTECTION WORD		; JGD02
	MOV	#FPROTCT,R1	; WHERE WE PUT ASCII STRING
	CALL	GETPRO		; GET FILE PROTECTION
	SUB	#FPROTCT,R1	; COMPUTE LENGTH OF LINE.
	MOV	R1,NFPRO	; SAVE LENGTH OF LINE.
 
	BIT	#CV.PRO,$FLAGS	; WAS /PRO= SPECIFIED?
	BEQ	310$		; NO
	MOV	PROVAL,HDRBUF+H.VPRO ; YES, SET NEW PROTECTION
310$:	MOV	HDRBUF+H.VPRO,R0 ; GET VOLUME PROTECTION WORD.
	MOV	#PROTCT,R1	; GET PROTECTION AREA
	CALL	GETPRO		; CONVERT TO PRINTABLE FORM
	SUB	#PROTCT,R1	; COMPUTE LENGTH
	MOV	R1,NPRO		; AND SAVE IT.
 
	BIT	#CV.CHA,$FLAGS	; WAS /CHA= SPECIFIED?
	BEQ	320$		; NO
	BIS	#30,HDRBUF+H.VCHA ; SET CHARACTERISTICS.
	BIC	VOLCHA,HDRBUF+H.VCHA ; AND CLEAR THE APPROPRIATE ONES.
320$:	MOV	#CHABUF,R1	; POINT TO BUFFER.
	CLR	R0		; NO , NEEDED.
	BIT	#20,HDRBUF+H.VCHA ; ATTACH ALLOWED?
	BNE	330$		; NO
	INC	R0		; COMMA NEEDED.
	MOVB	#'A,(R1)+	; MOVE IN ATCH
	MOVB	#'T,(R1)+	;
	MOVB	#'C,(R1)+	;
	MOVB	#'H,(R1)+	;
330$:	BIT	#10,HDRBUF+H.VCHA ; DCF ALLOWED?
	BNE	340$		; NO
	TST	R0		; COMMA NEEDED?
	BEQ	335$		; NO
	MOVB	#',,(R1)+	; YES, PUT IN
335$:	MOVB	#'D,(R1)+	; D
	MOVB	#'C,(R1)+	; C
	MOVB	#'F,(R1)+	; F
340$:	SUB	#CHABUF,R1	; GET LENGTH OF BUFFER.
	MOV	R1,NCHA		; AND SAVE IN NUMBER OF CHARACTERS.
 
	BIT	#CV.LAB,$FLAGS	; WAS A LABEL SPECIFIED?
	BEQ	400$		; NO -- SKIP.
	MOV	#LCHMSG,ARGBLK+2 ; SET FOR LABEL CHANGED MESSAGE
	MOV	#LCHLEN,ARGBLK	;
	BR	500$		; AND RETURN
400$:	MOV	#OLDLBL,ARGBLK+2 ; SET LABEL MESSAGE
	MOV	#OLDLEN,ARGBLK	;
500$:	RETURN
GETPRO:	CALL	SHOWPR		; SHOW SYSTEM PRIVLEGES	
	MOVB	#',,(R1)+	; PUT IN COMMA		
	CALL	SHOWPR		; SHOW OWNER PRIVLEGES	
	MOVB	#',,(R1)+	; PUT IN COMMA		
	CALL	SHOWPR		; SHOW GROUP PRIVLEGES	
	MOVB	#',,(R1)+	; PUT IN COMMA		
	CALL	SHOWPR		; PUT IN WORLD PRIVLEGES
	RETURN

;+										; 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

	.SBTTL	PARSING TABLES
;
; THIS AREA HAS THE .TPARS PARSING TABLES.
;
	ISTAT$	STATBL,KEYTBL
;
; FIND THE FIRST BLANK IN THE STRING
;
	STATE$	START
	TRAN$	$BLANK,FRSTCH
	TRAN$	$ANY,START
;
; FIND THE FIRST NON-BLANK AFTER THE FIRST BLANK.
;
	STATE$	FRSTCH
	TRAN$	$BLANK,FRSTCH
	TRAN$	$LAMDA
;
; GET THE DEVICE NAME
;
	STATE$
	TRAN$	$ALPHA,,SETDV1
 
	STATE$
	TRAN$	$ALPHA,,SETDV2
 
	STATE$
	TRAN$	$NUMBR,DEV1,SETUNT
	TRAN$	$LAMDA
 
	STATE$	DEV1
	TRAN$	':
;
; GET THE VOLUME LABEL
;
	STATE$
	TRAN$	$STRNG,RSWS,SETLAB,CV.LAB,$FLAGS
	TRAN$	$LAMDA
;
; GET THE SWITCHES
;
	STATE$	RSWS
	TRAN$	$EOS,$EXIT
	TRAN$	'/
 
	STATE$
	TRAN$	"VI",RSWS,,CV.VI,$FLAGS
	TRAN$	"LI",RSWS,,CV.VI,$FLAGS
	TRAN$	"EXT",EXT,,CV.EXT,$FLAGS
	TRAN$	"WINDOW",WINDOW,,CV.WIN,$FLAGS
	TRAN$	"LRU",LRU,,CV.LRU,$FLAGS
	TRAN$	"MXF",MXF,,CV.MXF,$FLAGS
	TRAN$	"UIC",UIC,,CV.UIC,$FLAGS
	TRAN$	"CHA",CHA,,CV.CHA,$FLAGS
	TRAN$	"PRO",PRO,STPRO,CV.PRO,$FLAGS
	TRAN$	"FPRO",PRO,STFPRO,CV.FPR,$FLAGS
	TRAN$	"NOLABEL",RSWS,,CV.LAB,$FLAGS
;
; DEFAULT FILE EXTENSION
;
; /EXT=NNN
;
	STATE$	EXT
	TRAN$	'=
 
	STATE$
	TRAN$	$DNUMB,RSWS,SETEXT
;
; FILE WINDOW
;
; /WINDOW=NNN
;
	STATE$	WINDOW
	TRAN$	'=
 
	STATE$
	TRAN$	$DNUMB,RSWS,SETWIN
;
; LRU
;
; /LRU=NNN
;
	STATE$	LRU
	TRAN$	'=
 
	STATE$
	TRAN$	$DNUMB,RSWS,SETLRU
;
; MAXIMUM NUMBER OF FILES
;
; /MXF=NNN
;
	STATE$	MXF
	TRAN$	'=
 
	STATE$
	TRAN$	$DNUMB,RSWS,SETMXF
;
; VOLUME OWNERSHIP
;
; /UIC=[NNN,MMM]
;
	STATE$	UIC
	TRAN$	'=
 
	STATE$
	TRAN$	'[
 
	STATE$
	TRAN$	$NUMBR,,SETUGC
 
	STATE$
	TRAN$	<',>
 
	STATE$
	TRAN$	$NUMBR,,SETUPC
 
	STATE$
	TRAN$	'],RSWS
;
; VOLUME CHARACTERISTICS
;
; /CHA=[(ATCH),(DCF)]
;
	STATE$	CHA
	TRAN$	'=
 
	STATE$
	TRAN$	'[
 
	STATE$	CHA0
	TRAN$	'],RSWS
	TRAN$	<',>,CHA0
	TRAN$	"ATCH",CHA0,ATCH
	TRAN$	"DCF",CHA0,DCF
;
; DEFAULT PROTECTION
;
; /FPRO=[REWD,REWD,REWD,REWD]
;
; VOLUME PROTECTION
;
; /PRO=[REWD,REWD,REWD,REWD]
;
	STATE$	PRO
	TRAN$	'=
 
	STATE$
	TRAN$	'[,,IGROUP
 
	STATE$	SPRO
	TRAN$	'],RSWS,ENDGRP
	TRAN$	<',>,SPRO,NXGRP
	TRAN$	'R,SPRO,SETRP
	TRAN$	'W,SPRO,SETWP
	TRAN$	'E,SPRO,SETEP
	TRAN$	'D,SPRO,SETDP
 
	STATE$

	.SBTTL	ACTION ROUTINES
	.PSECT	VOL
;
; THESE ARE THE ACTION ROUTINES FOR THE .TPARS PARSING TABLE.
;
; GET FIRST DEVICE NAME CHARACTER.
;
SETDV1::MOVB	.PCHAR,DEV+0	;RETURN FIRST PART OF DEVICE NAME.
	.IF DF	R$$11M		;IF RSX11M, REMEMBER BEGINNING OF
	MOV	.PSTPT,DEVPTR	;DEVICE NAME FOR $FDLOG.
	.ENDC	;R$$11M
	RETURN			;
;
; GET SECOND DEVICE NAME CHARACTER.
;
SETDV2::MOVB	.PCHAR,DEV+1	;RETURN SECOND PART OF DEVICE NAME.
	RETURN			;
;
; GET UNIT NUMBER
;
SETUNT::MOV	.PNUMB,UNIT	;SET THE UNIT.
	TST	.PNUMH		;IS IT TOO HIGH?
	BEQ	10$		;NO -- SKIP.
	ADD	#2,(SP)		;YES -- REJECT TRANSITION.
10$:	RETURN			;AND RETURN.
;
; SET LABEL
;
SETLAB::CMP	.PSTCN,#12.	;LABEL TOO LARGE?
	BLE	10$		;NO
	ADD	#2,(SP)		;YES, REJECT TRANSITION.
	RETURN			;AND RETURN.
10$:	MOV	R0,-(SP)	;SAVE REGS
	MOV	R1,-(SP)
	MOV	R2,-(SP)	;
	MOV	.PSTCN,R0	; GET LENGTH
	MOV	.PSTPT,R1	; GET ADDRESS
	MOV	#NEWLBL,R2	; POINT TO NEW LABEL.
20$:	MOVB	(R1)+,(R2)+	; MOVE IN NEW LABEL.
	SOB	R0,20$		; LOOP.
	MOV	(SP)+,R2	; RECOVER REGS
	MOV	(SP)+,R1	;
	MOV	(SP)+,R0	;
	RETURN			;AND RETURN.
;
; SET DEFAULT EXTENSION VALUE
;
SETEXT::MOV	.PNUMB,EXTVAL+2	;SET MAX VAL
	MOV	.PNUMH,EXTVAL	;AND HIGH ORDER.
	RETURN			;AND RETURN.
;
; SET WINDOW VALUE
;
SETWIN::MOV	.PNUMB,WINVAL+2	;SET WINDOW VALUE
	MOV	.PNUMH,WINVAL	;AND HI ORDER
	RETURN			;AND RETURN
;
; SET LRU VALUE
;
SETLRU::MOV	.PNUMB,LRUVAL+2	;SET LRU VALUE.
	MOV	.PNUMH,LRUVAL	;AND HI ORDER
	RETURN			;AND RETURN.
;
; SET MXF VALUE
;
SETMXF::MOV	.PNUMB,MXFVAL+2	;SET MXF VALUE.
	MOV	.PNUMH,MXFVAL	;AND HI ORDER.
	RETURN			;AND RETURN.
;
; SET USER GROUP CODE
;
SETUGC::CMP	.PNUMB,#255.	;TOO BIG?
	BHI	10$		;YES
	TST	.PNUMH		;WELL?
	BNE	10$		;YES
	MOVB	.PNUMB,UGCVAL	;
	BR	20$		;
10$:	ADD	#2,(SP)		;REJECT TRANSITION.
20$:	RETURN			;AND RETURN.
;
; SET USER PROGRAMMER CODE
;
SETUPC::CMP	.PNUMB,#255.	;TOO BIG?
	BHI	10$		;YES
	TST	.PNUMH		;WELL?
	BNE	10$		;YES
	MOVB	.PNUMB,UPCVAL	;
	BR	20$		;
10$:	ADD	#2,(SP)		;REJECT TRANSITION.
20$:	RETURN			;AND RETURN.
;
; SET ATCH CHARACTERISTIC
;
ATCH::	BIS	#20,VOLCHA	;SET VOLUME CHARACTERISTICS.
	RETURN			;AND RETURN
;
; SET DCF CHARACTERISITC
;
DCF::	BIS	#10,VOLCHA	;SET VOLUME CHARACTERISTICS.
	RETURN			;AND RETURN
;
; SET PROTECTION SYSTEM TO /PRO=
;
STPRO::	MOV	#PROVAL,PROWRD	;SET  PROTECTION WORD TO OPERATE ON
	RETURN			;AND RETURN.
;
; SET PROTECTION SYSTEM TO /FPRO=
;
STFPRO::MOV	#FPRVAL,PROWRD	;SET PROTECTION WORD TO OPERATE ON
	RETURN			;AND RETURN.
;
; INITIALISE VOLUME PROTECTION WORD.
;
IGROUP::MOV	#4,GRCNT	;INIT GROUP COUNT.
NXGRP::	SEC			;FORCE ONE'S
	ROR	@PROWRD		;SHIFT TO NEXT GROUP
	ASR	@PROWRD		;
	ASR	@PROWRD		;
	ASR	@PROWRD		;
	DEC	GRCNT		;COUNT GROUPS.
	BGE	30$		;TOO MANY IS AN ERROR.
	ADD	#2,(SP)		;IF SO, REJECT TRANSITION.
30$:	RETURN			;AND RETURN.
;
; SET READ PERMIT
;
SETRP::	BIC	#FP.RDV*10000,@PROWRD
	RETURN
;
; SET WRITE PERMIT
;
SETWP::	BIC	#FP.WRV*10000,@PROWRD
	RETURN
;
; SET EXTEND PERMIT
;
SETEP::	BIC	#FP.EXT*10000,@PROWRD
	RETURN
;
; SET DELETE PERMIT
;
SETDP::	BIC	#FP.DEL*10000,@PROWRD
	RETURN
;
; END OF PROTECTION SPEC.
;
ENDGRP::TST	GRCNT		;CHECK THE GROUP COUNT.
	BEQ	10$		;GOOD GROUP.
	ADD	#2,(SP)		;REJECT TRANSITION.
10$:	RETURN			;AND RETURN.

	.SBTTL	MSGGEN - MESSAGE TRAP ROUTINE
	.PSECT	MSGGEN
	.NLIST	BEX
;+
; 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	VOL