Google
 

Trailing-Edge - PDP-10 Archives - DEC_CMS-20_V1.0_SRC - cms/sources/xpoerr.bli
There are no other files named xpoerr.bli in the archive.
MODULE XPOERR (! Xport error functions
		 IDENT = '1',
		 %if
		      %bliss(bliss32)
		 %then
		      language(bliss32),
		      addressing_mode(external=long_relative,
				      nonexternal=long_relative)
		 %else
		      language(bliss36)
		 %fi
		 ) =
BEGIN

!
!			  COPYRIGHT (C) 1982 BY
!	      DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
!
! 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 WHICH IS NOT SUPPLIED BY DIGITAL.
!

!++
! FACILITY:
!
!   CMS library Processor
!
! ABSTRACT:
!
!   This module provides the function to analyze XPORT errors.
!
! ENVIRONMENT:
!   
!
! AUTHOR: R. Wheater, CREATION DATE: 15-Jan-80
!
! MODIFIED BY:
!
!--
!
! TABLE OF CONTENTS:
!

FORWARD ROUTINE
	XFSTAT;			! analyze xport status and print msg

!
! INCLUDE FILES:
!

LIBRARY 'XPORT:' ;
%if %bliss(bliss32) %then
    library 'sys$library:starlet';
%else
    require 'jsys:';
%fi
REQUIRE 'BLISSX:' ;

!
! MACROS:
!

!
! EQUATED SYMBOLS:
!

!
! OWN STORAGE:
!

!
! EXTERNAL REFERENCES:
!

EXTERNAL ROUTINE
	BUGIOB,		! print bug message involving an iob, and terminate.
	ERSIOB ;	        ! print error message involving an iob.
GLOBAL ROUTINE XFSTAT(value, A_IOB, A_MESSAGE) =

!++
! FUNCTIONAL DESCRIPTION:
!
!	This routine examines an IOB after an XPORT call.  It outputs
!	appropriate error messages for file spec related errors that could
!	have been caused by a user mistake in entering a file specification.
!	It is assumed that there was an error in the XPORT call and that
!	the XPORT call was made with the keyword FAILURE set to zero.
!
!	If the error could not have been a user file specification mistake,
!	the routine is silent and returns FALSE.
!
! FORMAL PARAMETERS:
!
!	a_iob	    Address of the IOB.
!	a_message   Address of a descriptor of a message to be output before
!		    any IOB information.
!	value	    Address of value descriptor prefixing IOB information.
!
! IMPLICIT INPUTS:
!
!	
!
! IMPLICIT OUTPUTS:
!
!	
!
! ROUTINE VALUE and
! COMPLETION CODES:
!
!	TRUE = File specification related error has been reported to the user.
!	FALSE = Error other than file specification related was not reported.
!
! SIDE EFFECTS:
!
!	
!
!--
    BEGIN
    
    BIND

	IOB=.A_IOB: $XPO_IOB(),
	MESSAGE =.A_MESSAGE: DESC_BLOCK ;
    LOCAL
        system_status,
	RETFLG ;	! Return value for this routine.

%if VaxVms %then
    system_status = .iob[iob$g_comp_code];
%fi

%if Tops20 %then	!on the 20 system status shifted 3 bits left so even.
    system_status = .iob[iob$g_comp_code] ^ -3;
%fi

    ! This routine does not handle success codes.
    IF .iob[iob$g_comp_code]
    THEN
	BUGIOB(IOB,LIT('XFSTAT was given a success code.')) ;

    ! See if the user could have made a file specification mistake.
    SELECTONE .system_status OF
	SET
%if VaxVMS %then
        [rms$_acc,
         rms$_chn,
         rms$_cre,
         rms$_dev,
         rms$_dir,
         rms$_dnf,
         rms$_dnr,
         rms$_exp,
         rms$_fex,
         rms$_flk,
         rms$_fnf,
         rms$_fnm,
         rms$_ful,
         rms$_lne,
         rms$_mkd,
         rms$_prv,
         rms$_syn,
         rms$_typ,
         rms$_ver,
         rms$_wld,
         rms$_wlk]:
%fi

%if tops20 %then
         [gjfx4  To gjfx20,
          gjfx23 To gjfx24,
          gjfx27 To gjfx35,
          opnx1  To opnx10,
          opnx12 To opnx15,
          opnx23,
          gjfx37,
          gjfx38,
          gjfx39,
          gjfx40,
          gjfx41,
          gjfx42,
          gjfx43,
          gjfx44,
          gjfx45,
          gjfx46,
          gjfx49,
          iox11 ,
          desx9 ,
          strx09,
          opnx25,
          ttyx01]:
%fi
	    	   BEGIN	! messages to be reported
 	    	   ERSIOB(.value,IOB,MESSAGE) ;
	    	   RETFLG=TRUE ;
	    	   END ;	! messages to be reported

	[OTHERWISE]:
	    			! messages that are not reported
	    	   RETFLG=FALSE ;
	TES;
    
    .RETFLG
    
    END;

END				! End of module
ELUDOM