Trailing-Edge
-
PDP-10 Archives
-
DEC_CMS-20_V1.0_SRC
-
cms/sources/errmsg.bli
There are no other files named errmsg.bli in the archive.
module errmsg ( ! Terminal input and output functions
ident = '1',
%if
%bliss(bliss32)
%then
language(bliss32),
addressing_mode(external=general,
nonexternal=long_relative)
%else
language(bliss36)
%fi
) =
begin
!
! COPYRIGHT (C) 1982, 1983 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 functions to process error messages,
! and provides functions to transmit these messages.
!
! Environment:
!
! Author: Earl Van Horn Creation Date: April, 1979
!
!--
!
! Table of Contents:
!
forward routine
!+
! WARNING: all the error/bug/badlib routine except
! BADBUG will perform Command Roll Back
! exiting so that the library is restored
! to a consistent state.
!-
badbug : novalue, ! report bug but no recovery attempted on library
badiob : novalue, ! Same as BADLIB, but accepts an iob address.
badlib : novalue, ! Report a problem in the project library and
! terminate execution.
badsts : novalue, ! Same as BADLIB, but accepts a system status code.
badxpo : novalue, ! Same as BADLIB, but accepts an Xport status code.
bug : novalue, ! Report a bug in CMS and terminate execution.
bugiob : novalue, ! Same as BUG, but accepts an iob address.
bugsts : novalue, ! Same as BUG, but accepts a system status code.
bugxpo : novalue, ! Same as BUG, but accepts an Xport status code.
bye : novalue, ! Report a user problem and abort without traceback.
byeiob : novalue, ! Same as BYE, but accepts an iob address.
byests : novalue, ! Same as BYE, but accepts a system status code.
byexpo : novalue, ! Same as BYE, but accepts an XPORT status code.
err, ! Report a user mistake, but continue execution.
erriob, ! Same as ERR, but accepts an iob address.
errsts, ! Same as ERR, but accepts a system status code.
errxpo, ! Same as ERR, but accept an Xport status code.
log_error_message, ! Enter message and user's command into error log.
report_error, ! Master error reporting routine.
write_error_iob : novalue, ! Log and display iob error information.
write_error_message, ! Log and display an error message.
write_error_system : novalue, ! Log and display system status code message.
write_error_xport : novalue ; ! Log and display XPORT status code message.
!
! Include Files:
!
%if %bliss(bliss32) %then
library 'SYS$LIBRARY:STARLET' ;
Undeclare %quote $descriptor ; ! conflict with xport name
%fi
%if %bliss(bliss36) %then
require 'JSYS:';
%fi
library 'XPORT:' ;
require 'BLISSX:' ;
require 'HOSUSR:' ;
require 'RBUSR:' ;
require 'TERUSR:' ;
require 'SCONFG:';
%if Tops10 %then
%warn('DS-10 code not implemented')
%fi
require 'CNCUSR:';
!
! Macros:
!
!
! Equated Symbols:
!
! Symbols for calling REPORT_ERROR.
$literal
! The presumed cause of the error.
k_library_error = $distinct, ! Problem with the project library.
k_program_error = $distinct, ! Bug in the program.
k_user_error = $distinct, ! User mistake or operational problem.
k_unrecoverable_error = $distinct, ! Unrecoverable error (usually during
! rolbck.
! The information associated with the error.
k_general_error = $distinct, ! Only a message is involved.
k_iob_error = $distinct, ! An iob is involved.
k_system_error = $distinct, ! A system status code is involved.
k_xport_error = $distinct, ! An XPORT status code is involved,
! but not an iob.
! The desired disposition of the error.
k_traceback_error = $distinct, ! Abort with traceback(rolbck performedfirst).
k_exit_error = $distinct, ! Abort without traceback(rolbck performed first).
k_continue_error = $distinct, ! Return to caller.
k_norb_error = $distinct ; ! abort without traceback(no rolbck)
!
! special binds - make the old ERS... calls point instead to the BYE...
! calls.
!
global bind
ers = bye,
ersiob = byeiob,
erssts = byests,
ersxpo = byexpo;
!
! Own Storage:
!
own
$io_block(err), ! User's error output stream.
errors_to_out_iob; ! TRUE means error messages will be written to
! OUT_IOB as well as ERR_IOB. FALSE means
! error messages will not go to OUT_IOB.
!
! External References:
!
external
f_rb_clspd, ! flag for committed transaction (ROLBCK)
f_rb_in_progress, ! flag for roll back in progress (ROLBCK)
f_rb_pending; ! flag for uncommitted tranaction (ROLBCK)
external literal
s_badbug, ! fatal bug error--unrecoverable
s_badlib, ! bad library error
s_bug, ! bug error - (severe)
s_errmisc, ! miscellaneous error
s_inviob, ! invalid IOB on error call
s_syserr, ! system error
s_unchanged; ! no changes were made to library
external routine
errlog, ! Append to the error log.
exits : novalue, ! Silently terminate execution of this image.
getcom, ! Gets the user's command string.
lib$put_output, ! put message to terminal (VMS SYSTEM ROUTINE)
! simulated on TOPS-10 and TOPS-20
localf, ! Report error if spec. involves network.
rbmain, ! process Command Roll Back(ROLBCK)
sysmes, ! Returns descriptor for system message.
%if vaxvms %then
rmsmsg,
%fi
sysmsg; ! outputs standard format system message.
%if Tops20 %then
external routine
xpo$xmsg; ! undocumented call to XPORT
! retrieves XPORT error message text
%fi
GLOBAL ROUTINE badbug(a_message):novalue =
!++
!
! FUNCTIONAL DESCRIPTION:
!
! This routine is primarily used by ROLBCK to issue messages when it
! encounters a serious error. Thus, the error message is printed ,no
! ROLBCK is attempted, and the image exits.
!
! FORMAL PARAMETERS:
!
! value System value of errnum
! a_message Address of descriptor pointing to message text.
!
! IMPLICIT INPUTS:
!
! None.
!
! IMPLICIT OUTPUTS:
!
! None.
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
! None.
!
! SIDE EFFECTS:
!
! None.
!
!--
BEGIN
report_error(s_badbug,k_unrecoverable_error,.a_message,k_general_error,0,k_norb_error) ;
END;
global routine badiob(a_iob, a_message) : novalue =
!++
! Functional Description:
!
! BADIOB writes to the user's error stream. It informs the
! user that there is something wrong with the project library,
! and then writes information provided by its arguments. It then
! terminates execution of the program, i.e., it never returns.
!
! The command and messages are appended to the error log.
!
! Formal Parameters:
!
! a_message: Address of a descriptor of a message.
! a_iob: Address of an iob containing more information.
!
! Implicit Inputs:
!
! None
!
! Implicit Outputs:
!
! None
!
! Routine Value:
! Completion Codes:
!
! None
!
! Side Effects:
!
! Information is written to the user's error stream and the error log,
! and execution is terminated without a traceback.
!
!--
begin ! BADIOB
report_error(s_badlib,k_library_error, .a_message, k_iob_error, .a_iob,
k_exit_error) ;
end ; ! BADIOB
global routine badlib(a_message) : novalue =
!++
! Functional Description:
!
! BADLIB writes to the user's error stream. It informs the
! user that there is something wrong with the project library,
! and then writes the string denoted by its argument. It then
! terminates execution of the program, i.e., it never returns.
!
! The command and message are appended to the error log.
!
! Formal Parameters:
!
! a_message: Address of descriptor of message to write.
!
! Implicit Inputs:
!
! None
!
! Implicit Outputs:
!
! None
!
! Routine Value:
! Completion Codes:
!
! None
!
! Side Effects:
!
! Information is written to the user's error stream and the error log,
! and execution is terminated without a traceback.
!
!--
begin ! BADLIB
report_error(s_badlib,k_library_error, .a_message, k_general_error, 0,
k_exit_error) ;
end ; ! BADLIB
global routine badsts(status_code, a_message) : novalue =
!++
! Functional Description:
!
! BADSTS writes to the user's error stream. It informs the
! user that there is something wrong with the project library,
! and then writes the information provided by its arguments. It then
! terminates execution of the program, i.e., it never returns.
!
! The command and messages are written to the error log.
!
! Formal Parameters:
!
! status_code: Host system status code whose message is to be written.
! a_message: Address of descriptor of another message to write.
!
! Implicit Inputs:
!
! None
!
! Implicit Outputs:
!
! None
!
! Routine Value:
! Completion Codes:
!
! None
!
! Side Effects:
!
! Information is written to the terminal error stream and the error log.
! Execution is terminated without a traceback.
!
!--
begin ! BADSTS
report_error(s_badlib,k_library_error, .a_message, k_system_error, .status_code,
k_exit_error) ;
end ; ! BADSTS
GLOBAL ROUTINE BADXPO(STATUS_CODE,A_MESSAGE): NOVALUE =
!++
! FUNCTIONAL DESCRIPTION:
!
! The purpose of this routine is the same as BADSTS, except that an
! XPORT status code is given instead of a system status code.
!
! FORMAL PARAMETERS:
!
! STATUS_CODE Xport status code. Used to print Xport standard
! error message.
! A_MESSAGE Address of descriptor for a message that will
! precede the Xport message.
!
! IMPLICIT INPUTS:
!
!
!
! IMPLICIT OUTPUTS:
!
!
!
! ROUTINE VALUE and
! COMPLETION CODES:
!
! novalue routine.
!
! SIDE EFFECTS:
!
! Same as BADSTS.
!
!--
BEGIN
REPORT_ERROR(s_badlib,K_LIBRARY_ERROR, .A_MESSAGE, K_XPORT_ERROR,
.STATUS_CODE, K_EXIT_ERROR) ;
END;
global routine bug(a_message) : novalue =
!++
! Functional Description:
!
! BUG writes to the user's error stream. It informs the
! user that there is a bug within CMS, and then writes
! the string denoted by its argument. It then terminates
! execution of the program, i.e., it never returns.
!
! The command and message are appended to the error log.
!
! Formal Parameters:
!
! a_message: Address of descriptor of message to write.
!
! Implicit Inputs:
!
! None
!
! Implicit Outputs:
!
! None
!
! Routine Value:
! Completion Codes:
!
! None
!
! Side Effects:
!
! Information is written to the user's error stream and the error log,
! and execution is terminated by calling SIGNAL_STOP.
!
!--
begin ! BUG
report_error(s_bug,k_program_error, .a_message, k_general_error, 0,
k_traceback_error) ;
end ; ! BUG
global routine bugiob(a_iob, a_message) : novalue =
!++
! Functional Description:
!
! BUGIOB writes to the user's error stream. It informs the
! user that there is a bug within CMS, and then writes
! the information provided by its arguments. It then terminates
! execution of the program, i.e., it never returns.
!
! The command and messages are appended to the error log.
!
! Formal Parameters:
!
! a_iob: Address of an iob with additional information.
! a_message: Address of a descriptor of a message to write.
!
! Implicit Inputs:
!
! None
!
! Implicit Outputs:
!
! None
!
! Routine Value:
! Completion Codes:
!
! None
!
! Side Effects:
!
! Information is written to the user's error stream and the error log,
! and execution is terminated by calling SIGNAL_STOP.
!
!--
begin ! BUGIOB
report_error(s_bug,k_program_error, .a_message, k_iob_error, .a_iob,
k_traceback_error) ;
end ; ! BUGIOB
global routine bugsts(status_code, a_message) : novalue =
!++
! Functional Description:
!
! BUGSTS writes into the terminal error stream. It informs the
! user that there is a bug within CMS, and then writes
! the string denoted by its argument. It then terminates
! execution of the program, i.e., it never returns.
! It terminates by calling SIGNAL_STOP with the status code supplied.
!
! The command and message are appended to the error log.
!
! Formal Parameters:
!
! status_code: Status code to be signaled.
! a_message: Address of descriptor of message to write.
!
! Implicit Inputs:
!
! None
!
! Implicit Outputs:
!
! None
!
! Routine Value:
! Completion Codes:
!
! None
!
! Side Effects:
!
! Information is written to the terminal error stream and error log, and
! execution is terminated by calling SIGNAL_STOP with the given status.
!
!--
begin ! BUGSTS
report_error(s_bug,k_program_error, .a_message, k_system_error,
.status_code, k_traceback_error) ;
end ; ! BUGSTS
GLOBAL ROUTINE BUGXPO(STATUS_CODE,A_MESSAGE): NOVALUE =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine does the same thing as BUGSTS, except that the code
! is an XPORT status code instead of a system status code.
!
! FORMAL PARAMETERS:
!
! STATUS_CODE The Xport status code which is used to generate
! the standard Xport error message.
! A_MESSAGE Address of a descriptor of the message to precede
! the standard Xport error message
!
! IMPLICIT INPUTS:
!
!
!
! IMPLICIT OUTPUTS:
!
!
!
! ROUTINE VALUE and
! COMPLETION CODES:
!
! Novalue routine
!
! SIDE EFFECTS:
!
! Same as BUGSTS.
!
!--
BEGIN
REPORT_ERROR(s_bug,K_PROGRAM_ERROR, .A_MESSAGE, K_XPORT_ERROR,
.STATUS_CODE, K_TRACEBACK_ERROR) ;
END;
global routine bye(value,a_message) : novalue =
!++
! Functional Description:
!
! BYE writes the string denoted by its argument to the user's error
! stream. It then terminates execution of the program without
! producing a traceback.
!
! The command and message are appended to the error log.
!
! Formal Parameters:
!
! a_message: Address of descriptor of message to write.
! value: System error value
!
! Implicit Inputs:
!
! None
!
! Implicit Outputs:
!
! None
!
! Routine Value:
! Completion Codes:
!
! None
!
! Side Effects:
!
! Information is written to the user's error stream and the error log,
! and execution is terminated by calling EXIT.
!
!--
begin ! BYE
report_error(.value, k_user_error, .a_message, k_general_error, 0,
k_exit_error) ;
end ; ! BYE
global routine byeiob(value, a_iob, a_message) : novalue =
!++
! Functional Description:
!
! BYEIOB writes the string denoted by its argument to the user's error
! stream, followed by information from the IOB supplied. It then
! terminates execution of the program without producing a traceback.
!
! The command and messages are appended to the error log.
!
! Formal Parameters:
!
! value: System error value.
! a_iob: Address of an iob with additional information.
! a_message: Address of a descriptor of a message to write.
!
! Implicit Inputs:
!
! None
!
! Implicit Outputs:
!
! None
!
! Routine Value:
! Completion Codes:
!
! None
!
! Side Effects:
!
! Information is written to the user's error stream and the error log,
! and execution is terminated by calling EXIT with the completion
! code in the iob.
!
!--
begin ! BYEIOB
report_error(.value, k_user_error, .a_message, k_iob_error, .a_iob,
k_exit_error) ;
end ; ! BYEIOB
global routine byests(value, status_code, a_message) : novalue =
!++
! Functional Description:
!
! BYESTS writes the string denoted by its argument to the user's error
! stream, followed by the message for the given status code. It then
! terminates execution of the program without producing a traceback.
!
! The command and message are appended to the error log.
!
! Formal Parameters:
!
! value: System error value.
! status_code: Status code to be signaled.
! a_message: Address of descriptor of message to write.
!
! Implicit Inputs:
!
! None
!
! Implicit Outputs:
!
! None
!
! Routine Value:
! Completion Codes:
!
! None
!
! Side Effects:
!
! Information is written to the terminal error stream and error log, and
! execution is terminated by calling EXIT with the given status.
!
!--
begin ! BYESTS
report_error(.value, k_user_error, .a_message, k_system_error,
.status_code, k_exit_error) ;
end ; ! BYESTS
GLOBAL ROUTINE BYEXPO(VALUE,STATUS_CODE,A_MESSAGE): NOVALUE =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine does the same thing as BYESTS, except that the code
! is an XPORT status code instead of a system status code.
!
! FORMAL PARAMETERS:
!
! VALUE System error value.
! STATUS_CODE The Xport status code which is used to generate
! the standard Xport error message.
! A_MESSAGE Address of a descriptor of the message to precede
! the standard Xport error message
!
! IMPLICIT INPUTS:
!
!
!
! IMPLICIT OUTPUTS:
!
!
!
! ROUTINE VALUE and
! COMPLETION CODES:
!
! Novalue routine
!
! SIDE EFFECTS:
!
! Same as BYESTS.
!
!--
BEGIN ! BYEXPO
REPORT_ERROR(.VALUE, K_USER_ERROR, .A_MESSAGE, K_XPORT_ERROR, .STATUS_CODE,
K_EXIT_ERROR) ;
END; ! BYEXPO
global routine err(value,a_message) =
!++
! Functional Description:
!
! ERS writes to the user's error stream. On successive calls,
! each message will begin a new line.
!
! The command and message are appended to the error log.
!
! Formal Parameters:
!
! value - system message value
! a_message : Address of a descriptor of the message to be written.
!
! Implicit Inputs:
!
! None
!
! Implicit Outputs:
!
! None
!
! Routine Value: The same address that was passed in as argument.
! Completion Codes:
!
! None
!
! Side Effects:
!
! The message supplied is written to the user's error stream and the
! error log.
!
!--
begin ! ERR
report_error(.value,k_user_error, .a_message, k_general_error, 0,
k_continue_error)
end ; ! ERR
global routine erriob(value,a_iob, a_message) =
!++
! Functional Description:
!
! ERSIOB writes a message to the user's error stream, followed by
! additional information from an iob. On successive calls,
! each message will begin a new line.
!
! The command and message are appended to the error log.
!
! Formal Parameters:
!
! value: system message value
! a_iob: Address of iob for additional information.
! a_message: Address of a descriptor of the message to be written.
!
! Implicit Inputs:
!
! None
!
! Implicit Outputs:
!
! None
!
! Routine Value:
! Completion Codes:
!
! The message descriptor address that was passed in as argument.
!
! Side Effects:
!
! The messages supplied is written to the user's error stream and the
! error log.
!
!--
begin ! ERRIOB
report_error(.value,k_user_error, .a_message, k_iob_error, .a_iob,
k_continue_error)
end ; ! ERRIOB
global routine errsts(value,status_code, a_message) =
!++
! Functional Description:
!
! ERRSTS writes a message to the user's error stream, followed by
! the text associated with a system status code. On successive calls,
! each message will begin a new line.
!
! The command and message are appended to the error log.
!
! Formal Parameters:
!
! value: system message value
! status_code: System status code whose message is to be written.
! a_message : Address of a descriptor of the message to be written.
!
! Implicit Inputs:
!
! None
!
! Implicit Outputs:
!
! None
!
! Routine Value:
! Completion Codes:
!
! The message descriptor address that was passed in as argument.
!
! Side Effects:
!
! The messages supplied is written to the user's error stream and the
! error log.
!
!--
begin ! ERRSTS
report_error(.value,k_user_error, .a_message, k_system_error, .status_code,
k_continue_error)
end ; ! ERRSTS
GLOBAL ROUTINE ERRXPO(value,STATUS_CODE,A_MESSAGE) =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine performs the same function as ERRSTS, except that
! the code is an XPORT status code instead of a system status code.
!
! FORMAL PARAMETERS:
!
! value system message value
! STATUS_CODE Xport error code which is used to print the
! standard Xport error message.
! A_MESSAGE Address of descriptor of the message that will
! precede the Xport standard error message.
!
! IMPLICIT INPUTS:
!
!
!
! IMPLICIT OUTPUTS:
!
!
!
! ROUTINE VALUE and
! COMPLETION CODES:
!
! Novalue routine.
!
! SIDE EFFECTS:
!
! Same as ERRSTS.
!
!--
BEGIN
REPORT_ERROR(.value,K_USER_ERROR, .A_MESSAGE, K_XPORT_ERROR, .STATUS_CODE,
K_CONTINUE_ERROR)
END;
routine log_error_message(a_message) =
!++
! Functional Description:
!
! This routine enters a message into the error log. The entry for the
! message is preceded by an entry giving the user's command string,
! unless such a command entry has already been made.
!
! Formal Parameters:
!
! a_message: Address of a descriptor of the message to be logged.
!
! Implicit Inputs:
!
! The own variable COMMAND_LOGGED declared in this routine.
!
! Implicit Outputs:
!
! The own variable COMMAND_LOGGED declared in this routine.
!
! Routine Value:
! Completion Codes:
!
! The descriptor address supplied as argument.
!
! Side Effects:
!
! An entry is made into the error log by calling ERRLOG.
!
!--
begin ! LOG_ERROR_MESSAGE
bind
message = .a_message : desc_block ;
own
command_logged : initial(false) ; ! Means command already logged.
local
command : desc_block ; ! User's command string.
if not .command_logged
then
begin ! Get command and log it.
getcom(command) ;
errlog(.command[desc_ptr], .command[desc_len]) ;
command_logged = true ;
end ; ! Get command and log it.
errlog(.message[desc_ptr], .message[desc_len]) ;
message
end ; ! LOG_ERROR_MESSAGE
routine report_error(value,cause, a_message, extra_info_type, extra_info,
disposition) =
!++
! Functional Description:
!
! This is the master error reporting routine for the CMS system.
! It displays the supplied information to the user and writes it to the
! library's error log. If the error was not a user mistake, the
! information includes the presumed cause of the error.
!
! Formal Parameters:
!
! value: system error value
! cause: The presumed cause of the error. It must be one of the
! following symbols, declared in this module:
!
! K_LIBRARY_ERROR, meaning something is wrong
! with the project library.
!
! K_PROGRAM_ERROR, meaning there is a bug in CMS
! or something it calls.
!
! K_USER_ERROR, meaning the user made a mistake,
! or that there was some operational problem,
! such as a disk off-line.
!
! K_UNRECOVERABLE_ERROR, error from which
! automatic recovery is not possible ( ususally
! during ROLBCK
!
! A_MESSAGE: Address of a descriptor of a message to write.
!
! EXTRA_INFO_TYPE: The kind of additional information supplied by the
! EXTRA_INFO parameter. It must be one of the following
! symbols, declared in this module:
!
! K_GENERAL_ERROR, meaning there is no additional
! information and EXTRA_INFO is ignored.
!
! K_IOB_ERROR, meaning EXTRA_INFO is the address
! of an iob.
!
! K_SYSTEM_ERROR, meaning EXTRA_INFO is a system
! status code.
!
! K_XPORT_ERROR, meaning EXTRA_INFO is an XPORT
! status code.
!
! EXTRA_INFO: Additional information of the kind specified by the
! EXTRA_INFO_TYPE parameter.
!
! DISPOSITION: Action to be taken after the error is reported.
! It must be one of the following symbols, declared
! in this module.
!
! K_TRACEBACK_ERROR, meaning to abort the
! current image and produce a traceback.
!
! K_EXIT_ERROR, meaning to abort the current
! image without producing a traceback.
!
! K_CONTINUE_ERROR, meaning to return to the
! caller.
!
! K_NORB_ERROR, meaning do not attempt ROLBCK,
! just exit image after message is printed.
!
! Implicit Inputs:
!
! None
!
! Implicit Outputs:
!
! None
!
! Routine Value:
! Completion Codes:
!
! If the disposition is K_CONTINUE_ERROR, the routine returns the message
! address that was passed as argument. Otherwise the routine never
! returns.
!
! Side Effects:
!
! The routine displays error information for the user and writes it
! to the error log. If the disposition is K_TRACEBACK_ERROR, the routine
! issues SIGNAL_STOP.
!
!--
begin ! REPORT_ERROR
bind
message = .a_message : desc_block ;
local
abort_code, ! Code to return if image is terminated.
rb_stat; ! rolbck status
! Explain the cause for anything but a user mistake.
selectone .cause of
set ! Explain the cause.
[k_library_error]:
sysmsg(s_badlib,
cat('Something is wrong with your ',
fac_name, ' library'),
write_error_message) ;
[k_program_error]:
sysmsg(s_bug,
cat('There is a bug in ',fac_name,
' or something it calls'), write_error_message) ;
[k_user_error]:
; ! No explanation means user mistake.
[k_unrecoverable_error]:
! do not attempt recovery from this error
sysmsg(s_badbug,cat('There is an unrecoverable bug in ',fac_name,
' or something it calls'),0);
[otherwise]:
report_error(.value,k_program_error,
lit('Invalid cause to REPORT_ERROR'),
k_general_error, 0, k_traceback_error) ;
! The preceding call never returns.
tes ; ! Explain the cause.
! Deliver the message.
SELECTONE .cause OF
SET
[k_unrecoverable_error]:
! do not attempt to write to error log
sysmsg(.value,message,0);
[otherwise]:
sysmsg(.value,message,write_error_message) ;
TES;
! Deliver the additional information.
selectone .extra_info_type of
set ! Extra information.
[k_general_error]:
; ! Nothing additional.
[k_iob_error]:
write_error_iob(.extra_info) ;
[k_system_error]:
write_error_system(.extra_info) ;
[k_xport_error]:
write_error_xport(.extra_info) ;
[otherwise]:
report_error(.value,k_program_error,
lit('Invalid information type to REPORT_ERROR'),
k_general_error, 0, k_traceback_error) ;
! The preceding call never returns.
tes ; ! Extra information.
! Compute the code to be returned by the image if it is to exit silently.
abort_code = (selectone .extra_info_type of
set ! Abort code.
[k_general_error]:
.value ;
[k_iob_error]:
begin ! IOB abort code.
bind
iob = .extra_info : $xpo_iob() ;
.iob[iob$g_comp_code]
end ; ! IOB abort code.
[k_system_error]:
.extra_info ;
[k_xport_error]:
%if %bliss(bliss32)
%then
.extra_info
%else
k_severe_program_abort
%fi ;
[otherwise]:
report_error(.value,k_program_error,
lit('Bad information type in REPORT_ERROR'),
k_general_error, 0, k_traceback_error) ;
! The preceding call never returns.
tes) ; ! Abort code.
! Dispose of the error as requested.
selectone .disposition of
set ! Disposition.
[k_traceback_error]:
BEGIN
! do command roll back
! find out if rolbck in progress
IF .f_rb_in_progress
THEN
badbug(lit('Fatal error occurred during rolbck (REPORT_ERROR)'))
ELSE
BEGIN ! rb not in progress
IF .f_rb_pending or .f_rb_clspd
THEN
BEGIN ! rolbck required
rbmain(k_from_error);
END ! rolbck required
else
begin ! exit without rolbck
sysmsg(s_unchanged,lit('No changes made to library'),0) ;
end; ! exit without rolback
END; ! rb not in progress
!make sure ctrl/y is still there
enable_ctl_y;
!+
! On TOPS-20 there is no mechinism to produce a symbolic stack
! dump when the image exits. If SIX12 is not included in the
! image, the signal_stop causes the BLSOTS to print an unwanted
! error message giving the signal value. Therefore if on TOPS-20
! and SIX12 is not going to be included (/DEBUG switch) just exit.
!-
%if TOPS20 and not %switches(debug) %then
exits(k_severe_program_abort);
%else
signal_stop(k_severe_program_abort) ; ! Never returns.
%fi
END;
[k_exit_error]:
BEGIN
! do command roll back
! find out if rolbck in progress
IF .f_rb_in_progress
THEN
badbug(lit('Fatal error occurred during rolbck (REPORT_ERROR)'))
ELSE
BEGIN ! rb not in progress
IF .f_rb_pending or .f_rb_clspd
THEN
BEGIN ! rolbck required
rbmain(k_from_error);
END ! rolbck required
END; ! rb not in progress
!make sure ctrl/y is still there
enable_ctl_y;
exits(.abort_code) ;
END;
[k_continue_error]:
; ! Fall through to normal return.
[k_norb_error]:
! exit without roll back.
begin
!make sure ctrl/y is still there
enable_ctl_y;
exits(.abort_code);
end;
[otherwise]:
report_error(.value,k_program_error,
lit('Invalid disposition to REPORT_ERROR'),
k_general_error, 0, k_traceback_error) ;
! The preceding call never returns.
tes ; ! Disposition.
message
end ; ! REPORT_ERROR
routine write_error_iob(a_iob) : novalue =
!++
! Functional Description:
!
! This routine obtains error information from an XPORT iob and
! writes it using WRITE_ERROR_MESSAGE.
!
! Formal Parameters:
!
! a_iob: Address of iob from which information is to be written.
!
! Implicit Inputs:
!
! None
!
! Implicit Outputs:
!
! None
!
! Routine Value:
! Completion Codes:
!
! None
!
! Side Effects:
!
! Messages are output as described above.
!
!--
begin ! WRITE_ERROR_IOB
bind
iob = .a_iob : $xpo_iob() ;
! Make sure the iob address is reasonable.
if iob eql 0 or iob eql k_null
then
sysmsg(s_inviob,lit('Invalid iob address to WRITE_ERROR_IOB'),
write_error_message)
else
begin ! Reasonable iob.
bind
resultant = iob[iob$t_resultant] : desc_block ; ! Full file spec.
! Say which file is involved.
if .resultant[desc_len] neq 0
then
sysmsg(s_errmisc,cat('Error in ', resultant),
write_error_message) ;
%if tops20 %then
!I'm not going to touch tops20 code
! There always is a primary completion code.
write_error_xport(.iob[iob$g_comp_code]) ;
! There may be a secondary completion code.
if .iob[iob$g_2nd_code] neq 0
then
write_error_xport(.iob[iob$g_2nd_code]) ;
%fi
%if vaxvms %then
rmsmsg(.iob[iob$g_comp_code],.iob[iob$g_2nd_code]);
%fi
end ; ! Reasonable iob.
end ; ! WRITE_ERROR_IOB
routine write_error_message(a_message) =
!++
! Functional Description:
!
! This routine writes an error message to the error output stream, to the
! regular output stream if required, and to the error log.
!
! Formal Parameters:
!
! a_message: Address of a descriptor of the message to write.
!
! Implicit Inputs:
!
! The OWN variable ERRORS_TO_OUT_IOB declared in this module.
!
! Implicit Outputs:
!
! None
!
! Routine Value:
! Completion Codes:
!
! TRUE
!
! Side Effects:
!
! Messages are output as described above.
!
!--
begin ! WRITE_ERROR_MESSAGE
bind
message = .a_message : desc_block ;
log_error_message(message);
true
end ; ! WRITE_ERROR_MESSAGE
routine write_error_system(status) : novalue =
!++
! Functional Description:
!
! This routine gets the message associated with a system status
! code and writes it by calling WRITE_ERROR_MESSAGE.
!
! Formal Parameters:
!
! status: System status code whose message is to be written.
!
! Implicit Inputs:
!
! None
!
! Implicit Outputs:
!
! None
!
! Routine Value:
! Completion Codes:
!
! None
!
! Side Effects:
!
! Messages are output as described above.
!
!--
begin ! WRITE_ERROR_SYSTEM
literal
k_max_system_message_chars = 256 ; ! Largest message available
! from SYSMES.
local
system_message_buf : vector[ch$allocation(k_max_system_message_chars)],
! Buffer for call to SYSMES.
system_message : desc_block ; ! To above buffer when SYSMES is
! called. SYSMES will adjust the
! length.
! Get the text of the system message.
$str_desc_init(descriptor = system_message,
string = (k_max_system_message_chars, ch$ptr(system_message_buf))) ;
sysmes(.status, system_message) ;
%if %bliss(bliss32)
%then
! Output the message.
sysmsg(.status,system_message,write_error_message) ;
%fi
%if %bliss(bliss36)
%then
! Output the message.
sysmsg(s_syserr,system_message,write_error_message) ;
%fi
end ; ! WRITE_ERROR_SYSTEM
routine write_error_xport(status) : novalue =
!++
! Functional Description:
!
! This routine gets the message associated with an XPORT status
! code and writes it by calling WRITE_ERROR_MESSAGE.
!
! To report error information associated with an iob, use
! WRITE_ERROR_IOB, declared in this module.
!
! Formal Parameters:
!
! status: XPORT status code whose message is to be written.
!
! Implicit Inputs:
!
! None
!
! Implicit Outputs:
!
! None
!
! Routine Value:
! Completion Codes:
!
! None
!
! Side Effects:
!
! A message is output as described above.
!
!--
begin ! WRITE_ERROR_XPORT
%if %bliss(bliss32)
%then
! On VMS, all the XPORT messages are also system messages, so use
! the system message facility until an XPORT $GET_MESSAGE is provided.
write_error_system(.status) ;
%fi
%if Tops20 %then
!+
! On TOPS-20 with the new I/O package SYSIO, XPORT error codes can
! be standard XPORT error codes or system error codes. Determine
! which it is by checking its value. $erbas and $ermax are defined
! in monsym.r36.
!-
! further the system status codes are shifted left 3 spaces
if in_range (.status, $erbas ^ 3, ($erbas+$ermax) ^ 3)
then
begin
write_error_system (.status ^ -3)
end
else
begin
local
xport_message : desc_block;
! XPORT message text
! WARNING - This is an undocumented feature of XPORT
! Currently useable only on the -20
xpo$xmsg(.status,xport_message);
!Now output the message
sysmsg(s_syserr,xport_message,write_error_message)
end;
%fi
end ; ! WRITE_ERROR_XPORT
end ! Module ERRMSG
eludom