Google
 

Trailing-Edge - PDP-10 Archives - bb-ee87b-sb - 10,7/dil/xpneve.b36
There are 25 other files named xpneve.b36 in the archive. Click here to see a list.
%TITLE 'XPNEVE - Return event information for logical links'
MODULE XPNEVE (
               ENTRY ( XPN$EVENT_INFO )
              ) =
BEGIN
!  COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1985.
!  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:
!   BLISSnet-10, the TOPS-10 implementation of the Transportable BLISS
!   interface to DECNET.
!
! ABSTRACT:
!   This module supports the BLISSnet macro $XPN_EVENT_INFO.
!
! ENVIRONMENT:
!   TOPS-10 user mode with XPORT.
!
! AUTHOR: Larry Campbell, CREATION DATE: November 20, 1981
!
! MODIFIED BY:
!
! Start using the DIL standard edit history format.
!
! Facility Blissnet
!
! Edit (%O'2', '12-Apr-84', 'Sandy Clemens')
!  %( Add the TOPS-10 BLISSnet sources for DIL V2.  )%
!
! Edit (%O'6', '5-Oct-84', 'Sandy Clemens')
!  %( Add new format of COPYRIGHT notice.  FILES:  ALL )%
!--
!
! TABLE OF CONTENTS:
!
FORWARD ROUTINE
    xpn$event_info,                     ! Outer routine, called by user
    xpn$$event_info,                    ! Does the actual work
    xpn$$connect,                       ! Check for connect event
    xpn$$aborted,                       ! Check for abort
    xpn$$interrupt,                     ! Check for interrupt message
    xpn$$link_service,                  ! Check for link service message
    xpn$$data_available,                ! Check for data available
    xpn$$disconnected,                  ! Check for disconnect event
    xpn$$get_connect_info : NOVALUE;    ! Reads remote object information
!
! INCLUDE FILES:
!
LIBRARY 'BLI:XPORT';
LIBRARY 'BLISSNET';
LIBRARY 'BLI:UUOSYM';
LIBRARY 'BLSN10';
LIBRARY 'BLI:TENDEF';
LIBRARY 'UUODEF';
!
! MACROS:
!

!
! EQUATED SYMBOLS:
!

!
! UNDECLARED SYMBOLS: Some problems with UUO macros defined in UUOSYM
!
UNDECLARE
    %QUOTE OUTPUT,
    %QUOTE WAIT;

!
! OWN STORAGE:
!

!
! EXTERNAL REFERENCES:
!
EXTERNAL ROUTINE
    xpn$$new_buffer : NOVALUE,          ! Sets new buffer in NLB
    xpn$$link_status,                   ! Returns status of a link
    xpn$$valid_nlb,                     ! Validates an NLB
    xpn$$int_set : NOVALUE,             ! Set interrupts for list of NLBs
    xpn$$get_data,			! Read data from LL
    xpn$$sleep : NOVALUE;               ! Sleep for n milliseconds
GLOBAL ROUTINE xpn$event_info (nlb_vector, success, failure, output, wait) =
!++
! FUNCTIONAL DESCRIPTION:
!   Outer routine called by $XPN_EVENT_INFO macro.  This routine
!   validates the NLBs, calls xpn$$event_info to do the work, and handles
!   user-supplied success/failure routines.
!
! FORMAL PARAMETERS:
!   nlb_vector          - counted vector (0th element is count) of addresses
!                         of Network Link Blocks to check
!   success             - optional address of routine to call on success
!   failure             - optional address of routine to call on failure
!   output              - this gets address of NLB for which an event occurred
!   wait                - 0 to return immediately, 1 to wait for an event
!                         to occur before returning
!
! IMPLICIT INPUTS:
!   NONE
!
! IMPLICIT OUTPUTS:
!   NONE
!
! ROUTINE VALUE and
! COMPLETION CODES:
!    Success codes:
!       Any code returned by xpn$$event_info
!
!    Error codes:
!       XPN$_BADVECTOR  - an invalid NLB vector was passed
!       XPN$_NOT_OPEN   - one of the NLBs was not open
!       In addition, any error code from xpn$$event_info may be returned
!
! SIDE EFFECTS:
!   If an event occurred, output gets the address of the pertinent NLB.
!   Otherwise a zero is stored in output.
!
!--
    BEGIN

    MAP
        nlb_vector : REF VECTOR[1];

    LOCAL
        out_nlb : REF $XPN_NLB(),       ! address of NLB for which event occurred
        this_nlb : REF $XPN_NLB(),      ! Current NLB
        retcode,                        ! Return code from xpn$$event_info
        retcode_2ndary;                 ! Secondary returned code
    !
    ! Validate the NLBs first
    !
    INCR index FROM 1 TO .nlb_vector[0] DO
        BEGIN
        IF NOT (retcode = xpn$$valid_nlb (.nlb_vector[.index])) THEN
            BEGIN
            IF .output NEQ 0 THEN (.output) = .nlb_vector[.index];
            EXITLOOP
            END;
        this_nlb = .nlb_vector[.index];
        IF NOT .this_nlb[NLB$V_OPEN] THEN
            BEGIN
            retcode = XPN$_NOT_OPEN;
            IF .output NEQ 0 THEN (.output) = .this_nlb;
            EXITLOOP
            END
        END;
    !
    ! Call xpn$$event_info to do the work, if the NLBs were valid
    !
    out_nlb = 0;
    WHILE 1 DO
        BEGIN
        !
        ! Insure interrupts are enabled for all NLBs
        !
        xpn$$int_set (.nlb_vector);
        !
        ! Check for events
        !
        IF .retcode THEN retcode = xpn$$event_info (.nlb_vector, out_nlb);
        !
        ! If user specified WAIT and no event, sleep and try again.  If
	! no links have timeouts set, we can do an infinite sleep and
	! expect any link state changes to interrupt us.  Otherwise, we
	! need to do short sleeps to do the housekeeping for the timeouts.

        !
        IF NOT (.wait AND (.retcode EQL XPN$_NO_EVENT))
        THEN
            EXITLOOP
        ELSE
            BEGIN
            LOCAL
                infinite_sleep_allowed;
            infinite_sleep_allowed = 1;
            INCR i FROM 1 TO .nlb_vector[0]
            DO
                BEGIN
                BIND
                    this_nlb = .nlb_vector[.i] : $XPN_NLB ();
                !
                ! Count down the timer if one exists
                !
                IF .this_nlb[NLB$B_TIMEOUT] GTR 0
                THEN
		    BEGIN
		    infinite_sleep_allowed = 0;
                    IF (this_nlb[NLB$B_TIMEOUT] =
                        .this_nlb[NLB$B_TIMEOUT] - 1) LEQ 0
                    THEN
                        EXITLOOP (out_nlb = this_nlb; retcode = XPN$_TIMEOUT);
		    END;
                END;
            IF .infinite_sleep_allowed
            THEN
                xpn$$sleep (0)          ! forever
            ELSE
                xpn$$sleep (1000)       ! Sleep for one second
            END
        END;
    !
    ! Store the output NLB address if user requested it
    !
    IF (.output NEQ 0) AND (.out_nlb NEQ 0) THEN (.output) = .out_nlb;
    !
    ! Check completion code and call action routines if appropriate
    !
    IF .retcode EQL XPN$_NO_EVENT
        THEN out_nlb = .nlb_vector[1];
    IF .out_nlb NEQ 0
        THEN retcode_2ndary = .out_nlb[NLB$G_2ND_CODE]
        ELSE retcode_2ndary = 0;
    IF .retcode THEN
        BEGIN
        !
        ! Call success routine if one specified
        !
        IF .success NEQ 0 THEN
            retcode =
                (.success) (XPN$K_EVENT, .retcode,
                                    .retcode_2ndary, .out_nlb)
        END
    ELSE
        IF .failure NEQ 0 THEN
            retcode =
                (.failure) (XPN$K_EVENT, .retcode,
                                    .retcode_2ndary, .out_nlb);
    RETURN (.retcode)
    END;
ROUTINE xpn$$event_info (nlb_vec, out_nlb) =
!++
! FUNCTIONAL DESCRIPTION:
!   This routine does the work for xpn$event_info.  When it is called,
!   the vector and each NLB in it have been validated.  The vector is
!   scanned in priority order for events and, when one is found, out_nlb
!   gets the address of the culpable NLB and the appropriate completion
!   code is returned.
!
! FORMAL PARAMETERS:
!   nlb_vec             - counted vector of NLB addresses
!   out_nlb             - where to store address of interesting NLB
!
! IMPLICIT INPUTS:
!   The state of each net link is examined with NPS. UUO's.
!
! IMPLICIT OUTPUTS:
!   For the "interesting" NLB, the following fields may be updated:
!       NLB$V_STATUS    - any bit here might be set or cleared
!
!   If a connect initiate event occurs for a passive link, the following
!   fields (or the descriptors pointed to by the fields) may be updated:
!       NLB$B_REM_FORMAT        - Object descriptor format for remote object
!       NLB$B_REM_OBJTYP        - Remote object type
!       NLB$A_NODE_NAME         - Remote node name
!       NLB$A_REM_DESCR         - Remote object descriptor
!       NLB$A_USER_ID           - User-ID supplied by remote task
!       NLB$A_PASSWORD          - Password supplied by remote task
!       NLB$A_ACCOUNT           - Account string supplied by remote task
!       NLB$A_OPTIONAL          - Optional data supplied by remote task
!       NLB$H_REM_USER          - Remote object's user code
!       NLB$H_REM_GROUP         - Remote object's group code
!
! ROUTINE VALUE and
! COMPLETION CODES:
!   Success codes:
!	XPN$_NO_EVENT   - no event has occurred
!       XPN$_CONNECT    - a connect event occurred
!       XPN$_INTERRUPT  - an interrupt message arrived
!       XPN$_LINK_SERV  - a link service message arrived
!       XPN$_DATA       - a data message arrived
!       XPN$_COMPLETED  - a previous I/O operation has finished
!
!   Warning codes:
!       XPN$_ABORTED    - an abort or connect reject event occurred
!       XPN$_DISCONN    - a disconnect event occurred
!
!   Error codes:
!       XPN$_NOT_OPEN   - NLB was not opened
!       XPN$_BAD_NLB    - an invalid NLB was detected
!
! SIDE EFFECTS:
!   out_nlb             - gets the address of the NLB for which an event
!                         occurred
!
!--
    BEGIN

    MAP
        nlb_vec : REF VECTOR[0];
    !
    ! Loop through the NLB vector and check each one for events.
    !
    INCR nlb_index FROM 1 TO .nlb_vec[0] DO
        BEGIN
        (.out_nlb) = .nlb_vec[.nlb_index];
        IF xpn$$connect (..out_nlb) THEN RETURN (XPN$_CONNECT);
        IF xpn$$aborted (..out_nlb) THEN RETURN (XPN$_ABORTED);
        IF xpn$$interrupt (..out_nlb) THEN RETURN (XPN$_INTERRUPT);
        IF xpn$$link_service (..out_nlb) THEN RETURN (XPN$_LINK_SERV);
        IF xpn$$data_available (..out_nlb) THEN RETURN (XPN$_DATA);
        IF xpn$$disconnected (..out_nlb) THEN RETURN (XPN$_DISCONN);
        END;
    (.out_nlb) = 0;
    RETURN (XPN$_NO_EVENT)
    END;
ROUTINE xpn$$connect (nlb) =
!++
! FUNCTIONAL DESCRIPTION:
!   Check to see if a connect completion (connect accept, for active links,
!   or connect initiate, for passive links) has occurred.
!
! FORMAL PARAMETERS:
!   nlb         - address of the NLB to check
!
! IMPLICIT INPUTS:
!   The monitor's database is queried via NSP. UUO's.
!
! IMPLICIT OUTPUTS:
!   NONE
!
! ROUTINE VALUE and
! COMPLETION CODES:
!    1  - a connect event has occurred
!    0  - no connect event occurred
!
! SIDE EFFECTS:
!   NLB$V_STATUS is updated to reflect the new status of the link.
!
!--
    BEGIN

    LOCAL
	link_status;

    MAP
        nlb : REF $XPN_NLB();

    nlb_binds;                          ! Get short names for popular fields
    !
    ! If already connected, return false, as we can't have a connect event
    ! for an already-connected link.
    !
    IF .nlb[NLB$V_CONNECTED] THEN RETURN (0);

    link_status = xpn$$link_status (.nlb);

    IF active THEN
        BEGIN
        !
        ! If no connect request pending, return false
        !
        IF NOT .nlb[NLB$V_CONN_REQ] THEN RETURN (0);
        !
        ! OK, link is active and connect request pending. See if satisfied yet.
        !
        IF .POINTR(link_status,NS$STA) EQL $NSSRN THEN
            BEGIN
            !
            ! Connect was accepted.  Update NLB$V_STATUS bits and return true.
            !
            nlb[NLB$V_CONN_REQ] = 0;
            nlb[NLB$V_CONNECTED] = 1;
            RETURN (1)
            END
        ELSE
            RETURN (0)
        END
    ELSE
        !
        ! Passive, see if waiting for connect confirm (indicates connect
        ! request has been received)
        !
        IF .POINTR(link_status,NS$STA) EQL $NSSCR
        THEN
            BEGIN
            !
            ! Connect request arrived.  Update NLB$V_STATUS bits, update
            ! connect information for the remote task, and return true.
            !
            nlb[NLB$V_CONN_REQ] = 1;
            xpn$$get_connect_info (.nlb);
            RETURN (1)
            END
        ELSE
            RETURN (0);
    END;
ROUTINE xpn$$get_connect_info (nlb) : NOVALUE =
!++
! FUNCTIONAL DESCRIPTION:
!   Gets the connect information for the remote task and stores it in
!   the appropriate NLB fields.
!
! FORMAL PARAMETERS:
!   nlb         - address of a Network Link Block
!
! IMPLICIT INPUTS:
!   Information returned by various NSP. UUO's.
!
! IMPLICIT OUTPUTS:
!   Information is copied to the appropriate NLB fields.
!
! ROUTINE VALUE and 
! COMPLETION CODES:
!   NONE
!
! SIDE EFFECTS:
!   NONE
!
!--
    BEGIN

    MAP
        nlb : REF $XPN_NLB();

    LOCAL
        descr,
	nsp_arg_blk : MONBLOCK[$NSAA1+1] INITIAL (0),
	nsp_connect_blk : VECTOR[$NSCUD+1]
		INITIAL ($NSCUD+1, REP $NSCUD OF (0)),
	nsp_node_string_ptr : VECTOR[XPN$K_HOSTN_MAX_LEN_W]
		INITIAL (XPN$K_HOSTN_MAX_LEN_W),
	nsp_dest_proc_blk : VECTOR[$NSDPN+1]
		INITIAL ($NSDPN+1, REP $NSDPN OF (0)),
	nsp_dest_task_string_ptr : VECTOR[XPN$K_TASKN_MAX_LEN_W]
		INITIAL (XPN$K_TASKN_MAX_LEN_W);

    REGISTER
	t1;

    BIND
	nsp_node_size = nsp_node_string_ptr[0],
	nsp_dest_task_size = nsp_dest_task_string_ptr[0],
	groups = nsp_dest_task_string_ptr[$NSDPP];

    nsp_connect_blk[$NSCND] = nsp_node_string_ptr;
    nsp_connect_blk[$NSCDD] = nsp_dest_proc_blk;

    nsp_arg_blk[$NSAFN,NS$AFN] = $NSFRI;		!function
    nsp_arg_blk[$NSAFN,NS$ALN] = $NSAA1 + 1;		!size of block
    nsp_arg_blk[$NSACH,$WORD] = .nlb[NLB$H_JFN];	!channel
    nsp_arg_blk[$NSAA1,$WORD] = nsp_connect_blk[0];	!addr of connect block
    t1 = nsp_arg_blk[0,$WORD];

    NSP$_UUO(t1);

    !
    ! If the user has allocated a descriptor for remote node name, fill it.
    !
    IF (descr = .nlb[NLB$A_NODE_NAME]) NEQ 0 THEN
        BEGIN
        $STR_COPY
	    (STRING = (.nsp_node_size<lh>, CH$PTR (nsp_node_string_ptr[1],0,8)),
            TARGET = .descr);
        END;
    !
    ! If user provided a descriptor for a remote object descriptor,
    ! fill it up.
    !
    IF (descr = .nlb[NLB$A_REM_DESCR]) NEQ 0 THEN
        BEGIN
        $STR_COPY
	    (STRING = (.nsp_dest_task_size<lh>,
		CH$PTR (nsp_dest_task_string_ptr[1],0,8)),
            TARGET = .descr)
        END;
    nlb[NLB$H_REM_GROUP] = .groups<lh>;
    nlb[NLB$H_REM_USER] = .groups<rh>;
    nlb[NLB$V_REM_GROUP] = .groups<lh> NEQ 0;
    nlb[NLB$V_REM_USER] = .groups<rh> NEQ 0
    END;
ROUTINE xpn$$aborted (nlb) =
!++
! FUNCTIONAL DESCRIPTION:
!   Tests to see if a logical link has been aborted.
!
! FORMAL PARAMETERS:
!   nlb         - address of a Network Link Block
!
! IMPLICIT INPUTS:
!	NONE
!
! IMPLICIT OUTPUTS:
!	NONE
!
! ROUTINE VALUE and
! COMPLETION CODES:
!   1   - an abort event occurred
!   0   - no abort event detected
!
! SIDE EFFECTS:
!   NLB$V_STATUS updated if an abort occurred.
!
!--
    BEGIN

    MAP
       nlb : REF $XPN_NLB();

    LOCAL
        link_status;

    !
    ! If not connected, can't have aborted
    !
    IF NOT .nlb[NLB$V_CONNECTED] THEN RETURN(0);

    !
    ! Now, was connected, so check for still running, or
    ! disconnect received (which will be reported as a disconnect
    ! event), in which case we will return 0.  All other state codes
    ! indicate some sort of problem.
    !
    link_status = xpn$$link_status (.nlb);
    IF (.POINTR(link_status,NS$STA) NEQ $NSSRN
	AND .POINTR(link_status,NS$STA) NEQ $NSSDR)
	THEN
        BEGIN
        nlb[NLB$V_ABORTED] = 1;
        nlb[NLB$V_CONNECTED] = 0;
        RETURN (1)
        END
    ELSE
        RETURN (0);
    END;
ROUTINE xpn$$interrupt (nlb) =
!++
! FUNCTIONAL DESCRIPTION:
!   Check for arrival of interrupt messages.
!
! FORMAL PARAMETERS:
!   nlb         - address of the Network Link Block
!
! IMPLICIT INPUTS:
!   NONE
!
! IMPLICIT OUTPUTS:
!   NLB$V_STATUS
!       NLB$V_IRPT_MSG  - set if an interrupt message has arrived
!
! ROUTINE VALUE and
! COMPLETION CODES:
!   0   - no new interrupt messages have arrived
!   1   - new interrupt messages have arrived
!
! SIDE EFFECTS:
!	NONE
!
!--
    BEGIN

    MAP
        nlb : REF $XPN_NLB();

    nlb[NLB$V_IRPT_MSG] = ((xpn$$link_status (.nlb) AND NS$IDA) NEQ 0)

    END;
ROUTINE xpn$$link_service (nlb) =
!++
! FUNCTIONAL DESCRIPTION:
!   Test to see if a link service message has been received for a logical link.
!   Since TOPS-10 does not support user control of link service messages, this
!   routine merely returns 0 (false).
!
! FORMAL PARAMETERS:
!    nlb        - address of Network Link Block
!
! IMPLICIT INPUTS:
!	NONE
!
! IMPLICIT OUTPUTS:
!	NONE
!
! ROUTINE VALUE and
! COMPLETION CODES:
!   Always returns false (0).
!
! SIDE EFFECTS:
!	NONE
!
!--
    0;
ROUTINE xpn$$data_available (nlb) =
!++
! FUNCTIONAL DESCRIPTION:
!   This routine tests for the existence of data available to be read on
!   a logical link for which a read was previously posted.  If this routine
!   returns success, then the NLB buffer descriptor points to the data.
!   Since the TOPS-10 support for user asynchronous I/O is cumbersome, this
!   routine will do the read as well (after having determined that the monitor
!   is holding a message so we won't block).
!
! FORMAL PARAMETERS:
!   nlb         - address of the Network Link Block.
!
! IMPLICIT INPUTS:
!   nlb[NLB$V_DATA_REQ] - if this bit is off, this routine returns false.
!   The monitor's database is queried with NSP. UUO's.
!
! IMPLICIT OUTPUTS:
!   nlb[NLB$V_DATA_REQ] - cleared if input is done (to force caller to post
!                         another read)
!   nlb[NLB$T_DATA]     - descriptor pointing to buffer of data read.
!                         Dynamic memory associated with this descriptor
!                         may be released and assigned.
!
! ROUTINE VALUE and
! COMPLETION CODES:
!
!   0   - no data returned
!   1   - data was available and has been read
!
! SIDE EFFECTS:
!
!	NONE
!
!--
    BEGIN

    MAP
        nlb : REF $XPN_NLB();

    LOCAL
	link_status;
    !
    ! Make sure a read was posted.
    !
    IF NOT (.nlb[NLB$V_DATA_REQ]) THEN RETURN (0);
    !
    ! Get link status, insure link still viable, see if a message is waiting.
    !
    IF (xpn$$link_status (.nlb) AND NS$NDA) EQL 0
    THEN
        RETURN (0)                      ! No message, return false
    ELSE                                ! Else do hair to read message
        BEGIN
        LOCAL
	    save_wait,
	    get_status;
	save_wait = .nlb[NLB$V_WAIT];	!save wait code
	nlb[NLB$V_WAIT] = 1;		!we will wait, please
	get_status = xpn$$get_data(.nlb);!get data
	nlb[NLB$V_WAIT] = .save_wait;	!restore wait code
        nlb[NLB$V_DATA_REQ] = 0;
	IF .get_status
	THEN
        RETURN (1)
	ELSE
	RETURN (0)
        END;
    END;			!End of xpn$$data_available
ROUTINE xpn$$disconnected (nlb) =
!++
! FUNCTIONAL DESCRIPTION:
!   This routine tests to see if a logical link has been disconnected.
!
! FORMAL PARAMETERS:
!   nlb         - address of the Network Link Block
!
! IMPLICIT INPUTS:
!   The monitor is queried with an NSP. UUO (in xpn$$link_status).
!
! IMPLICIT OUTPUTS:
!   NLB$V_CONNECTED     - cleared if link is disconnected
!
! ROUTINE VALUE and
! COMPLETION CODES:
!   0   - link is not disconnected
!   1   - link is disconnected
!
! SIDE EFFECTS
!	NONE
!
!--
    BEGIN

    MAP
        nlb : REF $XPN_NLB();

    LOCAL
        link_status;

    link_status = xpn$$link_status (.nlb);
    IF (.POINTR(link_status,NS$STA) EQL $NSSDR		!if disconnect received
	OR .POINTR(link_status,NS$STA) EQL $NSSRJ)	! or rejected
    THEN
        BEGIN
        nlb[NLB$V_CONNECTED] = 0;
        RETURN (1)
        END
    ELSE
        RETURN (0)
    END;			!End of xpn$$disconnected
END				!End of module
ELUDOM