Trailing-Edge
-
PDP-10 Archives
-
BB-T573C-DD_1986
-
10,7/xpnget.b36
There are 25 other files named xpnget.b36 in the archive. Click here to see a list.
%TITLE 'XPNGET - Get data from a DECNET link'
MODULE xpnget (
ENTRY ( XPN$GET, XPN$$GET_DATA )
) =
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:
! Transportable BLISS interface to DECNET for TOPS-10.
!
! ABSTRACT:
! This module implements the $XPN_GET macro.
!
! ENVIRONMENT:
! TOPS-10 user mode.
!
! AUTHOR: Larry Campbell, CREATION DATE: January 8, 1982
!
! MODIFIED BY: Doug Rayner
!
! 01 - Start TOPS-10 support [Doug Rayner]
!
! Start using the DIL standard edit history format.
!
! 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$get, ! Top-level routine
xpn$$get, ! Actual work routine
xpn$$get_data; ! Get data
!
! INCLUDE FILES:
!
LIBRARY 'BLI:XPORT';
LIBRARY 'BLISSNET'; ! Transportable BLISSnet definitions
LIBRARY 'BLI:UUOSYM'; ! Monitor symbols
LIBRARY 'BLSN10'; ! TOPS-10-specific definitions
LIBRARY 'BLI:TENDEF'; ! System dependant macros
LIBRARY 'UUODEF'; ! UUO definition macros
!
! MACROS:
!
!
! EQUATED SYMBOLS:
!
!
! OWN STORAGE:
!
!
! EXTERNAL REFERENCES:
!
EXTERNAL ROUTINE
xpn$$new_buffer, ! Sets new buffer in NLB
xpn$$valid_nlb, ! Validate an NLB
xpn$$link_status, ! Get link status
xpn$$uuo_error; ! Report NSP. error
GLOBAL ROUTINE xpn$get (nlb, success_routine, failure_routine ) =
!++
! FUNCTIONAL DESCRIPTION:
! This routine is the top-level routine called by the $XPN_GET macro.
! It validates the NLB, calls xpn$$get to do the work, and calls
! optional caller-supplied success or failure routines.
!
! FORMAL PARAMETERS:
! nlb - address of the Network Link Block
!
! IMPLICIT INPUTS:
! NONE
!
! IMPLICIT OUTPUTS:
! NLB$T_DATA - old descriptor released and new one assigned to hold input.
!
! ROUTINE VALUE and
! COMPLETION CODES:
! NONE
!
! SIDE EFFECTS:
! NONE
!
!--
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$$get (.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_GET, .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_GET, .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$get
ROUTINE xpn$$get (nlb) =
!++
! FUNCTIONAL DESCRIPTION:
! This routine does the actual work for $XPN_GET.
!
! FORMAL PARAMETERS:
! nlb - address of the Network Link Block.
!
! IMPLICIT INPUTS:
! NONE
!
! IMPLICIT OUTPUTS:
! NONE
!
! ROUTINE VALUE and
! COMPLETION CODES:
! XPN$_NORMAL - normal, data has been read
! XPN$_INCOMPLETE - read posted but incomplete (WAIT not specified)
!
! SIDE EFFECTS:
! NONE
!
!--
BEGIN
MAP
nlb : REF $XPN_NLB();
LOCAL
nsp_arg_blk : MONBLOCK[$NSAA2+1] INITIAL (0);
IF NOT .nlb[NLB$V_OPEN]
THEN
RETURN (XPN$_NOT_OPEN);
CASE .nlb[NLB$B_SUBFUNC] FROM NLB$K_DATA TO NLB$K_REJECT OF
SET
[NLB$K_DATA] : RETURN (xpn$$get_data (.nlb));
[NLB$K_INTERRUPT] :
BEGIN
LOCAL
byte_count,
intdt_string_ptr : VECTOR[XPN$K_INTDT_MAX_LEN_W]
INITIAL (XPN$K_INTDT_MAX_LEN_W);
BIND
intdt_size = intdt_string_ptr[0];
REGISTER
t1;
!
! If we're asked for interrupt msg but none pending, complain
!
IF (xpn$$link_status (.nlb) AND NS$IDA) EQL 0
THEN
RETURN (XPN$_ILLOGIC);
nsp_arg_blk[$NSAFN,NS$AFN] = $NSFIR; !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] = intdt_string_ptr[0]; !data buffer
t1 = nsp_arg_blk[0,$WORD];
IF NOT NSP$_UUO(t1)
THEN
RETURN (xpn$$uuo_error (.nlb, .t1));
byte_count = .intdt_size<lh>;
xpn$$new_buffer (nlb[NLB$T_INTERRUPT], .byte_count);
CH$MOVE (.byte_count,
CH$PTR (intdt_string_ptr[1], 0, 8),
.nlb[NLB$A_INTERRUPT]);
nlb[NLB$V_IRPT_MSG] = (xpn$$link_status (.nlb) AND NS$IDA) NEQ 0;
RETURN (XPN$_INTERRUPT)
END;
[NLB$K_DISCONNECT] :
BEGIN
LOCAL
byte_count,
link_status,
optdt_string_ptr : VECTOR[XPN$K_OPTDT_MAX_LEN_W]
INITIAL (XPN$K_OPTDT_MAX_LEN_W);
BIND
optdt_size = optdt_string_ptr[0];
REGISTER
t1;
!
! If disconnect info requested but link is connected, complain
!
link_status = xpn$$link_status(.nlb);
IF .POINTR(link_status,NS$STA) EQL $NSSRN
THEN
RETURN (XPN$_ILLOGIC);
IF .POINTR(.link_status,NS$STA) NEQ $NSSDR
THEN nlb[NLB$V_ABORTED] = 1; ! *** NLB$V_DISCONN undefined
! ELSE nlb[NLB$V_DISCONN] = 1; ! ***
nlb[NLB$V_CONNECTED] = 0;
!
! Get optional disconnect data, if any
!
nsp_arg_blk[$NSAFN,NS$AFN] = $NSFRD; !function
nsp_arg_blk[$NSAFN,NS$ALN] = $NSAA2 + 1; !size of block
nsp_arg_blk[$NSACH,$WORD] = .nlb[NLB$H_JFN]; !channel
nsp_arg_blk[$NSAA1,$WORD] = optdt_string_ptr[0]; !data buffer
t1 = nsp_arg_blk[0,$WORD];
IF NOT NSP$_UUO(t1)
THEN
RETURN (xpn$$uuo_error (.nlb, .t1));
IF (byte_count = .optdt_size<lh>) NEQ 0
THEN
BEGIN
xpn$$new_buffer (nlb[NLB$T_DISCONNECT], .byte_count);
CH$MOVE (.byte_count, CH$PTR (optdt_string_ptr[1], 0, 8),
.nlb[NLB$A_DISCONNECT])
END;
nlb[NLB$G_DISC_CODE] = .nsp_arg_blk[$NSAA2,$WORD];
RETURN (XPN$_DISCONN)
END;
[INRANGE, OUTRANGE] : xpn$$bug ('Invalid subfunction in xpn$$get');
TES;
xpn$$bug ('No subfunction selected in xpn$$get')
END; !End of xpn$$get
GLOBAL ROUTINE xpn$$get_data (nlb) =
!++
! FUNCTIONAL DESCRIPTION:
! This routine reads data from 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 - read OK
! XPN$_INCOMPLETE - read posted, caller didn't specify WAIT
! XPN$_ABORT - link aborted
! XPN$_DISCONN - link disconnected
!
! SIDE EFFECTS:
! NONE
!
!--
BEGIN
MAP
nlb : REF $XPN_NLB();
LOCAL
nsp_arg_blk : MONBLOCK[$NSAA2+1] INITIAL (0),
request_count;
REGISTER
t1;
!
! If WAIT not specified, just return ($XPN_EVENT_INFO will
! do the read when data arrives)
!
IF NOT .nlb[NLB$V_WAIT]
THEN
BEGIN
LOCAL
link_status;
!
! Make sure the link is still there.
!
link_status = xpn$$link_status (.nlb);
IF .POINTR(link_status,NS$STA) EQL $NSSDR
THEN
RETURN (XPN$_DISCONN);
IF .POINTR(link_status,NS$STA) NEQ $NSSRN
THEN
RETURN (XPN$_ABORT);
nlb[NLB$V_DATA_REQ] = 1; ! Flag that read has been posted
RETURN (XPN$_INCOMPLETE)
END;
!
! Caller is willing to wait. If no count is specified (NLB$H_REQ_SIZE),
! assume user wants to read exactly one message.
!
IF (request_count = .nlb[NLB$H_REQ_SIZE]) EQL 0
THEN
BEGIN
LOCAL
retcode,
byte_count,
buffer_count,
buffer_address;
!
! Allocate buffer according to user's request, or default maximum.
!
IF (buffer_count = .nlb[NLB$H_RECEIVE_MAX]) EQL 0
THEN
buffer_count = XPN$K_MAX_MSG;
IF NOT (retcode = $XPO_GET_MEM (FULLWORDS = ((.buffer_count + 3)/4),
RESULT = buffer_address))
THEN
RETURN (.retcode);
!
! Do the input.
!
nsp_arg_blk[$NSAFN,NS$AFN] = $NSFDR; !function
nsp_arg_blk[$NSAFN,$WORD] = (.nsp_arg_blk[$NSAFN,$WORD]
OR NS$WAI OR NS$EOM); !wait in message mode
nsp_arg_blk[$NSAFN,NS$ALN] = $NSAA2 + 1; !size of block
nsp_arg_blk[$NSACH,$WORD] = .nlb[NLB$H_JFN]; !channel
nsp_arg_blk[$NSAA1,$WORD] = .buffer_count; !byte count
nsp_arg_blk[$NSAA2,$WORD] = CH$PTR (.buffer_address, 0, 8);!buffer addr
t1 = nsp_arg_blk[0,$WORD];
IF NOT NSP$_UUO(t1)
THEN
BEGIN
$XPO_FREE_MEM (BINARY_DATA = (((.buffer_count + 3)/4),
.buffer_address,
FULLWORDS));
RETURN (xpn$$uuo_error (.nlb, .t1))
END;
IF (byte_count = .nsp_arg_blk[$NSAA1,$WORD]) LSS 0
THEN RETURN(XPN$_OVERRUN);
byte_count = .buffer_count - .byte_count;
!
! Release old buffer, allocate a new one, and copy data to it.
!
xpn$$new_buffer (nlb[NLB$T_DATA], .byte_count);
!
! *** Right here we reference NLB$A_DATA as NLB$A_STRING, because
! NLB$A_DATA is defined as an ADDRESS and BLISS generates
! a HRRZ instruction. NLB$A_STRING (which overlays NLB$A_DATA)
! is defined as a POINTER so the right things happen.
!
CH$MOVE (.byte_count, CH$PTR (.buffer_address, 0, 8),
.nlb[NLB$A_STRING]);
$XPO_FREE_MEM (BINARY_DATA = (((.buffer_count + 3)/4),
.buffer_address,
FULLWORDS));
RETURN (XPN$_NORMAL)
END
ELSE
!
! User specified a count, read exactly that many bytes
! ignoring message boundaries.
!
BEGIN
xpn$$new_buffer (nlb[NLB$T_DATA], .request_count);
nsp_arg_blk[$NSAFN,NS$AFN] = $NSFDR; !function, wait
nsp_arg_blk[$NSAFN,$WORD] = (.nsp_arg_blk[$NSAFN,$WORD]
OR NS$WAI); !must wait
nsp_arg_blk[$NSAFN,NS$ALN] = $NSAA2 + 1; !size of block
nsp_arg_blk[$NSACH,$WORD] = .nlb[NLB$H_JFN]; !channel
nsp_arg_blk[$NSAA1,$WORD] = .request_count; !byte count
nsp_arg_blk[$NSAA2,$WORD] = .nlb[NLB$A_DATA]; !buffer addr
t1 = nsp_arg_blk[0,$WORD];
IF NOT NSP$_UUO(t1)
THEN
RETURN (xpn$$uuo_error (.nlb, .t1))
ELSE
RETURN (XPN$_NORMAL)
END;
END;
END
ELUDOM