Trailing-Edge
-
PDP-10 Archives
-
BB-JF18A-BM
-
sources/rms/rmserm.b36
There are 4 other files named rmserm.b36 in the archive. Click here to see a list.
MODULE ErMsg ( ! Create error messages from status codes & print them
IDENT = '1'
%BLISS36(,
ENTRY(
R$MESSAGE,
R$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: RMS-20 (and friends) Error message handler
!
! ABSTRACT:
!
!
! ENVIRONMENT: TOPS-20 RMS
!
! AUTHOR: Andrew Nourse, CREATION DATE: 29-Mar-83
!
! Cloned out of ERROR.BLI (from FTS-20)
!--
!
! INCLUDE FILES:
!
LIBRARY 'CONDIT';
LIBRARY 'RMSINT';
LIBRARY 'BLI:XPORT';
LIBRARY 'DAP';
LIBRARY 'BLISSNET';
!
! TABLE OF CONTENTS:
!
FORWARD ROUTINE
R$MESSAGE,
R$ERRMSG;
!
! MACROS:
!
MACRO OURNAME='RMS20' %; !*** Prefix for error messages
MACRO TOPS20[]=%IF %BLISS(BLISS36)
%THEN %IF %SWITCHES(%QUOTE %QUOTE TOPS20)
%THEN %REMAINING
%FI
%FI
%;
%(
MACRO
LH = 18, 18 %;
)%
!
! OWN STORAGE:
!
STRUCTURE ORIGINNED_BITVECTOR[VAL;LOWEST,HIGHEST]=
[(HIGHEST-LOWEST+%BPUNIT)/%BPUNIT]
(((VAL-LOWEST)/%BPUNIT)+ORIGINNED_BITVECTOR)
<(VAL-LOWEST) MOD %BPUNIT,1>;
GLOBAL VERBOSITY: BITVECTOR[16]; ! How much info is enuff?
GLOBAL SRMSTV: ORIGINNED_BITVECTOR[RMS$K_ERR_MIN,RMS$K_ERR_MAX]
PRESET([RMS$_EOF]=1, [RMS$_FNF]=1, [RMS$_PRV]=1);
OWN ERROUT: $XPO_IOB(); ! Error output device
!
! EQUATED SYMBOLS
!
LITERAL
SUPRESS_SELECTED_RMS_CODES=1, ! Only print STV on 'unusual' RMS errors
SUPRESS_REMOTE_STV=2;
!
! EXTERNAL REFERENCES:
!
EXTERNAL ROUTINE
RMS$ERRMSG,
DAP$ERRMSG,
XPN$ERRMSG;
%IF %SWITCHES(DEBUG)
%THEN
EXTERNAL ROUTINE
SIX12;
%FI;
GLOBAL ROUTINE R$MESSAGE (CODE,CODE2,ADDTEXT) =
!++
! FUNCTIONAL DESCRIPTION:
!
! Find a message to match the error code
!
! FORMAL PARAMETERS:
!
! CODE: DAP/RMS/XPN/XPO/... error code
! CODE2: Secondary code
! ADDTEXT: Descriptor to additional text
!
! COMPLETION CODES:
!
! The primary code (CODE) that was passed to us
!
!--
BEGIN
LOCAL SEVERITY;
LOCAL DESCR: $STR_DESCRIPTOR(CLASS=DYNAMIC);
LOCAL LEN; ! Length of message
$STR_DESC_INIT(DESC=DESCR, CLASS=DYNAMIC);
R$ERRMSG(.CODE,.CODE2,.ADDTEXT,DESCR,LEN);
!? S$CRIF(); ! Get to left margin if not there now
SEVERITY=(SELECT .CODE OF
SET
[RMS$K_SUC_MIN TO RMS$K_SUC_MAX]: SS$_NORMAL;
[RMS$K_ERR_MIN TO RMS$K_ERR_MAX]: SS$_ERROR;
TOPS20( [%O'600000' TO %O'677777']: SS$_ERROR;)
! TOPS-20 Error code
[OTHERWISE]: .CODE<0,3>; ! Standard severity
TES);
BEGIN
IF .ERROUT[IOB$V_OPEN] EQL 0 ! If error device not open yet
THEN $XPO_OPEN(IOB=ERROUT,
FILE_SPEC=$XPO_ERROR); ! Open error device
SELECT .SEVERITY
OF
SET
[STS$K_SUCCESS, STS$K_INFO] :
$XPO_PUT(IOB = ERROUT,
STRING=$STR_CONCAT ('[',OURNAME,': ',
(.LEN,.DESCR[STR$A_POINTER]),
']'));
[STS$K_WARNING] :
$XPO_PUT(IOB=ERROUT,
STRING=$STR_CONCAT ('%',OURNAME,': ',
(.LEN,.DESCR[STR$A_POINTER])));
[OTHERWISE] :
$XPO_PUT(IOB = ERROUT,
STRING=$STR_CONCAT('?',OURNAME,': ',
(.LEN,.DESCR[STR$A_POINTER])));
TES;
END;
$XPO_FREE_MEM(STRING=DESCR);
.CODE ! Return the code we got
END; ! End of R$MESSAGE
GLOBAL ROUTINE R$ERRMSG (CODE,CODE2,ADDTEXT,DESC,LEN) =
!++
! FUNCTIONAL DESCRIPTION:
!
! Find a message to match the error code
!
! FORMAL PARAMETERS:
!
! CODE: DAP/RMS/XPN/XPO/... error code
! CODE2: Secondary code
! ADDTEXT: Additional text (usually a filespec)
! DESC: Target Descriptor for error text
! LEN: Length of error text
!
! ROUTINE VALUE:
!
! Length of text (same as is stored into LEN)
!
!--
BEGIN
MAP DESC: REF $STR_DESCRIPTOR();
MAP ADDTEXT: REF $STR_DESCRIPTOR();
LOCAL TDESC: $STR_DESCRIPTOR(CLASS=DYNAMIC);
LOCAL T2DESC: $STR_DESCRIPTOR(CLASS=DYNAMIC);
LOCAL LEN2: INITIAL(0);
$STR_DESC_INIT(DESC=TDESC, CLASS=DYNAMIC);
$STR_DESC_INIT(DESC=T2DESC, CLASS=DYNAMIC);
SELECT .CODE OF SET
[RMS$K_SUC_MIN TO RMS$K_SUC_MAX,
RMS$K_ERR_MIN TO RMS$K_ERR_MAX]:
RMS$ERRMSG(.CODE,TDESC,.LEN);
[RMS$K_ERR_MIN TO RMS$K_ERR_MAX]:
BEGIN ! Secondary status code is
IF (.CODE2 NEQ 0) ! probably system error code
AND ((.SRMSTV[.CODE]
AND .VERBOSITY[SUPRESS_SELECTED_RMS_CODES])
EQL 0)
THEN ! Print secondary code
BEGIN
! First see if it is a DAP code or system code
SELECT .CODE2 OF
SET
[1 TO 50,
RMS$K_ERR_MIN TO RMS$K_ERR_MAX, ! RMS code
XPN$$SELECT_XPN_ERRORS,
%O'600000' TO %O'677777']: ; ! System.
[OTHERWISE]: CODE2=.CODE2^3+SS$_ERROR ! DAP. make
+DAP$K_FACILITY_CODE; !standard
TES;
R$ERRMSG(.CODE2,0,0,T2DESC,LEN2);
END;
END;
[DAP$K_FACILITY_CODE TO DAP$K_FACILITY_CODE + %O'7777777']:
BEGIN
DAP$ERRMSG(.CODE,TDESC,.LEN);
IF (.CODE2 NEQ 0)
AND (.VERBOSITY[SUPRESS_REMOTE_STV] EQL 0)
THEN ($STR_COPY(STRING=$STR_CONCAT(' STV=',
$STR_ASCII(.CODE2,
BASE8),
' '),
TARGET=T2DESC);
LEN2=.T2DESC[STR$H_LENGTH]);
END;
[OTHERWISE]:
BEGIN
XPN$ERRMSG(.CODE,TDESC,.LEN,0);
IF (.CODE2 NEQ 0)
THEN
R$ERRMSG (.CODE2,0,0,T2DESC,LEN2)
END;
TES;
IF .LEN2 NEQ 0 ! Secondary status text?
THEN $STR_APPEND(TARGET=TDESC,
STRING=$STR_CONCAT(%CHAR (13,10), ! CRLF
'-', %CHAR (9),
T2DESC));
IF .ADDTEXT NEQ 0 ! Additional text (a filespec, for instance)
THEN (IF .ADDTEXT[STR$H_LENGTH] GTR 0 ! Additional text if available
THEN $STR_APPEND(TARGET=TDESC,
STRING=$STR_CONCAT(%CHAR (13,10), ! CRLF
'-', %CHAR (9),
'"', ADDTEXT[$],
'"')));
.LEN=.TDESC[STR$H_LENGTH]; ! Get length of all this
$STR_COPY(STRING=TDESC[$],TARGET=DESC[$]); ! Copy to user
$XPO_FREE_MEM(STRING=TDESC); ! Give back to memory manager
.LEN ! Return length of text
END;
END !End of module
ELUDOM