{ *************************************************************************** } MODULE mod_handle_tracing ; { Created 31-MAY-1989 MICHIGAN STATE UNIVERSITY, TRIGGER CONTROL SOFTWARE } { *************************************************************************** } INCLUDE mod_common_global_flags, mod_handle_console, mod_handle_logfile, $GET_MESSAGE_TEXT, { from ELN$:RTLOBJECT.OLB } $KERNEL, { from ELN$:RTLOBJECT.OLB } $KERNELMSG ; { from ELN$:RTLOBJECT.OLB } { *************************************************************************** } EXPORT state_type, {ENUMERATED TYPE of binary state } trace_info, {CUSTOM FLAG allowing TT/log information reports } trace_warn, {CUSTOM FLAG allowing TT/log report of warning conditions } trace_error, {CUSTOM FLAG allowing TT/log report of error conditions } db_tracing, {CUSTOM FLAG enabling warning/error messages on DBase actions} io_tracing, {CUSTOM FLAG enabling info/warning messages on CBUS actions } trace_elncon, {CUSTOM FLAG enabling tracing messages about ELNCON traffic } start_time, {STRING software boot time } logfile, {VARYING_STRING logfile name } { sys_w_size, {INTEGER initial system window size } { stagen, {INTEGER line of the info/warning general window } inline_time_now, {PROCEDURE produce a string of current time } modify_trace_inf, {PROCEDURE modify information trace mode } modify_trace_wrn, {PROCEDURE modify warning trace mode } modify_trace_err, {PROCEDURE modify error trace mode } modify_trace_con, {PROCEDURE modify elncon msg trace mode } modify_io_tracing, {PROCEDURE modify cbus io eligibility } modify_db_tracing, {PROCEDURE modify data base eligibility } save_tracing_status, {PROCEDURE saves the state of all tracing modes } restore_tracing_status, {PROCEDURE restores the state of all tracing modes } init_tracing, {PROCEDURE initiliaze tracing system } inline_tracing, {PROCEDURE check a tracing control flag } handle_trc_inf, {PROCEDURE information message tracing } handle_trc_wrn, {PROCEDURE warning message tracing } handle_trc_err, {PROCEDURE error message tracing } handle_trc_sys, {PROCEDURE system message tracing } handle_trc_sta, {PROCEDURE system status tracing } handle_trc_con, {PROCEDURE elncon message tracing } set_sys_window, {PROCEDURE change system window size } cleanscreen, {PROCEDURE clear screen windows } init_flush_to_logfile, {PROCEDURE create a process servicing exception } { message mailbox and regularly closing } { the logfile to keep it up to date } set_trc_exc_mode, {PROCEDURE set/reset exception mode tracing } handle_trc_exc, {PROCEDURE add a message to except message mailbox } handle_exception, {FUNCTION check and display status for exc.handler } decimal_string ; {FUNCTION real -> string(6) format s x.xx } { *************************************************************************** } IMPORT console_synch, {from module MOD_COMMON_GLOBAL_FLAGS } console_obj, {from module MOD_HANDLE_CONSOLE } init_console, {from module MOD_HANDLE_CONSOLE } inline_write_status, {from module MOD_HANDLE_CONSOLE } esc, bell, reverse, standard, {from module MOD_HANDLE_CONSOLE } save_cursor, restore_cursor, {from module MOD_HANDLE_CONSOLE } display_console, {from module MOD_HANDLE_CONSOLE } clearscreen {from module MOD_HANDLE_CONSOLE } scroll, {from module MOD_HANDLE_CONSOLE } goxy, {from module MOD_HANDLE_CONSOLE } lock_console, unlock_console, {from module MOD_HANDLE_CONSOLE } init_logfile, {from module MOD_HANDLE_LOGFILE } write_logfile, {from module MOD_HANDLE_LOGFILE } close_logfile, {from module MOD_HANDLE_LOGFILE } STATUS$TEXT,STATUS$IDENT,STATUS$SEVERITY,STATUS$FACILITY, ELN$GET_STATUS_TEXT, {from module $GET_MESSAGE_TEXT } KER$NAME_OBJECT, {from module $KERNEL } KER$_DEBUG_SIGNAL, {from module $KERNELMSG } KER$_QUIT_SIGNAL ; {from module $KERNELMSG } { *************************************************************************** } { *************************************************************************** } CONST line_feed = CHR(10) ; %INCLUDE 'SITE_DEPENDENT.CST/LIST' TYPE state_type = ( OFF, ON ) ; word = [WORD] 0..65535 ; tracing_control = [WORD] PACKED RECORD console : [BYTE] state_type ; logfile : [BYTE] state_type ; END ; exception_message = RECORD tag : VARYING_STRING(32) ; message : VARYING_STRING(266) ; {status # + decoded string = 11 + 255 char} {The messages are truncated in the logfile} {but available in the debugger } time : STRING(23) ; {Time at which the message happened } {which is not the time when it is reported} END ; VAR trace_info : tracing_control ; trace_warn : tracing_control ; trace_error : tracing_control ; trace_elncon : tracing_control ; io_tracing : state_type ; db_tracing : state_type ; {15-MAR-1991 modified to have the cursor position controlled from the shared { area mod_handle_console\console_synch {variable below was deleted { sys_w_size : INTEGER ; { number of lines in system/error special window } {variables below have been moved into recode conole_synch of MOD_HANDLE_CONSOLE { topgen : INTEGER ; {top line of the info/warning general window } { botgen : INTEGER ; {bottom line of the info/warning general window } { stagen : INTEGER ; {status line of the info/warning general window } { topspe : INTEGER ; {top line of the system/error special window } { botspe : INTEGER ; {bottom line of the system/error special window } { staspe : INTEGER ; {status line of the system/error special window } start_time : STRING(17) ; logfile : VARYING_STRING(50) ; save_trc_if_cons, save_trc_wr_cons, save_trc_er_cons : state_type ; save_trc_if_log, save_trc_wr_log, save_trc_er_log : state_type ; save_io_tracing , save_db_tracing : state_type ; bin_time : LARGE_INTEGER ; error_filter_time_last : LARGE_INTEGER := 0 ; error_filter_count : INTEGER ; error_filter_skip : INTEGER ; error_filter_active : BOOLEAN := FALSE ; exception_mailbox : EVENT ; mbx_msg_cnt : INTEGER := 0 ; exc_mbx_msg : ARRAY [1..mbx_msg_max+1] OF exception_message ; trc_exc_state : BOOLEAN := FALSE ; SS$_ACCVIO :[VALUE,EXTERNAL] INTEGER ; { *************************************************************************** } { *************************************************************************** } PROCEDURE init_tracing ; VAR status : INTEGER ; BEGIN start_time := inline_time_now ; trace_info.console := CONVERT(state_type, ini_trace_info_console ) ; trace_info.logfile := CONVERT(state_type, ini_trace_info_logfile ) ; trace_warn.console := CONVERT(state_type, ini_trace_warn_console ) ; trace_warn.logfile := CONVERT(state_type, ini_trace_warn_logfile ) ; trace_error.console := CONVERT(state_type, ini_trace_error_console ) ; trace_error.logfile := CONVERT(state_type, ini_trace_error_logfile ) ; trace_elncon.console := CONVERT(state_type, ini_trace_elncon_console ) ; trace_elncon.logfile := CONVERT(state_type, ini_trace_elncon_logfile ) ; io_tracing := CONVERT(state_type, ini_io_tracing ) ; db_tracing := CONVERT(state_type, ini_db_tracing ) ; init_console ; set_sys_window ( SIZE := 10, INPUT_LINE := -1 ) ; logfile := logfile_directory + 'TRICS_' + SUBSTR(start_time,1,2) + SUBSTR(start_time,4,3) + SUBSTR(start_time,10,2) + '.LOG' ; handle_trc_sys ( TAG := 'INI/LOG%', MESSAGE := ' Opening Logfile ' + logfile); init_logfile ( NAME := logfile, STATUS := status ) ; IF ( status <> 1 ) THEN BEGIN handle_trc_sta ( TAG := 'INI/LOG%', STATUS := status ) ; modify_trace_inf ( CONSOLE := trace_info.console, LOGFILE := OFF ) ; modify_trace_wrn ( CONSOLE := trace_warn.console, LOGFILE := OFF ) ; modify_trace_err ( CONSOLE := trace_error.console, LOGFILE := OFF ) ; modify_trace_con ( CONSOLE := trace_elncon.console, LOGFILE := OFF ) ; END ; END ; { *************************************************************************** } [INLINE] FUNCTION inline_time_now : STRING(23) ; VAR status : INTEGER ; bin_time : LARGE_INTEGER ; ascii_time : STRING(23) ; BEGIN GET_TIME ( bin_time, STATUS := status ) ; IF ( STATUS <> 1 ) THEN ascii_time := '' ELSE ascii_time := TIME_STRING(bin_time) ; IF ( SUBSTR(ascii_time,1,1) = ' ' ) THEN SUBSTR(ascii_time,1,1) := '0' ; inline_time_now := ascii_time ; END ; { *************************************************************************** } { *************************************************************************** } PROCEDURE cleanscreen ; BEGIN clearscreen ; init_status_special ; init_status_general ; update_status_special ; update_status_general ; END ; { *************************************************************************** } { *************************************************************************** } PROCEDURE init_status_general ; BEGIN inline_write_status ( LINE := console_synch^.stagen, MESSAGE := ' Info Cons/Log: / ' + ' Warning Cons/Log: / ' + ' CBUS: ' + ' ELNCON: / ' ) ; END ; { *************************************************************************** } PROCEDURE init_status_special ; BEGIN inline_write_status ( LINE := console_synch^.staspe, MESSAGE := ' System modif: ' + ' Error Cons/Log: / ' + ' Boot Time: ' + start_time ) ; END ; { *************************************************************************** } PROCEDURE update_status_general ; BEGIN inline_write_status ( LINE := console_synch^.stagen, MESSAGE := goxy(console_synch^.stagen,17) + CONVERT(STRING(3),trace_info.console) + '/' + CONVERT(STRING(3),trace_info.logfile) + goxy(console_synch^.stagen,44) + CONVERT(STRING(3),trace_warn.console) + '/' + CONVERT(STRING(3),trace_warn.logfile) + goxy(console_synch^.stagen,59) + CONVERT(STRING(3),io_tracing) + goxy(console_synch^.stagen,72) + CONVERT(STRING(3),trace_elncon.console) + '/' + CONVERT(STRING(3),trace_elncon.logfile)); END ; { *************************************************************************** } PROCEDURE update_status_special ; BEGIN inline_write_status ( LINE := console_synch^.staspe, MESSAGE := goxy(console_synch^.staspe,17) + ' ON' + goxy(console_synch^.staspe,44) + CONVERT(STRING(3),trace_error.console) + '/' + CONVERT(STRING(3),trace_error.logfile) ); END ; { *************************************************************************** } { *************************************************************************** } PROCEDURE set_sys_window ( size : INTEGER := 0 ; input_line : INTEGER := 0 ) ; BEGIN IF ( size <> 0 ) THEN BEGIN IF ( size < 2 ) THEN size := 2 ; IF ( size > 16 ) THEN size := 16 ; console_synch^.topspe := 4 ; console_synch^.botspe := console_synch^.topspe + size - 1 ; console_synch^.staspe := console_synch^.botspe + 1 ; console_synch^.topgen := console_synch^.staspe + 1 ; END ; IF ( input_line <> 0 ) THEN BEGIN IF ( input_line > 0 ) THEN console_synch^.stagen := 22 ELSE console_synch^.stagen := 24 ; console_synch^.botgen := console_synch^.stagen - 1 ; END ; display_console ( save_cursor ) ; cleanscreen ; display_console ( scroll(console_synch^.topgen,console_synch^.botgen) + goxy(console_synch^.botgen-1,1) + restore_cursor); END ; { *************************************************************************** } { *************************************************************************** } PROCEDURE modify_trace_inf ( console, logfile : state_type ; report : BOOLEAN := TRUE ) ; BEGIN trace_info.console := console ; trace_info.logfile := logfile ; IF ( report = TRUE ) THEN BEGIN handle_trc_sys ( TAG := 'MOD/TRC%', MESSAGE := ' Modify Info Tracing,' + ' console ' + CONVERT(STRING(3),trace_info.console) + ' log file ' + CONVERT(STRING(3),trace_info.logfile) ) ; END ; update_status_general ; IF ( inline_tracing(trace_info) = 0 ) THEN BEGIN IF ( inline_tracing(trace_warn) = 0 ) THEN modify_io_tracing ( STATE := OFF, REPORT := report ) ; END ; END ; { *************************************************************************** } PROCEDURE modify_trace_wrn ( console, logfile : state_type ; report : BOOLEAN := TRUE ) ; BEGIN trace_warn.console := console ; trace_warn.logfile := logfile ; IF ( report = TRUE ) THEN BEGIN handle_trc_sys ( TAG := 'MOD/TRC%', MESSAGE := ' Modify Warning Tracing,' + ' console ' + CONVERT(STRING(3),trace_warn.console) + ' log file ' + CONVERT(STRING(3),trace_warn.logfile) ) ; END ; update_status_general ; IF ( inline_tracing(trace_warn) = 0 ) THEN IF ( inline_tracing(trace_info) = 0 ) THEN modify_io_tracing ( STATE := OFF, REPORT := report ) ; END ; { *************************************************************************** } PROCEDURE modify_trace_err ( console, logfile : state_type ; report : BOOLEAN := TRUE ) ; BEGIN trace_error.console := console ; trace_error.logfile := logfile ; IF ( report = TRUE ) THEN BEGIN handle_trc_sys ( TAG := 'MOD/TRC%', MESSAGE := ' Modify Error Tracing,' + ' console ' + CONVERT(STRING(3),trace_error.console) + ' log file ' + CONVERT(STRING(3),trace_error.logfile) ) ; END ; update_status_special ; END ; { *************************************************************************** } PROCEDURE modify_io_tracing ( state : state_type ; report : BOOLEAN := TRUE ) ; BEGIN io_tracing := state ; IF ( report = TRUE ) THEN BEGIN handle_trc_sys ( TAG := 'MOD/TRC%', MESSAGE := ' Modify CBUS I/O tracing eligibility, state ' + CONVERT(STRING(3),io_tracing) ) ; END ; update_status_general ; END ; { *************************************************************************** } PROCEDURE modify_db_tracing ( state : state_type ; report : BOOLEAN := TRUE ) ; BEGIN db_tracing := state ; IF ( report = TRUE ) THEN BEGIN handle_trc_sys ( TAG := 'MOD/TRC%', MESSAGE := ' Modify Data Base tracing eligibility, state ' + CONVERT(STRING(3),db_tracing) ) ; { update_status_general ; nodisplay of this flag} END ; END ; { *************************************************************************** } PROCEDURE modify_trace_con ( console, logfile : state_type ; report : BOOLEAN := TRUE ) ; BEGIN trace_elncon.console := console ; trace_elncon.logfile := logfile ; update_status_general ; IF ( report = TRUE ) THEN handle_trc_sys ( TAG := 'MOD/TRC%', MESSAGE := ' Modify ELNCON message tracing,' + ' console ' + CONVERT(STRING(3),trace_elncon.console) + ' log file ' + CONVERT(STRING(3),trace_elncon.logfile) ) ; END ; { *************************************************************************** } PROCEDURE save_tracing_status ; BEGIN save_trc_if_cons := trace_info.console ; save_trc_if_log := trace_info.logfile ; save_trc_wr_cons := trace_warn.console ; save_trc_wr_log := trace_warn.logfile ; save_trc_er_cons := trace_error.console ; save_trc_er_log := trace_error.logfile ; save_io_tracing := io_tracing ; save_db_tracing := db_tracing ; END ; { *************************************************************************** } PROCEDURE restore_tracing_status ( report : BOOLEAN := TRUE ) ; BEGIN modify_trace_inf ( CONSOLE := save_trc_if_cons, LOGFILE := save_trc_if_log, REPORT := report ) ; modify_trace_wrn ( CONSOLE := save_trc_wr_cons, LOGFILE := save_trc_wr_log, REPORT := report ) ; modify_db_tracing ( STATE := save_db_tracing, REPORT := report ) ; modify_io_tracing ( STATE := save_io_tracing, REPORT := report ) ; modify_trace_err ( CONSOLE := save_trc_er_cons, LOGFILE := save_trc_er_log, REPORT := report ) ; END ; { *************************************************************************** } [INLINE] FUNCTION inline_tracing ( trace_flag : tracing_control ) : INTEGER ; BEGIN inline_tracing := trace_flag::word ; END ; { *************************************************************************** } { *************************************************************************** } PROCEDURE handle_trc_inf ( message : STRING() ; tag : VARYING_STRING(32) := '' ) ; BEGIN IF ( trc_exc_state = FALSE ) THEN BEGIN IF ( trace_info.console = ON ) THEN display_console ( save_cursor + scroll(console_synch^.topgen,console_synch^.botgen) + goxy(console_synch^.botgen,1) + line_feed + 'I-' + tag + message + restore_cursor ) ; IF ( trace_info.logfile = ON ) THEN write_logfile ( TIME := inline_time_now, MESSAGE := 'I-' + tag + message ) ; END ELSE handle_trc_exc ( TAG := tag, MESSAGE := message ) ; END ; { *************************************************************************** } { *************************************************************************** } PROCEDURE handle_trc_wrn ( message : STRING() ; tag : VARYING_STRING(32) := '' ) ; BEGIN IF ( trc_exc_state = FALSE ) THEN BEGIN IF ( trace_warn.console = ON ) THEN display_console ( save_cursor + scroll(console_synch^.topgen,console_synch^.botgen) + goxy(console_synch^.botgen,1) + line_feed + 'W-' + tag + message + restore_cursor ) ; IF ( trace_warn.logfile = ON ) THEN write_logfile ( TIME := inline_time_now, MESSAGE := 'W-' + tag + message ) ; END ELSE handle_trc_exc ( TAG := tag, MESSAGE := message ) ; END ; { *************************************************************************** } { *************************************************************************** } PROCEDURE handle_trc_err ( message : STRING() ; tag : VARYING_STRING(32) := '' ) ; {*** this declaration is also repeated as EXTERNAL in mod_handle_remcons *** } {*** and mod_sys_service *** } {*** remember to propagate any change *** } VAR status : INTEGER ; BEGIN GET_TIME ( bin_time, STATUS := status ) ; IF ( STATUS <> 1 ) THEN BEGIN error_filter_count := 0 ; error_filter_time_last := 0 ; END ; IF ( ( bin_time - error_filter_time_last ) > error_filter_time_constant ) THEN BEGIN error_filter_count := 0 ; IF ( error_filter_active = TRUE ) THEN BEGIN error_filter_active := FALSE ; handle_trc_sys ( TAG := 'ERR/FLT%', MESSAGE := ' Resume Normal Error Logging,' + ' after skipping ' + CONVERT(STRING,error_filter_skip) + ' errors' ) ; END ; END ELSE BEGIN IF ( error_filter_count < error_filter_threshold ) THEN error_filter_count := error_filter_count + 1 ELSE BEGIN IF ( error_filter_active = FALSE ) THEN BEGIN error_filter_active := TRUE ; error_filter_skip := 0 ; handle_trc_sys ( TAG := 'ERR/FLT%', MESSAGE := ' Error Rate Too High, start skipping' ) ; END ; error_filter_skip := error_filter_skip + 1 ; GOTO skip_logging_errors ; END ; END ; IF ( trc_exc_state = FALSE ) THEN BEGIN IF ( trace_error.console = ON ) THEN display_console ( bell + save_cursor + scroll(console_synch^.topspe,console_synch^.botspe) + goxy(console_synch^.botspe,1) + line_feed + 'E-' + tag + message + restore_cursor ) ; IF ( trace_error.logfile = ON ) THEN write_logfile ( TIME := inline_time_now, MESSAGE := 'E-' + tag + message ) ; END ELSE handle_trc_exc ( TAG := tag, MESSAGE := message ) ; skip_logging_errors : error_filter_time_last := bin_time ; END ; { *************************************************************************** } { *************************************************************************** } PROCEDURE handle_trc_sys ( message : STRING() ; tag : VARYING_STRING(32) := '' ) ; {*** this declaration is also repeated as EXTERNAL in mod_handle_console *** } {*** and mod_sys_service *** } {*** remember to propagate any change *** } VAR time : STRING(23) ; BEGIN IF ( trc_exc_state = FALSE ) THEN BEGIN display_console ( bell + save_cursor + scroll(console_synch^.topspe,console_synch^.botspe) + goxy(console_synch^.botspe,1) + line_feed + 'S-' + tag + message + restore_cursor ) ; time := inline_time_now ; write_logfile ( TIME := time, MESSAGE := 'S-' + tag + message ) ; END ELSE handle_trc_exc ( TAG := tag, MESSAGE := message ) ; END ; { *************************************************************************** } { *************************************************************************** } PROCEDURE handle_trc_sta ( status : INTEGER ; tag : VARYING_STRING(32) := 'SYS/STA%' ; VAR decoded :[OPTIONAL] VARYING_STRING(255) ) ; {*** this declaration is also repeated as EXTERNAL in mod_handle_remcons *** } {*** and in mod_handle_console *** } {*** and mod_sys_service *** } {*** remember to propagate any change *** } VAR decoded_stat : VARYING_STRING(255) ; BEGIN IF ( status <> 1 ) THEN BEGIN decoded_stat := sys_message(status) ; IF PRESENT(decoded) THEN decoded := decoded_stat ; handle_trc_sys ( TAG := tag, MESSAGE := CONVERT(STRING,status) + decoded_stat ) ; END ELSE IF PRESENT(decoded) THEN decoded := '' ; END ; { *************************************************************************** } { *************************************************************************** } PROCEDURE handle_trc_con ( message :^STRING() ; tag : VARYING_STRING(8) := '' ; length : INTEGER := - 1 ) ; VAR i : INTEGER ; clen : INTEGER := 80 ; { console line length } llen : INTEGER := 100 ; { logfile line length } time_now : STRING(23) ; tagext : STRING(10) ; BEGIN IF ( length < 0 ) THEN length := apparent_length ; tagext := ' : %' ; IF ( trace_elncon.console = ON ) THEN BEGIN clen := clen - 20 ; { remove tag length } FOR i := 0 TO ( (apparent_length-1) DIV clen ) DO BEGIN IF ( length <= clen*(i+1) ) THEN BEGIN SUBSTR(tagext,1,4) := CONVERT(STRING(4),1+clen*i) ; SUBSTR(tagext,6,4) := CONVERT(STRING,length) ; IF ( trc_exc_state = FALSE ) THEN display_console ( save_cursor + scroll(console_synch^.topgen,console_synch^.botgen) + goxy(console_synch^.botgen,1) + line_feed + 'C-' + tag + tagext + SUBSTR (message^, 1+clen*i, length-clen*i) + restore_cursor ) ELSE handle_trc_exc ( TAG := tag, MESSAGE := SUBSTR(message^,1+clen*i,length-clen*i) ) ; GOTO exit_handle_trace_elncon_cons ; END ; SUBSTR(tagext,1,4) := CONVERT(STRING(4),1+clen*i) ; SUBSTR(tagext,6,4) := CONVERT(STRING,clen*(i+1)) ; IF ( trc_exc_state = FALSE ) THEN display_console ( save_cursor + scroll(console_synch^.topgen,console_synch^.botgen) + goxy(console_synch^.botgen,1) + line_feed + 'C-' + tag + tagext + SUBSTR (message^, 1+clen*i, clen) + restore_cursor ) ELSE handle_trc_exc ( TAG := tag, MESSAGE := SUBSTR (message^, 1+clen*i, clen) ) ; END ; SUBSTR(tagext,1,4) := CONVERT(STRING(4),1+clen*i) ; SUBSTR(tagext,6,4) := CONVERT(STRING,length) ; IF ( trc_exc_state = FALSE ) THEN display_console ( save_cursor + scroll(console_synch^.topgen,console_synch^.botgen) + goxy(console_synch^.botgen,1) + line_feed + 'C-' + tag + tagext + SUBSTR (message^, 1+clen*i, length-clen*i) + restore_cursor ) ELSE handle_trc_exc ( TAG := tag, MESSAGE := SUBSTR (message^, 1+clen*i, length-clen*i) ) ; END ; exit_handle_trace_elncon_cons : IF ( trace_elncon.logfile = ON ) THEN BEGIN llen := llen - 20 ; { remove tag length } time_now := inline_time_now ; FOR i := 0 TO ( (apparent_length-1) DIV llen ) DO BEGIN IF ( length <= llen*(i+1) ) THEN BEGIN SUBSTR(tagext,1,4) := CONVERT(STRING(4),1+llen*i) ; SUBSTR(tagext,6,4) := CONVERT(STRING,length) ; IF ( trc_exc_state = FALSE ) THEN write_logfile ( TIME := time_now, MESSAGE := 'C-' + tag + tagext + SUBSTR(message^,1+llen*i,length-llen*i) ) ; GOTO exit_handle_trace_elncon_log ; END ; SUBSTR(tagext,1,4) := CONVERT(STRING(4),1+llen*i) ; SUBSTR(tagext,6,4) := CONVERT(STRING,llen*(i+1)) ; IF ( trc_exc_state = FALSE ) THEN write_logfile ( TIME := time_now, MESSAGE := 'C-' + tag + tagext + SUBSTR (message^, 1+llen*i, llen) ) ; END ; SUBSTR(tagext,1,4) := CONVERT(STRING(4),1+llen*i) ; SUBSTR(tagext,6,4) := CONVERT(STRING,length) ; IF ( trc_exc_state = FALSE ) THEN write_logfile ( TIME := time_now, MESSAGE := 'C-' + tag + tagext + SUBSTR(message^, 1+llen*i, length-llen*i) ); END ; exit_handle_trace_elncon_log : END ; { *************************************************************************** } { *************************************************************************** } FUNCTION sys_message ( status_to_decode : INTEGER ) : VARYING_STRING(255) ; VAR decoded_stat : VARYING_STRING(255) ; BEGIN ELN$GET_STATUS_TEXT ( status_to_decode, [STATUS$TEXT,STATUS$IDENT,STATUS$SEVERITY,STATUS$FACILITY], decoded_stat ); sys_message := decoded_stat ; END ; { *************************************************************************** } { *************************************************************************** } FUNCTION decimal_string ( string_length : INTEGER ; real_number : REAL ) : VARYING_STRING(8) ; VAR temp_str : STRING(12) ; formatted_str : VARYING_STRING(12) ; exponent : INTEGER ; digit_num : INTEGER ; BEGIN IF ( string_length > 8 ) THEN string_length := 8 ; IF ( string_length < 3 ) THEN string_length := 3 ; IF ( real_number < 0.0 ) THEN formatted_str := '-' ELSE formatted_str := ' ' ; temp_str := CONVERT(STRING,real_number) ; {format si.fffffEsnn, s=sign} exponent := CONVERT ( INTEGER, SUBSTR(temp_str,10,3) ) + 1 ; IF ( exponent >= string_length -1 ) {verify it fits in the requested length} THEN BEGIN formatted_str := formatted_str + '***********' ; {overflow} GOTO assign_return_value ; END ; IF ( exponent > 0 ) {round off} THEN real_number := ABS(real_number) +5.0 * 10.0**(1+exponent-string_length) ELSE real_number := ABS(real_number) +5.0 * 10.0**(2-string_length) ; temp_str := CONVERT(STRING,real_number) ; {redo after round off} exponent := CONVERT ( INTEGER, SUBSTR(temp_str,10,3) ) + 1 ; temp_str := SUBSTR(temp_str,2,1) + SUBSTR(temp_str,4,5) ;{significant digits} IF ( exponent <= 0 ) {pad with zeroes before the significant digits} THEN formatted_str := formatted_str + '0.' + SUBSTR('00000000',1,-exponent) ; FOR digit_num := 1 TO 6 { append significant digits} DO BEGIN formatted_str := formatted_str + SUBSTR(temp_str,digit_num,1) ; {new digit} exponent := exponent - 1 ; {only useful for numbers >=1} IF ( exponent = 0 ) THEN formatted_str := formatted_str + '.' ; {dec point} END ; assign_return_value : {format to the right length} decimal_string := SUBSTR(formatted_str,1,string_length) ; END ; { *************************************************************************** } { *************************************************************************** } PROCEDURE init_flush_to_logfile ; VAR proc_flush_to_logfile : PROCESS ; name_flush_to_logfile : NAME ; status : INTEGER ; BEGIN CREATE_PROCESS ( proc_flush_to_logfile, block_flush_to_logfile, STATUS := status ) ; handle_trc_sta ( TAG := 'CRE/PRC%flush%', STATUS := status ) ; KER$NAME_OBJECT ( name_flush_to_logfile, 'FLUSH->FILE', proc_flush_to_logfile, STATUS := status ) ; handle_trc_sta ( TAG := 'NAM/PRC%flush%', STATUS := status ) ; CREATE_EVENT ( exception_mailbox, EVENT$CLEARED, STATUS := status ) ; handle_trc_sta ( TAG := 'CRE/EVT%excmbx%', STATUS := status ) ; END ; { *************************************************************************** } PROCESS_BLOCK block_flush_to_logfile ; CONST forever = FALSE ; one_second = - 10000000 ; VAR status : INTEGER ; result : INTEGER ; msg_num : INTEGER ; mailbox_full : BOOLEAN ; BEGIN REPEAT mailbox_full := FALSE ; { wait for the regular flush time interval or a signal that the exception } { handler message mailbox needs servicing } WAIT_ANY ( exception_mailbox, TIME := flush_to_logfile_time_interval, STATUS := status, RESULT := result ) ; IF ( status <> 1 ) THEN BEGIN handle_trc_sta ( TAG := 'WAI/FLF%flush%', STATUS := status ) ; END ELSE IF ( result = 1 ) THEN mailbox_full := TRUE ; check_console_lock: WAIT_ANY ( console_obj, TIME := 5 * one_second, STATUS := status, RESULT := result ) ; IF ( status <> 1 ) THEN handle_trc_sta ( TAG := 'WAI/CNS%flush%', STATUS := status ) ELSE IF ( result = 0 ) THEN BEGIN { use the exception mailbox instead of direct screen message that are } { currently in trouble with their synchronization lock } handle_trc_exc ( TAG := 'WAI/CNS%flush%', MESSAGE := ' Console Locked for 5s, Recover: Force Unlock') ; unlock_console ; { repeat until this process was able to lock the console, then release it} GOTO check_console_lock ; END ELSE SIGNAL ( console_obj, STATUS := status ) ; IF ( ( mailbox_full = FALSE ) AND ( mbx_msg_cnt > 0 ) ) THEN BEGIN handle_trc_err ( TAG := 'EXC/MBX%', MESSAGE := ' Message Mailbox is Full but Not Signaled' ) ; mailbox_full := TRUE ; END ; IF ( mailbox_full = TRUE ) THEN BEGIN { Check that a process didn't leave the tracing in exception mode } IF ( trc_exc_state = TRUE ) THEN BEGIN lock_console ; { This is to make sure to wait that all processes } unlock_console ; { are out of the screen IO routines } set_trc_exc_mode ( tagext := 'recover%', exc_mode := FALSE ) ; handle_trc_err ( TAG := 'EXC/MBX%', MESSAGE := ' Tracing Exception Mode Found Left Set,' + ' Recover: Force Reset' ) ; END ; handle_trc_sys ( TAG := 'EXC/MBX%', MESSAGE := ' Flush_to_File now Servicing Exception Mailbox'); msg_num := 1 ; service_next_message: display_console ( bell + save_cursor + scroll(console_synch^.topspe,console_synch^.botspe) + goxy(console_synch^.botspe,1) + line_feed + 'X-' + exc_mbx_msg[msg_num].tag + exc_mbx_msg[msg_num].message + restore_cursor ) ; write_logfile ( TIME := exc_mbx_msg[msg_num].time, MESSAGE := 'X-' + exc_mbx_msg[msg_num].tag + exc_mbx_msg[msg_num].message ) ; msg_num := msg_num + 1 ; IF ( ( msg_num <= mbx_msg_cnt ) AND ( msg_num <= mbx_msg_max + 1 ) ) THEN GOTO service_next_message ; mbx_msg_cnt := 0 ; CLEAR_EVENT ( exception_mailbox ) ; handle_trc_sys ( TAG := 'EXC/MBX%', MESSAGE := ' Exception Mailbox now empty' ) ; END ; close_logfile ; UNTIL forever ; END ; { *************************************************************************** } PROCEDURE set_trc_exc_mode ( exc_mode : BOOLEAN ; tagext : VARYING_STRING(16) := '' ) ; {*** This declaration is also repeated as EXTERNAL in mod_handle_remcons *** } {*** remember to propagate any change *** } BEGIN IF ( tagext <> '' ) THEN handle_trc_exc ( TAG := 'TRC/EXC%' + tagext, MESSAGE := ' Setting Tracing Exception State ' + CONVERT(STRING,exc_mode) ) ; trc_exc_state := exc_mode ; { Once the exception mode is turned off, notify the flush to file process } { to empty the mailbox } IF ( exc_mode = FALSE ) THEN SIGNAL ( exception_mailbox ) ; END ; { *************************************************************************** } PROCEDURE handle_trc_exc ( message : VARYING_STRING(255) := '' ; tag : VARYING_STRING(32) := '' ) ; {*** This declaration is also repeated as EXTERNAL in mod_handle_remcons *** } {*** and in mod_handle_console *** } {*** remember to propagate any change *** } BEGIN mbx_msg_cnt := mbx_msg_cnt + 1 ; IF ( mbx_msg_cnt <= mbx_msg_max ) THEN BEGIN exc_mbx_msg[mbx_msg_cnt].tag := tag ; exc_mbx_msg[mbx_msg_cnt].time := inline_time_now ; exc_mbx_msg[mbx_msg_cnt].message := message END ELSE BEGIN exc_mbx_msg[mbx_msg_max+1].tag := 'MBX/OVF%' ; exc_mbx_msg[mbx_msg_max+1].time := inline_time_now ; exc_mbx_msg[mbx_msg_max+1].message := ' Exception Mailbox Overflow: ' + CONVERT(STRING,mbx_msg_cnt) + ' requests for ' + CONVERT(STRING,mbx_msg_max) + ' slots, last request at ' + exc_mbx_msg[mbx_msg_max+1].time ; END ; END ; { *************************************************************************** } FUNCTION handle_exception ( tag : VARYING_STRING(32) := 'EXC/HND%' ; exc_code : INTEGER ; VAR decoded :[OPTIONAL] VARYING_STRING(255) ; VAR handled :[OPTIONAL] BOOLEAN ) : BOOLEAN ; BEGIN IF PRESENT(decoded) THEN handle_trc_sta ( TAG := tag, STATUS := exc_code, DECODED := decoded ) ELSE handle_trc_sta ( TAG := tag, STATUS := exc_code ) ; IF ( exc_code = KER$_DEBUG_SIGNAL ) THEN BEGIN handle_exception := FALSE ; IF PRESENT(handled) THEN handled := FALSE ; handle_trc_exc ( TAG := tag, MESSAGE := 'Debugging' ) ; END ELSE IF ( exc_code = SS$_ACCVIO ) THEN BEGIN handle_exception := FALSE ; IF PRESENT(handled) THEN handled := FALSE ; handle_trc_exc ( TAG := tag, MESSAGE := 'Stalling' ) ; END ELSE IF ( exc_code = KER$_QUIT_SIGNAL ) THEN BEGIN handle_trc_exc ( TAG := tag, MESSAGE := 'Quitting' ) ; set_trc_exc_mode ( FALSE ) ; EXIT ; END ELSE BEGIN handle_exception := TRUE ; IF PRESENT(handled) THEN handled := TRUE ; handle_trc_exc ( TAG := tag, MESSAGE := 'Skipping' ) ; END ; END ; { *************************************************************************** } { *************************************************************************** } END .