MODULE SFAIL ( IDENT = 'V1.0-8' %TITLE 'STR$FAILURE - String Failure Action Routine' %BLISS32( ,ADDRESSING_MODE( EXTERNAL=LONG_RELATIVE ) ) %BLISS36( ,ENTRY( STR$FAILURE, STR$X_FAILURE, STR$C_FAILURE, STR$A_FAILURE, STR$S_FAILURE, STR$B_FAILURE ),OTS='' ) ) = BEGIN .skip;! ! COPYRIGHT (c) 1981 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. ! .skip;!++ ! ! FACILITY: BLISS Library ! ! ABSTRACT: ! ! This module includes all standard String Handling failure ! action routine processing. ! ! ENVIRONMENT: User mode - multiple host operating/file systems ! ! AUTHOR: Ward Clark, CREATION DATE: 28 February 1980 ! !-- .skip 3;! ! TABLE OF CONTENTS: ! .skip;FORWARD ROUTINE STR$FAILURE; ! Failure action routine dispatcher %IF %BLISS(BLISS16) %THEN EXTERNAL ROUTINE %ELSE FORWARD ROUTINE %FI STR$X_FAILURE, ! String comparison failure action routine STR$C_FAILURE, ! $STR_COPY failure action routine STR$A_FAILURE, ! $STR_APPEND failure action routine STR$S_FAILURE, ! $STR_SCAN failure action routine STR$B_FAILURE; ! $STR_BINARY failure action routine .skip;! ! INCLUDE FILES: ! .skip;LIBRARY 'BLI:XPORT' ; ! Public XPORT control block and macro definitions LIBRARY 'XPOSYS' ; ! Internal XPORT macro definitions .skip; $XPO_SYS_TEST( $ALL ) .skip;! ! MACROS: ! .skip;! ! EQUATED SYMBOLS: ! .skip;! ! PSECT DECLARATIONS: ! .skip; $XPO_PSECTS ! Declare XPORT PSECT names and attributes .skip;! ! OWN STORAGE: ! .skip;! See each function-specific failure action routine. .skip;! ! EXTERNAL REFERENCES: ! .skip;! See each function-specific failure action routine. .page;GLOBAL ROUTINE STR$FAILURE( function_code, primary_code, secondary_code, action_arg1, action_arg2, action_arg3 ) = .skip;!++ ! ! FUNCTIONAL DESCRIPTION: ! ! This routine dispatches a failure action routine call to the ! appropriate processing routine for the function which failed. ! ! FORMAL PARAMETERS: ! ! function_code - String Handling failure action routine function code ! primary_code - primary failure completion code ! secondary_code - secondary failure completion code ! action_arg1,2,3 - function-specific action routine arguments ! ! IMPLICIT INPUTS: ! ! None ! ! IMPLICIT OUTPUTS: ! ! None ! ! ROUTINE VALUE: ! ! primary completion code (value passed as a formal parameter) ! ! SIDE EFFECTS: ! ! This routine returns to the caller if the completion code ! severity is SUCCESS or WARNING. If the severity is ERROR or ! FATAL, this routine terminates program execution. ! !-- .skip; BEGIN .skip; LOCAL action_routine; ! Address of action routine to be called .skip;! ! Select the appropriate failure processing routine. ! .skip; action_routine = ( CASE .function_code FROM 1 TO STR$K_BINARY OF SET [ STR$K_COMPARE ] : STR$X_FAILURE; [ STR$K_COPY ] : STR$C_FAILURE; [ STR$K_APPEND ] : STR$A_FAILURE; [ STR$K_SCAN ] : STR$S_FAILURE; [ STR$K_BINARY ] : STR$B_FAILURE; TES ); .skip;! ! Call the action routine. ! .skip; (.action_routine)( .function_code, .primary_code, .secondary_code, .action_arg1, .action_arg2, .action_arg3 ); .skip;! ! Terminate program execution or return to the caller. ! .skip; IF .primary_code OR ! If the completion code is a success code .primary_code<0,3,0> EQL XPO$_WARNING ! or has a WARNING severity, THEN ! RETURN .primary_code ! return the input completion code to the caller. ELSE $XPO_TERMINATE( CODE = XPO$_PREV_ERROR ) ! Otherwise, terminate program execution. .skip; END; .skip;$XPO_MODULE( SFAIL1 ) .page;GLOBAL ROUTINE STR$X_FAILURE( function_code, primary_code, secondary_code, relation, string1, string2 ) = .skip;!++ ! ! FUNCTIONAL DESCRIPTION: ! ! This routine sends the user a message sequence similar to the following: ! ! ? comparison error: 'string1' equal to 'string2' ! - primary completion code message ! - secondary completion code message ! ! FORMAL PARAMETERS: ! ! function code - action routine function code (STR$K_COMPARE) ! primary_code - primary completion code ! secondary_code - secondary completion code ! relation - comparison relationship string (e.g., ' compared to ') ! string1 - address of primary string descriptor ! string2 - address of secondary string descriptor ! ! IMPLICIT INPUTS: ! ! None ! ! IMPLICIT OUTPUTS: ! ! None ! ! COMPLETION CODES: ! ! .primary_code - primary completion code passed by caller ! ! SIDE EFFECTS: ! ! None ! !-- .skip; BEGIN .skip; OWN initial_text : $STR_DESCRIPTOR( STRING = 'comparison error: ' ); .skip; EXTERNAL ROUTINE XST$INIT_MSG : NOVALUE, ! Failure message initialization routine XST$STRING : NOVALUE, ! Append string to failure message routine XST$QUOTED : NOVALUE; ! Append quoted string to failure message routine .skip; EXTERNAL XST$MESSAGE; ! Failure message string descriptor .skip;! ! Create the initial function-specific message. ! .skip; XST$INIT_MSG( initial_text ); XST$QUOTED( .string1 ); XST$STRING( .relation ); XST$QUOTED( .string2 ); .skip;! ! Send a multi-line failure message to the user. ! .skip; $XPO_PUT_MSG( STRING = XST$MESSAGE, ! Function-specific message CODE = .primary_code, ! Primary failure completion code CODE = .secondary_code, ! Secondary failure completion code FAILURE = 0 ); .skip;! ! Return to the caller. ! .skip; RETURN .primary_code .skip; END; .skip;$XPO_MODULE( SFAIL2 ) .page;GLOBAL ROUTINE STR$C_FAILURE( function_code, primary_code, secondary_code, dummy, string, target ) = .skip;!++ ! ! FUNCTIONAL DESCRIPTION: ! ! This routine sends the user a message sequence similar to the following: ! ! ? error copying 'string' ! - primary completion code message ! - secondary completion code message ! ! FORMAL PARAMETERS: ! ! function code - action routine function code (STR$K_COMPARE) ! primary_code - primary completion code ! secondary_code - secondary completion code ! dummy - dummy argument (not used) ! string - address of source string descriptor ! target - address of target string descriptor ! ! IMPLICIT INPUTS: ! ! None ! ! IMPLICIT OUTPUTS: ! ! None ! ! COMPLETION CODES: ! ! .primary_code - primary completion code passed by caller ! ! SIDE EFFECTS: ! ! None ! !-- .skip; BEGIN .skip; OWN initial_text : $STR_DESCRIPTOR( STRING = 'error copying ' ); .skip; EXTERNAL ROUTINE XST$INIT_MSG : NOVALUE, ! Failure message initialization routine XST$QUOTED : NOVALUE; ! Append quoted string to failure message routine .skip; EXTERNAL XST$MESSAGE; ! Failure message string descriptor .skip;! ! Create the initial function-specific message. ! .skip; XST$INIT_MSG( initial_text ); XST$QUOTED( .string ); .skip;! ! Send a multi-line failure message to the user. ! .skip; $XPO_PUT_MSG( STRING = XST$MESSAGE, ! Function-specific message CODE = .primary_code, ! Primary failure completion code CODE = .secondary_code, ! Secondary failure completion code FAILURE = 0 ); .skip;! ! Return to the caller. ! .skip; RETURN .primary_code .skip; END; .skip;$XPO_MODULE( SFAIL3 ) .page;GLOBAL ROUTINE STR$A_FAILURE( function_code, primary_code, secondary_code, dummy, string, target ) = .skip;!++ ! ! FUNCTIONAL DESCRIPTION: ! ! This routine sends the user a message sequence similar to the following: ! ! ? error appending 'string' to 'target' ! - primary completion code message ! - secondary completion code message ! ! FORMAL PARAMETERS: ! ! function code - action routine function code (STR$K_COMPARE) ! primary_code - primary completion code ! secondary_code - secondary completion code ! dummy - dummy argument (not used) ! string - address of source string descriptor ! target - address of target string descriptor ! ! IMPLICIT INPUTS: ! ! None ! ! IMPLICIT OUTPUTS: ! ! None ! ! COMPLETION CODES: ! ! .primary_code - primary completion code passed by caller ! ! SIDE EFFECTS: ! ! None ! !-- .skip; BEGIN .skip; OWN initial_text : $STR_DESCRIPTOR( STRING = 'error appending ' ), to_text : $STR_DESCRIPTOR( STRING = ' to ' ); .skip; EXTERNAL ROUTINE XST$INIT_MSG : NOVALUE, ! Failure message initialization routine XST$STRING : NOVALUE, ! Append string to failure message routine XST$QUOTED : NOVALUE; ! Append quoted string to failure message routine .skip; EXTERNAL XST$MESSAGE; ! Failure message string descriptor .skip;! ! Create the initial function-specific message. ! .skip; XST$INIT_MSG( initial_text ); XST$QUOTED( .string ); XST$STRING( to_text ); XST$QUOTED( .target ); .skip;! ! Send a multi-line failure message to the user. ! .skip; $XPO_PUT_MSG( STRING = XST$MESSAGE, ! Function-specific message CODE = .primary_code, ! Primary failure completion code CODE = .secondary_code, ! Secondary failure completion code FAILURE = 0 ); .skip;! ! Return to the caller. ! .skip; RETURN .primary_code .skip; END; .skip;$XPO_MODULE( SFAIL4 ) .page;GLOBAL ROUTINE STR$S_FAILURE( function_code, primary_code, secondary_code, scan_function, string, pattern ) = .skip;!++ ! ! FUNCTIONAL DESCRIPTION: ! ! This routine sends the user a message sequence similar to the following: ! ! ? error scanning 'string' to find 'pattern' ! - primary completion code message ! - secondary completion code message ! ! FORMAL PARAMETERS: ! ! function code - action routine function code (STR$K_COMPARE) ! primary_code - primary completion code ! secondary_code - secondary completion code ! scan_function - $STR_SCAN function code ! string - address of source string descriptor ! pattern - address of pattern string descriptor ! ! IMPLICIT INPUTS: ! ! None ! ! IMPLICIT OUTPUTS: ! ! None ! ! COMPLETION CODES: ! ! .primary_code - primary completion code passed by caller ! ! SIDE EFFECTS: ! ! None ! !-- .skip; BEGIN .skip; OWN initial_text : $STR_DESCRIPTOR( STRING = 'error scanning ' ), find_text : $STR_DESCRIPTOR( STRING = ' to find ' ), span_text : $STR_DESCRIPTOR( STRING = ', spanning ' ), stop_text : $STR_DESCRIPTOR( STRING = ', stopping at ' ); .skip; EXTERNAL ROUTINE XST$INIT_MSG : NOVALUE, ! Failure message initialization routine XST$STRING : NOVALUE, ! Append string to failure message routine XST$QUOTED : NOVALUE; ! Append quoted string to failure message routine .skip; EXTERNAL XST$MESSAGE; ! Failure message string descriptor .skip;! ! Create the initial function-specific message. ! .skip; XST$INIT_MSG( initial_text ); XST$QUOTED( .string ); .skip; CASE .scan_function FROM STR$K_FIND TO STR$K_STOP OF SET [ STR$K_FIND ] : XST$STRING( find_text ); [ STR$K_SPAN ] : XST$STRING( span_text ); [ STR$K_STOP ] : XST$STRING( stop_text ); TES; .skip; XST$QUOTED( .pattern ); .skip;! ! Send a multi-line failure message to the user. ! .skip; $XPO_PUT_MSG( STRING = XST$MESSAGE, ! Function-specific message CODE = .primary_code, ! Primary failure completion code CODE = .secondary_code, ! Secondary failure completion code FAILURE = 0 ); .skip;! ! Return to the caller. ! .skip; RETURN .primary_code .skip; END; .skip;$XPO_MODULE( SFAIL5 ) .page;GLOBAL ROUTINE STR$B_FAILURE( function_code, primary_code, secondary_code, convert_function, string, result ) = .skip;!++ ! ! FUNCTIONAL DESCRIPTION: ! ! This routine sends the user a message sequence similar to the following: ! ! ? error converting 'string' to binary ! - primary completion code message ! - secondary completion code message ! ! FORMAL PARAMETERS: ! ! function code - action routine function code (STR$K_COMPARE) ! primary_code - primary completion code ! secondary_code - secondary completion code ! convert_function - $STR_BINARY function code ! string - address of source string descriptor ! result - address of result area ! ! IMPLICIT INPUTS: ! ! None ! ! IMPLICIT OUTPUTS: ! ! None ! ! COMPLETION CODES: ! ! .primary_code - primary completion code passed by caller ! ! SIDE EFFECTS: ! ! None ! !-- .skip; BEGIN .skip; OWN initial_text : $STR_DESCRIPTOR( STRING = 'error converting ' ), binary_text : $STR_DESCRIPTOR( STRING = ' to binary' ); .skip; EXTERNAL ROUTINE XST$INIT_MSG : NOVALUE, ! Failure message initialization routine XST$STRING : NOVALUE, ! Append string to failure message routine XST$QUOTED : NOVALUE; ! Append quoted string to failure message routine .skip; EXTERNAL XST$MESSAGE; ! Failure message string descriptor .skip;! ! Create the initial function-specific message. ! .skip; XST$INIT_MSG( initial_text ); XST$QUOTED( .string ); XST$STRING( binary_text ); .skip;! ! Send a multi-line failure message to the user. ! .skip; $XPO_PUT_MSG( STRING = XST$MESSAGE, ! Function-specific message CODE = .primary_code, ! Primary failure completion code CODE = .secondary_code, ! Secondary failure completion code FAILURE = 0 ); .skip;! ! Return to the caller. ! .skip; RETURN .primary_code .skip; END; END ELUDOM