Google
 

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