.TITLE	ASN - VIRTUAL DEVICES
	.IDENT	/010000/
	.ENABL	LC
;+
; Abstract:	ASN
;
;	This task will do virtual device creation/deletion/
;	reassignment for IAS V3.0
;
; Operating procedures:
;
;	This is designed to be run as an MCR task (...ASN) or as
;	a System Library task ($$$ASN), under IAS V3.0.  It will
;	not work well on earlier versions of IAS or RSX-11D, since
;	some of the data structures it plays with have been
;	modified in IAS V3.0.  The command string syntax is:
;
;	PDS> ASN[/switches] [device-1] [device-2]
;
;	The valid switches are:
;
;	/CREATE - Creates a logical reassignment.  The logical
;		name "device-1" is translated to the logical name
;		"device-2" whenever a LUN assignment is done.
;		Both "device-1" and "device-2" must be specified.
;	/REASSIGN - Reassigns an existing logical assignment.
;		The syntax is identical to /CREATE.
;	/LIST - Lists existing logical assignments.  No devices
;		can be specified on the command string.
;	/DELETE - Delete a logical assignment.  Only "device-1"
;		can be specified.  This command has an optional
;		subswitch, /ALL, which will delete all logical
;		assignments for the current user.  When /ALL is
;		specified, "device-1" must not be specified.
;
;	If no switches are specified, /CREATE is assumed if the
;	logical name "device-1" did not exist, and /REASSIGN is
;	assumed if the logical name "device-1" did exist.
;
; Nonstandard features:
;
;	This task requires a non-standard IAS executive.
;	The major change is to ..FDEV in SCOMM to scan the
;	reassignment list for a task.  A task (MUNG) is currently
;	being used on an IAS V3.0 multi-user system to put the
;	extra code in ..FDEV;  it picks a node for its patch
;	and links in to it from ..FDEV.
;
; Limitations:
;
;	It is not possible to create a pseudo-device which
;	changes the meaning of 'OV0:' since this is the name
;	of the IAS pseudo-device which contains the overlays
;	for the associated task.  It is possible, and considered
;	a feature, that 'standard' pseudo-devices such as 'TI0:',
;	'TO0:', 'CL0:', and 'CO0:' can be re-assigned;  of these,
;	the only one which is questionable is 'CO0:' since some
;	system tasks might want to get to the real CO:.  These
;	pseudo-devices can be re-assigned to change the location
;	of the default I/O files.
;
; Written: 30-Jan-80, -1.0.0-, Bruce C. Wright
; Modified:
; Verified:
;-

	.SBTTL	MACRO CALLS AND MACRO DEFINITIONS
 
	.MCALL	QIOW$,GMCR$,EXST$S,DIR$
	.MCALL	ISTAT$,TRAN$,STATE$
 
	.MACRO	ERROR	STR
	JSR	R0,$ERROR
	.NCHR	$$$,<STR>
	.WORD	$$$
	.ASCII	"STR"
	.EVEN
	.ENDM
 
	.MACRO	TYPE	STR,LEN,VFC
	MOV	STR,-(SP)
	MOV	LEN,-(SP)
	.IF NB	VFC
	MOV	VFC,-(SP)
	.IFF
	CLR	-(SP)
	.ENDC
	CALL	$TYPE
	.ENDM
 
	.MACRO	CALLR	ARG
	JMP	ARG
	.ENDM

	.SBTTL	STORAGE AND SYMBOLIC EQUATES
;
	.PSECT	ASN
;
; Constants and work areas.
;
GMCR:	GMCR$		; MCR command buffer
CURUNI:	.WORD	DEV1	; Pointer to current device block
DEV1:	.ASCII	"  "	; First unit - pseudo device
UNI1:	.WORD	0	; First unit - pseudo device
DEV2:	.ASCII	"  "	; Second unit - pseudo device
UNI2:	.WORD	0	; Second unit - pseudo device
;
DEVMSG:	.ASCII	"ASN -- No assignment(s) active"
DEVLEN	=	.-DEVMSG
;
BUFFER:	.BLKB	80.	; Buffer for output.
;
QIO:	QIOW$	IO.WVB,5,5,,,,<0,0,40>
;
STATUS:	.WORD	EX$SUC	; Error status
;
$FLAGS::.WORD	0	; Flags word
AS.LI	=	000001	; List current assignments
AS.DE	=	000002	; Delete an assignment
AS.CR	=	000004	; Create an assignment
AS.RE	=	000010	; Reassign an assignment
AS.AL	=	000020	; /ALL specified on /DELETE
AS.D1	=	040000	; First device specified
AS.D2	=	100000	; Second device specified
;
; Format of the Pseudo-device volume control word:
;
V.NX	=	0	; word 0 - Next entry in list
V.DN	=	2	; Word 1 - Device name in ascii
V.UN	=	4	; Word 2 - Device unit number
V.LDN	=	6	; Word 3 - Logical device name
V.LUN	=	10	; Word 4 - Logical unit number
V.SIZ	=	12	; Size of this block in bytes

	.SBTTL	MAIN LINE CODE
;
ASN::	DIR$	#GMCR		; Get MCR command line
	BCC	10$		; If CC, got one - process it
5$:	CALLR	EXIT		; And exit to the system.
10$:	MOV	#GMCR+G.MCRB,R1	; R1 = address of command line
	MOV	@#$DSW,R2	; Get length of command.
	BEQ	5$		; Leave if not specified.
20$:	CMPB	(R1)+,#140	; Is it lower case?
	BLO	30$		; No
	BICB	#40,-1(R1)	; Yes, make it upper case.
30$:	SOB	R2,20$		; and loop.
	MOV	#GMCR+G.MCRB,R1	; R1 = address of command
;
; Clear volatile words
;
	CLR	$FLAGS		; Clear flags word
	MOV	#DEV1,CURUNI	; Get current device field
;
; Set up for call to .TPARS
;
	MOV	#1+<1*256.>,R1	; Blanks are significant, keywords
				; must match to 1 chars.
	MOV	#KEYTBL,R2	; Point to .TPARS keyword table.
	MOV	@#$DSW,R3	; Get length of string.
	MOV	#GMCR+G.MCRB,R4	; Point to the string to be parsed.
	MOV	#STATBL,R5	; Point to initial state.
	CALL	.TPARS		; Parse the command line.
	BCC	50$		; Skip if no error.
	ERROR	<ASN -- Syntax error>

	.SBTTL	/LIST PROCESSING
;
; Now we do the appropriate things.
;
50$:	BIT	#AS.LI,$FLAGS	; Was /LIST specified?
	BEQ	100$		; No - must be a delete or create
;
; /LIST was specified - list the current assignments
;
	BIT	#AS.DE!AS.CR!AS.AL!AS.D1!AS.D2,$FLAGS
	BEQ	60$		; No conflicts - continue
	ERROR	<ASN -- Conflicting switches>
60$:	CALL	GETLST		; Get to the head of the list.
	TST	(R5)		; Is there a device list there?
	BNE	80$		; Yes -- list it out.
	TYPE	#DEVMSG,#DEVLEN,#40 ; Type out the message
	CALLR	EXIT		; And exit.
80$:	MOV	(R5),R5		; Get to the next element in list
	BEQ	90$		; To end, exit.
	MOV	#BUFFER,R0	; Get output buffer.
	MOV	V.DN(R5),(R0)+	; Output the device name
	MOV	V.UN(R5),R1	; Get the Unit Number.
	CLR	R2		; Set for zero-suppress.
	CALL	$CBOMG		; Convert the Unit Number
	MOVB	#':,(R0)+	; Output a :
	MOVB	#'	,(R0)+	; Output a <tab>
	MOVB	V.LDN(R5),(R0)+	; Output first character of logical name
	MOVB	V.LDN+1(R5),(R0)+ ; Output second character of logical
	MOV	V.LUN(R5),R1	; Get the logical unit number
	CLR	R2		; Set R2 for zero suppress
	CALL	$CBOMG		; Convert unit number
	MOVB	#':,(R0)+	; Output a :
	SUB	#BUFFER,R0	; Compute length of buffer
	TYPE	#BUFFER,R0,#40	; Type it out.
	BR	80$		; And get the next assignment
90$:	CALLR	EXIT		; And return to the system.

	.SBTTL	/DELETE PROCESSING
;
; Check for /DELETE switch specified
;
100$:	BIT	#AS.DE,$FLAGS	; Was /DELETE specified?
	BEQ	200$		; No - must be create or reassign
	BIT	#AS.CR!AS.D2,$FLAGS ; Illegal bits?
	BEQ	110$		; No - keep going
105$:	ERROR	<ASN -- Conflicting switches>
110$:	BIT	#AS.D1,$FLAGS	; Device must be specified.
	BNE	120$		; OK, continue.
	BIT	#AS.AL,$FLAGS	; Is /DELETE/ALL specified?
	BNE	150$		; Yes - handle it.
	ERROR	<ASN -- No device specified>
120$:	BIT	#AS.AL,$FLAGS	; Is /ALL specified with a device?
	BNE	105$		; Yes - conflicting switches.
	CALL	GETLST		; Pick up the listhead.
130$:	MOV	R5,R4		; Remember last entry.
	MOV	(R5),R5		; Get to the next entry.
	BEQ	140$		; To end of list, error.
	CMP	V.DN(R5),DEV1	; Does the device name match?
	BNE	130$		; No, next entry.
	CMP	V.UN(R5),UNI1	; Does the unit number match?
	BNE	130$		; No, next entry.
	MOV	(R5),(R4)	; De-link the entry from the list.
	MOV	R5,R1		; Get the address of the node.
	MOV	#<V.SIZ+17>/20,R3 ; Get the length of the node.
	CALL	..NADV		; And return to the pool.
	CALLR	EXIT		; And return to the system.
140$:	ERROR	<ASN -- No such assignment>
150$:	CALL	GETLST		; Get the listhead.
	MOV	(R5),R4		; Get the first element.
	BEQ	190$		; Leave if none there.
	CLR	(R5)		; Show no more translations.
160$:	MOV	R4,R1		; Get next element in list for ..NADV
	BEQ	190$		; Leave if found end of list.
	MOV	(R4),R4		; Get to next element.
	MOV	#<V.SIZ+17>/20,R3 ; Get length of the node.
	CALL	..NADV		; Return the node to the system.
	BR	160$		; And loop over the nodes.
190$:	CALLR	EXIT		; And exit the system.

	.SBTTL	/CREATE AND /REASSIGN PROCESSING
;
; The operation must be a /CREATE or a /REASSIGN.
;
200$:	MOV	$FLAGS,R0	; Get the flags word.
	BIC	#^C<AS.D1!AS.D2>,R0 ; Ensure both devices are there.
	CMP	#<AS.D1!AS.D2>,R0 ; Well??
	BEQ	205$		; Yes -- go on.
	ERROR	<ASN -- Two device names required>
205$:	MOV	$FLAGS,R0	; Get flags word again.
	BIT	#AS.AL,R0	; /ALL specified?
	BNE	207$		; Yes - error
	BIC	#^C<AS.CR!AS.RE>,R0 ; Clear out all but /CR and /RE
	CMP	R0,#<AS.CR!AS.RE> ; Are both specified?
	BNE	210$		; No - OK to go on.
207$:	ERROR	<ASN -- Conflicting switches>
210$:	CALL	GETLST		; Pick up the listhead.
	CALL	CHKASN		; Check assignment for circularity.
220$:	MOV	R5,R4		; Remember the old node.
	MOV	(R5),R5		; Get to the next node.
	BEQ	230$		; Not there, check flags.
	CMP	V.DN(R5),DEV1	; Device 1 match?
	BNE	220$		; No - next device.
	CMP	V.UN(R5),UNI1	; Unit 1 match?
	BNE	220$		; No - next device.
;
; A match has been found - ensure that /CREATE was not specified.
;
	BIT	#AS.CR,$FLAGS	; Was /CREATE specified?
	BEQ	260$		; No -- OK to go on.
	ERROR	<ASN -- Assignment already exists>
;
; There are no more entries in the list - ensure that
; /REASSIGN was not specified
;
230$:	BIT	#AS.RE,$FLAGS	; Was /REASSIGN specified?
	BEQ	240$		; No -- OK to go on.
	ERROR	<ASN -- Assignment does not exist>
240$:	CALL	CHKNUM		; Check number of reassignments.
	MOV	#<V.SIZ+17>/20,R3 ; Get the length of the node.
	MOV	R4,-(SP)	; Save address of previous node
	CALL	..PICV		; Pick it from the pool.
	MOV	R4,R5		; Put new node address in R5
	MOV	(SP)+,R4	; Recover address of previous node.
	BCC	250$		; Skip if gotten OK.
	ERROR	<ASN -- Can't pick node>
250$:	MOV	(R4),(R5)	; Link in at end of chain.
	MOV	R5,(R4)		; Ditto.
;
; Move the new assignment into the node which has been created.
;
260$:	MOV	DEV1,V.DN(R5)	; Move in the new device name.
	MOV	UNI1,V.UN(R5)	; And the unit number.
	MOV	DEV2,V.LDN(R5)	; Move in the logical device name
	MOV	UNI2,V.LUN(R5)	; And the unit number.
	CALLR	EXIT		; And return to the system.

	.SBTTL	CHKASN - CHECK FOR CIRCULAR ASSIGNMENT AND OTHER PROBLEMS
;
; This subroutine checks the new assignment for circularity.
; This is necessary to avoid any possible infinite loops in
; the Executive when ..FDEV attempts to find the assignment
; for the device!
;
CHKASN:
	CMP	DEV1,#"OV	; Is the logical name = "OV"?
	BEQ	99$		; Yes - then he can't do this!
	MOV	R5,R3		; Remember the listhead address.
	CMP	DEV1,DEV2	; Check for internal circularity
	BNE	10$		; Not equal - OK
	CMP	UNI1,UNI2	; Well?
	BEQ	90$		; Equal -- circular chain.
10$:	MOV	DEV2,R0		; Get assigned device name.
	MOV	UNI2,R1		; And the unit number.
20$:	MOV	R3,R5		; Get back to the listhead.
30$:	MOV	(R5),R5		; Get to next element in list.
	BEQ	70$		; None there, end of loop.
	CMP	V.DN(R5),R0	; Same device name?
	BNE	30$		; No - keep going.
	CMP	V.UN(R5),R1	; Same unit number?
	BNE	30$		; No - keep going.
	CMP	V.LDN(R5),DEV1	; Is it equal to the new device?
	BNE	40$		; No -- not a circular loop yet
	CMP	V.LUN(R5),UNI1	; Is it equal to the new device?
	BEQ	90$		; Yes -- circular loop
40$:	MOV	V.LDN(R5),R0	; Get the new pointers.
	MOV	V.LUN(R5),R1	; ...
	BR	20$		; And look again.
70$:	MOV	R3,R5		; Remember listhead for caller.
	RETURN			; Return to the caller - OK
90$:	ERROR	<ASN -- Circular logical assignment>
99$:	ERROR	<ASN -- Can't reassign 'OV'>

	.SBTTL	CHKNUM - CHECK NUMBER OF REASSIGNMENTS
;
; This subroutine checks the number of reassignments for the
; current user.  It ensures that the non-privileged user cannot
; create more than 3. assignments, or else he might end up
; using up all of SCOMM with useless assignments.
;
CHKNUM:
	MOV	R5,-(SP)	; Save registers
	MOV	R4,-(SP)	; ...
	MOV	.CRTSK,R5	; Get our ATL node.
	MOV	A.TI(R5),R5	; Get our PUD address.
	BITB	#UT.PR,U.TF(R5)	; Is this guy privileged?
	BNE	20$		; Yes - let him do it anyway.
	CALL	GETLST		; Get listhead
	MOV	#-1,R4		; Clear count of entries.
10$:	INC	R4		; Increment count of entries.
	MOV	(R5),R5		; Get to the next entry.
	BNE	10$		; And loop over entries.
	CMP	R4,#3		; Too many entries?
	BLT	20$		; No, just return to the user.
	ERROR	<ASN -- Too many assignments for non-privileged user>
20$:	MOV	(SP)+,R4	; Recover registers.
	MOV	(SP)+,R5	; ...
	RETURN			; And return to the caller.

	.SBTTL	$ERROR - PRINT ERROR MESSAGES
;
; This module prints error messages for the ASN program.
;
$ERROR:
	MOV	(R0)+,QIO+Q.IOPL+2 ; Set the length of the QIO
	MOV	R0,QIO+Q.IOPL	; Set the address of the QIO
	MOV	#' ,QIO+Q.IOPL+4 ; Set the VFC in the QIO
	MOV	#QIO,-(SP)	; DPB to stack
	CALL	.DIRDL		; Do the I/O
	MOV	#EX$ERR,STATUS	; Show error occurred.
EXIT:	EXST$S	STATUS		; And exit to the system.
;
	.SBTTL	TYPE -- TYPE MESSAGES
;
; $TYPE -- Types out arguments
;
;	(SP) = return address
;	2(SP) = VFC
;	4(SP) = length
;	6(SP) = buffer
;
$TYPE:	MOV	2(SP),QIO+Q.IOPL+4 ; Set the VFC
	MOV	4(SP),QIO+Q.IOPL+2 ; Set the length
	MOV	6(SP),QIO+Q.IOPL ; Set the buffer
	MOV	(SP),6(SP)	; Pop return address
	ADD	#6,SP		; Pop stack.
	MOV	#QIO,-(SP)	; DPB to stack
	CALL	.DIRDL		; Do the I/O
	RETURN			; And return to the caller.

	.SBTTL	GETLST - GET LISTHEAD
;
; This module gets the listhead for the logical assignment
; chain.  It also checks to ensure that the current TI is
; an appropriate header for a logical assignment chain.
;
GETLST:	MOV	.CRTSK,R5	; Get our ATL node
	MOV	A.TI(R5),R5	; Get our PUD address.
	BIT	#UC.MNT!UC.F11,U.C1(R5) ; Is this a valid device?
	BEQ	70$		; Yes -- continue
	ERROR	<ASN -- Illegal TI device>
70$:	ADD	#U.VA,R5	; Point to the pseudo device list
	RETURN			; And return to the caller.

	.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$	!RSWS,START
	TRAN$	$EOS,$EXIT
	TRAN$	$ANY,START
;
; Find the first non-blank after the first blank.
;
	STATE$	FRSTCH
	TRAN$	$BLANK,FRSTCH
	TRAN$	!RSWS,FRSTCH
	TRAN$	$LAMDA
;
; Get the pseudo device name
;
	STATE$
	TRAN$	$EOS,$EXIT
	TRAN$	!GETDEV,,,AS.D1,$FLAGS
 
	STATE$
	TRAN$	$EOS,$EXIT
	TRAN$	$BLANK
;
; Get the actual device name
;
	STATE$
	TRAN$	$EOS,$EXIT
	TRAN$	!GETDEV,,,AS.D2,$FLAGS
;
; Get the end of the command
;
	STATE$	EXPEND
	TRAN$	$BLANK,EXPEND
	TRAN$	$EOS,$EXIT

;
; Subexpression to read a device name
;
	STATE$	GETDEV
	TRAN$	$ALPHA,,SETDV1
 
	STATE$
	TRAN$	$ALPHA,,SETDV2
 
	STATE$
	TRAN$	$NUMBR,NONUM,SETUNT
	TRAN$	$LAMDA
 
	STATE$	NONUM
	TRAN$	':,DEVEND
	TRAN$	$LAMDA
 
	STATE$	DEVEND
	TRAN$	$LAMDA,$EXIT,NXTDEV
;
; Subexpression to read switches.
;
	STATE$	RSWS
	TRAN$	'/
 
	STATE$	
	TRAN$	"LIST",$EXIT,,AS.LI,$FLAGS
	TRAN$	"DELETE",$EXIT,,AS.DE,$FLAGS
	TRAN$	"CREATE",$EXIT,,AS.CR,$FLAGS
	TRAN$	"REASSIGN",$EXIT,,AS.RE,$FLAGS
	TRAN$	"ALL",$EXIT,,AS.AL,$FLAGS
;
; Terminate TPARS tables.
;
	STATE$

	.SBTTL	ACTION ROUTINES
	.PSECT	ASN
;
; These are the action routines for the .TPARS parsing table.
;
; Get the first device name character.
;
SETDV1::MOV	R0,-(SP)	; Save R0
	MOV	CURUNI,R0	; Get current Device block
	MOVB	.PCHAR,(R0)	; Return the device name.
	MOV	(SP)+,R0	; Recover R0
	RETURN			; And return to .TPARS
;
; Get second device name character.
;
SETDV2::MOV	R0,-(SP)	; Save R0
	MOV	CURUNI,R0	; Get current device block
	MOVB	.PCHAR,1(R0)	; Return the device name.
	MOV	(SP)+,R0	; Recover R0
	RETURN			; And return to .TPARS
;
; Get unit number
;
SETUNT::MOV	R0,-(SP)	; Save R0
	MOV	CURUNI,R0	; Get current device block
	MOV	.PNUMB,2(R0)	; Return the unit number
	MOV	(SP)+,R0	; Recover R0
	CMP	.PNUMB,#255.	; Is the unit number too high?
	BHI	5$		; Yes - CSI won't like it!
	TST	.PNUMH		; Is it too high?
	BEQ	10$		; No - skip.
5$:	ADD	#2,(SP)		; Yes - reject transition.
10$:	RETURN			; And return to .TPARS
;
; Get to the next device block
;
NXTDEV::ADD	#4,CURUNI	; Get to the next device block.
	RETURN			; And return to .TPARS
	.END	ASN