%TITLE 'PERFORM_DISCONNECT'
MODULE PERFORM_DISCONNECT (IDENT='V1.0-1') =
BEGIN
!++
! FACILITY: 	    PERFORM_DISCONNECT
!
! ABSTRACT: 	    Kernel-mode routine to do a virtual terminal disconnect.
!
! MODULE DESCRIPTION:
!
!   description
!
! AUTHOR:   	    M. Madison
!   	    	    COPYRIGHT © 1993, 1994  MADGOAT SOFTWARE.  ALL RIGHTS RESERVED.
!
! CREATION DATE:    03-FEB-1993
!
! MODIFICATION HISTORY:
!
!   03-FEB-1993	V1.0	Madison	    Initial coding.
!   01-SEP-1994	V1.0-1	Madison	    Make LIB reference VMS-version specific.
!--

    LIBRARY 'LIBREQ_DIR:LIB';

    FORWARD ROUTINE
    	PERFORM_DISCONNECT,
    	AFTER_PERFORM_DISCONNECT;

    MACRO
    	CLASS_DISC = 24,0,32,0%;

%IF %BLISS(BLISS32E) %THEN
    PSECT
    	NODEFAULT = $$$BEGIN_LOCKED_CODE (READ,WRITE,NOEXECUTE),
    	NODEFAULT = $$$END_LOCKED_CODE   (READ,WRITE,NOEXECUTE);

    GLOBAL
    	$$$LOCK_START	: PSECT ($$$BEGIN_LOCKED_CODE),
    	$$$LOCK_END 	: PSECT ($$$END_LOCKED_CODE);
%FI

%SBTTL 'PERFORM_DISCONNECT'
GLOBAL ROUTINE PERFORM_DISCONNECT (DEVNAM_A) = 
BEGIN
!++
! FUNCTIONAL DESCRIPTION:
!
!   Does the K-mode dirty work for DISCONNECT.
!
! RETURNS:  	cond_value, longword (unsigned), write only, by value
!
! PROTOTYPE:
!
!   PERFORM_DISCONNECT  trmnam
!
! IMPLICIT INPUTS:  None.
!
! IMPLICIT OUTPUTS: None.
!
! COMPLETION CODES:
!
!   SS$_NORMAL:	    	normal successful completion.
!
! SIDE EFFECTS:
!
!   None.
!--

    LINKAGE
    	SCH_ROUTINE = JSB (REGISTER=4) : NOPRESERVE(0,1,2,3,5,6,7,8,9,10,11),
    	IOC_ROUTINE = JSB (REGISTER=1, REGISTER=2, REGISTER=3; REGISTER=1)
    	    	    	  : NOPRESERVE(4,5,6,7,8,9,10,11),
    	CLS_ROUTINE = JSB (REGISTER=5) : NOPRESERVE (0,1,2,3,4,6,7,8,9,10,11);

    EXTERNAL ROUTINE
    	SCH$IOLOCKR 	: SCH_ROUTINE ADDRESSING_MODE (GENERAL),
    	IOC$SEARCHDEV	: IOC_ROUTINE ADDRESSING_MODE (GENERAL),
    	SCH$IOUNLOCK	: SCH_ROUTINE ADDRESSING_MODE (GENERAL);

    EXTERNAL
    	CTL$GL_PCB  	: REF BLOCK [,BYTE] ADDRESSING_MODE (GENERAL);

    LOCAL
    	UCB 	    : REF BLOCK [,BYTE],
    	CLASS_BASE  : REF BLOCK [,BYTE],
    	TMP,
    	STATUS;

    SCH$IOLOCKR (.CTL$GL_PCB);

    STATUS = IOC$SEARCHDEV (.DEVNAM_A, 0, 0 ; UCB);
    IF .STATUS THEN
    BEGIN
    	BIND
    	    DEVCHR  = UCB [UCB$L_DEVCHAR]	: BLOCK [,BYTE],
    	    DEVCHR2 = UCB [UCB$L_DEVCHAR2]	: BLOCK [,BYTE];
    	IF .UCB [UCB$B_DEVCLASS] EQL DC$_TERM AND .DEVCHR [DEV$V_TRM]
    	    	AND NOT .DEVCHR [DEV$V_NET] AND NOT (.DEVCHR2 [DEV$V_DET]
    	    	    OR .DEVCHR2 [DEV$V_RTT] OR .DEVCHR2 [DEV$V_RED]) AND
    	    	.UCB [UCB$L_TL_PHYUCB] NEQA .UCB
    	THEN
    	BEGIN
    	    LOCAL
    	    	U   : REF BLOCK [,BYTE];
    	    U = .UCB;
    	    STATUS = (WHILE 1 DO
    	    	BEGIN
    	    	    BIND DD = UCB [UCB$Q_DEVDEPEND] + 4 : BLOCK [,BYTE];
    	    	    IF NOT .DD [TT2$V_DISCONNECT] THEN EXITLOOP 0;
    	    	    UCB = .U [UCB$L_TL_PHYUCB];
    	    	    IF .U EQLA .UCB THEN EXITLOOP 1;
    	    	    U = .UCB;
    	    	END);
    	    CLASS_BASE = .UCB [UCB$L_TT_CLASS];
    	    IF .STATUS AND .CLASS_BASE NEQA 0 THEN
    	    BEGIN
    	    	SCH$IOUNLOCK (.CTL$GL_PCB);
    	    	$DEVICELOCK (LOCKADDR=.UCB [UCB$L_DLCK],
    	    	    LOCKIPL=.UCB [UCB$B_DIPL],
    	    	    SAVIPL=TMP,
    	    	    PRESERVE=NO);
    	    	CLS_ROUTINE (.CLASS_BASE [CLASS_DISC], .UCB);
    	    	$DEVICEUNLOCK (LOCKADDR=.UCB [UCB$L_DLCK],
    	    	    NEWIPL=.TMP, PRESERVE=NO);
    	    	$SETIPL (NEWIPL=0);
    	    	RETURN SS$_NORMAL;
    	    END
    	    ELSE STATUS = 2;!SS$_DEVREQERR;
    	END
    	ELSE STATUS = 4;!SS$_DEVREQERR;
    END;

    SCH$IOUNLOCK (.CTL$GL_PCB);
    $SETIPL (NEWIPL=0);

    .STATUS

END; ! PERFORM_DISCONNECT
GLOBAL ROUTINE AFTER_PERFORM_DISCONNECT = (SS$_NORMAL);  ! dummy routine for LCKPAG

%SBTTL 'LOCK_DISCONNECT_CODE'
GLOBAL ROUTINE LOCK_DISCONNECT_CODE = 
BEGIN
!++
! FUNCTIONAL DESCRIPTION:
!
!   Locks down the disconnect code (and linkage on AXP systems),
!   which runs at high IPL.
!
! RETURNS:  	cond_value, longword (unsigned), write only, by value
!
! PROTOTYPE:
!
!   LOCK_DISCONNECT_CODE
!
! IMPLICIT INPUTS:  None.
!
! IMPLICIT OUTPUTS: None.
!
! COMPLETION CODES:
!
!   SS$_NORMAL:	    	normal successful completion.
!
! SIDE EFFECTS:
!
!   None.
!--
    LOCAL
    	LCKLST	: VECTOR [2,LONG],
%IF %BLISS(BLISS32E) %THEN
    	PGSIZE	: ALIAS,
    	SYILST	: $ITMLST_DECL(ITEMS=1),
%FI
    	STATUS;

%IF %BLISS(BLISS32E) %THEN

    $ITMLST_INIT(ITMLST=SYILST,
    	(ITMCOD=SYI$_PAGE_SIZE, BUFSIZ=%ALLOCATION(PGSIZE), BUFADR=PGSIZE));
    STATUS = $GETSYI(ITMLST=SYILST);
    IF NOT .STATUS THEN RETURN .STATUS;

!++
! Because on AXP systems we have multiple PSECTs that must be locked down
! (both code and linkage), and those PSECTs might not be on contiguous
! pages, we probe each page between the starting and ending points of the
! locked-down cluster to see if it exists before we try and lock it down.
!--

    LCKLST [0] = $$$LOCK_START;

    WHILE (.LCKLST [0] LSSA $$$LOCK_END) DO
    BEGIN
    	LCKLST [1] = .LCKLST [0] + .PGSIZE-4;
    	IF $PROBE (.LCKLST [0], 4, RQ, 0) THEN
    	BEGIN
    	    STATUS = $LKWSET (INADR=LCKLST);
    	    IF NOT .STATUS THEN EXITLOOP;
    	END;
    	LCKLST [0] = .LCKLST [0] + .PGSIZE;
    END;

%ELSE

! This code is for VAX only

    LCKLST [0] = PERFORM_DISCONNECT;
    LCKLST [1] = AFTER_PERFORM_DISCONNECT;

    STATUS = $LKWSET (INADR=LCKLST);

%FI

    .STATUS

END; ! LOCK_DISCONNECT_CODE

END
ELUDOM