.TITLE	QTA
	.IDENT	"V1.1"
	.NLIST	BEX,CND
;
;   Author:	D. Mischler	07-SEP-88
;
;   This program is used to assign a unit of the QT: driver to
;   a physical tape device, and to create a memory region for
;   buffering.  The unit may only be assigned if it is offline.
;   The unit will be automatically deassigned when it is taken
;   offline.
;
; V1.1	D. Mischler  11-DEC-88	Add /PA switch to create buffer regions
;				 in partitions other than GEN.
;
;   The command line must be in the following form:
;
;	QTA QTn:=dev:/switches
;
;   The following switches are supported:
;
;	/BS:n	Specify buffer size.
;	/NU:n	Specify number of buffers.
;	/PA:par	Specify main partition for buffering region.
;	/WB	Allow write-behind caching.
;
CR	=	15		; ASCII carriage return.
LF	=	12		; ASCII line feed.
SY	=	1		; SY: LUN.
TI	=	5		; TI: LUN.

	.MCALL	DCBDF$,PCBDF$
	DCBDF$			; Define DCB offsets.
	PCBDF$			; Define PCB offsets.

	.MCALL	DIR$,CRAW$,CRRG$,EXIT$S,EXST$S,GIN$,GMCR$,GTSK$S,QIOW$S
	.MCALL	WDBBK$
	.PAGE
;
;   Macro to build a switch table entry.
;
	.MACRO	SWITCH	NAME,TRUTH,PARSE,DEFAULT
	.WORD	"'NAME
SWI.'NAME:
	.WORD	TRUTH-0
	.WORD	PARSE-0
	.WORD	DEFAULT-0
	.ENDM	SWITCH

;
;   Switch table entry offsets.
;
	.ASECT
	.=0
SW.NAM:	.BLKW	1	; Switch name.
SW.TRU:	.BLKW	1	; Switch truth value.
SW.PRS:	.BLKW	1	; Address of value parse routine.
SW.VAL:	.BLKW	1	; Address of value string.
SW.LEN	=	.
	.PAGE
	.PSECT	DATA,D,RW
;
;   Data definitions.
;
BUFNUM:	.WORD	NUMBUF		; Number of buffers to allocate.
BUFSIZ:	.WORD	SIZBUF		; Size of buffers to allocate.
CRTADW:	CRAW$	WDB		; Create address window DPB.
CRTREG:	CRRG$	RDB		; Create region DPB.
DEVNAM:	.WORD	0		; Device name pointer.
ERRPTR:	.WORD	-1		; System state error pointer.
GETCMD:	GMCR$			; Get MCR command line DPB.
MXUNIT:	.WORD	0		; Physical device unit.
QTUNIT:	.WORD	0		; QT: unit UCB address.
TARGET:	.WORD	0		; Target device name pointer.
;
;   Switch table.
;
SWITBL:	SWITCH	BS,0,BSVALU	; /BS:size	Specify buffer size.
	SWITCH	NU,0,NUVALU	; /NU:number	Specify number of buffers.
	SWITCH	PA,0,PAVALU	; /PA:main	Main partition for buffer.
	SWITCH	WB,0		; /WB		Allow write-behind caching.
	.WORD	0		; Terminator.
;
;   Region definition block.
;
RDB:	.WORD	0			; Region ID word.
REGSIZ:	.WORD	0			; Region size.
REGNAM:	.RAD50	"QT0BUF"		; Region name in RAD50.
REGPAR:	.RAD50	"GEN   "		; Main partition name in RAD50.
REGSTS:	.WORD	RS.ATT!RS.NDL!RS.RED	; Region creation flags.
	.WORD	177756			; Allow owner and system read access.
;
;   Window definition block.
;
WDB:	WDBBK$	7,8.,0,0,0,WS.MAP!WS.UDS ; Window definition block.
	.PAGE
;
;   Message definitions.
;
ALLFLR:	.ASCIZ	"Buffer descriptor allocation failed"
CMDMIS:	.ASCIZ	"Missing command line"
CMDSYN:	.ASCIZ	"Required command line elements missing"

ERRHDR:	.BYTE	CR,LF
TSKNAM:	.ASCII	"TSKNAM -- "
ERRHDL	=	.-ERRHDR

ILLSWI:	.ASCII	"Illegal switch /"
SN.ILL:	.ASCIZ	"XX"

MAPERR:	.ASCIZ	"Region mapping error"
QTAASN:	.ASCIZ	"Specified QT: unit is already assigned"
QTDERM:	.ASCIZ	"Bad QT: device specification"
QTLOAD:	.ASCIZ	"QT: driver has not been loaded"
QTNXU:	.ASCIZ	"Specified QT: unit does not exist"
RGAXST:	.ASCIZ	"Region already exists"
RGCBNF:	.ASCIZ	"Region not found in common block directory"
RGCERR:	.ASCIZ	"Region creation failure"
RGOUTM:	.ASCIZ	"Region is out of memory"
TDNERR:	.ASCIZ	"Target device name error"
TDNIS:	.ASCIZ	"Target device not in system"

VALERR:	.ASCII	"Bad value specified for /"
SN.VAL:	.ASCIZ	"XX"

VNTERR:	.ASCII	"/"
SN.VNT:	.ASCIZ	"XX does not take a value"

VRQERR:	.ASCII	"Value required for /"
SN.VRQ:	.ASCIZ	"XX"
	.PAGE
	.PSECT	CODE,I,RO
;
;   Get the MCR command line and parse it.
;
START:	SUB	#G.TSDU+2,SP		; Allocate a GTSK$ buffer.
	MOV	SP,R4			; Point to it.
	GTSK$S	R4			; Get task parameters.
	MOV	#TSKNAM,R0		; Point to task name buffer.
	MOV	(R4)+,R1		; Get first task name word.
	CALL	$C5TA			; Convert it to ASCII.
	MOV	(R4),R1			; Get second task name word.
	CALL	$C5TA			; Convert it too.
	MOV	#CMDMIS,R5		; Point to possible error message.
	DIR$	#GETCMD			; Attempt to get MCR command line, OK?
	BCS	ERROR			; No, complain.
	MOV	#GETCMD+G.MCRB,R1	; Point to MCR command line.
	MOV	$DSW,R2			; Get command line length.
	ADD	R1,R2			; Point after command line buffer.
	CLRB	(R2)			; Terminate buffer.
	MOVB	#' ,R0			; Get expected terminator.
	CALL	SWICHK			; Process any switches on command, OK?
	BCS	ERROR			; No, complain.
	MOV	R1,DEVNAM		; Point to device name field.
	MOVB	#'=,R0			; Get expected field terminator.
	CALL	SWICHK			; Process any switches, OK?
	BCS	ERROR			; No, complain.
	MOV	R1,TARGET		; Point to target name field.
	CLR	R0			; Indicate expected terminator.
	CALL	SWICHK			; Process switches, OK?
	BCS	ERROR			; No, complain.
	CALL	SWIVAL			; Process switch values, OK?
	BCS	ERROR			; No, complain.
	CALL	QTUCB			; Locate appropriate QT: unit, OK?
	BCS	ERROR			; No, complain.
	CALL	QTASN			; Perform actual assignment, OK?
	BCS	ERROR			; No, complain.
	EXIT$S				; Terminate successfully.
;
;   Output error message and terminate.
;
ERROR:	QIOW$S	#IO.WVB,#TI,#TI,,,,<#ERRHDR,#ERRHDL>	; Output error header.
	MOV	R5,R4					; Copy message address.
10$:	TSTB	(R5)+					; Found end of message?
	BNE	10$					; No, keep looking.
	MOVB	#CR,-1(R5)				; Terminate message.
	SUB	R4,R5					; Get message length.
	QIOW$S	#IO.WVB,#TI,#TI,,,,<R4,R5>		; Dump it on the user.
	EXST$S	#EX$SEV					; Terminate.
	.PAGE
;
;   Subroutine to locate the QT: and physical UCBs.
;
QTUCB:	MOV	#TDNERR,R5	; Point to target device name error.
	MOV	TARGET,R0	; Point to target device name string.
	ADD	#2,R0		; Skip device mnemonic.
	CALL	$COTB		; Convert unit number to binary.
	CMPB	#':,R2		; Was unit properly terminated?
	BNE	QTDERR		; No, complain.
	BIT	#177760,R1	; Is unit approximately reasonable?
	BNE	QTDERR		; No, complain.
	MOV	R1,MXUNIT	; Save unit number for later.
	MOV	DEVNAM,R0	; Point to device name string.
	MOV	#QTDERM,R5	; Point to QT: device error message.
	CMPB	(R0)+,#'Q	; Is the Q in place?
	BNE	QTDERR		; No, complain.
	CMPB	(R0)+,#'T	; Is the T where it belongs?
	BNE	QTDERR		; No, complain.
	CALL	$COTB		; Convert unit number to binary.
	CMPB	#':,R2		; Was unit number terminated properly?
	BNE	QTDERR		; No, complain.
	TSTB	(R0)		; Does anything follow the colon?
	BNE	QTDERR		; Yes, complain.
	BIT	#177770,R1	; Is the unit number OK?
	BNE	QTDERR		; No, complain.
	ADD	R1,REGNAM	; Put unit number in region name.
	MOV	#QTLOAD,ERRPTR	; Set up error pointer.
	CALL	$SWSTK,QTRTRN	; Switch stack to system state.
;   Locate QT: DCB.
	MOV	$DEVHD,R0	;; Point to first DCB in the system.
10$:	CMP	#"QT,D.NAM(R0)	;; Found the correct DCB yet?
	BEQ	20$		;; Yes, now find the UCB.
	MOV	D.LNK(R0),R0	;; Get link to next DCB, zero?
	BNE	10$		;; No, keep looking.
	RETURN			;; QT: driver has not been loaded.
;   QT: DCB found. Locate the UCB.
20$:	MOV	#QTNXU,ERRPTR	;; Set up error pointer.
	CMPB	R1,D.UNIT+1(R0)	;; Does the requested unit exist?
	BHI	50$		;; No, cause a later complaint.
	MUL	D.UCBL(R0),R1	;; Calculate offset from first UCB.
	ADD	D.UCB(R0),R1	;; Point to the correct UCB.
	MOV	R1,QTUNIT	;; Pass UCB address back to task level.
	MOV	#QTAASN,ERRPTR	;; Set up already assigned message.
	TST	U.PHYU(R1)	;; Is the unit already assigned?
	BNE	50$		;; Yes, complain.
	.PAGE
;
;   Locate target device DCB.
;
	MOV	#TDNIS,ERRPTR	;; Set up error message.
	MOV	$DEVHD,R0	;; Point to first DCB in the system.
	MOV	TARGET,R2	;; Get target device mnemonic address.
	MOVB	1(R2),R1	;; Get 2nd character.
	SWAB	R1		;; Position it correctly.
	BISB	(R2),R1		;; Or in 1st character.
30$:	CMP	R1,D.NAM(R0)	;; Found the correct DCB yet?
	BEQ	40$		;; Yes, now find the UCB.
	MOV	D.LNK(R0),R0	;; Get link to next DCB, zero?
	BNE	30$		;; No, keep looking.
	RETURN			;; Target device is not in system.
;   Target DCB found. Locate the UCB.
40$:	MOV	MXUNIT,R1	;; Get target device unit number.
	CMPB	R1,D.UNIT+1(R0)	;; Does the requested unit exist?
	BHI	50$		;; No, cause a later complaint.
	MUL	D.UCBL(R0),R1	;; Calculate offset from first UCB.
	ADD	D.UCB(R0),R1	;; Point to the correct UCB.
	MOV	R1,MXUNIT	;; Pass UCB address back to task level.
	CLR	ERRPTR		;; Indicate success.
50$:	RETURN

;   $SWSTK return point.
QTRTRN:	CLC			; Assume success.
	MOV	ERRPTR,R5	; Was an error encountered?
	BEQ	QTDOK		; No, just exit.
QTDERR:	SEC			; Indicate an error has occurred.
QTDOK:	RETURN
	.PAGE
;
;   Subroutine to allocate buffer region and perform actual assignment.
;
QTASN:	MOV	#RGCERR,R5	; Point to region creation failure message.
	MOV	BUFSIZ,R0	; Get buffer size.
	MUL	BUFNUM,R0	; Multiply by number of buffers to get size.
	BIT	#177700,R0	; Is required size ridiculous?
	BNE	QTDERR		; Yes, complain.
	ASHC	#-6,R0		; Get size in 64-byte blocks.
	MOV	R1,REGSIZ	; Set up region size.
	DIR$	#CRTREG		; Create the region, OK?
	BCS	QTDERR		; No, complain.
	MOV	#RGAXST,R5	; Point to region already exists message.
	BIT	#RS.CRR,REGSTS	; Did the region already exist?
	BEQ	QTDERR		; Yes, complain.
	MOV	#WDB,R0		; Point to window definition block.
	MOV	RDB,W.NRID(R0)	; Put region ID in window block.
	MOV	#MAPERR,R5	; Point to mapping error message.
	DIR$	#CRTADW		; Create address window and map region.
	BCS	QTDERR		; Complain if error.
;   Find region PCB in the common block directory.
	CALL	$SWSTK,PCBRTN	; Switch stacks to system state.
	MOV	$CBDHD,R0		;; Get address of first PCB in CBD.
10$:	CMP	P.NAM(R0),REGNAM	;; Does name match?
	BNE	20$			;; No, try next entry.
	CMP	P.NAM+2(R0),REGNAM+2	;; Does the whole name match?
	BEQ	30$			;; Yes, check it out.
20$:	MOV	P.CBDL(R0),R0		;; Point to next PCB in CBD, zero?
	BNE	10$			;; No, keep looking.
	MOV	#RGCBNF,ERRPTR		;; Set up error message address.
	RETURN				;; Specified region is not in CBD.
;   Found requested region in the common block directory.
30$:	MOV	#RGOUTM,ERRPTR		;; Assume region is out of memory.
	BIT	#PS.CKP!PS.CKR!PS.OUT,P.STAT(R0) ;; Is region in memory?
	BNE	PCBXIT			;; No, complain.
	.PAGE
;
;   Region is OK.  Chop the region up into buffers.
;
	MOV	#QTAASN,ERRPTR		;; Set up possible error.
	MOV	QTUNIT,R5		;; Point to QT: UCB.
	TST	U.PHYU(R5)		;; Has somebody grabbed the unit?
	BNE	PCBXIT			;; Yes, complain about it.
	MOV	R0,U.RPCB(R5)		;; Save region PCB address in UCB.
;   Allocate buffer descriptors, assign buffers.
	MOV	#ALLFLR,ERRPTR		;; Set up possible error.
	MOV	P.REL(R0),R4		;; Get base block number of region.
	MOV	#BD.SIZ,R0		;; Get buffer descriptor size.
	MUL	BUFNUM,R0		;; Get size of all needed descriptors.
	CALL	$ALOCB			;; Allocate necessary pool, OK?
	BCS	50$			;; No, complain.
	MOV	BUFSIZ,R1		;; Get buffer size.
	ASH	#-6,R1			;; Get size in blocks.
40$:	MOV	R4,BD.ADR(R0)		;; Set up buffer address doubleword.
	MOV	#APR6,BD.ADR+2(R0)
	MOV	BUFSIZ,BD.LEN(R0)	;; Set up buffer length.
	MOV	U.FBDL(R5),(R0)		;; Link descriptor to old newest.
	MOV	R0,U.FBDL(R5)		;; Push it onto the list.
	ADD	R1,R4			;; Get base block of next buffer.
	ADD	#BD.SIZ,R0		;; Point to next descriptor.
	DEC	BUFNUM			;; All descriptors set up?
	BNE	40$			;; No, keep going.
	MOV	U.RPCB(R5),R0		;; Get region PCB address again.
	INCB	P.RMCT(R0)		;; Indicate region is in use.
	BIS	#P2.LMA!P2.RON,P.ST2(R0);; Prevent exec from harming partition.
	BIS	#PS.CHK!PS.FXD!PS.NSF,P.STAT(R0)
	CLR	U.CW3(R5)		;; Assume write-behind caching disabled.
	TST	SWI.WB			;; Was write-behind caching specified?
	BEQ	45$			;; No, driver flags are OK.
	BIS	#QT.WB,U.CW3(R5)	;; Allow write-behind caching.
45$:	MOV	MXUNIT,U.PHYU(R5)	;; Assign QT: unit to physical device.
	CLR	ERRPTR			;; Indicate success.
50$:	RETURN

;   Return point from PCB search.
PCBRTN:	CLC			; Assume everything is OK.
	MOV	ERRPTR,R5	; Get error message address, zero?
	BEQ	PCBXIT		; Yes, the assumption was correct.
	SEC			; Indicate an error.
PCBXIT:	RETURN
	.PAGE
;
;   Subroutine to handle command line switches.
;   On entry:	R0 contains expected terminator.
;		R1 points into command line.
;
;   On exit:	If error detected then carry set, R5 points to message.
;		Else R1 points after zeroed terminator,
;		all switch indicators '/' also zeroed.
;
SWICHK:	CALL	UPCASE		; Make all alphabetics into capitals.
	CLR	R3		; Zero switch table entry pointer.
10$:	MOVB	(R1)+,R2	; Fetch a character.
	CMPB	R0,R2		; Expected terminator?
	BEQ	60$		; Yes, leave quietly.
	TSTB	R2		; Absolute terminator?
	BEQ	50$		; Yes, alert the authorities.
	CMPB	#':,R2		; Value indicator?
	BNE	20$		; No, check for switch indicator.
	TST	R3		; Has a switch been encountered?
	BEQ	10$		; No, get next character.
	MOV	R1,SW.VAL(R3)	; Save switch value string address.
	CLR	R3		; Don't accept another value for this switch.
	BR	10$		; Get next character.
;   Check for a switch.
20$:	CMPB	#'/,R2		; Switch indicator?
	BNE	10$		; No, keep looking.
	MOV	R1,-(SP)	; Save command line pointer.
	CLRB	-(R1)		; Zero switch indicator.
	MOV	#SWITBL,R2	; Point to start of switch table.
;   Check switch against table entry.
30$:	MOV	(SP),R1		; Recover command line pointer.
	CMPB	(R1)+,(R2)	; Does switch match table entry?
	BNE	40$		; No, try next entry.
	CMPB	(R1)+,1(R2)	; Does second character match?
	BNE	40$		; No, try next entry.
	MOV	#1,SW.TRU(R2)	; Set switch truth value.
	MOV	R2,R3		; Save switch table entry pointer.
	TST	(SP)+		; Clean up stack.
	BR	10$		; Fetch next character.
;   Try next switch table entry.
40$:	ADD	#SW.LEN,R2	; Point to next table entry.
	TST	(R2)		; End of switch table?
	BNE	30$		; No, check it out.
	MOV	#ILLSWI,R5	; Point to illegal switch message.
	MOV	#SN.ILL,R4	; Point to switch name field.
	BR	SWIERR		; Process switch error.
;   Premature command line termination.
50$:	MOV	#CMDSYN,R5	; Point to command syntax error message.
	SEC			; Set error flag.
	RETURN
;   Exit normally.
60$:	CLRB	-1(R1)		; Wipe out the terminator (clears carry).
	RETURN
	.PAGE
;
;   Switch error processing routine.
;
SWIERR:	MOV	(SP)+,R1	; Point to switch name.
	MOVB	(R1)+,(R4)+	; Insert switch name into message.
	MOVB	(R1),(R4)
	SEC			; Indicate an error condition.
	RETURN

;
;   Subroutine to scan the switch table for value parsing.
;
SWIVAL:	MOV	#SWITBL,-(SP)	; Point to switch table.
10$:	MOV	(SP),R1		; Get switch table entry pointer.
	TST	SW.TRU(R1)	; Was switch specified?
	BEQ	40$		; No, check next entry.
	MOV	SW.VAL(R1),R5	; Get switch value string address.
	MOV	SW.PRS(R1),R4	; Get parsing routine address, zero?
	BEQ	30$		; Yes, make sure there's no value.
	TST	R5		; Is there a value for this switch?
	BEQ	20$		; No, complain.
	CALL	(R4)		; Parse value OK?
	BCC	40$		; Yes, check next switch table entry.
	MOV	#VALERR,R5	; Point to value error message.
	MOV	#SN.VAL,R4	; Point to switch name field.
	BR	SWIERR		; Complain bitterly.
;   Value required but not specified.
20$:	MOV	#VRQERR,R5	; Point to value required message.
	MOV	#SN.VRQ,R4	; Point to switch name field.
	BR	SWIERR		; Complain.
;   No value allowed (make sure there is none).
30$:	TST	R5		; Was a value specified?
	BEQ	40$		; No, check next table entry.
	MOV	#VNTERR,R5	; Point to value not taken message,
	MOV	#SN.VNT,R4	; Point to switch name field.
	BR	SWIERR		; Complain.
;   Check next table entry.
40$:	ADD	#SW.LEN,(SP)	; Point to next table entry.
	TST	@(SP)		; End of switch table?
	BNE	10$		; No, keep scanning.
	TST	(SP)+		; Clean up stack.
	RETURN
	.PAGE
;
;   Routine to parse the value for the /BS switch.
;   On entry:	R5 points to the value string.
;
BSVALU:	MOV	R5,R0		; Place string address appropriately.
	CALL	$CDTB		; Convert value to decimal.
	ADD	#63.,R1		; Round up to next multiple of 64.
	BIC	#63.,R1
	MOV	R1,BUFSIZ	; Save buffer size.
	CLC			; Indicate success.
	RETURN

;
;   Routine to parse the value for the /NU switch.
;   On entry:	R5 points to the value string.
;
NUVALU:	MOV	R5,R0		; Place string address appropriately.
	CALL	$CDTB		; Convert value to decimal.
	MOV	R1,BUFNUM	; Save number of buffers, zero?
	BEQ	10$		; Yes, illegal value.
	CLC			; Indicate success.
	RETURN
;   Can't have 0 buffers.
10$:	SEC			; Indicate failure.
	RETURN

;
;   Routine to parse the value for the /PA switch.
;   On entry:	R5 points to the value string.
;
PAVALU:	MOV	R5,R0		; Put string address where needed.
	MOV	#1,R1		; Accept periods.
	CALL	$CAT5		; Convert first 3 characters.
	MOV	R1,REGPAR	; Save first word, another word needed?
	BCS	10$		; No, finish up.
	MOV	#1,R1		; Keep accepting periods.
	CALL	$CAT5		; Convert next 3 characters.
	MOV	R1,REGPAR+2	; Save second main partition name word.
10$:	CLC			; Indicate success.
	RETURN

;
;   Subroutine to capitalize the null-terminated string pointed to by R1.
;   R2 is destroyed by this routine.
;
UPCASE:	MOV	R1,R2		; Copy string address.
10$:	CMPB	(R2),#'a	; Is character too low to need capitalization?
	BLO	20$		; Yes, check for end of string.
	CMPB	(R2),#'z	; Is character too high to be capitalized?
	BHI	20$		; Yes, check for end of string.
	BICB	#'a-'A,(R2)	; Make character upper case.
20$:	TSTB	(R2)+		; End of string?
	BNE	10$		; No, keep going.
	RETURN

	.END	START