%TITLE 'Set and Force Preferred Disk Path'
MODULE PREFERED (IDENT = 'X01-000',
		MAIN = main_force,
		ADDRESSING_MODE (EXTERNAL = GENERAL, NONEXTERNAL = GENERAL)
		) =
BEGIN
!
! COPYRIGHT (c) 1985 BY
! DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASSACHUSETTS.
! ALL RIGHTS RESERVED.
!
! THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
! ONLY  IN  ACCORDANCE  OF  THE  TERMS  OF  SUCH  LICENSE  AND WITH THE
! INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR  ANY  OTHER
! COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
! OTHER PERSON.  NO TITLE TO AND  OWNERSHIP OF THE  SOFTWARE IS  HEREBY
! TRANSFERRED.
!
! THE INFORMATION IN THIS SOFTWARE IS  SUBJECT TO CHANGE WITHOUT NOTICE
! AND  SHOULD  NOT  BE  CONSTRUED  AS A COMMITMENT BY DIGITAL EQUIPMENT
! CORPORATION.
!
! DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE  OR  RELIABILITY OF ITS
! SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
!
! CREATION DATE: 10-October=1990
!
! MODIFIED BY:
!--
 
!
! INCLUDE FILES:
!
 
LIBRARY 'SYS$LIBRARY:LIB';
 
!
! TABLE OF CONTENTS:
!
 
FORWARD ROUTINE
    main_force,
    do_force : NOVALUE;
 
!
! OWN STORAGE:
!
 
OWN
    force_flag,
    io_channel : UNSIGNED WORD;			!
 
!
! EXTERNAL REFERENCES:
!
 
EXTERNAL ROUTINE
    CLI$DCL_PARSE : ADDRESSING_MODE (GENERAL),	! Parse a DCL command line
    CLI$GET_VALUE : ADDRESSING_MODE (GENERAL),	! Get value of command param or qual
    CLI$PRESENT : ADDRESSING_MODE (GENERAL);	! Indicate presence of qualifier
 
EXTERNAL LITERAL
    CLI$_PRESENT;

ROUTINE main_force =
 
!++
!
! Set the prefered path for a disk and/or force the disk to the
! prefered path.  If the disk is not currently mounted the force
! is skipped because the path selection will be done at mount time.
!
!--
 
    BEGIN
 
    LOCAL
	host_desc : BLOCK [DSC$C_D_BLN, BYTE] VOLATILE PRESET (	!
		    [DSC$W_LENGTH] = 0,		! Will be filled later
		    [DSC$B_DTYPE] = DSC$K_DTYPE_T,	! Data type = text
		    [DSC$B_CLASS] = DSC$K_CLASS_D,	! Class is static
		    [DSC$A_POINTER] = 0),		! Will be filled in later
	host_name : VECTOR [256, BYTE],
	disk_desc : BLOCK [DSC$C_D_BLN, BYTE] VOLATILE PRESET (	!
		    [DSC$W_LENGTH] = 0,		! Will be filled later
		    [DSC$B_DTYPE] = DSC$K_DTYPE_T,	! Data type = text
		    [DSC$B_CLASS] = DSC$K_CLASS_D,	! Class is static
		    [DSC$A_POINTER] = 0),		! Will be filled in later
	iosb : VECTOR [4, WORD],
	host_length : WORD,
	status;
    !
    ! Set the force_flag based on the presence of the /FORCE
    ! qualifier in the command line
    !
    IF CLI$PRESENT (%ASCID'force') EQL CLI$_PRESENT
    THEN
	force_flag = 1
    ELSE
	force_flag = 0;
    !
    ! Get the name of the disk.  If the disk name is not specified exit.
    ! This should not be possible because the CLD should catch it - but...
    !
    IF NOT (status = CLI$GET_VALUE (%ASCID'disk_name', disk_desc))
    THEN
	SIGNAL_STOP (.status);
    !
    ! Now that we have the device name assign a channel to it for later use.
    !
    IF NOT (status = $ASSIGN (
				DEVNAM = disk_desc,
				CHAN = io_channel))
    THEN
	SIGNAL_STOP (.status);
    !
    ! Get the prefered host if specified.  If it is not do the force
    ! if requested and exit.  If the host is not specified the CLD should
    ! require that /FORCE be present.
    !
    IF NOT CLI$GET_VALUE (%ASCID'host_name', host_desc, host_length)
    THEN
	BEGIN
	IF .force_flag THEN do_force();
	RETURN SS$_NORMAL
	END;
    !
    ! The QIOW wants a counted ascii string.  Build it.
    !
    host_name[0] = .host_length;	! Fill in the count and copy the string
    CH$COPY(.host_length, .host_desc[DSC$A_POINTER],0,255,host_name[1]);
    !
    ! We have the device name and the prefered host.
    ! Set the preferred path.
    !
    IF NOT (status = $QIOW (		!
		FUNC = IO$_SETPRFPATH,	! Set  prefered path function
		CHAN = .io_channel, 	! Channel already assigned
		IOSB = iosb, 		! I/O Status for check
		P1 = host_name))	! Prefered path name
    THEN
	SIGNAL_STOP(.status);
    IF NOT .IOSB [0] THEN SIGNAL_STOP(.status);
    !
    ! Now that the prefered host has been set, force a path change if 
    ! requested.
    !
    IF .force_flag THEN do_force();
    !
    ! All done
    !
    SS$_NORMAL
 
    END;

ROUTINE do_force : NOVALUE =
 
!++
!
! Force the disk to switch to the preferred path if it is mounted.
! If the disk is not mounted the QIO is just a no-op
!
!--
 
    BEGIN
 
    LOCAL
	iosb : VECTOR [4, WORD],
	status;
 
    !
    ! Force the path change
    !
    IF NOT (status = $QIOW (				!
		FUNC = IO$_SETPRFPATH OR IO$M_FORCEPATH,! Force prefered path function
		CHAN = .io_channel, 			! Channel already assigned
		IOSB = iosb)) 				! I/O Status for check
    THEN
	SIGNAL_STOP(.status);
    IF NOT .IOSB [0] THEN SIGNAL_STOP(.status);
 
    END;
 
END
ELUDOM