MODULE XFAIL ( IDENT = 'V1.0-14' %TITLE 'XPO$FAILURE - Default Failure Action Routine' %BLISS32( ,ADDRESSING_MODE( EXTERNAL=LONG_RELATIVE ) ) %BLISS36( ,ENTRY( XPO$FAILURE, XPO$IO_FAILURE, XPO$PS_FAILURE, XPO$GM_FAILURE, XPO$FM_FAILURE, XPO$PM_FAILURE ),OTS='' ) ) = BEGIN ! ! 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. ! !++ ! ! FACILITY: BLISS Library ! ! ABSTRACT: ! ! This module is the default XPORT failure action routine. ! ! ENVIRONMENT: User Mode - system-independent ! ! AUTHOR: Ward Clark, CREATION DATE: 11 July 1978 ! !-- ! ! TABLE OF CONTENTS: ! FORWARD ROUTINE XPO$FAILURE; ! Failure action routine dispatcher %IF %BLISS(BLISS16) %THEN EXTERNAL ROUTINE %ELSE FORWARD ROUTINE %FI XPO$IO_FAILURE, ! XPORT I/O failure action routine XPO$PS_FAILURE, ! $XPO_PARSE_SPEC failure action routine XPO$GM_FAILURE, ! $XPO_GET_MEM failure action routine XPO$FM_FAILURE, ! $XPO_FREE_MEM failure action routine XPO$PM_FAILURE; ! $XPO_PUT_MSG failure action routine ! ! 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 each function-specific failure action routine. ! ! EXTERNAL REFERENCES: ! ! See each function-specific failure action routine. GLOBAL ROUTINE XPO$FAILURE( function_code, primary_code, secondary_code, action_argument ) = !++ ! ! FUNCTIONAL DESCRIPTION: ! ! This routine dispatches a failure action routine call to the ! appropriate processing routine for the function which failed. ! ! FORMAL PARAMETERS: ! ! function_code - XPORT failure action routine function code ! primary_code - primary failure completion code ! secondary_code - secondary failure competion code ! action_argument - function-specific action routine argument ! ! IMPLICIT INPUTS: ! ! None ! ! IMPLICIT OUTPUTS: ! ! None ! ! ROUTINE VALUE: ! ! .primary_code - primary completion code passed by caller ! ! 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. ! !-- BEGIN LOCAL action_routine; ! ! Select the appropriate failure processing routine. ! action_routine = ( CASE .function_code FROM 1 to XPO$K_PUT_MSG OF SET [ XPO$K_IO ] : XPO$IO_FAILURE; [ XPO$K_PARSE ] : XPO$PS_FAILURE; [ XPO$K_GET_MEM ] : XPO$GM_FAILURE; [ XPO$K_FREE_MEM ] : XPO$FM_FAILURE; [ XPO$K_PUT_MSG ] : XPO$PM_FAILURE; TES ); ! ! Call the action routine. ! (.action_routine)( .function_code, .primary_code, .secondary_code, .action_argument ); ! ! Terminate program execution or return to the caller. ! 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. END; $XPO_MODULE( XFAIL1 ) %TITLE 'XPO$IO_FAILURE - I/O Failure Action Routine' GLOBAL ROUTINE XPO$IO_FAILURE( function_code, primary_code, secondary_code, iob ) = !++ ! ! FUNCTIONAL DESCRIPTION: ! ! This routine sends the user a message sequence similar to the following: ! ! ? error opening 'file-spec' as input ! - primary completion code message ! - secondary completion code message ! ! FORMAL PARAMETERS: ! ! function_code - failure action routine function code (XPO$K_IO) ! primary_code - primary I/O failure completion code ! secondary_code - secondary failure competion code ! iob - address of the associated IOB ! ! IMPLICIT INPUTS: ! ! None ! ! IMPLICIT OUTPUTS: ! ! None ! ! COMPLETION CODES: ! ! .primary_code - primary completion code passed by caller ! ! SIDE EFFECTS: ! ! None ! !-- BEGIN MAP iob : REF $XPO_IOB(); BIND file_spec = .iob[IOB$A_FILE_SPEC] : $STR_DESCRIPTOR(), resultant = iob[IOB$T_RESULTANT] : $STR_DESCRIPTOR(); OWN initial_text : $STR_DESCRIPTOR( STRING = 'error ' ), open_text : $STR_DESCRIPTOR( STRING = 'opening ' ), close_text : $STR_DESCRIPTOR( STRING = 'closing ' ), delete_text : $STR_DESCRIPTOR( STRING = 'deleting ' ), rename_text : $STR_DESCRIPTOR( STRING = 'renaming ' ), backup_text : $STR_DESCRIPTOR( STRING = 'backing up ' ), put_text : $STR_DESCRIPTOR( STRING = 'writing to ' ), get_text : $STR_DESCRIPTOR( STRING = 'reading from ' ), auto_open_text : $STR_DESCRIPTOR( STRING = 'auto-opening ' ), auto_close_text : $STR_DESCRIPTOR( STRING = 'auto_closing ' ), bad_func_text : $STR_DESCRIPTOR( STRING = 'invalid operation on ' ), input_text : $STR_DESCRIPTOR( STRING = ' for input' ), and_output_text : $STR_DESCRIPTOR( STRING = ' and output' ), output_text : $STR_DESCRIPTOR( STRING = ' for output' ), to_text : $STR_DESCRIPTOR( STRING = ' to ' ); 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 EXTERNAL XST$MESSAGE; ! Failure message string descriptor ! ! Don't issue a message for SUCCESS or WARNING conditions. ! IF .primary_code OR ! If this is a SUCCESS or WARNING condition, .primary_code<0,3,0> EQL XPO$_WARNING ! THEN ! RETURN .primary_code; ! return without doing anything. ! ! Create the initial function-specific message. ! IF .iob[IOB$B_FUNCTION] LEQ IOB$K_PUT ! All messages except "invalid function" start with "error". THEN XST$INIT_MSG( initial_text ); CASE .iob[IOB$B_FUNCTION] ! Use the XPORT function code to select FROM IOB$K_OPEN TO IOB$K_PUT OF ! the next part of the message. SET [ OUTRANGE ] : XST$INIT_MSG( bad_func_text ); [ IOB$K_OPEN ] : XST$STRING( open_text ); [ IOB$K_CLOSE ] : XST$STRING( close_text ); [ IOB$K_DELETE ] : XST$STRING( delete_text ); [ IOB$K_RENAME ] : XST$STRING( rename_text ); [ IOB$K_BACKUP ] : XST$STRING( backup_text ); [ IOB$K_PUT ] : XST$STRING( put_text ); [ IOB$K_GET ] : IF .iob[IOB$V_AUTO_CONC] ! If input switching is in progress, THEN ! special open and close text will be needed. IF .iob[IOB$V_OPEN] THEN XST$STRING( auto_close_text ) ELSE XST$STRING( auto_open_text ) ELSE XST$STRING( get_text ); ! Otherwise, use the normal input failure text. TES; IF .resultant[STR$H_LENGTH] NEQ 0 ! Put the best file name into the message: THEN ! XST$QUOTED( resultant ) ! resultant file-spec (if one exists) ELSE ! XST$QUOTED( file_spec ); ! user file-spec SELECTONE .iob[IOB$B_FUNCTION] OF SET [ IOB$K_OPEN, IOB$K_CLOSE ] : ! Special OPEN/CLOSE message suffix: IF .iob[IOB$V_INPUT] ! Indicate whether this is an THEN ! input or an output file. BEGIN XST$STRING( input_text ); IF .iob[IOB$V_OUTPUT] THEN XST$STRING( and_output_text ); END ELSE XST$STRING( output_text ); [ IOB$K_RENAME ] : ! Special RENAME message suffix: BEGIN ! BIND ! new_iob = .iob[IOB$A_ASSOC_IOB] : ! $XPO_IOB(), ! new_result = new_iob[IOB$T_RESULTANT] : ! $STR_DESCRIPTOR(); ! ! XST$STRING( to_text ); ! ! IF .new_result[STR$H_LENGTH] NEQ 0 ! THEN ! XST$QUOTED( new_result ) ! Add the new resultant file-spec ELSE ! XST$QUOTED(.new_iob[IOB$A_FILE_SPEC]); ! or the new primary file-spec. ! ! Send a multi-line failure message to the user. ! IF .iob[IOB$G_COMP_CODE] EQL XPO$_BAD_NEW ! Test for special linked RENAME messages. AND .iob[IOB$G_2ND_CODE] EQL 0 THEN BEGIN $XPO_PUT_MSG( STRING = XST$MESSAGE, ! RENAME-specific message: CODE = XPO$_BAD_NEW, ! "invalid new file" CODE = .new_iob[IOB$G_COMP_CODE], ! primary new file completion code CODE = .new_iob[IOB$G_2ND_CODE], ! secondary new file completion code FAILURE = 0 ); RETURN .primary_code ! Return after a special RENAME message. END; END; TES; $XPO_PUT_MSG( STRING = XST$MESSAGE, ! Function-specific message CODE = .iob[IOB$G_COMP_CODE], ! Primary completion code CODE = .iob[IOB$G_2ND_CODE], ! Secondary competion code, if any FAILURE = 0 ); ! ! Return to the caller. ! RETURN .primary_code ! Return the original completion code to the caller. END; $XPO_MODULE( XFAIL2 ) %TITLE 'XPO$PS_FAILURE - Parse File-spec Action Routine' GLOBAL ROUTINE XPO$PS_FAILURE( function_code, primary_code, secondary_code, file_spec ) = !++ ! ! FUNCTIONAL DESCRIPTION: ! ! This routine sends the user a message sequence similar to the following: ! ! ? error parsing 'file-spec' ! - primary completion code message ! - secondary completion code message ! ! FORMAL PARAMETERS: ! ! function_code - failure action routine function code (XPO$K_PARSE) ! primary_code - primary $XPO_PARSE_SPEC failure completion code ! secondary_code - secondary failure competion code ! file_spec - address of file-spec string descriptor ! ! IMPLICIT INPUTS: ! ! None ! ! IMPLICIT OUTPUTS: ! ! None ! ! COMPLETION CODES: ! ! .primary_code - primary completion code passed by caller ! ! SIDE EFFECTS: ! ! None ! !-- BEGIN OWN initial_text : $STR_DESCRIPTOR( STRING = 'error parsing ' ); EXTERNAL ROUTINE XST$INIT_MSG : NOVALUE, ! Failure message initialization routine XST$QUOTED : NOVALUE; ! Append quoted string to failure message routine EXTERNAL XST$MESSAGE; ! Failure message string descriptor ! ! Create the initial function-specific message. ! XST$INIT_MSG( initial_text ); XST$QUOTED( .file_spec ); ! ! Send a multi-line failure message to the user. ! $XPO_PUT_MSG( STRING = XST$MESSAGE, ! Tell the user that $XPO_PARSE_SPEC failed CODE = .primary_code, ! and what the failure was. CODE = .secondary_code, FAILURE = 0 ); ! ! Return to the caller. ! RETURN .primary_code ! Return the original completion code to the caller. END; $XPO_MODULE( XFAIL3 ) %TITLE 'XPO$GM_FAILURE - Get Memory Action Routine' GLOBAL ROUTINE XPO$GM_FAILURE( function_code, primary_code, secondary_code, descriptor ) = !++ ! ! FUNCTIONAL DESCRIPTION: ! ! This routine sends the user a message sequence similar to the following: ! ! ? dynamic memory allocation error ! - primary completion code message ! - secondary completion code message ! ! FORMAL PARAMETERS: ! ! function_code - XPORT failure action routine function code (ignored) ! primary_code - primary $XPO_GET_MEM failure completion code ! secondary_code - secondary failure competion code ! descriptor - address of $XPO_GET_MEM request descriptor ! ! IMPLICIT INPUTS: ! ! None ! ! IMPLICIT OUTPUTS: ! ! None ! ! COMPLETION CODES: ! ! .primary_code - primary completion code passed by caller ! ! SIDE EFFECTS: ! ! None ! !-- BEGIN MAP descriptor : REF $STR_DESCRIPTOR(); ! Redefine the descriptor argument. ! ! Send a three-line error message to the user. ! $XPO_PUT_MSG( CODE = XPO$_GET_MEM, ! Tell the user that $XPO_GET_MEM failed CODE = .primary_code, ! and what the failure was. CODE = .secondary_code, FAILURE = 0 ); RETURN .primary_code ! Return the original completion code to the caller. END; $XPO_MODULE( XFAIL4 ) %TITLE 'XPO$FM_FAILURE - Free Memory Action Routine' GLOBAL ROUTINE XPO$FM_FAILURE( function_code, primary_code, secondary_code, descriptor ) = !++ ! ! FUNCTIONAL DESCRIPTION: ! ! This routine sends the user a message sequence similar to the following: ! ! ? dynamic memory deallocation error ! - primary completion code message ! - secondary completion code message ! ! FORMAL PARAMETERS: ! ! function_code - XPORT failure action routine function code (ignored) ! primary_code - primary $XPO_FREE_MEM failure completion code ! secondary_code - secondary failure competion code ! descriptor - address of $XPO_FREE_MEM request descriptor ! ! IMPLICIT INPUTS: ! ! None ! ! IMPLICIT OUTPUTS: ! ! None ! ! COMPLETION CODES: ! ! .primary_code - primary completion code passed by caller ! ! SIDE EFFECTS: ! ! None ! !-- BEGIN MAP descriptor : REF $STR_DESCRIPTOR(); ! Redefine the descriptor argument. ! ! Send a three-line error message to the user. ! $XPO_PUT_MSG( CODE = XPO$_FREE_MEM, ! Tell the user that $XPO_FREE_MEM failed CODE = .primary_code, ! and what the failure was. CODE = .secondary_code, FAILURE = 0 ); RETURN .primary_code ! Return the original completion code to the caller. END; $XPO_MODULE( XFAIL5 ) %TITLE 'XPO$PM_FAILURE - Put Message Action Routine' GLOBAL ROUTINE XPO$PM_FAILURE( function_code, primary_code, secondary_code, actual_severity ) = !++ ! ! FUNCTIONAL DESCRIPTION: ! ! This routine sends the user a message sequence similar to the following: ! ! ? message output error ! - primary completion code message ! - secondary completion code message ! ! FORMAL PARAMETERS: ! ! function_code - XPORT failure action routine function code (ignored) ! primary_code - primary $XPO_PUT_MSG failure completion code ! secondary_code - secondary failure competion code ! actual_severity - actual severity of 1st message ! ! IMPLICIT INPUTS: ! ! None ! ! IMPLICIT OUTPUTS: ! ! None ! ! COMPLETION CODES: ! ! .primary_code - primary completion code passed by caller ! ! SIDE EFFECTS: ! ! None ! !-- BEGIN ! ! Send a three-line error message to the user. ! $XPO_PUT_MSG( CODE = XPO$_PUT_MSG, ! Tell the user that PUT_MESSAGE failed CODE = .primary_code, ! and what the failure was CODE = .secondary_code, ! FAILURE = 0 ); ! (blocking failure recursion). RETURN .primary_code ! Return the original completion code to the caller. END; END ELUDOM