Enter your search terms Submit search form
	Web pdp-10.trailing-edge.com

MODULE DAPERR(
              IDENT='1',
              ENTRY(D$ERDR, DAP$ERRMSG, XPN$SIGNAL)
              )=
BEGIN

! THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY  BE  USED
! OR COPIED ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
!
! COPYRIGHT  (C)  DIGITAL  EQUIPMENT  CORPORATION 1986.
! ALL RIGHTS RESERVED.


! EDIT HISTORY
! 
! Facility DAP
!
! Edit (%O'2', '23-May-84', 'Sandy Clemens')
!  %( Add a CRLF to the end of a bunch of files because without it, if
!     you copy the file to another system with FTS, you will lose the
!     last line of the file!  FILES:  DAPBLK.10-REQ, DAPERR.BLI,
!     DIRLST.10-BLI, DIR10.10-B36, DAPT10.10-B36.
!  )%
!
! Edit (%O'5', '5-Oct-84', 'Sandy Clemens')
!  %( Add new format of COPYRIGHT notice.  FILES:  ALL )%

!
! INCLUDE FILES:
!

LIBRARY 'CONDIT';
LIBRARY 'RMS';
LIBRARY 'BLISSNET';
LIBRARY 'DAP';

!
! Table of Contents
!

FORWARD ROUTINE
               DAP$ERROR_DAP_RMS,
               DAP$ERRMSG,
               XPN$SIGNAL;

!
! Macros
!

! Declare DAP error code/string table

UNDECLARE %QUOTE $DAP$ERROR;

$FIELD ERROR_TABLE_FIELDS=
    SET
    DAP$G_ERRTAB_CODE=[$INTEGER],
    DAP$T_ERRTAB_TEXT=[$DESCRIPTOR(FIXED)],
    $OVERLAY(DAP$T_ERRTAB_TEXT)
    DAP$B_ERRTAB_DTYPE=[$SUB_FIELD(DAP$T_ERRTAB_TEXT,STR$B_DTYPE)],
    DAP$B_ERRTAB_CLASS=[$SUB_FIELD(DAP$T_ERRTAB_TEXT,STR$B_CLASS)],
    DAP$H_ERRTAB_LENGTH=[$SUB_FIELD(DAP$T_ERRTAB_TEXT,STR$H_LENGTH)],
    DAP$A_ERRTAB_POINTER=[$SUB_FIELD(DAP$T_ERRTAB_TEXT,STR$A_POINTER)]
    $CONTINUE
    TES;

LITERAL DAP$K_ERRTAB_WIDTH=$FIELD_SET_SIZE;

MACRO ERROR_TABLE=BLOCKVECTOR[DAP$K_ERRTAB_LENGTH,DAP$K_ERRTAB_WIDTH]
                             FIELD(ERROR_TABLE_FIELDS) %;

MACRO $DAP$ERROR[CODE,VALUE,SEVERITY,TEXT]=
   [%COUNT,DAP$G_ERRTAB_CODE]= (VALUE^3)+DAP$K_FACILITY_CODE+%NAME(STS$K_,SEVERITY),
   [%COUNT,DAP$B_ERRTAB_DTYPE]=STR$K_DTYPE_T,
   [%COUNT,DAP$B_ERRTAB_CLASS]=STR$K_CLASS_F,
   [%COUNT,DAP$H_ERRTAB_LENGTH]=%CHARCOUNT(%REMOVE(TEXT)),
   [%COUNT,DAP$A_ERRTAB_POINTER]=CH$PTR(UPLIT(TEXT)) %;
                                        
!
! Own Storage
!


PSECT
    OWN=$HIGH$;

OWN ERRTAB: ERROR_TABLE PRESET($DAP$ERRORS);

PSECT
    OWN=$LOW$;

GLOBAL ROUTINE DAP$ERRMSG(CODE,DESC,LEN)= !Return error message for DAP code
BEGIN
MAP DESC: REF $STR_DESCRIPTOR();
LOCAL TEMP: $STR_DESCRIPTOR(CLASS = DYNAMIC);

$STR_DESC_INIT (DESCRIPTOR=TEMP,CLASS = DYNAMIC);

INCR I FROM 0 TO DAP$K_ERRTAB_LENGTH
DO  BEGIN
    IF .ERRTAB[.I,DAP$G_ERRTAB_CODE] EQL .CODE
    THEN
        BEGIN
        $STR_COPY(STRING=
                  $STR_CONCAT('DAP Status: [MACcode=',
                              $STR_ASCII((.CODE^-15) AND %O'17',
                                         BASE8,LENGTH=2),
                              ', MICcode=',
                              $STR_ASCII((.CODE^-3) AND %O'7777',
                                         BASE8,LENGTH=4),
                              ']: ',
                               ERRTAB[.I,DAP$T_ERRTAB_TEXT]),
                  TARGET=TEMP);
        $STR_COPY(STRING=TEMP,TARGET=DESC[$]);
        .LEN=.TEMP[STR$H_LENGTH];
        $XPO_FREE_MEM(STRING=TEMP);
        RETURN .CODE
        END
    END;

!No text for error code if we get here
$STR_COPY(TARGET=TEMP,
          STRING=$STR_CONCAT('DAP Status: [MACcode=',
                             $STR_ASCII((.CODE^-15) AND %O'17',BASE8,LENGTH=2),
                             ', MICcode=',
                             $STR_ASCII((.CODE^-3) AND %O'7777',
                                        BASE8,LENGTH=4),
                             ']'
                            )
         );
$STR_COPY(STRING=TEMP,TARGET=DESC[$]);
.LEN=.TEMP[STR$H_LENGTH];
$XPO_FREE_MEM(STRING=TEMP);
.CODE
END;

GLOBAL ROUTINE DAP$ERROR_DAP_RMS(ERR)=
!
! Convert DAP error code to RMS error code
!
BEGIN
LOCAL V;
! Translate all the common DAP errors into RMS errors
V=$DAP_TRANSLATE_VALUE(.ERR,DAP$_,RMS$_,
                       CCF,CEF,COF,DEV,DNF,EOF,FEX,FLK,FNF,FNM,FUL,
                       MRS,RAT,RFM,SHR,RNF,RSZ,PRV);

IF .V EQL -1
THEN
    BEGIN
    V=(SELECT .ERR OF
          SET
          [DAP$_GES,
           DAP$_SYN,
           DAP$_DIR,
           DAP$_FNM,
           DAP$_TYP]: RMS$_FSI;         ! Invalid syntax in filespec
          [DAP$_RFX]: RMS$_FEX;         ! File already exists
          [DAP$_DNF]: RMS$_FNF;         ! File not found
          [OTHERWISE]:
                IF ((.ERR^-3) AND %O'170000') EQL DAP$K_MAC_UNSUPPORTED
                THEN RMS$_SUP            ! Not supported
                ELSE RMS$_DPE;           ! Catch all 'DAP Protocol Error'
          TES);
    END;
.V
END;

GLOBAL ROUTINE xpn$signal (function, primary_code, secondary_code, nlb) =
!++
! FUNCTIONAL DESCRIPTION:
!   This is the failure action routine called by the various
!   BLISSnet macros. It SIGNALs the error condition.
!
! 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
!
! ROUTINE VALUE and
! COMPLETION CODES:
!   This routine returns the primary completion code as its completion code.
!
!--
    BEGIN

    MAP
        nlb : REF $XPN_NLB();

    SIGNAL (.primary_code, .secondary_code, .nlb);
    RETURN (.primary_code)
    END;			!End of xpn$signal

END ELUDOM                            ! End of module