Google
 

Trailing-Edge - PDP-10 Archives - BB-LW55A-BM_1988 - language-sources/xpnclo.b36
There are 25 other files named xpnclo.b36 in the archive. Click here to see a list.
%TITLE 'XPNCLO - Close a network link'
MODULE xpnclo (
               ENTRY ( XPN$CLOSE )
              ) =
BEGIN
!  COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1981, 1986.
!  ALL RIGHTS RESERVED.
!  
!  THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY  BE  USED  AND
!  COPIED ONLY IN ACCORDANCE WITH 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 THAT IS NOT SUPPLIED BY DIGITAL.

!++
! FACILITY:
!   Transportable BLISS interface to DECNET for TOPS-20.
!
! ABSTRACT:
!   This module implements the $XPN_CLOSE macro.
!
! ENVIRONMENT:
!   TOPS-20 user mode.
!
! AUTHOR:  Larry Campbell, CREATION DATE:  January 8, 1982
!
! MODIFIED BY:
!
!--
!
! TABLE OF CONTENTS:
!
FORWARD ROUTINE
    xpn$close,                          ! Called by $XPN_CLOSE macro
    xpn$$close;                         ! Does actual work
!
! INCLUDE FILES:
!
LIBRARY 'BLI:XPORT';                    ! XPORT definitions
LIBRARY 'BLISSNET';                     ! Transportable interface definitions
LIBRARY 'BLI:MONSYM';                   ! Monitor symbols
LIBRARY 'BLISSNET20';                   ! TOPS-20-specific definitions
REQUIRE 'JSYSDEF';
!
! MACROS:
!

!
! EQUATED SYMBOLS:
!

!
! OWN STORAGE:
!

!
! EXTERNAL REFERENCES:
!
EXTERNAL ROUTINE
    xpn$$valid_nlb;                     ! Validate an NLB
GLOBAL ROUTINE xpn$close (nlb, success_routine, failure_routine) =
!++
! FUNCTIONAL DESCRIPTION:
!   This routine is called by the $XPN_CLOSE macro to close a network link.
!
! FORMAL PARAMETERS:
!   nlb                 - address of the Network Link Block
!   success_routine     - address (optional) of routine to call on success
!   failure_routine     - address (optional) of routine to call on failure
!
! IMPLICIT INPUTS:
!   NONE
!
! IMPLICIT OUTPUTS:
!   NLB$V_OPEN          - cleared
!   NLB$V_CONNECTED     - cleared
!   NLB$H_JFN           - cleared, unless NLB$V_REMEMBER is set
!
! ROUTINE VALUE and
! COMPLETION CODES:
!   XPN$_BAD_NLB        - invalid NLB
!   or any code returned by xpn$$close (q.v.)
!
! SIDE EFFECTS:
!   The JFN associated with the link is closed, and if NLB$V_REMEMBER is not
!   set, the JFN is released.
!
!--
    BEGIN

    MAP
        nlb : REF $XPN_NLB();

    LOCAL
        original_primary_code,
        primary_code,
        secondary_code,
        retcode;

    nlb_binds;                          ! create nice names for NLB fields
    !
    ! validate the NLB
    !
    retcode = xpn$$valid_nlb (.nlb);
    IF NOT .retcode THEN
        BEGIN
        original_primary_code = XPN$_BAD_NLB;
        secondary_code = .retcode
        END
    ELSE
        BEGIN
	original_primary_code = xpn$$close (.nlb);
        nlb[NLB$G_COMP_CODE] = .original_primary_code;
        secondary_code = .nlb[NLB$G_2ND_CODE]
        END;
    !
    ! Check completion code and call success or failure routine as required
    !
    IF .original_primary_code THEN
        IF .success_routine NEQ 0 THEN
            primary_code =
                (.success_routine) (XPN$K_CLOSE, .original_primary_code,
                    .secondary_code, .nlb)
        ELSE
            primary_code = .original_primary_code
    ELSE
        IF .failure_routine NEQ 0 THEN
            primary_code =
                (.failure_routine) (XPN$K_CLOSE, .original_primary_code,
                    .secondary_code, .nlb)
        ELSE
            primary_code = .original_primary_code;
    !
    ! Unless the NLB was bad, store the completion code there
    !
    IF .original_primary_code NEQ XPN$_BAD_NLB
    THEN
        nlb[NLB$G_COMP_CODE] = .primary_code;
    RETURN (.primary_code);

    END;                                !End of xpn$close
ROUTINE xpn$$close (nlb) =
!++
! FUNCTIONAL DESCRIPTION:
!   This routine does the actual work to close a network link.
!
! FORMAL PARAMETERS:
!   nlb         - address of the Network Link Block
!
! IMPLICIT INPUTS:
!   NONE
!
! IMPLICIT OUTPUTS:
!   NONE
!
! ROUTINE VALUE and 
! COMPLETION CODES:
!   XPN$_NORMAL         - successful close
!   XPN$_NOT_OPEN       - the link was not open
!
! SIDE EFFECTS:
!   NONE
!
!--
    BEGIN

    MAP
        nlb : REF $XPN_NLB();

    LOCAL
        count,
        address,
        xport_code,
        retcode;

    IF NOT .nlb[NLB$V_OPEN]
    THEN
        RETURN (XPN$_NOT_OPEN);
    retcode = XPN$_NORMAL;              ! Default returned value
    IF .nlb[NLB$V_ABORTALL] OR .nlb[NLB$V_CONNECTED]
    THEN
        !
        ! User requested abort, or did not called $XPN_CLOSE without first
        ! calling $XPN_DISCONNECT.  Abort the link and get out.
        !
        JSYS_CLOSF (.nlb[NLB$H_JFN] OR CZ_ABT
                    OR (IF .nlb[NLB$V_REMEMBER]
                        THEN            ! If OPTION=REMEMBER,
                            CO_NRJ      !  keep the JFN
                        ELSE
                            0))
    ELSE
        !
        ! Disconnect nice and synchronously
        !
        IF NOT JSYS_CLOSF (.nlb[NLB$H_JFN]
                           OR (IF .nlb[NLB$V_REMEMBER]
                               THEN            ! If OPTION=REMEMBER,
                                   CO_NRJ      !  keep the JFN
                               ELSE
                                   0))
        THEN
            !
            ! If the CLOSF failed, the other end must have aborted.  We must
            ! now abort our end, or the JFN will not be closed.
            !
            JSYS_CLOSF (.nlb[NLB$H_JFN] OR CZ_ABT
                        OR (IF .nlb[NLB$V_REMEMBER]
                            THEN            ! If OPTION=REMEMBER,
                                CO_NRJ      !  keep the JFN
                            ELSE
                                0));
    IF NOT .nlb[NLB$V_REMEMBER]
    THEN
        nlb[NLB$H_JFN] = 0;
    !
    ! If any read buffer exists, free up its memory.  See xpn$$new_buffer
    ! for a description of why all this kludgery is required here.
    !
    IF (count = .nlb[NLB$H_STRING]) NEQ 0
    THEN
        BEGIN
        nlb[NLB$H_STRING] = (.count + 3) / 4;
        address = CH$PLUS (.nlb[NLB$A_STRING], 1);
        nlb[NLB$A_STRING] = .address<rh>;
        IF NOT (xport_code = $XPO_FREE_MEM (BINARY_DATA = nlb[NLB$T_STRING],
                                            FAILURE = 0))
        THEN
            BEGIN
            nlb[NLB$G_2ND_CODE] = .xport_code;
            retcode = XPN$_FREE_MEM
            END
        END;
    nlb[NLB$V_OPEN] = 0;
    nlb[NLB$V_CONNECTED] = 0;
    nlb[NLB$V_WAIT] = 0;
    nlb[NLB$V_DATA_REQ] = 0;
    nlb[NLB$V_END_MSG] = 0;
    nlb[NLB$V_ABORTALL] = 0;
    IF NOT .nlb[NLB$V_REMEMBER]
    THEN
        BEGIN
        nlb[NLB$V_ACTIVE] = 0;
        nlb[NLB$V_PASSIVE] = 0
        END;
    nlb[NLB$V_CONN_REQ] = 0;
    nlb[NLB$V_ABORTED] = 0;
    nlb[NLB$V_DISCONNECTED] = 0;
    nlb[NLB$V_INT_SET] = 0;
    RETURN (.retcode)
    END;                                ! End of xpn$$close
END
ELUDOM