Google
 

Trailing-Edge - PDP-10 Archives - cuspjul86upd_bb-jf24a-bb - 10,7/dil/dilsrc/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 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-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