Trailing-Edge
-
PDP-10 Archives
-
BB-R775C-BM
-
sources/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 1981, 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-20, the TOPS-20 implementation of the Transportable BLISS
! interface to DECNET.
!
! ABSTRACT:
! This module supports the BLISSnet macro $XPN_EVENT_INFO.
!
! ENVIRONMENT:
! TOPS-20 user mode with XPORT.
!
! AUTHOR: Larry Campbell, CREATION DATE: November 20, 1981
!
! MODIFIED BY:
!
!--
!
! 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:MONSYM';
LIBRARY 'BLISSNET20';
REQUIRE 'JSYSDEF';
!
! MACROS:
!
!
! EQUATED SYMBOLS:
!
!
! 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$$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
! all links are passive and waiting for connect, we can do an infinite
! sleep. However, if links are active we must do short sleeps because
! not all abort/disconnect events cause interrupts (sigh).
!
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 ();
infinite_sleep_allowed = .this_nlb[NLB$V_PASSIVE]
AND (NOT .this_nlb[NLB$V_CONNECTED])
AND (NOT .this_nlb[NLB$V_CONN_REQ])
AND .infinite_sleep_allowed;
!
! Count down the timer if one exists
!
IF .this_nlb[NLB$B_TIMEOUT] GTR 0
THEN
IF (this_nlb[NLB$B_TIMEOUT] =
.this_nlb[NLB$B_TIMEOUT] - 1) LEQ 0
THEN
EXITLOOP (out_nlb = this_nlb; retcode = XPN$_TIMEOUT);
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 MTOPR JSYSes.
!
! 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 JSYSes.
!
! 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
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);
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 ((xpn$$link_status (.nlb) AND MO_CON) NEQ 0) 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 ((xpn$$link_status (.nlb) AND MO_WCC) NEQ 0)
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 MTOPR% JSYSes.
!
! 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
count,
descr,
groups,
string_buffer : VECTOR [CH$ALLOCATION (132)];
!
! If the user has allocated a descriptor for remote node name, fill it.
!
IF (descr = .nlb[NLB$A_NODE_NAME]) NEQ 0 THEN
BEGIN
IF NOT JSYS_MTOPR (.nlb[NLB$H_JFN],
$MORHN,
CH$PTR (string_buffer),
0; ,,count)
THEN
RETURN;
count = ABS (CH$DIFF (.count, CH$PTR (string_buffer)));
$STR_COPY (STRING = (.count, CH$PTR (string_buffer)),
TARGET = .descr);
END;
!
! Get remote object-descriptor, and user and group codes
!
IF NOT JSYS_MTOPR (.nlb[NLB$H_JFN],
$MOROD,
CH$PTR (string_buffer),
0; , , count, groups)
THEN
RETURN;
!
! If user provided a descriptor for a remote object descriptor,
! fill it up.
!
IF (descr = .nlb[NLB$A_REM_DESCR]) NEQ 0 THEN
BEGIN
count = ABS (CH$DIFF (.count, CH$PTR (string_buffer)));
$STR_COPY (STRING = (.count, CH$PTR (string_buffer)),
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 ((link_status = xpn$$link_status (.nlb)) AND MO_ABT) NEQ 0 THEN
BEGIN
nlb[NLB$V_ABORTED] = 1;
nlb[NLB$V_CONNECTED] = 0;
nlb[NLB$G_2ND_CODE] = .link_status<rh>;
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 MO_INT) 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-20 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 TOPS-20 does not support user asynchronous I/O, this routine must
! actually 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 SIBE and MTOPR JSYSes.
!
! 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.
!
link_status = xpn$$link_status (.nlb);
IF (.link_status AND MO_CON) EQL 0 THEN RETURN (0);
IF (.link_status AND MO_EOM) EQL 0
THEN
RETURN (0) ! No message, return false
ELSE ! Else do hair to read message
BEGIN
LOCAL
byte_count;
IF JSYS_SIBE (.nlb[NLB$H_JFN]; byte_count)
THEN
xpn$$bug ('MO%EOM on but SIBE skipped');
xpn$$new_buffer (nlb[NLB$T_DATA], .byte_count);
IF NOT JSYS_SINR (.nlb[NLB$H_JFN],
.nlb[NLB$A_STRING],
-.byte_count,
0)
THEN
RETURN (0);
nlb[NLB$V_DATA_REQ] = 0;
RETURN (1)
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 MTOPR JSYS (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;
!
! If link isn't connected, we can't have a disconnect event
!
IF NOT .nlb[NLB$V_CONNECTED] THEN RETURN (0);
IF ((link_status = xpn$$link_status (.nlb)) AND MO_CON) EQL 0
THEN
BEGIN
nlb[NLB$V_CONNECTED] = 0;
nlb[NLB$G_2ND_CODE] = .link_status<rh>;
RETURN (1)
END
ELSE
RETURN (0)
END; !End of xpn$$disconnected
END !End of module
ELUDOM