Google
 

Trailing-Edge - PDP-10 Archives - BB-LW55A-BM_1988 - language-sources/xpnerr.b36
There are 26 other files named xpnerr.b36 in the archive. Click here to see a list.
%TITLE 'XPNERR - Return error message for a given error code'
MODULE xpnerr (
               ENTRY ( XPN$ERRMSG )
              ) =
BEGIN
!  COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1981, 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-20.
!
! ABSTRACT:
!   This module contains code to implement the $XPN_ERRMSG macro, which
!   returns the text message corresponding to a given error code.
!
! ENVIRONMENT:
!   TOPS-20 user mode.
!
! AUTHOR:  Larry Campbell, CREATION DATE:  January 14, 1982
!
! MODIFIED BY:
!
! 01    - (LC) Include prefix and numeric code in all error messages.
!--
!
! TABLE OF CONTENTS:
!
FORWARD ROUTINE
    xpn$errmsg,                         ! Top level routine
    xpn$$blissnet_error: NOVALUE,       ! BLISSnet interface error codes
    xpn$$decnet_error : NOVALUE,        ! DECNET disconnect codes
    xpn$$tops20_error : NOVALUE;        ! TOPS-20 error codes
!
! INCLUDE FILES:
!
LIBRARY 'BLI:XPORT';
LIBRARY 'BLISSNET';
LIBRARY 'BLI:MONSYM';
LIBRARY 'BLISSNET20';
REQUIRE 'JSYSDEF';
!
! MACROS:
!
MACRO
    xpn$$canned_msg (text) =
        BEGIN
        $STR_COPY (STRING = text, TARGET = temp_descriptor);
        (.length) = .temp_descriptor[STR$H_LENGTH]
        END %;

COMPILETIME
    error_table_size = 0,
    error_table_index = 0;

$FIELD
    xpn$$error_fields =
    SET
    xpn$$error_code = [$INTEGER],
    xpn$$error_severity = [$BYTE],
    xpn$$error_text = [$DESCRIPTOR ()]
    TES;

LITERAL
    xpn$$error_block_size = $FIELD_SET_SIZE;
!
! Count the number of error strings to be defined
!
UNDECLARE
    %QUOTE $xpn$comp_code;

MACRO
    $xpn$comp_code (name, severity, text) =
        %ASSIGN (error_table_size, error_table_size + 1) %;

xpn$$define_codes
!
! Now define a macro to create the PRESET attributes for the error table
!
UNDECLARE
    %QUOTE $xpn$comp_code;

MACRO
    $xpn$comp_code (name, severity, text) =
        [error_table_index, xpn$$error_code] = %NAME ('XPN$_', name),
        [error_table_index, xpn$$error_severity] = %NAME ('XPN$K_SEVERITY_', severity),
        [error_table_index, $SUB_FIELD (xpn$$error_text, STR$A_POINTER)] = CH$PTR (UPLIT (%ASCII text)),
        [error_table_index, $SUB_FIELD (xpn$$error_text, STR$H_LENGTH)] = %CHARCOUNT (text),
        [error_table_index, $SUB_FIELD (xpn$$error_text, STR$B_DTYPE)] = STR$K_DTYPE_T,
        [error_table_index, $SUB_FIELD (xpn$$error_text, STR$B_CLASS)] = STR$K_CLASS_F,
        %ASSIGN (error_table_index, error_table_index + 1) %;
!
! Put these tables in the high segment
!
PSECT
    OWN = $HIGH$;

OWN
    error_table : BLOCKVECTOR [error_table_size + 1, xpn$$error_block_size]
                  FIELD (xpn$$error_fields)
                  PRESET (xpn$$define_codes
                          [error_table_index, xpn$$error_code] = 0);
!
! Define the DECNET error message table
!
$FIELD
    decnet_msg_fields =
    SET
    xpn$$dcn_code = [$BYTE],
    xpn$$dcn_text = [$DESCRIPTOR()]
    TES;

LITERAL
    xpn$$dcn_block_size = $FIELD_SET_SIZE;

MACRO
    $xpn$define_decnet_codes =
        $xpn$dcn_codes ($DCX1, 'Resource allocation failure',
                        $DCX2, 'Destination node does not exist',
                        $DCX3, 'Node shutting down',
                        $DCX4, 'Destination process does not exist',
                        $DCX5, 'Invalid name field',
                        $DCX6, 'Destination process queue overflow',
                        $DCX7, 'Unspecified error',
                        $DCX8, 'Third party aborted link',
                        $DCX9, 'User abort (asynchronous disconnect)',
                        $DCX11,'Undefined error code',
                        $DCX21,'Connect initiate with illegal destination address',
                        $DCX22,'Connnect confirm with illegal destination address',
                        $DCX23,'Connect initiate or connect confirm with zero source address',
                        $DCX24,'Flow control violation',
                        $DCX32,'Too many connects to node',
                        $DCX33,'Too many connects to destination process',
                        $DCX34,'Access not permitted',
                        $DCX35,'Logical link services mismatch',
                        $DCX36,'Invalid account',
                        $DCX37,'Segment size too small',
                        $DCX38,'Process aborted',
                        $DCX39,'No path to destination node',
                        $DCX40,'Link aborted due to data loss',
                        $DCX41,'Destination process does not exist',
                        $DCX42,'Confirmation of disconnect initiate',
                        $DCX43,'Image data field too long') %;

COMPILETIME
    dcn_count = 0,
    dcn_index = 0;
!
! Count the number of entries in DECNET error message table
!
MACRO
    $xpn$dcn_codes [code, text] =
        %ASSIGN (dcn_count, dcn_count + 1) %;

$xpn$define_decnet_codes                ! Count the entries

UNDECLARE
    %QUOTE $xpn$dcn_codes;
!
! Define a macro to do the PRESETs for the table
!
MACRO
    $xpn$dcn_codes [code, text] =
        [dcn_index, xpn$$dcn_code] = code,
        [dcn_index, $SUB_FIELD (xpn$$dcn_text, STR$A_POINTER)] = CH$PTR (UPLIT (text)),
        [dcn_index, $SUB_FIELD (xpn$$dcn_text, STR$H_LENGTH)] = %CHARCOUNT (text),
        [dcn_index, $SUB_FIELD (xpn$$dcn_text, STR$B_DTYPE)] = STR$K_DTYPE_T,
        [dcn_index, $SUB_FIELD (xpn$$dcn_text, STR$B_CLASS)] = STR$K_CLASS_F
        %ASSIGN (dcn_index, dcn_index + 1) %;
!
! Now build the table
!
OWN
    decnet_errors : BLOCKVECTOR [dcn_count, xpn$$dcn_block_size]
                    FIELD (decnet_msg_fields)
                    PRESET ($xpn$define_decnet_codes);
!
! EXTERNAL REFERENCES:
!
EXTERNAL ROUTINE
    xpo$xmsg : NOVALUE;                 ! XPORT error message translator
GLOBAL ROUTINE xpn$errmsg (code, buffer_descriptor, length, bits) =
!++
! FUNCTIONAL DESCRIPTION:
!   This routine, called by the $XPN_ERRMSG macro, returns in the buffer
!   described by the descriptor in buffer_descriptor the error message
!   text corresponding to the code supplied.
!
! FORMAL PARAMETERS:
!   code                - Interface error code
!   buffer_descriptor   - Address of a descriptor defining the buffer 
!                         the error message text
!   length              - Address of a fullword to receive the length
!                         of the message returned
!
! IMPLICIT INPUTS:
!   NONE
!
! IMPLICIT OUTPUTS:
!   NONE
!
! ROUTINE VALUE and
! COMPLETION CODES:
!   NONE
!
! SIDE EFFECTS:
!   The message is copied to the buffer described by buffer_descriptor.
!   The length of the message is copied into the location pointed to by length.
!--
    BEGIN

    MAP
        buffer_descriptor : REF $STR_DESCRIPTOR();

    LOCAL
        xport_msg_descr : $STR_DESCRIPTOR ();

    SELECTONE .code OF
        SET
        [XPN$_NLBADDR TO XPN$_MSGNOTFD1,
         XPN$_ABORTED TO XPN$_MSGTRUNC,
         XPN$_NO_OPEN TO XPN$_NO_ACCESS,
         XPN$_ACTIVE TO XPN$_ACCVIO] :
            xpn$$blissnet_error (.code, .buffer_descriptor, .length);
        [$DCX1 TO $DCX43] :
            xpn$$decnet_error (.code, .buffer_descriptor, .length);
        [%O'600010' TO %O'677777'] :
            xpn$$tops20_error (.code, .buffer_descriptor, .length);
        [OTHERWISE] :
            BEGIN
            xpo$xmsg (.code, xport_msg_descr);
            $STR_COPY (TARGET = .buffer_descriptor,
                       STRING = xport_msg_descr);
            (.length) = .xport_msg_descr[STR$H_LENGTH];
            END;
        TES;
    RETURN (XPN$_NORMAL)
    END;
ROUTINE xpn$$blissnet_error (code, buffer_descriptor, length) : NOVALUE =
!++
! FUNCTIONAL DESCRIPTION:
!   Return the error message for a BLISSnet-defined error code.
!
! FORMAL PARAMETERS:
!   same as for xpn$errmsg
!
! IMPLICIT INPUTS:
!   NONE
!
! IMPLICIT OUTPUTS:
!   NONE
!
! ROUTINE VALUE and 
! COMPLETION CODES:
!   NONE
!
! SIDE EFFECTS:
!   The error message is copied to the buffer described by buffer_descriptor.
!   The length of the message is copied to the location pointed to by length.
!
!--
    BEGIN

    MAP
        buffer_descriptor : REF $STR_DESCRIPTOR();

    LOCAL
	msg_index,
        temp_descriptor : $STR_DESCRIPTOR (CLASS = DYNAMIC);

    $STR_DESC_INIT (DESCRIPTOR = temp_descriptor, CLASS = DYNAMIC);
    msg_index =
        (INCR index FROM 0 TO error_table_size DO
             IF .error_table[.index, xpn$$error_code] EQL .code
             THEN
                 EXITLOOP .index);
    IF .msg_index EQL -1
    THEN
        xpn$$canned_msg ($STR_CONCAT ('Undefined XPN error code ',
                                      $STR_ASCII (.code, BASE10)))
    ELSE
        BEGIN
        $STR_COPY (STRING =
                   $STR_CONCAT ('XPN event ',
                                $STR_ASCII (.code, BASE10),
                                ': ',
                                error_table[.msg_index, xpn$$error_text]),
                   TARGET = temp_descriptor);
        (.length) = .temp_descriptor[STR$H_LENGTH];
        END;
    $STR_COPY (TARGET = .buffer_descriptor, STRING = temp_descriptor);
    $XPO_FREE_MEM (STRING = temp_descriptor);
    END;                                ! End of xpn$$blissnet_error
ROUTINE xpn$$decnet_error (code, buffer_descriptor, length) : NOVALUE =
!++
! FUNCTIONAL DESCRIPTION:
!   Return the error message associated with a DECNET disconnect code.
!
! FORMAL PARAMETERS:
!   same as xpn$errmsg
!
! IMPLICIT INPUTS:
!   NONE
!
! IMPLICIT OUTPUTS:
!   NONE
!
! ROUTINE VALUE and
! COMPLETION CODES:
!   NONE
!
! SIDE EFFECTS:
!   The error message is copied to the buffer described by buffer_descriptor.
!   The length of the message is copied to the location pointed to by length.
!
!--
    BEGIN

    MAP
        buffer_descriptor : REF $STR_DESCRIPTOR();

    LOCAL
	msg_index,
        temp_descriptor : $STR_DESCRIPTOR (CLASS = DYNAMIC);
        
    $STR_DESC_INIT (DESCRIPTOR = temp_descriptor, CLASS = DYNAMIC);
    msg_index =
        (INCR index FROM 0 TO dcn_count DO
            IF .decnet_errors[.index, xpn$$dcn_code] EQL .code
            THEN EXITLOOP (msg_index = .index));
    IF .msg_index EQL -1
    THEN
        xpn$$canned_msg ($STR_CONCAT ('Undefined DECNET disconnect code ',
                                       $STR_ASCII (.code, BASE10)))
    ELSE
        BEGIN
        $STR_COPY (STRING =
                   $STR_CONCAT ('DECNET disconnect code ',
                                $STR_ASCII (.code, BASE10),
                                ': ',
                                decnet_errors[.msg_index, xpn$$dcn_text]),
                   TARGET = temp_descriptor);
        (.length) = .temp_descriptor[STR$H_LENGTH];
        END;
    $STR_COPY (TARGET = .buffer_descriptor, STRING = temp_descriptor);
    $XPO_FREE_MEM (STRING = temp_descriptor);
    END;                                ! End of xpn$$decnet_error
ROUTINE xpn$$tops20_error (code, buffer_descriptor, length) : NOVALUE =
!++
! FUNCTIONAL DESCRIPTION:
!   Returns the error message associated with a TOPS-20 error code.
!
! FORMAL PARAMETERS:
!   same as for xpn$errmsg
!
! IMPLICIT INPUTS:
!   NONE
!
! IMPLICIT OUTPUTS:
!   NONE
!
! ROUTINE VALUE and
! COMPLETION CODES:
!   NONE
!
! SIDE EFFECTS:
!   The error message is copied to the buffer described by buffer_descriptor.
!   The length of the message is copied to the location pointed to by length.
!
!--
    BEGIN

    MAP
        buffer_descriptor : REF $STR_DESCRIPTOR();

    LOCAL
	retval,
        erstr_buffer : VECTOR [CH$ALLOCATION (132)],
        temp_descriptor : $STR_DESCRIPTOR (CLASS = DYNAMIC);

    $STR_DESC_INIT (DESCRIPTOR = temp_descriptor, CLASS = DYNAMIC);
    retval = JSYS_ERSTR (CH$PTR (erstr_buffer),
                         ($FHSLF ^ 18) + .code,
                         (-132 ^ 18));
    CASE .retval FROM 0 TO 2 OF
	SET
	[0] : xpn$$canned_msg
                  ($STR_CONCAT ('Undefined TOPS-20 error code ',
                                $STR_ASCII (.code, BASE8)));
	[1] : xpn$$canned_msg ('Bad args to ERSTR% in XPN$$TOPS20_ERROR');
	[2] :
	    BEGIN
	    LOCAL
		ptr,
		byte_count;
            $STR_COPY (TARGET = temp_descriptor,
                       STRING = $STR_CONCAT ('TOPS20 error code ',
                                             $STR_ASCII (.code,
                                                         BASE8,
                                                         LENGTH = 6),
                                             ': ',));
	    ptr = CH$PTR (erstr_buffer);
	    byte_count = 0;
	    WHILE (CH$RCHAR_A (ptr) NEQ 0) DO byte_count = .byte_count + 1;
	    $STR_APPEND (STRING = (.byte_count, CH$PTR (erstr_buffer)),
                         TARGET = temp_descriptor);
            (.length) = .temp_descriptor[STR$H_LENGTH];
	    END;
	TES;
    $STR_COPY (TARGET = .buffer_descriptor, STRING = temp_descriptor);
    $XPO_FREE_MEM (STRING = temp_descriptor);
    END;                                ! End of xpn$$tops20_error
END                                     ! End of module
ELUDOM