PDP-10.stacken/files/stacken-tape-backup/dskb:10_7/dil/dilsrc/xpnfai.b36

%TITLE ' XPNFAI - Default failure routine for BLISSnet-10'
MODULE xpnfai (
               ENTRY ( XPN$FAILURE,
                       XPN$NF_FAILURE )
              ) =
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-10.
!
! ABSTRACT:
!   This module contains the routines XPN$FAILURE and XPN$NF_FAILURE.
!
! ENVIRONMENT:
!   TOPS-10 user mode.
!
! AUTHOR:  Larry Campbell, CREATION DATE:  January 13, 1982
!
! MODIFIED BY: Doug Rayner
!
! 01    - Start TOPS-10 support
!
! 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$failure,                        ! Type error msg and terminate if fatal
    xpn$nf_failure;                     ! Just type the message
!
! INCLUDE FILES:
!
LIBRARY 'BLI:XPORT';
LIBRARY 'BLISSNET';
LIBRARY 'BLI:UUOSYM';
LIBRARY 'BLSN10';
!
! MACROS:
!

!
! EXTERNAL REFERENCES:
!


GLOBAL ROUTINE xpn$failure (function, primary_code, secondary_code, nlb) =
!++
! FUNCTIONAL DESCRIPTION:
!   This is the default failure action routine called by the various
!   BLISSnet macros.  It calls XPN$$NF_FAILURE to report the error
!   to the user, and then, for fatal errors, terminates program execution.
!
! FORMAL PARAMETERS:
!   function            - code which identifies the function that failed
!   primary_code        - primary completion code
!   secondary_code      - secondary completion code
!   nlb                 - address of the Network Link Block involved
!
! IMPLICIT INPUTS:
!   NONE
!
! IMPLICIT OUTPUTS:
!   NONE
!
! ROUTINE VALUE and
! COMPLETION CODES:
!   This routine returns the primary completion code as its completion code.
!
! SIDE EFFECTS:
!   For fatal errors, the program is terminated and this routine never returns.
!
!--
    BEGIN

    MAP
        nlb : REF $XPN_NLB();

    xpn$nf_failure (.function, .primary_code, .secondary_code, .nlb);
    IF (.primary_code AND XPN$K_SEVERITY_F) NEQ 0
    THEN $XPO_TERMINATE ()
    ELSE RETURN (.primary_code)
    END;			!End of xpn$failure

GLOBAL ROUTINE xpn$nf_failure (function, primary_code, secondary_code, nlb) =
!++
! FUNCTIONAL DESCRIPTION:
!   This routine prints error messages on the controlling terminal.
!
! FORMAL PARAMETERS:
!   function            - code which identifies function that failed
!   primary_code        - primary completion code
!   secondary_code      - secondary completion code
!   nlb                 - address of the Network Link Block involved
!
! IMPLICIT INPUTS:
!   NONE
!
! IMPLICIT OUTPUTS:
!   NONE
!
! ROUTINE VALUE and
! COMPLETION CODES:
!   The primary completion code is returned.
!
! SIDE EFFECTS:
!	NONE
!
!--
    BEGIN

    MAP
        nlb : REF $XPN_NLB();

    LOCAL
        prefix_string : $STR_DESCRIPTOR (CLASS = DYNAMIC),
        msg_length,
        msg2_length,
        msg_buffer : VECTOR [CH$ALLOCATION (256)],
        msg_descriptor : $STR_DESCRIPTOR (CLASS = FIXED),
        msg2_buffer : VECTOR [CH$ALLOCATION (256)],
        msg2_descriptor : $STR_DESCRIPTOR (CLASS = FIXED);

    $STR_DESC_INIT (DESCRIPTOR = prefix_string, CLASS = DYNAMIC);
    $STR_DESC_INIT (DESCRIPTOR = msg_descriptor, CLASS = FIXED,
                    STRING = (256, CH$PTR (msg_buffer)));
    $STR_DESC_INIT (DESCRIPTOR = msg2_descriptor, CLASS = FIXED,
                    STRING = (256, CH$PTR (msg2_buffer)));
    CASE .function FROM XPN$K_OPEN TO XPN$K_CLOSE OF
        SET
        [XPN$K_OPEN] : $STR_COPY (STRING = 'Network open failed',
                                  TARGET = prefix_string);
        [XPN$K_EVENT] : $STR_COPY (STRING = 'Network event info failed',
                                   TARGET = prefix_string);
        [XPN$K_PUT] : $STR_COPY (STRING = 'Network output failed',
                                 TARGET = prefix_string);
        [XPN$K_GET] : $STR_COPY (STRING = 'Network input failed',
                                 TARGET = prefix_string);
        [XPN$K_DISCONNECT] : $STR_COPY (STRING = 'Network disconnect failed',
                                        TARGET = prefix_string);
        [XPN$K_CLOSE] : $STR_COPY (STRING = 'Network close failed',
                                   TARGET = prefix_string);
        [INRANGE, OUTRANGE] : $STR_COPY (STRING = 'Unknown network failure',
                                         TARGET = prefix_string);
        TES;
    $XPN_ERRMSG (CODE = .primary_code,
                 BUFFER = msg_descriptor,
                 LENGTH = msg_length);
    msg_descriptor[STR$H_LENGTH] = .msg_length;
    IF .secondary_code NEQ 0
    THEN
        BEGIN
        $XPN_ERRMSG (CODE = .secondary_code,
                     BUFFER = msg2_descriptor,
                     LENGTH = msg2_length);
        msg2_descriptor[STR$H_LENGTH] = .msg2_length;
        !
        ! If the secondary code is an XPORT code, we have to let XPORT print it
        !
        SELECTONE .secondary_code OF
            SET
            [XPO$_BAD_ADDR TO XPO$_BAD_SYNTAX,
             STR$_BAD_CHAR TO STR$_OUT_RANGE,
             XPO$_BAD_IOB TO XPO$_TERMINATE,
             STR$_BAD_LOGIC, XPO$_END_FILE] :
                $XPO_PUT_MSG (STRING = prefix_string,
                              STRING = msg_descriptor,
                              CODE = .secondary_code);
            [OTHERWISE] :
                $XPO_PUT_MSG (STRING = prefix_string,
                              STRING = msg_descriptor,
                              STRING = msg2_descriptor);
            TES
        END
    ELSE
        $XPO_PUT_MSG (STRING = prefix_string,
                      STRING = msg_descriptor);
    RETURN (.primary_code)
    END;			!End of xpn$$nf_failure

END
ELUDOM