$! --- This command procedure compiles the condition handler test $! --- demonstration program. The /LIST command modifier on the $! --- FORTRAN command is required to generate a compiler listing $! --- (CH_DEMO.LIS) File. The source code line numbers in this $! --- listing file are what are referenced in the traceback. $! $! --- When you link this image, you should receive a warning message $! --- that procedure 'XYZ' cannot be found. This is normal, and is $! --- necessary for the demonstration to work correctly. $! $ fortran/list ch_demo $ link ch_demo,sys$input/opt ch_shared_image/share $ delete ch_demo.obj;* $ exit ! ! --- This is the condition handler test demonstration program. ! --- This program contains three errors; two warnings and one ! --- fatal. Run this program with the condition handler shared ! --- image linked in, to receive exception traceback VAXmail. ! program ch_demo ! ! --- Make the Condition Handler and the Exit Handler known ! --- to the system. Change the argument "'ROSENSTEIN'" to ! --- your own VMS account name, to receive mail correctly. ! external fch_condition_handler call lib$establish(fch_condition_handler) call sch_set_exithandler('Rosenstein') ! ! --- Induce two warnings, by trying to print out five digit ! --- numbers in four digit fields. After each exception is ! --- signaled, execution will continue. ! i=10000 type 100, i 100 format(' i=',i4) k=10000 type 200, k 200 format(' k=',i4) ! ! --- Induce a fatal exception, by trying to call a non-existant ! --- subroutine. Execution will stop at this point, and image ! --- rundown begin. We should have received a message from the ! --- linker indicating that it could not find a subroutine XYZ. ! call xyz ! ! --- We should never see the following message on our terminal ! type 300 300 format(' The program has completed normally') call exit end $! CH_MAKE_SHARED_IMAGE.COM $!++ $! Author: Steve Rosenstein $! $! Creation Date: 01-OCT-1988 $! $! Modification History: $! $! Functional Description: $! $! This command procedure compiles the three FORTRAN procedures $! used in the combination condition/exit handler technique to $! log and report runtime exception conditions. It assembles $! the macro procedure used to create the transfer vectors for $! the resulting shared image, and then it links everything $! together into a shared image. If shared image installation $! is desired, the last line should be uncommented. $! $! An assumption which is made is that the logical $! CH_SHARED_IMAGE has been created as a system-wide logical $! name. It is equivalenced to the full filespec of the $! condition handler executable. For this example, this $! definition is as follows: $! $ DEFINE/SYSTEM - $! CH_SHARED_IMAGE - $! SSW_DISK:[ROSENSTEIN.CH.CODE]CH.EXE $! If this logical cannot been defined, you will have to $! replace every instance of CH_SHARED_IMAGE with the full path $! to the condition handler shared image. This logical *MUST* $! be defined at runtime so that the applications can find the $! shared image, so it is best to have it defined on a $! system-wide basis. $! $! Calling Format: $! $! @CH_MAKE_SHARED_IMAGE $! $! Formal Argument(s): NONE $! $! Implicit Inputs: NONE $! Implicit Outputs: NONE $! Side Effects: NONE $! $!------------------------------------------------------------------------------ $! $ fortran fch_condition_handler,sch_set_exithandler,sch_exit_handler $ macro ch_transfer_vectors $ link/notraceback/share=ch_shared_image - ch_transfer_vectors,- fch_condition_handler,sch_set_exithandler,sch_exit_handler,- sys$input/options gsmatch=always,0,0 $ delete *.obj;* $! $! --- To install the condition handler, uncomment the following $! --- statements. The condition handler uses 3 global sections, $! --- 4 global pages, and requires CMKRNL privilege. $! $!install create/open/shared/header ch_shared_image $ exit ; CH_TRANSFER_VECTORS.MAR ;++ ; Author: Steve Rosenstein ; ; Creation Date: 01-OCT-1988 ; ; Modification History: ; ; Functional Description: ; ; This procedure creates the transfer vectors that allow the ; condition handler shared image to be linker independent. ; ; Calling Format: NONE ; ; Formal Argument(s): NONE ; ; Implicit Inputs: NONE ; Implicit Outputs: NONE ; Side Effects: NONE ; ;------------------------------------------------------------------------------- ; .macro xfer module .transfer module .mask module jmp l^module+2 .endm ; .psect condition_handler_xfr,nowrt,exe xfer FCH_CONDITION_HANDLER xfer SCH_SET_EXITHANDLER .end integer*4 function fch_condition_handler(j_sigargs,j_mechargs) !++ ! Author: Steve Rosenstein ! ! Creation Date: 01-OCT-1988 ! ! Modification History: ! ! Functional Description: ! ! This procedure is made known to the user's process as a VMS ! Condition Handler via a call to the VMS Runtime Library ! procedure LIB$ESTABLISH. Control is passed to it by the VMS ! Condition Handling Facility whenever an exception condition ! is signaled. It is not called directly by any application ! program. ! ! Calling Format: ! ! EXTERNAL FCH_CONDITION_HANDLER ! CALL LIB$ESTABLISH(FCH_CONDITION_HANDLER) ! ! Formal Argument(s): ! ! J_SIGARGS ! Type: Longword array ! Access: Read Only ! Mechanism: By reference ! VMS Usage: Describes the nature of the exception condition ! to the Condition Handler ! ! J_MECHARGS ! Type: Longword array ! Access: Read/Write ! Mechanism: By reference ! VMS Usage: Describes the state of the process at the time ! the condition was signaled ! ! FCH_CONDITION_HANDLER ! Type: Longword function return value ! Access: Write Only ! Mechanism: By reference ! VMS Usage: Passes a value representing the current Condition ! Value back to the Condition Handling Facility. ! ! Implicit Inputs: NONE ! ! Implicit Outputs: NONE ! ! Side Effects: ! ! Modifies the way the Condition Handling Facility continues ! to process the exception condition, based on the value ! returned via the function call return value. Can also ! modify the value returned via a function procedure call. ! !------------------------------------------------------------------------------- ! include 'fortran_types.inc/nolist' include '($jpidef)/nolist' include '($lnmdef)/nolist' integer*4 j_sigargs(*) integer*4 j_mechargs(*) character*128 c_exception_logfile/' '/ character*128 c_imagename parameter (j_unit=99) character*(*) c_null_device parameter (c_null_device='NLA0:') record/itmlst/getjpi(2) record/itmlst/crelnm(2) ! ! --- Test if the current exception is the first one to be trapped (via the ! --- character variable C_EXCEPTION_LOGFILE being a blank strint), and if ! --- so, do all exception reporting initialization and file creation. ! if (c_exception_logfile.eq.' ') then open ( 1 unit=j_unit, 1 file='sys$scratch:exception_report.log', 1 carriagecontrol='list', 1 status='new') inquire (unit=j_unit,name=c_exception_logfile) j_exception_logfile_lth=index(c_exception_logfile,' ')-1 ! ! --- Create the logical name "EXCEPTION_LOGFILE" the first time an ! --- exception is trapped by the condition handler. This serves two ! --- purposes: 1) it's existance signals the exit handler that an exception ! --- log file exists and has to be mailed, and 2) it passes the full file ! --- specification of the exception log file to the exit handler. ! crelnm(1).i_buflen=j_exception_logfile_lth crelnm(1).i_itmcod=lnm$_string crelnm(1).j_bufadr=%loc(c_exception_logfile) crelnm(2).j_endlst=0 call sys$crelnm(, 1 'LNM$PROCESS', 1 'EXCEPTION_LOGFILE',, 1 crelnm) ! ! --- During normal VMS condition handling, the traceback information is ! --- provided to SYS$OUTPUT and SYS$ERROR after the image exits. In order ! --- to be able to save traceback information, the logical name SYS$OUTPUT ! --- is re-defined to be the exception textfile. The logical name SYS$ERROR ! --- is re-defined to be the null device (NLA0:) to inhibit output to ! --- the screen. ! crelnm(1).i_buflen=j_exception_logfile_lth crelnm(1).i_itmcod=lnm$_string crelnm(1).j_bufadr=%loc(c_exception_logfile) crelnm(2).j_endlst=0 call sys$crelnm(,'LNM$PROCESS','SYS$OUTPUT',,crelnm) crelnm(1).i_buflen=len(c_null_device) crelnm(1).i_itmcod=lnm$_string crelnm(1).j_bufadr=%loc(c_null_device) crelnm(2).j_endlst=0 call sys$crelnm(,'LNM$PROCESS','SYS$ERROR',,crelnm) ! ! --- Use GETJPI to obtain the name of the image currently signaling the ! --- exception. Other image and process dependent information can be ! --- returned and made a part of the exception reporting file if required. ! getjpi(1).i_buflen=len(c_imagename) getjpi(1).i_itmcod=jpi$_imagname getjpi(1).j_bufadr=%loc(c_imagename) getjpi(1).j_retlen=%loc(j_imagename_lth) getjpi(2).j_endlst=0 call sys$getjpiw(,,,getjpi,,,) write (j_unit,10100) c_imagename(1:j_imagename_lth) 10100 format( 'Signaling Image: ',A,/) close (unit=j_unit) endif ! ! --- At this point we are finished looking at the condition value. We want ! --- to re-signal the condition to allow VMS to proceed according to the ! --- severity of the exception. ! fch_condition_handler=j_sigargs(2) return end subroutine sch_exit_handler( 1 j_exit_status, 1 b_exception_mailist, 1 j_mailist_len) !++ ! Author: Steve Rosenstein ! ! Creation Date: 01-OCT-1991 ! ! Modification History: ! ! Functional Description: ! ! This procedure is made known to the user's process as a VMS ! exit handler via the exit handler control block created in ! SCH_SET_EXITHANDLER. If any exception conditions are ! signaled, this procedure will submit a batch job that will ! send a mailgram continaing exception condition traceback ! information to the accounts of those users on the VAXmail ! distribution list. ! ! Calling Format: ! ! (Not called directly by an application, but made known to ! the system via a call to the $DCLEXH system service in ! SCH_SET_EXITHANDLER.) ! ! Formal Argument(s): ! ! J_EXIT_STATUS ! Type: Longword ! Access: Read Only ! Mechanism: By reference ! VMS Usage: Contains the final Condition Value of image ! execution at the start of image rundown ! ! B_EXCEPTION_MAILIST ! Type: Byte array ! Access: Read Only ! Mechanism: By reference ! VMS Usage: Contains the VAXmail mail distribution list ! text string ! ! J_MAILIST_LEN ! Type: Longword ! Access: Read Only ! Mechanism: By reference ! VMS Usage: Contains the length (in bytes) of the VAXmail ! mail distribution list text string ! ! Implicit Inputs: NONE ! ! Implicit Outputs: NONE ! ! Side Effects: ! ! Modifies the normal functioning of process image rundown ! by receiving control and performing additional image rundown ! tasks. ! !------------------------------------------------------------------------------- ! include 'fortran_types.inc/nolist' include '($ssdef)/nolist' include '($lnmdef)/nolist' include '($sjcdef)/nolist' byte b_exception_mailist(j_mailist_len) record/itmlst/trnlnm(2) record/itmlst/sndjbc(5) character*128 c_exception_logfile character*128 c_exception_comfile character*064 c_exception_message character*(*) c_queue parameter (c_queue='sys$batch') parameter (j_unit=99) ! ! --- The exit handler is invoked upon image termination. If any exceptions ! --- have been trapped by the condition handler, the logical name ! --- EXCEPTION_LOGFILE has been created in the process table. ! --- If the logical name does not exist, it is assumed there is no traceback ! --- information to be mailed. ! trnlnm(1).i_buflen=len(c_exception_logfile) trnlnm(1).i_itmcod=lnm$_string trnlnm(1).j_bufadr=%loc(c_exception_logfile) trnlnm(1).j_retlen=%loc(j_txtfile_len) trnlnm(2).j_endlst=0 j_status=sys$trnlnm(,'LNM$PROCESS','EXCEPTION_LOGFILE',,trnlnm) if (j_status.and.j_status.ne.ss$_nolognam) then ! ! --- The subject of the mail message will be the Facility-Severity-Ident of ! --- the condition value at image termination. These are obtained via the ! --- call to SYS$GETMSG. ! call sys$getmsg( 1 %val(j_exit_status.and.'0fffffff'x), 1 i_message_len, 1 c_exception_message, 1 %val(14),) ! ! --- The exit handler creates a small .COM file containing all of the ! --- commands necessary to send the traceback logging file to the people ! --- on the VAXmail distribution list. This is done here. ! open ( 1 unit=j_unit, 1 file='sys$scratch:exception_report.com', 1 status='new') inquire (unit=j_unit,name=c_exception_comfile) write (j_unit,10100) 1 c_exception_logfile(1:j_txtfile_len), 1 b_exception_mailist, 1 c_exception_message(1:i_message_len), 1 c_exception_logfile(1:j_txtfile_len) 10100 format( '$ mail ',a,' -',/, 1 ' ',a1,'/sub="',a,'"',/, 1 '$ delete ',a,/, 1 '$ exit') close (unit=j_unit) ! ! --- Submit the command procedure created above to the batch queue named ! --- in C_QUEUE (in our case, SYS$BATCH). ! sndjbc(1).i_buflen=len(c_queue) sndjbc(1).i_itmcod=sjc$_queue sndjbc(1).j_bufadr=%loc(c_queue) sndjbc(2).i_buflen=len(c_exception_comfile) sndjbc(2).i_itmcod=sjc$_file_specification sndjbc(2).j_bufadr=%loc(c_exception_comfile) sndjbc(3).i_itmcod=sjc$_no_log_specification sndjbc(4).i_itmcod=sjc$_delete_file sndjbc(5).j_endlst=0 j_status=sys$sndjbcw(,%val(sjc$_enter_file),,sndjbc,,,) endif return end subroutine sch_set_exithandler(c_exception_mailist) !++ ! Author: Steve Rosenstein ! ! Creation Date: 01-OCT-1988 ! ! Modification History: ! ! Functional Description: ! ! This procedure sets up the control block for the final exit ! handler. It also accepts the mail distribution list from ! the main program. This list can be in any form valid to the ! VMS MAIL facility. It can either be the actual name(s) of ! the users, a VAXmail distribution list (@xxxx.DIS), or a ! logical name containing any of the above. An example of a ! system-wide logical containing the names of the programmers ! responsible for maintaining the application programs is: ! ! DEFINE/SYSTEM CH_MAIL_DIST "ROSENSTEIN,AHDERS,FLICKER" ! ! "CH_MAIL_DIST" would be used as the input argument into ! CH_SET_EXITHANDLER. The quotes around the list of names is ! required so that they are not taken to be elements of the ! logical. It is suggested that logicals be used, so the mail ! distribution scheme can be changed without requiring any ! modifications to the actual application program. This ! subroutine must be called before any additional exit ! handlers are declared. ! ! Calling Format: ! ! CALL SCH_SET_EXITHANDLER(C_EXCEPTION_MAILLIST) ! ! Formal Argument(s): ! ! C_EXCEPTION_MAILLIST ! Type: Character string ! Access: Read Only ! Mechanism: By descriptor ! VMS Usage: Passes the VAXmail distribution list into the ! exit handler ! ! Implicit Inputs: NONE ! ! Implicit Outputs: NONE ! ! Side Effects: ! ! Modifies the normal functioning of process image rundown ! by making an exit handler known to the system. ! !------------------------------------------------------------------------------- ! include 'fortran_types.inc/nolist' character*(*) c_exception_mailist external sch_exit_handler ! ! --- Set up the exit handler control block ! integer*4 j_exit_ctrlblk(6)/ 1 0, ! Forward link (used by VMS) 1 0, ! Exit handler address (set by %LOC(SCH_EXIT_HANDLER)) 1 3, ! Number of exit handler arguments 1 0, ! Status longword address (set by %LOC(J_EXIT_STATUS)) 1 0, ! Mail distribution list character string array 1 0/ ! Mail distribution list character string length ! ! --- Establish the exit handler ! j_len=index(c_exception_mailist//' ',' ')-1 j_exit_ctrlblk(2)=%loc(sch_exit_handler) j_exit_ctrlblk(4)=%loc(j_exit_status) j_exit_ctrlblk(5)=%loc(c_exception_mailist) j_exit_ctrlblk(6)=%loc(j_len) call sys$dclexh(j_exit_ctrlblk) return end