.title GET_DISK -- gets disk names
	.ident /V1-00/
;+++
;
; FACILITY:
;	GET_DISK
;
; ENVIRONMENT:
;	VAX/VMS Kernel Mode (call by $CMKRNL GET_DISK)
;	V3.00 or greater
;
; IMPLICIT INPUTS:
;	NONE
;
; IMPLICIT OUTPUTS:
;	R0 - contains SS$_NORMAL if a disk was found or
;	     SS$_NOSUCHDEV if no more disks in the DDB
;
; IMPLICIT OUTPUTS:
;	Modified global locations:
;	 DISK_LENGTH     : (word)
;	 DISK_NAME	 : (less than 16 bytes of data)
;	 UNIT_NUMBER	 : (word)
;
; AUTHOR:
;	Joel M Snyder	(1-Aug-1983)
;	 CompuServe Incorporated, Research and Development
;
; MODIFIED BY:
;
;
; ABSTRACT:
;	GETDISK is a subroutine that is used to determine the disk
;	drives used on a system. The subroutine is not absolutely
;	brilliant -- it doesn't check to see that the device which
;	it thinks is a disk drive is indeed a disk drive, but
;	the heuristic it uses is accurate for my VAX, and that's all
;	I can test it on. 
;	GETDISK does have a minor problem -- it modifies global data
;	areas, in direct violation of the VAX Modular Coding Standard.
;	But this was the easiest way to write the subroutine, both
;	from a user's standpoint and from the programmer's standpoint.
;	GETDISK requires that global areas DISK_NAME(15 bytes, no less),
;	DISK_LENGTH (1 longword) and UNIT_NUMBER (1 longword) be defined
;	and available at link-time. For example:
;	.GLOBAL DISK_NAME,DISK_LENGTH,UNIT_NUMBER
;	DISK_NAME:	.blkb 15
;	DISK_LENGTH:	.blkl  1
;	UNIT_NUMBER:	.blkl  1
;
;	GET_DISK maintains it's own 'context' within the system device
;	table. This could cause problems on a system which is highly
;	volatile in terms of disks, but I can't imagine such a system,
;	so I assume that the disks configured into the system are
;	not removed during runs of programs which call GETDISK. 
;	GETDISK returns SS$_NORMAL for each call in which a new
;	disk drive got placed in global data. On the next call, it
;	returns SS$_NOSUCHDEV, and then resets itself, ready to
;	trace through the system DDB again.
;
;	GETDISK selects disk on this criterion:
;	IF the first character of the name in the DDB is "D"
;	THEN the device is a disk. 
;	I suppose that the correct thing to do is a bit test for
;	DEV$V_FOD (file oriented) and perhaps DEV$V_DIR (directory
;	device) with secondary tests for DEV$V_AVL (device available)
;	and DEV$V_MNT (device mounted) in UCB$L_DEVCHAR (defined
;	by $DEVDEF), but I have a feeling that you don't really need
;	to worry about that. The really correct thing to do is
;	to test that UCB$B_DEVCLASS is DC$_DISK (in $DCDEF). GETDISK
;	does this.
;
;	In DISK_LENGTH is placed the length of DISK_NAME (usually
;	three or four characters; this does NOT include the UNIT
;	NUMBER). In DISK_NAME (up to 15 characters) is the name
;	from the DDB. In UNIT_NUMBER (a longword) is a unit number
;	of this disk. 
;---

;
;	library definitions
;
	.library /SYS$LIBRARY:LIB/

	$DDBDEF
	$SSDEF
	$UCBDEF
	$DCDEF
;
;	external definitions
;
	.external DISK_NAME,DISK_LENGTH,UNIT_NUMBER

	.psect Get_Disk_Data
SAVED_R11:
	.long 0
SAVED_R10:
	.long 0


	.psect Get_Disk_Code
	.ENTRY GET_DISK,^M<R2,R3,R4,R5,R6,R7,R8,R9,R10,R11>

	movl	SAVED_R11,R11		; get R11 (DDB address)
	movl	SAVED_R10,R10		; and get R10 (UCB address)
	tstl 	r10			; is R10 zero (on first call) ?
	bnequ	get_a_ucb		;  if R10#0, get another UCB
					;  if R10=0, initialize ddb table
	moval	L^IOC$GL_DEVLIST-DDB$L_LINK,R11
					; get the address of the first DDB

get_a_ddb:
	movl	DDB$L_LINK(R11),R11	; get the next DDB
	bnequ	got_a_ddb		;  if R11#0, we got a DDB
	brw	no_more_ddb		;  if R11=0, there are no more DDBs

got_a_ddb:
	movzbl 	DDB$T_NAME(R11),R6	; get number of characters in name
	cmpb	#^A/D/, DDB$T_NAME+1(R11)
					; is this device a disk? 
	bnequ	get_a_ddb		;  if not a disk, get another DDB
	movc3	R6,DDB$T_NAME+1(R11),W^DISK_NAME
					;  if a disk, save disk name
	movzbl	R6,W^DISK_LENGTH	; ... and disk name length
	movl	DDB$L_UCB(R11),R10	; see if there is a UCB for this
	beqlu	get_a_ddb		; ... DDB. If not, get another DDB
	moval	DDB$L_UCB-UCB$L_LINK(R11), R10
					; get address of address of 1st UCB

get_a_ucb:				; ignoring grammar
	movl	UCB$L_LINK(R10),R10	; get next UCB
	beqlu	get_a_ddb		;  if no more UCBs, get a DDB
	cmpb	#DC$_DISK,UCB$B_DEVCLASS(R10)
					; is this a disk?
	bnequ	get_a_ucb		;  no, get the next ucb
	movw	UCB$W_UNIT(R10),W^UNIT_NUMBER
					; save the unit number for this one
	movl	R10,SAVED_R10		; Save R10 (the UCB address) and
	movl	R11,SAVED_R11		; R11 (the DDB address) for later
	movzwl	#SS$_NORMAL,R0		; and give a status return
	ret				; EXIT POINT

no_more_ddb:
	clrl	SAVED_R10		; clear out the UCB address
	clrl	SAVED_R11		; and DDB address in case  called again
	movzwl	#SS$_NOSUCHDEV,R0	; give a status return
	ret				; EXIT POINT
	
	.end