Google
 

Trailing-Edge - PDP-10 Archives - BB-H138F-BM_1988 - 7-sources/daperr.b36
There are 5 other files named daperr.b36 in the archive. Click here to see a list.
MODULE DAPERR(
              IDENT='2',
              ENTRY(D$ERDR, DAP$ERRMSG, XPN$SIGNAL)
              )=
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.
!
!
!
!
! REVISION HISTORY:
!
! 03 - Make error translation smarter.
! 02 - ALL OWN storage is really pure stuff from XPORT, etc. Put in Hiseg
! 01 - Split off from ERROR.
!


!
! INCLUDE FILES:
!

LIBRARY 'RMSINT';                       ! External RMS definitions        !m526
LIBRARY 'CONDIT';                       ! Standard condition handling defs
LIBRARY 'BLISSNET';                     ! BLISS Decnet Interface defs
LIBRARY 'DAP';                          ! DAP definitions                 !a526
LIBRARY 'BLI:XPORT';                    ! XPORT definitions               !a526

!
! 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);
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)=
!++
! FUNCTIONAL DESCRIPTION
!
!     Convert DAP error code to RMS error code
!
! FORMAL PARAMETERS:
!
!     ERR, A DAP status code (either form)
!
! RETURN VALUE:
!
!     The corresponding RMS status code
!--
BEGIN
LOCAL v;
LOCAL daperr;

IF .err GTR Dap$k_Facility_Code
THEN daperr=.err<dapcode>
ELSE daperr=.err;

! Translate all the common DAP file errors into RMS errors
SELECT .daperr AND Dap$m_Maccode OF
SET
 [Dap$k_Mac_Unsupported]:
    Rms$_Ons;

[Dap$k_Mac_Pending,
 Dap$k_Mac_Open TO Dap$K_Mac_Termination]:
    BEGIN
    LOCAL v;

    v=$dap_Translate_Value( .daperr AND Dap$m_Miccode,
                            Dap$k_Err_, Rms$_,
                            bsz,ccf,ccr,cef,cgj,chg,cod,cof,cur,
                            dan,del,dev,dtp,dup,dme,dnf,eof,ext,
                            fex,flg,flk,fnf,fnm,ful,ian,iop,key,ksz,mrs,
                            nef,nmf,npk,org,pef,prv,
                            rac,rat,rbf,rex,rfa,rfm,rlk,rnf,rnl,rop,rsz,
                            rtb,shr,seq,siz,
                            suc,
                            xab,xcl);                                 !m657


    IF .V EQL -1
    THEN
        BEGIN                                                         !m577vv
        V=(SELECT .DAPERR AND DAP$M_MACCODE OF
              SET
              [DAP$K_MAC_OPEN]:
                  SELECT .DAPERR AND DAP$M_MICCODE OF
                      SET
                      [DAP$K_ERR_VER,
                       DAP$K_ERR_SYN,
                       DAP$K_ERR_DIR,
                       DAP$K_ERR_FNM,
                       DAP$K_ERR_TYP]: RMS$_FSI;   ! Invalid syntax in filespec
                      [DAP$K_ERR_RFE]: RMS$_FEX;   ! File already exists
                      [DAP$K_ERR_DNF]: RMS$_FNF;   ! File not found
                      [OTHERWISE]:
                         RMS$_COF;      ! Catch all File Open error
                      TES;
              [DAP$K_MAC_TERMINATION]:
                  RMS$_CCF;             ! Catch all File Close error
              [OTHERWISE]:
                  RMS$_DPE;             ! Catch all 'DAP Protocol Error'
              TES);
        END;

    .V                                  ! Code to return
    END;

[Dap$k_Mac_Success]:
   SELECT .daperr AND Dap$M_Miccode OF
       SET
       [Dap$k_Err_Normal,
        Dap$k_Err_Suc]:  Rms$_Suc;
       [Dap$k_Err_Ok_Idx]: Rms$_Ok_Idx;
!      [Dap$k_Err_Ok_Reo]: Rms$_Ok_Reo;  ! Dap does not have this code
       [Dap$k_Err_Ok_Rrv]: Rms$_Ok_Rrv;
       [Dap$k_Err_Ok_Dup]: Rms$_Ok_Dup;
       [OTHERWISE]:        Rms$_Suc;    ! success
       TES;                                                            !m577^^


[OTHERWISE]: ! Protocol errors
    Rms$_Dpe;
TES
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