MODULE SMSG (	IDENT = 'X00.05'	%TITLE 'Failure Message Builder'
		%BLISS32( ,ADDRESSING_MODE( EXTERNAL=LONG_RELATIVE ) )
		%BLISS36( ,ENTRY( XST$INIT_MSG, XST$STRING, XST$QUOTED ),OTS='' )
		) =
BEGIN

!
!			  COPYRIGHT (c) 1980 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:  BLISS Library
!
! ABSTRACT:
!
!	This module is the Failure Action Routine Message Builder.  It was
!	created to eliminate a significant amount of redundant code in the
!	XPORT default failure action routines.
!
! ENVIRONMENT:  User mode - multiple host operating/file systems
!
! AUTHOR:  Ward Clark,	CREATION DATE:  28 February 1980
!
!--

!
! TABLE OF CONTENTS:
!

%IF NOT %BLISS(BLISS16) %THEN
FORWARD ROUTINE
    XST$INIT_MSG :  NOVALUE,				! Message initialization routine
    XST$STRING :  NOVALUE,				! Append string to message routine
    XST$QUOTED :  NOVALUE;				! Append quoted string to message
%FI

!
! INCLUDE FILES:
!

LIBRARY  'XPORT' ;					! Public XPORT control block and macro definitions
LIBRARY  'XPOSYS' ;					! Internal XPORT macro definitions

    $XPO_SYS_TEST( $ALL )

!
! MACROS:
!

!
! EQUATED SYMBOLS:
!

!
! PSECT DECLARATIONS:
!

    $XPO_PSECTS						! Declare XPORT PSECT names and attributes

!
! OWN STORAGE:
!

!	See individual routines

!
! EXTERNAL REFERENCES:
!

%TITLE 'XST$INIT_MSG - Initialize failure message'

GLOBAL ROUTINE XST$INIT_MSG( string ) :  NOVALUE =

!++
!
! FUNCTIONAL DESCRIPTION:
!
!	This routine initializes the failure message buffer.
!
! FORMAL PARAMETERS:
!
!	string - address of string descriptor
!
! IMPLICIT INPUTS:
!
!	None
!
! IMPLICIT OUTPUTS:
!
!	None
!
! ROUTINE VALUE:
!
!	None
!
! SIDE EFFECTS:
!
!	None
!
!--

    BEGIN

    EXTERNAL
	XST$MESSAGE :  $STR_DESCRIPTOR();		! Message buffer descriptor

!
! Initialize the message buffer with the caller's string.
!

    $STR_COPY( STRING = .string,
		TARGET = XST$MESSAGE,
		OPTION = TRUNCATE,
		FAILURE = 0 );

!
! Return to the caller.
!

    RETURN

    END;

$XPO_MODULE( SMSG1 )

%TITLE 'XST$STRING - Add String to Failure Message'

GLOBAL ROUTINE XST$STRING( string ) :  NOVALUE =

!++
!
! FUNCTIONAL DESCRIPTION:
!
!	This routine appends a string to the current failure message.
!
! FORMAL PARAMETERS:
!
!	string - address of a string descriptor
!
! IMPLICIT INPUTS:
!
!	None
!
! IMPLICIT OUTPUTS:
!
!	None
!
! ROUTINE VALUE:
!
!	None
!
! SIDE EFFECTS:
!
!	None
!
!--

    BEGIN

    EXTERNAL
	XST$MESSAGE :  $STR_DESCRIPTOR();		! Message buffer descriptor

!
! Add the caller's string to the end of the current failure message.
!

    $STR_APPEND( STRING = .string,
		TARGET = XST$MESSAGE,
		OPTION = TRUNCATE,
		FAILURE = 0 );

!
! Return to the caller.
!

    RETURN

    END;

$XPO_MODULE( SMSG2 )

%TITLE 'XST$QUOTED - Add Quoted String to Failure Message'

GLOBAL ROUTINE XST$QUOTED( string ) :  NOVALUE =

!++
!
! FUNCTIONAL DESCRIPTION:
!
!	This routine adds a quoted version of the caller's string
!	to the current failure message.  If the caller's string is
!	invalid, error text is substituted for the string.
!
! FORMAL PARAMETERS:
!
!	string - address of string descriptor
!
! IMPLICIT INPUTS:
!
!	None
!
! IMPLICIT OUTPUTS:
!
!	None
!
! ROUTINE VALUE:
!
!	None
!
! SIDE EFFECTS:
!
!	None
!
!--

    BEGIN

    MAP
	string :  REF $STR_DESCRIPTOR();

    OWN
	apostrophe :  $STR_DESCRIPTOR( STRING = '''' ),

	invalid_string :  $STR_DESCRIPTOR( STRING = '[invalid string]' );

    EXTERNAL
	XST$MESSAGE :  $STR_DESCRIPTOR();		! Message buffer descriptor


!
! If the caller's string is valid, add it to the current message.
!

    IF $STR_VALIDATE( .string )				! See if the string is valid.
    THEN
	BEGIN
	$STR_APPEND( STRING = apostrophe, TARGET = XST$MESSAGE, OPTION = TRUNCATE, FAILURE = 0 );
	$STR_APPEND( STRING = .string, TARGET = XST$MESSAGE, OPTION = TRUNCATE, FAILURE = 0 );
	$STR_APPEND( STRING = apostrophe, TARGET = XST$MESSAGE, OPTION = TRUNCATE, FAILURE = 0 );
	END

!
! Add error text to the message if the caller's string is invalid.
!

    ELSE
	$STR_APPEND( STRING = invalid_string, TARGET =  XST$MESSAGE, OPTION = TRUNCATE, FAILURE = 0 );

!
! Return to the caller.
!

    RETURN

    END;
END
ELUDOM