.ENABL	LC
	.TITLE	SVD	Show Virtual Disk Assignments
	.NLIST	BEX
	.IDENT	/1.00/
	.SBTTL	Symbols, Macros, DPBs, and Local Storage
;+
;  VERSION 1.00
;
;  AUTHOR:	R.S. Mearns, Informatics Inc.,  May 4, 1981
;
;  MODIFIED BY:
;
;  PURPOSE:
;		Shows which file a VD: unit is assigned to.
;
;  NOTES:
;	1.	Assemble with the VD prefix file, VDPRE.MAC
;-
;
;  EQUATES
TILUN	= 5	;TI: LUN
LUN1	= 1	;VD: working LUN
CMDLUN	= 5	;Command input LUN
CMDBLN	= 10.	;Get Command Line buffer length
ALLBIT	= 1	;/ALL switch bit in CSI maskword
;
;  MACROS
	.MACRO	ERROR	ERM,?A,?B	;Error reporting macro
	BR	B			;Branch around error message text
A:	.ASCIZ	\ERM\			;Error message text
	.EVEN
B:	MOV	#A,R0			; Move in address of text
	CALL	PUTERR			; Call writing routine
	.ENDM	ERROR
;
;
	.MCALL	EXIT$S, DIR$,   ALUN$,  QIOW$
	.MCALL	CSI$,   CSI$1,  CSI$2,  CSI$SW
	.MCALL	GCMLB$, GCML$,  FINIT$, FSRSZ$
	.MCALL	HDRDF$, NBOF$L
;
	HDRDF$				; Define task header offsets
	NBOF$L				; Define FNB offsets
;
;  CONTROL BLOCKS
;
GCLBLK:	GCMLB$	1,SVD,,CMDLUN,,CMDBLN	; Get Command Line
;
	CSI$
CSIBLK:	.BLKB	C.SIZE			; Command String Interpreter
;
SWTAB:	CSI$SW	ALL,ALLBIT,MSKWRD,SET	; Switch Table for CSI
;
;
	FSRSZ$	1			; For command files
;
;  DPBs
;
ALNDPB:	ALUN$	LUN1,VD			; Assign VD: working LUN
;
;
;  LOCAL STORAGE
;
VDFNB:	.BLKW	S.FNBW			; Internal copy of .DSK file's FNB
FILSPC:	.BLKB	32.			; Filespec of .DSK file
MSKWRD:	.WORD	0			; CSI switch mask word
UNIT:	.WORD	0			; Current VD: unit under scrutiny
EXTADR:	.WORD	0			; Address of VDn:'s UCB extension
;
;
	.PAGE
	.SBTTL	Module SVD
;+
;  MODULE SVD
;
;  FUNCTION:
;	Main Routine
;		Prompts for command line
;		Checks CL syntax
;		Determines if a single VD: unit or /ALL
;		FOR each VD: unit requested (single or ALL)
;		   Copy filename block of .DSK file from VDn's UCB extension
;		   Pass address of copied FNB to XLATE for writing
;
;  INPUTS:
;	A command line of the form:
;	SVD>VDn:    or   /ALL
;	where:
;	n is a virtual disk unit number
;	/ALL specifies that assignments of all VD: units are to be displayed
;
;  OUTPUTS:
;	1 or more lines on TI: in the following format:
;	VDn: is assigned to DDu:[ggg,mmm]filename.ext;ver     or
;	VDn: is currently unassigned
;
;-
;
SVD::
;
	FINIT$
;
;
;  GET A COMMAND LINE AND SEE IF ITS USEFUL
;
GETLIN:
	GCML$	#GCLBLK			; Get command line
	BCC	5$			; If CC, no error
	CMPB	G.ERR(R0),#GE.EOF	; Is the error EOF?
	BEQ	3$			;  If EQ, yes - exit
	ERROR	<Couldn't get command line>	; Write error message
3$:	EXIT$S				; Bye
5$:
	TST	G.CMLD(R0)		; Any characters in command line?
	BEQ	GETLIN			;  If EQ, no - try again
	CSI$1	#CSIBLK,GCLBLK+G.CMLD+2,GCLBLK+G.CMLD	; Check line syntax
	BCC	10$			; If CC, no error
	ERROR	<Command line syntax error>	; Write error message
	BR	GETLIN			; Try again
10$:
	CLR	MSKWRD			; Clear leftovers from last time
	CSI$2	#CSIBLK,OUTPUT,#SWTAB	; Parse command line
	BCC	20$			; If CC, no error
	ERROR	<Error in command line parse>	; Write error message
	BR	GETLIN			; Try again
;
;
;
;  /ALL OR A SINGLE UNIT?  IF SINGLE UNIT, WHICH ONE?
;
20$:
	BIT	#ALLBIT,MSKWRD		; /ALL?
	BEQ	30$			;  If EQ, no - single unit
	CLR	UNIT			; Initialize current unit to 0
	BR	LOOP
30$:
	MOV	CSIBLK+C.DEVD+2,R0	; Address of device name
	CMPB	#'V,(R0)+		; First char = V?
	BNE	38$			;  If NE, no - error
	CMPB	#'D,(R0)+		; Second char = D?
	BNE	38$			;  If NE, no - error
	MOVB	(R0),R1			; Get first byte of unit number
	SUB	#60,R1			; Convert ASCII to binary
	CMP	CSIBLK+C.DEVD,#3	; 3 char device/unit?
	BEQ	35$			;  If EQ, yes - only 1 unit char
	MOVB	1(R0),R2		; Get second byte of unit number
	SUB	#60,R2			; Convert ASCII to binary
	ASH	#3,R1			; Multiply first byte by 10(8)
	ADD	R2,R1			; Voila - 2 byte ASCII to word binary
35$:	MOV	R1,UNIT			; Store binary unit number
	BR	LOOP
38$:
	ERROR	<Invalid device name>	; Write error message
	JMP	GETLIN			; Try again
;
;
;  TRY TO ASSIGN VD'UNIT: TO WORKING LUN
;
LOOP:
	MOV	UNIT,ALNDPB+A.LUNU	; Move unit into ALUN$ DPB
	DIR$	#ALNDPB			; Assign LUN
	CMP	$DSW,#IS.SUC		; Success?
	BEQ	40$			;  If EQ, yes
	   CMP	   $DSW,#IE.IDU		   ; Invalid unit? (device ok)
	   BNE	   30$			   ;  If NE, no
	      BIT     #ALLBIT,MSKWRD	      ; Are we doing all units?
	      BEQ     20$		      ;  If EQ, no
		 TST	 UNIT			 ; Are we doing unit 0 now?
		 BNE	 99$			 ;  If NE, no - we just fin-
						 ;  ished all units
		 ERROR	 <VD: not loaded>	 ;  Else no VD: in system
		 BR	 99$			 ; Get out
20$:	      ERROR   <VDn: not in system>    ; Bad unit no. in single mode
	      BR      99$		      ; Get out
30$:	   ERROR   <Could not assign a LUN to VDn:>	; Some other error
99$:	   JMP	   GETLIN		   ; General failure exit for ALUN$
;
;
;  COPY FILENAME BLOCK OF .DSK FILE FROM UCB EXTENSION
;
40$:
;  NOTE: The VD unit in question HAS to be assigned to LUN 1 (repeat 1)
;  for this to work
	CLR	EXTADR			; Clear any leftovers
	CALL	$SWSTK,50$		;; Enter system state
	MOV	$HEADR,R5		;; Get our task header
	MOV	H.LUN(R5),R5		;; Get VDn UCB address
	MOV	U.NXT(R5),EXTADR	;; Get UCB extension address
	RETURN				;; Return to user state
50$:
	MOV	EXTADR,R5		; Is extension allocated?
	BEQ	56$			;  If EQ, no - VDn: not assigned
	ADD	#X.FNB,R5		; Add FNB offset to extension address
	MOV	#VDFNB,R4		; Get address of internal FNB
	MOV	R4,R1			; Save for XLATE
	MOV	#S.FNBW,R3		; Get length of FNB
52$:	MOV	(R5)+,(R4)+		; Copy FNB
	SOB	R3,52$			; ...till done
	MOV	#FILSPC,R0		; Get address of filespec
	CALL	XLATE			; Translate FNB contents to a filespec
	CLC				; Indicate this unit assigned
	BR	60$
56$:	SEC				; Indicate this unit NOT assigned
60$:	MOV	UNIT,R2			; Get current unit number
	CALL	TIWRT			; Write about this unit on TI:
	BIT	#ALLBIT,MSKWRD		; Are we doing all units?
	BEQ	62$			;  If EQ, no
	INC	UNIT			;  Yes, set up next unit
	JMP	LOOP			;  Go do it
62$:	JMP	GETLIN			;  No, get another command line
;
;
	.PAGE
	.SBTTL	Module XLATE
;+
;  MODULE XLATE
;
;  FUNCTION
;	Translate filename block contents into an ASCII filespec
;
;  INPUTS
;	R1	FNB address
;	R0	Address of ASCII filespec
;
;  OUTPUTS
;	R0	Length of ASCII filespec pointed to by R1 (in bytes)
;	R1	Address of ASCII filespec
;
;-
;
DEVLUN=2			; LUN to assign to device containing VDn:
ALUDPB:	ALUN$	DEVLUN		; DPB for ALUN$
RATDPB:	QIOW$	IO.RAT,DEVLUN,DEVLUN,,,,<,ATTLST,0,0,0,0> ;Read attributes DPB
ATTLST:	.BYTE	-05,06		; Read filename
	.WORD	DIRNAM		; Pointer to filename (of directory file)
	.BYTE	0,0		; Attribute list terminator
DIRNAM:	.BLKB	6		; Filename of directory file (RAD50)
	.EVEN
;
;

XLATE:
	MOV	R1,R4			; FNB address
	MOV	R0,-(SP)		; Save pointer to start of filespec
;
;    Process device name
	MOV	N.DVNM(R4),(R0)+	; Just 2 ASCII characters
;
;    Process unit number (1 binary word)
	MOV	N.UNIT(R4),R1		; Move binary unit number to convert
	CLR	R2			; Indicate leading 0 suppression
	CALL	$CBOMG			; Convert to ASCII
	MOVB	#':,(R0)+		; Move in colon
;
;    Process UIC (get directory filename from it's file header)
	TST	N.DID(R4)		; Directory FID non-zero?
	BEQ	20$			; If EQ, no - error
	MOV	N.DVNM(R4),ALUDPB+A.LUNA; Move device name for ALUN$
	MOV	N.UNIT(R4),ALUDPB+A.LUNU; Move device unit number for ALUN$
	DIR$	#ALUDPB			; Assign LUN
	BCS	20$			; If CS, directive failed
;
	MOV	R4,RATDPB+Q.IOPL	; Move FNB pointer into DPB
	ADD	#N.DID,RATDPB+Q.IOPL	; Add directory ID offset
	DIR$	#RATDPB			; Read filename of directory file
	BCS	20$			; If CS, directive failed
;
	MOVB	#'[,(R0)+		; Move in left bracket
	MOV	DIRNAM,R1		; RAD50 word to convert
	CALL	$C5TA			; Convert group number to ASCII
	CALL	LZTRNC			; Truncate leading zeros
	MOVB	#',,(R0)+		; Move in comma
	MOV	DIRNAM+2,R1		; RAD50 word to convert
	CALL	$C5TA			; Convert member number to ASCII
	CALL	LZTRNC			; Truncate leading zeros
	MOVB	#'],(R0)+		; Move in right bracket
;
;    Process filename (3 RAD50 words)
	MOV	N.FNAM(R4),R1		; Move in first word of filename
	CALL	$C5TA			; To ASCII
	MOV	N.FNAM+2(R4),R1		; Move in second word of filename
	CALL	$C5TA			; To ASCII
	MOV	N.FNAM+4(R4),R1		; Move in third word of filename
	CALL	$C5TA			; To ASCII
	CALL	RBTRNC			; Truncate trailing blanks
;
;    Process file type (1 RAD50 word)
	MOVB	#'.,(R0)+		; Move in period
	MOV	N.FTYP(R4),R1		; Move in file type
	CALL	$C5TA			; To ASCII
	CALL	RBTRNC			; Truncate trailing blanks
;
;    Process version number (1 binary word)
	MOVB	#';,(R0)+		; Move in semicolon
	MOV	N.FVER(R4),R1		; Number to be converted
	CLR	R2			; Indicate leading zero suppression
	CALL	$CBOMG			; Convert to ASCII
;
;    Calculate length of line
10$:
	MOV	(SP)+,R1		; Restore filespec string pointer
	SUB	R1,R0			; Set filename string length
	RETURN
;
;    Process directory file access errors
20$:
	ERROR	<Couldn't access directory file information>
	BR	10$			;
;
;
;+
;  MODULE LZTRNC
;-
;
NBYTES:	.WORD	3			; Number of bytes to consider
LZTRNC:
	MOV	R0,R1
	SUB	#3,R1			; Point to beginning
10$:	CMPB	#'0,(R1)		; Zero?
	BNE	20$			;  If NE, no - all done
	CLRB	(R1)+			; Make the ASCII 0 a null
	CMP	R1,R0			; Done yet?
	BNE	10$			; If NE, no
20$:	RETURN
;
;
;+
;  MODULE RBTRNC
;-
;
RBTRNC:
10$:
	CMPB	#' ,-(R0)		; Is this a blank?
	BEQ	10$			; If EQ, yes
	INC	R0			; Fix R0
	RETURN
;
;
	.PAGE
	.SBTTL Module TIWRT
;+
;  MODULE TIWRT
;
;  FUNCTION
;	Writes to TI: a message about a VD: unit; either the filespec of
;	the file it is assigned to, or, if unassigned, that it is unassigned.
;
;  INPUTS
;	R2	Unit number (in binary)
;	C bit	set   - indicates unit unassigned
;		clear - indicates unit assigned
;
;	if C clear:
;	R0	length of filespec pointed to by R1
;	R1	address of filespec
;
;  OUTPUTS
;	A line is written to TI:
;
;-
;
TIQIO:	QIOW$	IO.WVB,TILUN,TILUN,,,,<MESBUF,,40>
MESBUF:	.ASCII	\ VD\			; Constant part of message
UNITNO:	.ASCII	\    \
BASLEN	=.-MESBUF
MESTXT:	.BLKB	50.			; Variable part of message
UNASIG:	.ASCII	\ is currently unassigned\
UNALEN	=.-UNASIG
ASIGND:	.ASCII	\ is assigned to  \
ASILEN	=.-ASIGND
	.EVEN
;
;
TIWRT:
	MOV	R2,-(SP)		; Save unit number
	MOV	#MESTXT,R4		; Set QIO buffer address
	BCC	10$			; If CC, unit is assigned
	MOV	#UNASIG,R1		; Set message address
	MOV	#UNALEN,R0		; Set message length
	CLR	R5			; Set cumulative message length
	BR	30$
10$:
	MOV	#ASIGND,R2		; Set address of intermediate message
	MOV	#ASILEN,R3		; Set length of intermediate message
	MOV	R3,R5			; Set cumulative message length
20$:	MOVB	(R2)+,(R4)+		; Copy intermediate message to QIO buf
	SOB	R3,20$			; ...till done
30$:
	ADD	R0,R5			; Add message length to cumulative len
	ADD	#BASLEN,R5		; Add length of message base
	MOV	R5,TIQIO+Q.IOPL+2	; Set total message length
40$:	MOVB	(R1)+,(R4)+		; Move message to QIO buf
	SOB	R0,40$			; ...till done
;
	MOV	(SP)+,R1		; Restore unit number
	MOV	#UNITNO,R0		; Set ASCII output address
	CLR	R2			; Indicate leading zero suppression
	CALL	$CBOMG			; Convert unit number to ASCII
	MOVB	#':,(R0)		; Just for impeccable syntax
	DIR$	#TIQIO			; Write the message
	RETURN
;
;
	.PAGE
	.SBTTL Module PUTERR
;+
;
;  FUNCTION
;	Writes error messages to TI:
;
;  INPUTS
;	R0	Address of error message string (terminated by a 0 byte)
;
;  OUTPUTS
;	Error message written to TI:
;	R1 lost
;
;-
;
ERRQIO:	QIOW$	IO.WVB,TILUN,TILUN,,,,<EMBUF,,40>	;Error message DPB
EMBUF:	.ASCII	\ SVD -- \		; Error message prefix
EMTEXT:	.BLKB	50.			; Error message text
	.EVEN
;
PUTERR:
	MOV	#EMTEXT,R1		; Get address of text portion of EMBUF
10$:	MOVB	(R0)+,(R1)+		; Copy text
	BNE	10$			; ...until null encountered
	SUB	#EMBUF,R1		; Figure length of this message
	MOV	R1,ERRQIO+Q.IOPL+2	; Move length to DPB
	DIR$	#ERRQIO			; Issue QIOW
	RETURN
;
;
	.END	SVD