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