channel_comm_meters.pl1 10/25/89 1156.0r w 10/25/89 1005.1 102807 /* *********************************************************** * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ /* format: style4,delnl,insnl,^ifthendo */ channel_comm_meters: procedure; /* Command to print meters on one or more communications channels (specified by a single starname). It calls comm_meters_ to get the information, and the appropriate multiplexer-specific entries to display it. */ /* Written April 1981 by Robert Coren */ /* Modified July 1981 by Robert Coren to handle sub_error_ */ /* AUTOMATIC */ dcl brief bit (1); dcl error bit (1); dcl summary bit (1); dcl since_boot bit (1); dcl boot_spec bit (1); dcl dial_spec bit (1); dcl chan_spec bit (1); dcl i fixed bin; dcl code fixed bin (35); dcl ctl_arg char (16); dcl nargs fixed bin; dcl argl fixed bin (21); dcl argp pointer; dcl chan_star_name (1) char (32); /* comm_meters_ requires an array */ dcl areap pointer; dcl n_channels fixed bin; dcl orig_meterp pointer; dcl display_flags bit (36) aligned; dcl beginning fixed bin (71); /* time from which meters are measured */ dcl seconds fixed bin (71); dcl all_time fixed bin (71); /* time since beginning */ dcl time_string char (9); dcl chanx fixed bin; dcl name char (32); dcl entry_var entry options (variable) variable; dcl total_errors fixed bin; dcl user_name char (22); dcl user_proj char (9); dcl input_chars fixed bin (35); dcl output_chars fixed bin (35); dcl cps fixed bin; dcl 1 auto_summary aligned like channel_summary; /* BASED */ dcl arg char (argl) based (argp); /* ENTRIES */ dcl cu_$arg_count entry (fixed bin, fixed bin (35)); dcl ioa_ entry () options (variable); dcl com_err_ entry () options (variable); dcl cu_$arg_ptr entry (fixed bin, ptr, fixed bin (21), fixed bin (35)); dcl get_system_free_area_ entry () returns (ptr); dcl get_userid_ entry (bit (36) aligned, char (*), char (*), fixed bin, fixed bin, fixed bin (35)); dcl system_info_$timeup entry (fixed bin (71)); dcl comm_meters_ entry ((*) char (32), fixed bin, pointer, fixed bin, pointer, fixed bin (35)); dcl comm_meters_$free entry (pointer, pointer, fixed bin (35)); dcl comm_meters_$get_mpx_entry entry (char (*), fixed bin) returns (entry); dcl meter_format_$time entry (fixed bin (71)) returns (char (10)); dcl meter_format_$quotient entry (fixed bin (71), fixed bin (71), char (*)) returns (char (12) varying); dcl find_condition_info_ entry (ptr, ptr, fixed bin (35)); dcl continue_to_signal_ entry (fixed bin (35)); /* EXTERNAL STATIC */ dcl ( error_table_$noarg, error_table_$badopt, error_table_$inconsistent, error_table_$bigarg, error_table_$no_channel_meters, error_table_$no_operation ) fixed bin (35) external static; /* INTERNAL STATIC */ dcl CMD_NAME char (19) internal static options (constant) init ("channel_comm_meters"); /* BUILTINS & CONDITIONS */ dcl sub_error_ condition; dcl (substr, divide, clock, null, addr, unspec) builtin; %include channel_meters; %page; %include channel_summary; %page; %include multiplexer_types; %page; %include condition_info; %page; %include sub_error_info; %page; %include condition_info_header; %page; %include comm_meters_error_info; call cu_$arg_count (nargs, code); if code ^= 0 then do; call com_err_ (code, CMD_NAME); return; end; if nargs = 0 then do; call com_err_ (error_table_$noarg, CMD_NAME, "^/Usage: channel_comm_meters channel_name {-brief} {-error} {-summary} {-since_bootload | -since_dialup}" ); return; end; brief, error, summary, since_boot, boot_spec, dial_spec, chan_spec = "0"b; do i = 1 to nargs; /* parse the arguments */ call cu_$arg_ptr (i, argp, argl, code); if substr (arg, 1, 1) = "-" /* control arg */ then do; ctl_arg = substr (arg, 2); if ctl_arg = "brief" | ctl_arg = "bf" then brief = "1"b; else if ctl_arg = "error" then error = "1"b; else if ctl_arg = "summary" | ctl_arg = "sum" then summary = "1"b; else if ctl_arg = "since_bootload" | ctl_arg = "boot" then do; boot_spec = "1"b; since_boot = "1"b; end; else if ctl_arg = "since_dialup" | ctl_arg = "dial" then do; dial_spec = "1"b; since_boot = "0"b; end; else do; call com_err_ (error_table_$badopt, CMD_NAME, arg); return; end; end; else do; if chan_spec /* already gave a channel name */ then do; call com_err_ (error_table_$inconsistent, CMD_NAME, "Only one channel starname may be specified."); return; end; if argl > 32 /* too big to be a channel name */ then do; call com_err_ (error_table_$bigarg, CMD_NAME, "^a. Channel name must not exceed 32 characters.", arg); return; end; chan_spec = "1"b; chan_star_name (1) = arg; end; end; /* Now check for unacceptable combinations */ if (brief | error) & summary then do; call com_err_ (error_table_$inconsistent, CMD_NAME, "-summary may not be specified with either -brief or -error."); return; end; if boot_spec & dial_spec then do; call com_err_ (error_table_$inconsistent, CMD_NAME, "only one of -since_bootload and -since_dialup may be specified."); return; end; /* handler for sub_error_ */ on sub_error_ begin; dcl pass_on bit (1); dcl 1 auto_cond_info aligned like condition_info; pass_on = "0"b; condition_info_ptr = addr (auto_cond_info); call find_condition_info_ (null (), condition_info_ptr, code); if code ^= 0 /* rather unlikely */ then pass_on = "1"b; /* but we'll let someone else worry about it */ else if condition_info.info_ptr = null () | condition_info.condition_name ^= "sub_error_" /* we're not about to deal with this */ then pass_on = "1"b; else do; sub_error_info_ptr = condition_info.info_ptr; if sub_error_info.name ^= "comm_meters_" /* not someone we know */ then pass_on = "1"b; else if sub_error_info.info_ptr = null () /* simple enough */ then go to report_it; comm_meters_errp = sub_error_info.info_ptr; if comm_meters_error_info.version ^= COMM_METERS_ERR_V1 then pass_on = "1"b; else do; if ^comm_meters_error_info.starname_matched then go to report_it; if sub_error_info.status_code ^= error_table_$no_channel_meters /* this is not worth reporting */ | ^comm_meters_error_info.more_than_one_match /* unless there's only one channel anyway */ then do; report_it: call com_err_ (sub_error_info.status_code, CMD_NAME, sub_error_info.info_string); end; end; end; if pass_on then call continue_to_signal_ (code); end; /* Now start to do some work */ areap = get_system_free_area_ (); call comm_meters_ (chan_star_name, CHANNEL_METERS_VERSION_1, areap, n_channels, chan_meterp, code); if code ^= 0 then return; /* comm_meters_ calls sub_err_, which should explain everything */ orig_meterp = chan_meterp; /* save this for later freeing */ display_flags = brief || error || summary || since_boot || (32)"0"b; call system_info_$timeup (beginning); all_time = clock () - beginning; call ioa_ ("Total metering time ^a", meter_format_$time (all_time)); if summary /* print header */ then call ioa_ ("^/cps^7tcpsi^14tcpso^20tiotxXsbepQqa^34terr^39tABE^44tname^60tuser^/"); do chanx = 1 to n_channels; name = channel_meters.channel_name; if ^summary then do; call ioa_ ("^/^a^/", name); entry_var = comm_meters_$get_mpx_entry ("display_mpx", channel_meters.multiplexer_type); call entry_var (name, null (), chan_meterp, display_flags, code); if code ^= 0 & code ^= error_table_$no_operation /* don't fuss if entry simply not supplied */ then call com_err_ (code, CMD_NAME, "No multiplexer meters for ^a (multiplexer type ^a)", name, mpx_types (channel_meters.multiplexer_type)); if channel_meters.parent_type > 0 /* not level-1 mpx */ then do; entry_var = comm_meters_$get_mpx_entry ("display_subchan", channel_meters.parent_type); call entry_var (name, null (), chan_meterp, display_flags, code); if code ^= 0 & code ^= error_table_$no_operation /* as above */ then call com_err_ (code, CMD_NAME, "No subchannel meters for ^a (parent type ^a)", name, mpx_types (channel_meters.parent_type)); end; end; else do; /* get summary information and print it ourselves */ unspec (auto_summary) = "0"b; auto_summary.version = CHANNEL_SUMMARY_VERSION_1; entry_var = comm_meters_$get_mpx_entry ("mpx_summary", channel_meters.multiplexer_type); call entry_var (chan_meterp, since_boot, addr (auto_summary), code); total_errors = auto_summary.error_count;/* save this */ auto_summary.error_count = 0; /* parent may update this */ if channel_meters.parent_type > 0 then do; entry_var = comm_meters_$get_mpx_entry ("subchan_summary", channel_meters.parent_type); call entry_var (chan_meterp, since_boot, addr (auto_summary), code); total_errors = total_errors + auto_summary.error_count; end; if since_boot then do; input_chars = channel_meters.cumulative.unconverted_input_chars; output_chars = channel_meters.cumulative.converted_output_chars; seconds = divide (all_time, 1000000, 71, 0); end; else do; input_chars = channel_meters.cumulative.unconverted_input_chars - channel_meters.saved.unconverted_input_chars; output_chars = channel_meters.cumulative.converted_output_chars - channel_meters.saved.converted_output_chars; seconds = divide (auto_summary.time_since_dial, 1000000, 71, 0); end; if auto_summary.user_process = "0"b then user_name = ""; else call get_userid_ (auto_summary.user_process, user_name, user_proj, (0), (0), code); if auto_summary.synchronous then cps = divide (auto_summary.baud_rate, 8, 17, 0); else cps = divide (auto_summary.baud_rate, 10, 17, 0); call ioa_ ( "^3d^6t^a^13t^a^20t^[i^;^x^]^[o^;^x^]^[t^;^x^]^[x^;^x^]^[X^;^x^]^[s^;^x^]^[b^;^x^]^[e^;^x^]^[p^;^x^]^[Q^;^x^]^[q^;^x^]^[a^;^x^]^33t^4d^39t^[s^;a^]^[B^;^x^]^[E^;^x^]^44t^a^60t^a" , cps, meter_format_$quotient ((input_chars), seconds, "^5.2f"), meter_format_$quotient ((output_chars), seconds, "^5.2f"), auto_summary.invalid_input, auto_summary.output_re_xmit, auto_summary.timeout, auto_summary.pre_exhaust, auto_summary.exhaust, auto_summary.xte, auto_summary.bell_quit, auto_summary.echo_overflow, auto_summary.parity, auto_summary.ssqo, auto_summary.hsqo, auto_summary.alloc_failure, total_errors, auto_summary.synchronous, auto_summary.breakall, auto_summary.echoplex, name, user_name); end; chan_meterp = channel_meters.next_channelp; end; call comm_meters_$free (areap, orig_meterp, code); if code ^= 0 then call com_err_ (code, CMD_NAME, "While freeing channel meters."); return; end channel_comm_meters;  comm_meters_.pl1 10/25/89 1156.0r w 10/25/89 1005.1 121410 /* *********************************************************** * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ /* format: style4,delnl,insnl,^ifthendo */ comm_meters_: proc (a_chan_names, a_version, a_area_ptr, a_n_channels, a_chan_meterp, a_code); /* Subroutine for use by comm. channel metering commands. It takes a list of channel names, any or all of which may be starnames, and returns metering information for the specified channels. The comm_meters_$free entry frees the structures allocated by the main entry. This subroutine requires the aid of some multiplexer-specific entries to allocate and free structures whose formats are known only to the multiplexer involved. These entries have names of the form MPX_meters_$allocate_mpx, MPX_meters_$allocate_subchan, MPX_meters_$free_mpx, and MPX_meters_$free_subchan, where MPX is the name of the relevant multiplexer type. */ /* Written February 1981 by Robert S. Coren */ /* Modified July 1981 by Robert S. Coren to supply some info with call to sub_err_ */ /* PARAMETERS */ dcl a_chan_names (*) char (*) parameter; /* channel names for which to meter */ dcl a_version fixed bin parameter; /* version of structure to be allocated */ dcl a_area_ptr pointer parameter; /* pointer to area in which to do allocation */ dcl a_entry_type char (*); /* name of multiplexer-specific entry */ dcl a_mpx_type fixed bin; /* multiplexer type for get_mpx_entry entry */ dcl a_n_channels fixed bin parameter; /* number of channels matching a_chan_ names (OUTPUT) */ dcl a_chan_meterp pointer parameter; /* pointer to list of metering structures allocated (OUTPUT) */ dcl a_code fixed bin (35); /* status code (OUTPUT) */ /* AUTOMATIC */ dcl chan_meter_areap ptr; dcl n_channels fixed bin; dcl code fixed bin (35); dcl last_chanp pointer; dcl names_areap ptr; dcl i fixed bin; dcl chanx fixed bin; dcl mpx_type fixed bin; dcl chan_name char (32); dcl name_matched bit (1); dcl 1 meter_info aligned like get_comm_meters_info; dcl 1 auto_logical_meters aligned like logical_chan_meters; /* BASED */ dcl names_area area (256) based (names_areap); dcl chan_meter_area area (256) based (chan_meter_areap); /* ENTRIES */ dcl get_system_free_area_ entry (pointer); dcl metering_gate_$comm_chan_star_list entry (char (*), fixed bin, ptr, ptr, fixed bin (35)); dcl metering_gate_$get_comm_meters entry (char (*), ptr, fixed bin (35)); dcl phcs_$get_comm_meters entry (char (*), ptr, fixed bin (35)); dcl entry_var entry options (variable) variable; dcl sub_err_ entry options (variable); /* EXTERNAL STATIC */ dcl error_table_$noalloc fixed bin (35) external static; dcl error_table_$no_operation fixed bin (35) external static; dcl error_table_$unimplemented_version fixed bin (35) external static; /* BUILTINS & CONDITIONS */ dcl (addr, hbound, null) builtin; dcl (area, cleanup, linkage_error) condition; if a_version ^= CHANNEL_METERS_VERSION_1 then do; a_code = error_table_$unimplemented_version; return; end; chan_meter_areap = a_area_ptr; n_channels = 0; last_chanp = null; chan_star_list_ptr = null; on cleanup call cleanup_proc; on area begin; call cleanup_proc; a_code = error_table_$noalloc; go to exit; end; call get_system_free_area_ (names_areap); name_matched = "0"b; do i = 1 to hbound (a_chan_names, 1); call metering_gate_$comm_chan_star_list (a_chan_names (i), CHAN_STAR_INFO_VERSION_1, names_areap, chan_star_list_ptr, code); if code ^= 0 then do; call report_error (a_chan_names (i)); a_code = code; call cleanup_proc; return; end; name_matched = "1"b; n_channels = n_channels + chan_star_info.n_channels; do chanx = 1 to chan_star_info.n_channels; mpx_type = chan_star_info.chan_entry (chanx).mpx_type; chan_name = chan_star_info.chan_entry (chanx).name; allocate channel_meters in (chan_meter_area) set (chan_meterp); if last_chanp = null /* this is first one in list */ then a_chan_meterp = chan_meterp; /* have to tell caller where to start */ else last_chanp -> channel_meters.next_channelp = chan_meterp; /* else chain it on to previous */ channel_meters.version = a_version; channel_meters.next_channelp = null; channel_meters.multiplexer_type = mpx_type; channel_meters.line_type = chan_star_info.chan_entry (chanx).line_type; channel_meters.parent_type = chan_star_info.chan_entry (chanx).parent_type; channel_meters.channel_name = chan_name; meter_info.version = GET_COMM_METERS_INFO_VERSION_1; meter_info.logical_chan_ptr = addr (auto_logical_meters); entry_var = get_entry ("allocate_mpx", mpx_type); /* returns iox_$err_no_operation if there isn't one */ call entry_var (chan_meter_areap, meter_info.subchan_ptr, code); if code ^= 0 then do; if code ^= error_table_$no_operation then call report_error (chan_name); meter_info.subchan_ptr = null; end; if channel_meters.parent_type >= 0 then do; entry_var = get_entry ("allocate_subchan", channel_meters.parent_type); call entry_var (chan_meter_areap, meter_info.parent_ptr, code); if code ^= 0 then do; if code ^= error_table_$no_operation then call report_error (chan_name); meter_info.parent_ptr = null; end; end; else meter_info.parent_ptr = null; channel_meters.mpx_specific_meterp = meter_info.subchan_ptr; channel_meters.parent_meterp = meter_info.parent_ptr; /* now get the actual meters out of ring 0 */ on linkage_error begin; /* we're going to try phcs_ first */ revert linkage_error; call metering_gate_$get_comm_meters (chan_name, addr (meter_info), code); go to proceed; end; call phcs_$get_comm_meters (chan_name, addr (meter_info), code); revert linkage_error; proceed: if code ^= 0 then do; call report_error (chan_name); free channel_meters in (chan_meter_area); /* skip this one */ if last_chanp ^= null then last_chanp -> channel_meters.next_channelp = null; /* wipe out forward pointer to it */ n_channels = n_channels - 1; /* don't count it */ end; else do; last_chanp = chan_meterp; /* this one is last now */ /* now copy them into the structure */ channel_meters.cumulative.unconverted_input_chars = auto_logical_meters.current_meters.in_bytes; channel_meters.cumulative.converted_output_chars = auto_logical_meters.current_meters.out_bytes; channel_meters.cumulative.read_calls = auto_logical_meters.current_meters.in.calls; channel_meters.cumulative.read_call_time = auto_logical_meters.current_meters.in.call_time; channel_meters.cumulative.write_calls = auto_logical_meters.current_meters.out.calls; channel_meters.cumulative.write_call_time = auto_logical_meters.current_meters.out.call_time; channel_meters.cumulative.control_calls = auto_logical_meters.current_meters.control.calls; channel_meters.cumulative.control_call_time = auto_logical_meters.current_meters.control.call_time; channel_meters.cumulative.software_interrupts = auto_logical_meters.current_meters.in.interrupts + auto_logical_meters.current_meters.out.interrupts + auto_logical_meters.current_meters.control.interrupts; channel_meters.cumulative.interrupt_time = auto_logical_meters.current_meters.in.interrupt_time + auto_logical_meters.current_meters.out.interrupt_time + auto_logical_meters.current_meters.control.interrupt_time; channel_meters.saved.unconverted_input_chars = auto_logical_meters.saved_meters.in_bytes; channel_meters.saved.converted_output_chars = auto_logical_meters.saved_meters.out_bytes; channel_meters.saved.read_calls = auto_logical_meters.saved_meters.in.calls; channel_meters.saved.read_call_time = auto_logical_meters.saved_meters.in.call_time; channel_meters.saved.write_calls = auto_logical_meters.saved_meters.out.calls; channel_meters.saved.write_call_time = auto_logical_meters.saved_meters.out.call_time; channel_meters.saved.control_calls = auto_logical_meters.saved_meters.control.calls; channel_meters.saved.control_call_time = auto_logical_meters.saved_meters.control.call_time; channel_meters.saved.software_interrupts = auto_logical_meters.saved_meters.in.interrupts + auto_logical_meters.saved_meters.out.interrupts + auto_logical_meters.saved_meters.control.interrupts; channel_meters.saved.interrupt_time = auto_logical_meters.saved_meters.in.interrupt_time + auto_logical_meters.saved_meters.out.interrupt_time + auto_logical_meters.saved_meters.control.interrupt_time; end; end; /* done with that channel */ free chan_star_info in (names_area); /* done with that starname */ chan_star_list_ptr = null; /* in case of cleanup */ end; /* done processing all names */ if n_channels <= 0 then a_code = code; else a_code = 0; a_n_channels = n_channels; exit: return; free: entry (a_area_ptr, a_chan_meterp, a_code); /* this entry frees metering structure allocated by main entry */ chan_meter_areap = a_area_ptr; call free_all (a_chan_meterp); /* internal subroutine does all the work */ a_code = code; return; get_mpx_entry: entry (a_entry_type, a_mpx_type) returns (entry); /* this is an entry to allow external access to the get_entry procedure */ return (get_entry (a_entry_type, a_mpx_type)); /* CLEANUP_PROC -- called for cleanup condition or if subroutine aborts */ cleanup_proc: procedure; if chan_star_list_ptr ^= null then free chan_star_info in (names_area); if last_chanp ^= null then call free_all (a_chan_meterp); return; end cleanup_proc; /* FREE_ALL -- frees metering structures. Multiplexer-specific entries are called to free stuff allocated by corresponding entries */ free_all: procedure (a_list_meterp); dcl a_list_meterp ptr; dcl next_chanp ptr; chan_meterp = a_list_meterp; do while (chan_meterp ^= null); if channel_meters.mpx_specific_meterp ^= null then do; entry_var = get_entry ("free_mpx", channel_meters.multiplexer_type); call entry_var (channel_meters.mpx_specific_meterp, code); if code ^= 0 then call sub_err_ (code, "comm_meters_$free", "c", null, 0, "Couldn't free meters for ^a subchannel.", mpx_types (channel_meters.multiplexer_type)); end; if channel_meters.parent_meterp ^= null then do; entry_var = get_entry ("free_subchan", channel_meters.parent_type); call entry_var (channel_meters.parent_meterp, code); if code ^= 0 then call sub_err_ (code, "comm_meters_$free", "c", null, 0, "Couldn't free meters for ^a multiplexer.", mpx_types (channel_meters.parent_type)); end; code = 0; next_chanp = channel_meters.next_channelp; free channel_meters in (chan_meter_area); chan_meterp = next_chanp; /* on to the next */ end; return; end free_all; /* GET_ENTRY -- given a multiplexer type and an entrypoint name, returns the entry. If there is no corresponding entry, returns iox_$err_no_operation, so result can always be called and will do something comprehensible. */ get_entry: procedure (a_entry_type, a_mpx_type) returns (entry); dcl a_entry_type char (*); dcl a_mpx_type fixed bin; dcl segname char (32); dcl entname char (32); dcl entry_ptr pointer; dcl entry_result entry variable; dcl code fixed bin (35); dcl cu_$make_entry_value entry (pointer, entry); dcl hcs_$make_ptr entry (pointer, char (*), char (*), pointer, fixed bin (35)); dcl iox_$err_no_operation entry options (variable); dcl rtrim builtin; segname = rtrim (mpx_types (a_mpx_type)) || "_meters_"; entname = a_entry_type; call hcs_$make_ptr (null, segname, entname, entry_ptr, code); if entry_ptr = null then return (iox_$err_no_operation); call cu_$make_entry_value (entry_ptr, entry_result); return (entry_result); end get_entry; /* REPORT_ERROR -- internal procedure to call sub_err_ with a channel name */ report_error: procedure (err_name); dcl err_name char (*); dcl 1 auto_meters_error_info aligned like comm_meters_error_info; comm_meters_errp = addr (auto_meters_error_info); comm_meters_error_info.version = COMM_METERS_ERR_V1; comm_meters_error_info.chan_name = err_name; comm_meters_error_info.more_than_one_starname = (hbound (a_chan_names, 1) > 1); if name_matched then do; comm_meters_error_info.starname_matched = "1"b; comm_meters_error_info.more_than_one_match = (n_channels > 1); end; else comm_meters_error_info.starname_matched, comm_meters_error_info.more_than_one_match = "0"b; call sub_err_ (code, "comm_meters_", "c", comm_meters_errp, 0, "Processing channel name ^a", err_name); return; end report_error; %include multiplexer_types; %page; %include chan_star_info; %page; %include get_comm_meters_info; %page; %include channel_meters; %page; %include lct; %page; %include comm_meters_error_info; end comm_meters_;  display_fnp_idle.pl1 11/15/82 1813.1rew 11/15/82 1449.1 249138 /* *********************************************************** * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ /* format: style4,delnl,insnl,^ifthendo */ display_fnp_idle: procedure; /* This command displays the data accumulated in segments by meter_fnp_idle. The information is displayed either in summary form or as a histogram over a specified time interval. */ /* Written January 1982 by Robert S. Coren */ /* Modified March 1981 by Robert S. Coren to fix entry-counting bugs */ /* AUTOMATIC */ dcl dirname char (168); dcl hist bit (1); dcl summary bit (1); dcl from_time fixed bin (71); dcl to_time fixed bin (71); dcl minutes fixed bin; dcl line_length fixed bin; dcl code fixed bin (35); dcl fnp_names (8) char (1); dcl fnps (8) bit (1); /* indicates whether an FNP is to be included */ dcl fnpx fixed bin; dcl nargs fixed bin; dcl iarg fixed bin; dcl fnp_no fixed bin; dcl areap pointer; dcl earliest_of_all fixed bin (71); dcl latest_of_all fixed bin (71); dcl fnp_name char (1); dcl i fixed bin; dcl ok bit (1); dcl starname char (32); dcl entryx fixed bin; dcl earliest_found bit (1); dcl latest_found bit (1); dcl segx fixed bin; dcl entname char (32); dcl last_segx fixed bin; dcl last_start fixed bin (71); dcl last_finish fixed bin (71); dcl last_entry fixed bin; dcl last_time_in_seg fixed bin (71); dcl last_entry_in_seg fixed bin; dcl opening_time fixed bin (71); dcl closing_time fixed bin (71); dcl time_to_stop fixed bin (71); dcl total_entries fixed bin; dcl beginning_found bit (1); dcl prev_fnp_idle_datap pointer; dcl first_segx fixed bin; dcl first_entry fixed bin; dcl first_idle_count fixed bin (35); dcl first_sample_count fixed bin (35); dcl last_idle_count fixed bin (35); dcl last_sample_count fixed bin (35); dcl latest_beginning fixed bin (71); dcl min_sample fixed bin (35); dcl minimum_time fixed bin (71); dcl start_of_minimum_average fixed bin (71); dcl min_idle fixed bin (35); dcl min_idle_time fixed bin (71); dcl total_samples fixed bin (35); dcl absolute_max fixed bin (35); dcl overall_average float bin; dcl start_time_string char (24); dcl end_time_string char (24); dcl start_string char (16); dcl end_string char (16); dcl average_sample fixed bin (35); dcl minimum_average float bin; dcl min_start_string char (24); dcl min_end_string char (24); dcl min_idle_string char (24); dcl hist_interval fixed bin (71); dcl total_intervals fixed bin; dcl no_of_fnps fixed bin; dcl minimum_idle fixed bin; dcl fnp_id fixed bin; dcl next_time fixed bin (71); dcl valuex fixed bin; dcl residual bit (1); dcl entries_per_interval fixed bin; dcl last_interval_start fixed bin; dcl max_idle fixed bin (35); dcl next_entryx fixed bin; dcl latest_time fixed bin (71); dcl last_origin pointer; dcl end_of_last pointer; dcl last_interval fixed bin (71); dcl remaining_entries fixed bin; dcl scale_marks fixed bin; dcl top_of_scale fixed bin; dcl hist_width fixed bin; dcl cols_per_pct float bin; dcl space fixed bin; dcl ioa_str char (32); dcl ioa_strl fixed bin; dcl any bit (1); dcl prev_date char (8); dcl cur_time fixed bin (71); dcl suppressed (8) fixed bin; dcl line fixed bin; dcl cells fixed bin; dcl last_had_data bit (1); dcl output_line char (120); dcl dt_string char (24); dcl cur_column fixed bin; dcl already fixed bin; dcl new fixed bin; dcl 1 output (8) aligned, 2 column fixed bin, 2 name char (1); dcl 1 fnp_info_array (8) aligned like fnp_histogram_info; dcl names_array_ptr pointer; dcl seg_array_ptr pointer; dcl seg_count fixed bin; dcl idle_value_ptr pointer; dcl infop pointer; /* ARGUMENT PARSING */ dcl argp pointer; dcl argl fixed bin (21); dcl arg char (argl) based (argp); /* BASED */ dcl the_area area (261120) based (areap); dcl 1 auto_area_info aligned like area_info; dcl 1 names_array aligned based (names_array_ptr), /* used in call to sort_intems_ */ 2 n_names, 2 name_ptr (star_entry_count refer (names_array.n_names)) pointer unaligned; dcl 1 seg_array aligned based (seg_array_ptr), 2 no_of_segs fixed bin, 2 pad bit (36), 2 segptr (seg_count refer (seg_array.no_of_segs)) pointer; dcl idle_values (total_intervals, no_of_fnps) fixed bin based (idle_value_ptr); dcl 1 fnp_histogram_info aligned based (infop), 2 seg_array_ptr pointer, /* points to array of pointers to segments containing data for this FNP */ 2 total_segs fixed bin, 2 first_seg_of_interest fixed bin, /* index in seg_array of earliest segment we will use */ 2 last_seg_of_interest fixed bin; dcl based_entname char (32) based; /* ENTRIES */ dcl define_area_ entry (ptr, fixed bin (35)); dcl release_area_ entry (ptr); dcl get_wdir_ entry returns (char (168)); dcl cu_$arg_count entry (fixed bin, fixed bin (35)); dcl cu_$arg_ptr entry (fixed bin, ptr, fixed bin (21), fixed bin (35)); dcl com_err_ entry () options (variable); dcl com_err_$suppress_name entry () options (variable); dcl parse_fnp_name_ entry (char (*), fixed bin); dcl cv_dec_check_ entry (char (*), fixed bin (35)) returns (fixed bin (35)); dcl get_system_free_area_ entry () returns (ptr); dcl expand_pathname_ entry (char (*), char (*), char (*), fixed bin (35)); dcl hcs_$star_ entry (char (*), char (*), fixed bin (2), ptr, fixed bin, ptr, ptr, fixed bin (35)); dcl hcs_$initiate entry (char (*), char (*), char (*), fixed bin (1), fixed bin (2), ptr, fixed bin (35)); dcl pathname_ entry (char (*), char (*)) returns (char (168)); dcl sort_items_$char entry (ptr, fixed bin (24)); dcl hcs_$terminate_noname entry (ptr, fixed bin (35)); dcl date_time_ entry (fixed bin (71), char (*)); dcl ioa_ entry () options (variable); dcl ioa_$rsnnl entry options (variable); dcl get_line_length_$switch entry (ptr, fixed bin (35)) returns (fixed bin); /* EXTERNAL STATIC */ dcl ( error_table_$inconsistent, error_table_$noarg, error_table_$badopt, error_table_$nomatch ) fixed bin (35) external static; dcl sys_info$max_seg_size fixed bin (19) external static; /* INTERNAL STATIC */ dcl COMMAND_NAME char (16) internal static options (constant) init ("display_fnp_idle"); dcl PERCENTS (10) fixed bin internal static options (constant) init (10, 20, 30, 40, 50, 60, 70, 80, 90, 100); /* BUILTINS, CONDITIONS, ETC. */ dcl cleanup condition; dcl (addr, substr, sum, divide, null, max, float, fixed, empty, index) builtin; dirname = get_wdir_ (); hist, summary = "0"b; from_time, to_time = 0; minutes = 0; line_length = 0; fnp_names (*) = " "; fnps (*) = "0"b; fnpx = 0; call cu_$arg_count (nargs, code); if code ^= 0 then do; call com_err_ (code, COMMAND_NAME); return; end; if nargs = 0 then do; call com_err_$suppress_name (0, COMMAND_NAME, "Usage: display_fnp_idle -summary | -histogram {fnp_names} {-control_args}"); return; end; do iarg = 1 to nargs; call cu_$arg_ptr (iarg, argp, argl, code); if code ^= 0 then do; call com_err_ (code, COMMAND_NAME); return; end; if substr (arg, 1, 1) ^= "-" /* not a control arg, must be an FNP name */ then do; call parse_fnp_name_ (arg, fnp_no); if fnp_no < 0 then do; call com_err_ (0, COMMAND_NAME, "^a is not a valid FNP name.", arg); return; end; if fnps (fnp_no) then do; call com_err_ (error_table_$inconsistent, COMMAND_NAME, "FNP ^a specified more than once.", arg); return; end; fnps (fnp_no) = "1"b; fnpx = fnpx + 1; fnp_names (fnpx) = arg; end; else do; if arg = "-histogram" | arg = "-hist" then if summary then go to BOTH; else hist = "1"b; else if arg = "-summary" | arg = "-sum" then if hist then do; BOTH: call com_err_ (error_table_$inconsistent, COMMAND_NAME, "Cannot specify both -histogram and -summary"); return; end; else summary = "1"b; else if arg = "-from" | arg = "-fm" then from_time = get_time (arg); else if arg = "-to" then to_time = get_time (arg); else if arg = "-interval" then minutes = get_numeric_arg (arg); else if arg = "-line_length" | arg = "-ll" then do; line_length = get_numeric_arg (arg); if line_length < 38 then do; call com_err_ (0, COMMAND_NAME, "Specified line length of ^d is less than allowable minimum of 38.", line_length); return; end; end; else if arg = "-directory" | arg = "-dr" then do; iarg = iarg + 1; call cu_$arg_ptr (iarg, argp, argl, code); if code ^= 0 then do; NO_DIR: call com_err_ (code, COMMAND_NAME, "No directory pathname specified."); return; end; if substr (arg, 1, 1) = "-" then go to NO_DIR; call expand_pathname_ (arg, dirname, entname, code); if code ^= 0 then do; call com_err_ (code, COMMAND_NAME, arg); return; end; dirname = pathname_ (dirname, entname); end; else do; call com_err_ (error_table_$badopt, COMMAND_NAME, arg); return; end; end; end; if ^(hist | summary) then do; call com_err_ (error_table_$noarg, COMMAND_NAME, "one of -histogram or -summary must be specified."); return; end; if to_time ^= 0 then if to_time <= from_time then do; call com_err_ (error_table_$inconsistent, COMMAND_NAME, "Time specified by -to is not later than time specified by -from"); return; end; if ^hist then if minutes ^= 0 | line_length ^= 0 then call com_err_ (0, COMMAND_NAME, "-interval and/or -line_length was specified without -histogram, and will be ignored."); if fnpx = 0 /* no FNPs specified, so do them all */ then fnps (*) = "1"b; idle_value_ptr = null (); earliest_of_all, latest_of_all = 0; star_entry_ptr, star_names_ptr, names_array_ptr = null (); area_infop = addr (auto_area_info); area_info.version = area_info_version_1; string (area_info.control) = "0"b; area_info.owner = COMMAND_NAME; area_info.size = sys_info$max_seg_size; area_info.areap = null (); call define_area_ (area_infop, code); if code ^= 0 then do; call com_err_ (code, COMMAND_NAME, "Could not define area."); return; end; areap = area_info.areap; the_area = empty (); fnp_info_array (*).seg_array_ptr = null (); on cleanup call clean_up_everything; do i = 1 to 8; if fnps (i) then do; infop = addr (fnp_info_array (i)); fnp_name = substr ("abcdefgh", i, 1); ok = "0"b; seg_array_ptr = null (); starname = "fnp_idle_data." || fnp_name || ".**"; call hcs_$star_ (dirname, starname, star_BRANCHES_ONLY, areap, star_entry_count, star_entry_ptr, star_names_ptr, code); if code = error_table_$nomatch then go to NO_DATA; if code ^= 0 then call com_err_ (code, COMMAND_NAME, starname); else do; allocate names_array in (the_area) set (names_array_ptr); do entryx = 1 to star_entry_count; names_array.name_ptr (entryx) = addr (star_names (star_entries (entryx).nindex)); end; call sort_items_$char (names_array_ptr, 32); fnp_histogram_info.total_segs = star_entry_count; seg_count = star_entry_count; allocate seg_array in (the_area) set (seg_array_ptr); fnp_histogram_info.seg_array_ptr = seg_array_ptr; earliest_found, latest_found = "0"b; do segx = 1 to seg_count while (^latest_found); entname = names_array.name_ptr (segx) -> based_entname; call hcs_$initiate (dirname, entname, "", 0, 1, seg_array.segptr (segx), code); if seg_array.segptr (segx) = null () then call com_err_ (code, COMMAND_NAME, "Could not initiate ^a", pathname_ (dirname, entname)); else do; fnp_idle_data_ptr = seg_array.segptr (segx); if to_time ^= 0 then if fnp_idle_data.time_started > to_time then do; call hcs_$terminate_noname (fnp_idle_data_ptr, (0)); seg_array.segptr (segx) = null (); latest_found = "1"b; go to NEXT_SEG; end; if ^earliest_found then do; if from_time ^= 0 then if fnp_idle_data.time_started <= from_time then if fnp_idle_data.last_time <= from_time then do; call hcs_$terminate_noname (fnp_idle_data_ptr, (0)); seg_array.segptr (segx) = null (); go to NEXT_SEG; end; fnp_histogram_info.first_seg_of_interest = segx; earliest_found = "1"b; if earliest_of_all = 0 | fnp_idle_data.time_started < earliest_of_all then earliest_of_all = fnp_idle_data.time_started; end; last_segx = segx; last_start = fnp_idle_data.time_started; last_finish = fnp_idle_data.last_time; if to_time ^= 0 then if last_finish >= to_time then latest_found = "1"b; end; NEXT_SEG: end; if ^earliest_found then go to NO_DATA; ok = "1"b; latest_of_all = max (latest_of_all, to_time, last_finish); fnp_histogram_info.last_seg_of_interest = last_segx; if summary then do; /* we can deal with this right now and be done with it */ fnp_idle_data_ptr = seg_array.segptr (last_segx); if to_time = 0 | fnp_idle_data.last_time <= to_time then do; last_entry = fnp_idle_data.entries_used; closing_time = fnp_idle_data.last_time; end; else do; last_entry = fnp_idle_data.entries_used - divide (fnp_idle_data.last_time - to_time, fnp_idle_data.sample_interval, 17, 0); closing_time = to_time; end; total_entries = last_entry; beginning_found = "0"b; first_segx, segx = last_segx; first_entry = 0; last_idle_count = fnp_idle_data.entries (last_entry).idle_count; last_sample_count = fnp_idle_data.entries (last_entry).sample_count; min_sample = fnp_idle_data.minimum_delta_idle; minimum_time = fnp_idle_data.time_of_minimum_average; min_idle = fnp_idle_data.minimum_idle_count; min_idle_time = fnp_idle_data.time_of_minimum_sample; do while (^beginning_found); if from_time = 0 | fnp_idle_data.time_started > from_time then do; latest_beginning = fnp_idle_data.time_started; do segx = segx - 1 to 1 by -1 while (seg_array.segptr (segx) = null ()); end; if segx < 1 then beginning_found = "1"b; else do; prev_fnp_idle_datap = fnp_idle_data_ptr; /* in case we have to go back to it */ fnp_idle_data_ptr = seg_array.segptr (segx); if latest_beginning - fnp_idle_data.last_time > fnp_idle_data.sample_interval + 30000000 /* 30-second fudge factor */ then do; beginning_found = "1"b; fnp_idle_data_ptr = prev_fnp_idle_datap; /* back to other segment */ end; else do; total_entries = total_entries + fnp_idle_data.entries_used; if fnp_idle_data.minimum_delta_idle < min_sample & fnp_idle_data.time_of_minimum_average >= from_time then do; min_sample = fnp_idle_data.minimum_delta_idle; minimum_time = fnp_idle_data.time_of_minimum_average; end; if fnp_idle_data.minimum_idle_count < min_idle & fnp_idle_data.time_of_minimum_sample >= from_time then do; min_idle = fnp_idle_data.minimum_idle_count; min_idle_time = fnp_idle_data.time_of_minimum_sample; end; end; end; end; else do; beginning_found = "1"b; first_entry = divide (from_time - fnp_idle_data.time_started, fnp_idle_data.sample_interval, 17, 0); total_entries = total_entries - first_entry; end; end; first_entry = first_entry + 1; if total_entries <= 1 | last_entry ^> first_entry then go to NO_DATA; opening_time = max (from_time, fnp_idle_data.time_started); first_idle_count = fnp_idle_data.entries (first_entry).idle_count; first_sample_count = fnp_idle_data.entries (first_entry).sample_count; start_of_minimum_average = minimum_time - fnp_idle_data.sample_interval; total_samples = last_sample_count - first_sample_count; absolute_max = total_samples * fnp_idle_data.maximum_idle_count; overall_average = 100 * float (last_idle_count - first_idle_count) / float (absolute_max); call date_time_ (opening_time, start_time_string); call date_time_ (closing_time, end_time_string); start_string = substr (start_time_string, 1, 16); if substr (end_time_string, 1, 8) = substr (start_time_string, 1, 8) then end_string = substr (end_time_string, 11, 6); else end_string = substr (end_time_string, 1, 16); call ioa_ ("^/FNP ^a idle time from ^a to ^a: ^.1f%", fnp_name, start_string, end_string, overall_average); if start_of_minimum_average >= opening_time & minimum_time <= closing_time then do; average_sample = divide (total_samples, total_entries - 1, 35, 0); minimum_average = 100 * float (min_sample) / float (average_sample * fnp_idle_data.maximum_idle_count); call date_time_ (start_of_minimum_average, min_start_string); call date_time_ (minimum_time, min_end_string); call ioa_ ("Busiest sample interval:^/^a to ^a: ^.1f% idle", substr (min_start_string, 1, 16), substr (min_end_string, 11, 6), minimum_average) ; end; if min_idle_time >= opening_time & min_idle_time <= closing_time then do; call date_time_ (min_idle_time, min_idle_string); call ioa_ ("Busiest single sample: ^a: ^.1f% idle", substr (min_idle_string, 1, 16), 100 * float (min_idle) / float (fnp_idle_data.maximum_idle_count)); end; end; if ^ok then do; NO_DATA: if fnpx ^= 0 then call com_err_$suppress_name (0, COMMAND_NAME, "no data available for FNP ^a", fnp_name) ; if seg_array_ptr ^= null () then call free_segs; fnps (i) = "0"b; end; if star_names_ptr ^= null () then do; free star_names; star_names_ptr = null (); end; if star_entry_ptr ^= null () then do; free star_entries; star_entry_ptr = null (); end; if names_array_ptr ^= null () then do; free names_array; names_array_ptr = null (); end; end; end; end; if hist then do; if minutes = 0 then minutes = 15; /* default */ hist_interval = 60000000 * minutes; /* convert to microseconds */ if earliest_of_all < from_time then earliest_of_all = from_time; if to_time ^= 0 then if latest_of_all > to_time then latest_of_all = to_time; total_intervals = divide (latest_of_all - earliest_of_all, hist_interval, 17, 0); no_of_fnps = 0; do i = 1 to 8; if fnps (i) then no_of_fnps = no_of_fnps + 1; end; if no_of_fnps = 0 then go to ALL_DONE; allocate idle_values in (the_area) set (idle_value_ptr); idle_values (*, *) = -1; /* initialize to value indicating no data */ fnpx = 0; minimum_idle = 100; do fnp_id = 1 to 8; if fnps (fnp_id) then do; fnpx = fnpx + 1; fnp_names (fnpx) = substr ("ABCDEFGH", fnp_id, 1); infop = addr (fnp_info_array (fnp_id)); seg_array_ptr = fnp_histogram_info.seg_array_ptr; next_time = earliest_of_all; valuex = 1; residual = "0"b; do segx = fnp_histogram_info.first_seg_of_interest to fnp_histogram_info.last_seg_of_interest while (next_time < latest_of_all); fnp_idle_data_ptr = seg_array.segptr (segx); if fnp_idle_data_ptr = null () then go to SCAN_NEXT_SEG; if fnp_idle_data.last_time < next_time then go to SCAN_NEXT_SEG; entries_per_interval = divide (hist_interval, fnp_idle_data.sample_interval, 17, 0); if entries_per_interval = 0 /* data is too sparse */ then go to SCAN_NEXT_SEG; last_time_in_seg = fnp_idle_data.last_time; last_entry_in_seg = fnp_idle_data.entries_used; max_idle = fnp_idle_data.maximum_idle_count; if residual then do; if fnp_idle_data.sample_interval = last_interval & fnp_idle_data.time_started - latest_time <= last_interval + 30000000 /* 30-second fudge factor */ & fnp_idle_data.time_started > latest_time then call store_value (last_origin, addr (fnp_idle_data.entries (entries_per_interval - remaining_entries + 1))); else call store_value (last_origin, end_of_last); next_time = next_time + hist_interval; residual = "0"b; end; if fnp_idle_data.time_started > next_time then do; /* we have to skip some */ valuex = valuex + divide (fnp_idle_data.time_started - next_time, hist_interval, 17, 0); next_time = fnp_idle_data.time_started; first_entry = 1; end; else first_entry = divide (next_time - fnp_idle_data.time_started, fnp_idle_data.sample_interval, 17, 0) + 1; last_interval_start = last_entry_in_seg - entries_per_interval + 1; time_to_stop = min (last_time_in_seg, latest_of_all); do entryx = first_entry to last_interval_start by entries_per_interval while (next_time < time_to_stop); next_entryx = entryx + entries_per_interval; if next_entryx <= last_entry_in_seg then call store_value (addr (fnp_idle_data.entries (entryx)), addr (fnp_idle_data.entries (next_entryx))); next_time = next_time + hist_interval; end; if entryx < last_entry_in_seg & next_time < latest_of_all then do; residual = "1"b; latest_time = last_time_in_seg; last_origin = addr (fnp_idle_data.entries (entryx)); end_of_last = addr (fnp_idle_data.entries (last_entry_in_seg)); last_interval = fnp_idle_data.sample_interval; remaining_entries = last_entry_in_seg - entryx + 1; end; SCAN_NEXT_SEG: end; end; end; /* now format it */ if line_length = 0 then do; line_length = get_line_length_$switch (null (), code); if code ^= 0 then line_length = 80; end; scale_marks = max (10 - divide (minimum_idle, 10, 17, 0), 5); top_of_scale = 10 * scale_marks; hist_width = min (100, line_length - 17); hist_width = hist_width - mod (hist_width, scale_marks); cols_per_pct = float (hist_width) / float (top_of_scale); space = divide (hist_width, scale_marks, 17, 0); call ioa_$rsnnl ("^^9x%busy^^2x0^^^d(^^^dd^^)", ioa_str, ioa_strl, scale_marks, space); call ioa_ (substr (ioa_str, 1, ioa_strl), PERCENTS); call ioa_$rsnnl ("^^16x|^^^d(^^^dx|^^)", ioa_str, ioa_strl, scale_marks, space - 1); call ioa_ (substr (ioa_str, 1, ioa_strl)); any = "0"b; prev_date = " "; cur_time = earliest_of_all; suppressed (*) = 0; do line = 1 to total_intervals; cells = 0; do fnp_no = 1 to no_of_fnps; if idle_values (line, fnp_no) ^= -1 then do; cells = cells + 1; output.column (cells) = 17 + fixed (cols_per_pct * (100 - idle_values (line, fnp_no))); output.name (cells) = fnp_names (fnp_no); end; end; if cells = 0 then if any then if last_had_data then do; call ioa_ ("^16(-^)"); last_had_data = "0"b; end; else ; else ; else do; any = "1"b; last_had_data = "1"b; output_line = " "; call date_time_ (cur_time, dt_string); if substr (dt_string, 1, 8) ^= prev_date then prev_date, substr (output_line, 1, 8) = substr (dt_string, 1, 8); substr (output_line, 10, 5) = substr (dt_string, 11, 5); do i = 1 to cells; cur_column = output (i).column; if substr (output_line, cur_column, 1) = " " then substr (output_line, cur_column, 1) = output (i).name; else do; already = index ("ABCDEFGH", substr (output_line, cur_column, 1)); new = index ("ABCDEFGH", output (i).name); if suppressed (already) >= suppressed (new) then suppressed (new) = suppressed (new) + 1; else do; substr (output_line, cur_column, 1) = output (i).name; suppressed (already) = suppressed (already) + 1; end; end; end; call ioa_ (output_line); end; cur_time = cur_time + hist_interval; end; end; ALL_DONE: call clean_up_everything; EXIT: return; get_numeric_arg: procedure (name) returns (fixed bin); dcl name char (*); dcl result fixed bin; iarg = iarg + 1; call cu_$arg_ptr (iarg, argp, argl, code); if code ^= 0 then do; NO_NUMERIC_ARG: call com_err_ (code, COMMAND_NAME, "No value specified for ^a.", name); go to EXIT; end; else if substr (arg, 1, 1) = "-" then do; code = error_table_$noarg; go to NO_NUMERIC_ARG; end; result = cv_dec_check_ (arg, code); if code ^= 0 then do; call com_err_ (0, COMMAND_NAME, "^a is not a valid value for ^a.", arg, name); go to EXIT; end; return (result); end get_numeric_arg; get_time: procedure (arg_name) returns (fixed bin (71)); dcl arg_name char (*); dcl time fixed bin (71); dcl convert_date_to_binary_ entry (char (*), fixed bin (71), fixed bin (35)); iarg = iarg + 1; call cu_$arg_ptr (iarg, argp, argl, code); if code ^= 0 then do; call com_err_ (code, COMMAND_NAME, "No value supplied for ^a", arg_name); go to EXIT; end; call convert_date_to_binary_ (arg, time, code); if code ^= 0 then do; call com_err_ (code, COMMAND_NAME, """^a"" is not a valid time.", arg); go to EXIT; end; else return (time); end get_time; store_value: procedure (first_entryp, last_entryp); dcl first_entryp pointer; dcl last_entryp pointer; dcl delta_sample fixed bin (35); dcl max_possible fixed bin (35); dcl value fixed bin; delta_sample = last_entryp -> fnp_idle_entry.sample_count - first_entryp -> fnp_idle_entry.sample_count; max_possible = delta_sample * max_idle; value = divide (100 * (last_entryp -> fnp_idle_entry.idle_count - first_entryp -> fnp_idle_entry.idle_count), max_possible, 17, 0); idle_values (valuex, fnpx) = value; if value < minimum_idle then minimum_idle = value; valuex = valuex + 1; return; end store_value; clean_up_everything: procedure; dcl infox fixed bin; do infox = 1 to 8; if fnps (infox) then do; infop = addr (fnp_info_array (infox)); seg_array_ptr = fnp_histogram_info.seg_array_ptr; if seg_array_ptr ^= null () then call free_segs; end; end; if idle_value_ptr ^= null () then free idle_values; if star_names_ptr ^= null () then free star_names; if star_entry_ptr ^= null () then free star_entries; if names_array_ptr ^= null () then free names_array; idle_value_ptr, star_entry_ptr, star_names_ptr, names_array_ptr = null (); call release_area_ (areap); return; end clean_up_everything; free_segs: procedure; do segx = 1 to seg_array.no_of_segs; if seg_array.segptr (segx) ^= null () then call hcs_$terminate_noname (seg_array.segptr (segx), (0)); end; free seg_array_ptr -> seg_array; seg_array_ptr, fnp_histogram_info.seg_array_ptr = null (); return; end free_segs; %include fnp_idle_data; %page; %include star_structures; %page; %include area_info; end display_fnp_idle;  fnp_throughput.pl1 10/25/89 1156.0r w 10/25/89 1005.1 65826 /* *********************************************************** * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ /* format: style4,delnl,insnl,^ifthendo */ fnp_throughput: procedure; /* Command to report throughput statistics for one FNP or all FNPs */ /* Usage: fnp_throughput {fnp_name | * {-report_reset}} | {-reset} */ /* written September 1981 by Robert Coren */ /* AUTOMATIC */ dcl nargs fixed bin; dcl code fixed bin (35); dcl chan_name char (1); dcl report bit (1); dcl reset bit (1); dcl iarg fixed bin; dcl fnp_no fixed bin; dcl reported bit (1); dcl time_now fixed bin (71); dcl areap ptr; dcl star_name (1) char (1); dcl n_channels fixed bin; dcl orig_chan_meterp ptr; dcl chanx fixed bin; dcl time_from fixed bin (71); dcl time_interval fixed bin (71); dcl cur_input_chars fixed bin (35); dcl cur_output_chars fixed bin (35); dcl 1 fnp_stats aligned, 2 input_chars fixed bin (35), 2 output_chars fixed bin (35); dcl argp ptr; dcl argl fixed bin (21); dcl arg char (argl) based (argp); /* ENTRIES */ dcl cu_$arg_count entry (fixed bin, fixed bin (35)); dcl com_err_ entry () options (variable); dcl cu_$arg_ptr entry (fixed bin, ptr, fixed bin (21), fixed bin (35)); dcl parse_fnp_name_ entry (char (*), fixed bin); dcl get_system_free_area_ entry () returns (ptr); dcl comm_meters_ entry ((*) char (*), fixed bin, ptr, fixed bin, ptr, fixed bin (35)); dcl comm_meters_$free entry (ptr, ptr, fixed bin (35)); dcl system_info_$timeup entry (fixed bin (71)); dcl ioa_ entry () options (variable); dcl meter_format_$picture entry (fixed bin (35), fixed bin) returns (char (15) var); dcl meter_format_$time entry (fixed bin (71)) returns (char (10)); /* EXTERNAL STATIC */ dcl ( error_table_$wrong_no_of_args, error_table_$badopt, error_table_$noarg, error_table_$inconsistent, error_table_$no_channel_meters ) fixed bin (35) external static; /* INTERNAL STATIC */ dcl CMD_NAME char (14) internal static options (constant) init ("fnp_throughput"); dcl first_time bit (1) internal static init ("1"b); dcl earliest_time fixed bin (71) internal static; dcl 1 prev_fnp_stats (8) aligned internal static like fnp_stats; /* BUILTIN FUNCTIONS */ dcl (substr, clock, max, divide) builtin; call cu_$arg_count (nargs, code); if code ^= 0 then do; call com_err_ (code, CMD_NAME); return; end; if nargs < 1 | nargs > 2 then do; call com_err_ (error_table_$wrong_no_of_args, CMD_NAME, "^/Usage: ^a channel_name {-report_reset} | {-reset}", CMD_NAME); return; end; chan_name = " "; report = "1"b; reset = "0"b; do iarg = 1 to nargs; call cu_$arg_ptr (iarg, argp, argl, code); if substr (arg, 1, 1) = "-" then do; if arg = "-reset" | arg = "-rs" then do; report = "0"b; reset = "1"b; end; else if arg = "-report_reset" | arg = "-rr" then report, reset = "1"b; else do; call com_err_ (error_table_$badopt, CMD_NAME, arg); return; end; end; else do; if chan_name ^= " " then do; call com_err_ (0, CMD_NAME, "More than one FNP name specified."); return; end; if arg = "*" then ; else do; call parse_fnp_name_ (arg, fnp_no); if fnp_no = -1 then do; call com_err_ (0, CMD_NAME, "^a is not a valid FNP name.", arg); return; end; end; chan_name = arg; end; end; if chan_name = " " then if report then do; /* didn't tell us who to get */ call com_err_ (error_table_$noarg, CMD_NAME, "No FNP name supplied."); return; end; else ; else if ^report then do; call com_err_ (error_table_$inconsistent, CMD_NAME, "Cannot specify FNP name and -reset."); return; end; /* Arguments all parsed, now do the real work */ reported = "0"b; if first_time then do; prev_fnp_stats (*) = 0; call system_info_$timeup (earliest_time); first_time = "0"b; end; time_now = clock (); call ioa_ ("Total metering time ^a", meter_format_$time (time_now - earliest_time)); if reset then star_name (1) = "*"; /* need statistics on everyone to reset */ else star_name (1) = chan_name; areap = get_system_free_area_ (); call comm_meters_ (star_name, CHANNEL_METERS_VERSION_1, areap, n_channels, chan_meterp, code); if code ^= 0 /* comm_meters_ calls sub_err_, so don't sweat it */ then return; orig_chan_meterp = chan_meterp; /* we'll need this later for freeing */ do chanx = 1 to n_channels; if channel_meters.multiplexer_type = MCS_MPX /* only ones we're interested in */ then do; call parse_fnp_name_ ((channel_meters.channel_name), fnp_no); /* find out which one this is */ if fnp_no > 0 /* it would be awfully surprising if it weren't */ then do; fnp_meterp = channel_meters.mpx_specific_meterp; fnp_stats.input_chars = channel_meters.cumulative.unconverted_input_chars; fnp_stats.output_chars = channel_meters.cumulative.converted_output_chars; if report /* not just -reset */ then if chan_name = "*" /* we want them all */ | chan_name = channel_meters.channel_name /* or anyway we want this one */ then do; if ^reported then do; call ioa_ ("^35tinput^10xoutput"); reported = "1"b; end; time_from = max (earliest_time, fnp_meters.from_fnp.time_booted); time_interval = divide (time_now - time_from, 1000000, 71, 0); cur_input_chars = fnp_stats.input_chars - prev_fnp_stats (fnp_no).input_chars; cur_output_chars = fnp_stats.output_chars - prev_fnp_stats (fnp_no).output_chars; call ioa_ ("^/FNP ^a -- up ^[for ^a^;time not available^]", channel_meters.channel_name, fnp_meters.from_fnp.time_booted ^= 0, meter_format_$time (time_now - fnp_meters.from_fnp.time_booted)); call ioa_ ("Characters transmitted^29t^a^44t^a", meter_format_$picture (cur_input_chars, 11), meter_format_$picture (cur_output_chars, 11)); call ioa_ ("Characters per second^29t^a^44t^a", meter_format_$picture (divide (cur_input_chars, time_interval, 35, 0), 11), meter_format_$picture (divide (cur_output_chars, time_interval, 35, 0), 11)); end; if reset then prev_fnp_stats (fnp_no) = fnp_stats; end; end; chan_meterp = channel_meters.next_channelp; /* on to next channel */ end; call comm_meters_$free (areap, orig_chan_meterp, code); if code ^= 0 /* unlikely, but we should check */ then call com_err_ (code, CMD_NAME, "From comm_meters_$free"); if report & ^reported /* wanted some display and didn't get it */ then call com_err_ (error_table_$no_channel_meters, CMD_NAME, chan_name); if reset then earliest_time = time_now; return; %include channel_meters; %page; %include fnp_meters; %page; %include multiplexer_types; end fnp_throughput;  hasp_dump_.pl1 07/20/88 1256.8r w 07/19/88 1537.3 157572 /* ****************************************************** * * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * * * ****************************************************** */ /* Interpret a HASP multiplexer database: called from tty_dump and tty_analyze */ /* Created: November 1979 by G. Palter */ /* Modified: December 1980 by G. Palter as part of "loopback bug" fix */ /* Modified: 30 March 1981 by G. Palter to add last_loopback_bcb to HMD */ /* Modified: 16 April 1981 by G. Palter to interpret rts_mode flag in HMD */ /* Modified: July 1981 by G. Palter to support SIGNON processing and metering */ /* Modified: 20 August 1981 by G. Palter to correct bugs in displaying minor-state and loopback stacks */ /* Modified: 29 December 1981 by G. Palter to let the analyze entry print the buffer chain and to properly order calls to the analyzer's check_used procedure which writes into its arguments */ /* Modified: 5 January 1982 by G. Palter to not display the HMD when displaying the HSTE of a single subchannel */ hasp_dump_: procedure (P_ttybp, P_ttyap, P_hmd_ptr, P_subchannel_idx, P_brief_sw); /* Parameters */ dcl P_ttybp pointer parameter; /* -> tty_buf segment */ dcl P_ttyap pointer parameter; /* -> tty_area segment */ dcl P_hmd_ptr pointer parameter; /* hasp_dump_: -> HASP multiplexer data */ dcl P_subchannel_idx fixed binary parameter; /* hasp_dump_: index of sub-channel to dump (-1 for all) */ dcl P_brief_sw bit (1) parameter; /* hasp_dump_: ON => brief output format */ dcl P_devx fixed binary parameter; /* hasp_analyze_: LCT index of HASP multiplexer channel */ dcl P_check_used entry variable parameter; /* hasp_analyze_: tracks space used in tty_buf */ dcl P_long_sw bit (1) parameter; /* hasp_analyze_: ON => long output format */ /* Local copies of parameters */ dcl subchannel_idx fixed binary; dcl brief_sw bit (1); dcl devx fixed binary; dcl check_used entry () options (variable) variable; /* Remaining declarations */ dcl analyze_entry bit (1) aligned; /* ON => hasp_analyze_; OFF => hasp_dump_ */ dcl idx fixed binary; dcl (ioa_, ioa_$nnl) entry () options (variable); dcl tty_dump$print_chain entry (pointer, character (*), fixed binary (18), bit (1)); dcl (addr, binary, currentsize, null, pointer, rel, unspec) builtin; %page; /* Dump a HASP multiplexer database and sub-channels (if requested) */ /* hasp_dump_: entry (P_ttybp, P_ttyap, P_hmd_ptr, P_subchannel_idx, P_brief_sw); */ analyze_entry = "0"b; ttybp = P_ttybp; /* copy parameters */ hmd_ptr = P_hmd_ptr; subchannel_idx = P_subchannel_idx; brief_sw = P_brief_sw; if (subchannel_idx = -1) | (subchannel_idx = 0) then call dump_multiplexer_data (); /* global data only */ else call dump_subchannel_data (subchannel_idx); /* data about one subchannel */ return; /* Analyze a HASP multiplexer database and all sub-channels */ hasp_analyze_: entry (P_ttybp, P_ttyap, P_devx, P_check_used, P_long_sw); analyze_entry = "1"b; ttybp = P_ttybp; /* copy parameters */ devx = P_devx; check_used = P_check_used; brief_sw = ^P_long_sw; /* dump entry works the other way */ lctp = pointer (ttybp, rel (tty_buf.lct_ptr)); lctep = addr (lct.lcte_array (devx)); hmd_ptr = pointer (ttybp, rel (lcte.data_base_ptr)); call dump_multiplexer_data (); do subchannel_idx = 1 to hmd.n_subchannels; call dump_subchannel_data (subchannel_idx); end; call trace_buffer_chain (binary (rel (hmd.output_chain_ptr), 18, 0)); call trace_buffer_chain (binary (rel (hmd.input.first_bufferp), 18, 0)); call trace_buffer_chain (binary (rel (hmd.loopback.first_bufferp), 18, 0)); call trace_buffer_chain (binary (rel (hmd.output_block.first_bufferp), 18, 0)); do idx = 1 to hmd.n_subchannels; hste_ptr = addr (hmd.subchannels (idx)); call trace_buffer_chain (binary (rel (hste.input.first_bufferp), 18, 0)); call trace_buffer_chain (binary (rel (hste.loopback.first_bufferp), 18, 0)); call trace_buffer_chain (binary (rel (hste.output.first_bufferp), 18, 0)); end; call check_used (hmd_ptr, currentsize (hmd)); return; %page; /* Dump the multiplexer's database (and the requested sub-channels also) */ dump_multiplexer_data: procedure (); call ioa_ ("^/HMD at ^o; channel ^a; devx ^o", binary (rel (hmd_ptr), 18, 0), hmd.name, hmd.devx); call ioa_ ("configuration:^/^3xtype = ^[workstation^;host^]; max_block_size = ^d", (hmd.type + 1), hmd.max_block_size); if ^brief_sw then do; /* only in long mode, please... */ call ioa_ ("^3xmax_device_input_records = ^d; max_device_output_records = ^d", hmd.max_device_input_records, hmd.max_device_output_records); call ioa_ ("^3xic_timeout = ^d; receive_timeout = ^d; transmit_timeout = ^d", hmd.ic_timeout, hmd.receive_timeout, hmd.transmit_timeout); end; call ioa_ ("^3xflags:^[ suspend_all_mode^]^[ signon_mode^]^[ multileave_mode^]^[ trace_mode^]^[ rts_mode^]", hmd.suspend_all_mode, hmd.signon_mode, hmd.multileave_mode, hmd.trace_mode, hmd.rts_mode); if ^brief_sw then /* keep it short when requested */ call ioa_ ("loader_process = ^.3b; loader_event = ^.3b", hmd.loader_process_id, unspec (hmd.loader_event_channel)); call ioa_ ("state = ^[down^;loading^;loaded^;started^]; minor_state = ^[send-signon^;wait-signon-response^;normal^;send-sync^;loopback^;reprocess^;send-bad-bcb^;hangup^]", hmd.state, hmd.minor_state); call ioa_ ("foreign_block_count = ^d; foreign_fcs_bytes = ^6.3b; local_block_count = ^d; local_fcs_bytes = ^6.3b", hmd.foreign_block_count, unspec (hmd.foreign_fcs_bytes), hmd.local_block_count, unspec (hmd.local_fcs_bytes)); call ioa_ ("subchannels_for_output.first = ^d; subchannels_for_output.last = ^d", hmd.subchannels_for_output.first, hmd.subchannels_for_output.last); if hmd.output_chain_ptr ^= null () then call ioa_ ("output_chain_ptr = ^p", hmd.output_chain_ptr); if hmd.input.first_bufferp ^= null () then call ioa_ ("input.first_bufferp = ^p; input.last_bufferp = ^p", hmd.input.first_bufferp, hmd.input.last_bufferp); if hmd.loopback.first_bufferp ^= null () then call ioa_ ("loopback.first_bufferp = ^p; loopback.last_bufferp = ^p", hmd.loopback.first_bufferp, hmd.loopback.last_bufferp); if hmd.output_block.first_bufferp ^= null () then call ioa_ ("output_block.subchannel_idx = ^d, output_block.tally = ^d; output_block.first_bufferp = ^p; output_block.last_bufferp = ^p", hmd.output_block.subchannel_idx, hmd.output_block.tally, hmd.output_block.first_bufferp, hmd.output_block.last_bufferp); call ioa_ ("signon_data = ^[none^s^;^p^]; minor_state_stack = ^[none^s^;^p^]; loopback_block_chain_stack = ^[none^s^;^p^]; last_loopback_bcb = ^3.3b", (hmd.signon_data_ptr = null ()), hmd.signon_data_ptr, (hmd.minor_state_stack = null ()), hmd.minor_state_stack, (hmd.loopback_block_chain_stack = null ()), hmd.loopback_block_chain_stack, unspec (hmd.last_loopback_bcb)); call ioa_ ("input_wabs (0:8) =^9(^[ on^; off^]^)", hmd.input_wabs (*)); call ioa_ ("output_wabs (0:8) =^9(^[ on^; off^]^)", hmd.output_wabs (*)); call ioa_ ("send_rts (0:8) = ^9(^[ on^; off^]^)", hmd.send_rts (*)); call ioa_ ("send_rts_ack (0:8) =^9(^[ on^; off^]^)", hmd.send_rts_ack (*)); call ioa_$nnl ("flags:^[ suspend_all_output^]^[ suspend_all_input^]^[ send_output^]^[ input_available^]^[ output_in_progress^]^[ first_foreign_block^]^[ reset_local_block_count^]", hmd.suspend_all_output, hmd.suspend_all_input, hmd.send_output, hmd.flags.input_available, hmd.output_in_progress, hmd.first_foreign_block, hmd.reset_local_block_count); call ioa_ ("^[ retry_transmit_output^]^[ retry_process_output^]^[ retry_process_loopback_records^]^[ retry_process_input^]", retry_transmit_output, hmd.retry_process_output, hmd.retry_process_loopback_records, hmd.retry_process_input); call ioa_ ("console_hste_idx = ^d; n_subchannels = ^d", hmd.console_hste_idx, hmd.n_subchannels); if hmd.output_chain_ptr ^= null () then call tty_dump$print_chain (ttybp, "Output-chain", binary (rel (hmd.output_chain_ptr), 18, 0), brief_sw); if hmd.input.first_bufferp ^= null () then call tty_dump$print_chain (ttybp, "Input-chain", binary (rel (hmd.input.first_bufferp), 18, 0), brief_sw); if hmd.loopback.first_bufferp ^= null () then call tty_dump$print_chain (ttybp, "Loopback-chain", binary (rel (hmd.loopback.first_bufferp), 18, 0), brief_sw); if hmd.output_block.first_bufferp ^= null () then call tty_dump$print_chain (ttybp, "Output-block", binary (rel (hmd.output_block.first_bufferp), 18, 0), brief_sw); if ^brief_sw then /* keep it short */ call dump_multiplexer_meters (); if hmd.signon_data_ptr ^= null () then call dump_signon_data (); if hmd.minor_state_stack ^= null () then call dump_minor_state_stack (); if hmd.loopback_block_chain_stack ^= null () then call dump_loopback_block_chain_stack (); return; end dump_multiplexer_data; %page; /* Print the database for an individual HASP sub-channel */ dump_subchannel_data: procedure (P_subchannel_idx); dcl P_subchannel_idx fixed binary parameter; hste_ptr = addr (hmd.subchannels (P_subchannel_idx)); call ioa_ ("^/HSTE at ^o; channel ^a.^a; devx ^o", binary (rel (hste_ptr), 18, 0), hmd.name, hste.name, hste.devx); call ioa_ ("subchannel_idx = ^d; device_type = ^[console^;reader^;printer^;punch^]; direction = ^[i/o^;input^;output^]", hste.subchannel_idx, hste.device_type, (hste.direction + 1)); call ioa_ ("rcb = ^3.3b; device_wab_idx = ^d", unspec (hste.rcb), hste.device_wab_idx); call ioa_ ("state = ^[hungup^;listening^;dialed^]; minor_state = ^[normal^;send-rts^;wait-rts-ack^]; next_subchannel_for_output = ^d", hste.state, hste.minor_state, hste.next_subchannel_for_output); if hste.input.first_bufferp ^= null () then call ioa_ ("input.n_records = ^d; input.first_bufferp = ^p; input.last_bufferp = ^p", hste.input.n_records, hste.input.first_bufferp, hste.input.last_bufferp); if hste.loopback.first_bufferp ^= null () then call ioa_ ("loopback.n_records = ^d; loopback.first_bufferp = ^p; loopback.last_bufferp = ^p", hste.loopback.n_records, hste.loopback.first_bufferp, hste.loopback.last_bufferp); if hste.output.first_bufferp ^= null () then call ioa_ ("output.first_bufferp = ^p; output.last_bufferp = ^p", hste.output.first_bufferp, hste.output.last_bufferp); call ioa_ ("flags:^[ requested_input^]^[ input_available^]^[ holding_output^]", hste.requested_input, hste.input_available, hste.holding_output); if ^brief_sw then /* keep it short */ call dump_subchannel_meters (); if hste.input.first_bufferp ^= null () then call tty_dump$print_chain (ttybp, "Input-chain", binary (rel (hste.input.first_bufferp), 18, 0), brief_sw); if hste.loopback.first_bufferp ^= null () then call tty_dump$print_chain (ttybp, "Loopback-chain", binary (rel (hste.loopback.first_bufferp), 18, 0), brief_sw); if hste.output.first_bufferp ^= null () then call tty_dump$print_chain (ttybp, "Output-chain", binary (rel (hste.output.first_bufferp), 18, 0), brief_sw); return; end dump_subchannel_data; %page; /* Dump the multiplexer channel's metering data */ dump_multiplexer_meters: procedure (); call ioa_ ("meters:^/^3xtime_mpx_booted = ^.3b; time_meters_copied = ^.3b; saved_meters_ptr = ^p", unspec (hmd.time_mpx_booted), unspec (hmd.time_meters_copied), hmd.saved_meters_ptr); call ioa_ ("^3xn_local_wab_set = ^d; n_input_blocks = ^d; n_input_records = ^d; n_duplicate_input_blocks = ^d", hmd.n_local_wab_set, hmd.n_input_blocks, hmd.n_input_records, hmd.n_duplicate_input_blocks); call ioa_ ("^3xn_foreign_wab_set = ^d; n_output_blocks = ^d; n_output_records = ^d", hmd.n_foreign_wab_set, hmd.n_output_blocks, hmd.n_output_records); call ioa_ ("^3xn_wraparounds = ^d; n_wraparound_blocks = ^d", hmd.n_wraparounds, hmd.n_wraparound_blocks); return; end dump_multiplexer_meters; %page; /* Dump the meters associated with a subchannel */ dump_subchannel_meters: procedure (); call ioa_ ("meters: saved_meters_ptr = ^p", hste.saved_meters_ptr); call ioa_ ("^3xn_local_wab_set = ^d; n_input_records = ^d; n_input_eof_records = ^d", hste.device_n_local_wab_set, hste.device_n_input_records, hste.device_n_input_eof_records); call ioa_ ("^3xn_foreign_wab_set = ^d; n_output_records = ^d; n_output_eof_records = ^d", hste.device_n_foreign_wab_set, hste.device_n_output_records, hste.device_n_output_eof_records); return; end dump_subchannel_meters; %page; /* Dump the SIGNON data associated with this multiplexer */ dump_signon_data: procedure (); hsd_ptr = pointer (ttybp, rel (hmd.signon_data_ptr)); if ^brief_sw then /* keep it short */ call ioa_ ("SIGNON data at ^o:^/^3xsignon_record_process = ^.3b; signon_record_event = ^.3b", binary (rel (hsd_ptr), 18, 0), hmd_signon_data.processid, unspec (hmd_signon_data.event_channel)); if analyze_entry then call check_used (hsd_ptr, currentsize (hmd_signon_data)); return; /* don't bother to dump the actual record */ end dump_signon_data; %page; /* Dump the minor state stack */ dump_minor_state_stack: procedure (); dcl next_msse_ptr pointer; do msse_ptr = pointer (ttybp, rel (hmd.minor_state_stack)) repeat (next_msse_ptr) while (msse_ptr ^= null ()); call dump_msse (); if (msse.previous = null ()) then next_msse_ptr = null (); else next_msse_ptr = pointer (ttybp, rel (msse.previous)); end; return; /* Dump a single entry on the minor state stack */ dump_msse: procedure (); dcl idx fixed binary; call ioa_ ("^/MSSE at ^o; ^[previous = ^p^;last entry^s^]; minor_state = ^[send-signon^;wait-signon-response^;normal^;send-sync^;loopback^;reprocess^;send-bad-bcb^;hangup^]", binary (rel (msse_ptr), 18, 0), (msse.previous ^= null ()), msse.previous, msse.minor_state); do idx = 1 to hmd.n_subchannels; if msse.subchannels(idx).loopback.first_bufferp ^= null () then do; call ioa_ ("^3xSubchannel ^d; loopback.n_records = ^d; loopback.first_bufferp = ^p; loopback.last_bufferp = ^d", idx, msse.subchannels(idx).loopback.n_records, msse.subchannels(idx).loopback.first_bufferp, msse.subchannels(idx).loopback.last_bufferp); call tty_dump$print_chain (ttybp, "Saved loopback records", binary (rel (msse.subchannels(idx).loopback.first_bufferp), 18, 0), brief_sw); if analyze_entry then call trace_buffer_chain (binary (rel (msse.subchannels(idx).loopback.first_bufferp), 18, 0)); end; end; if analyze_entry then call check_used (msse_ptr, currentsize (msse)); return; end dump_msse; end dump_minor_state_stack; %page; /* Dump the loopback block chain stack */ dump_loopback_block_chain_stack: procedure (); dcl next_lbcse_ptr pointer; do lbcse_ptr = pointer (ttybp, rel (hmd.loopback_block_chain_stack)) repeat (next_lbcse_ptr) while (lbcse_ptr ^= null ()); call dump_lbcse (); if (lbcse.previous = null ()) then next_lbcse_ptr = null (); else next_lbcse_ptr = pointer (ttybp, rel (lbcse.previous)); end; return; /* Dump a single entry on the stack */ dump_lbcse: procedure (); call ioa_ ("^/LBCSE at ^o; ^[previous = ^p^;last entry^s^]; first_bufferp = ^p; last_bufferp = ^p", binary (rel (lbcse_ptr), 18, 0), (lbcse.previous ^= null ()), lbcse.previous, lbcse.loopback.first_bufferp, lbcse.loopback.last_bufferp); if lbcse.loopback.first_bufferp ^= null () then do; call tty_dump$print_chain (ttybp, "Saved loopback block chain", binary (rel (lbcse.loopback.first_bufferp), 18, 0), brief_sw); if analyze_entry then call trace_buffer_chain (binary (rel (lbcse.loopback.first_bufferp), 18, 0)); end; if analyze_entry then call check_used (lbcse_ptr, currentsize (lbcse)); return; end dump_lbcse; end dump_loopback_block_chain_stack; %page; /* Trace a chain and buffers and account for the space used */ trace_buffer_chain: procedure (P_chain_offset); dcl P_chain_offset fixed binary (18) parameter; dcl offset fixed binary (18); offset = P_chain_offset; do while (offset ^= 0); if (offset < binary (tty_buf.borig, 18, 0)) then return; /* invalid buffer chain */ blockp = pointer (ttybp, offset); offset = buffer.next; /* following call smashes buffer's contents */ call check_used (blockp, (16 * (binary (buffer.size_code) + 1))); end; return; end trace_buffer_chain; %page; %include hasp_mpx_data; %page; %include hasp_load_data; %page; %include hasp_mpx_meters; %page; %include hasp_subchannel_meters; %page; %include mcs_interrupt_info; %page; %include tty_buf; %page; %include lct; %page; %include tty_buffer_block; end hasp_dump_;  hasp_meters_.pl1 10/25/89 1156.0r w 10/25/89 1005.1 132498 /* *********************************************************** * * * Copyright, (C) Honeywell Information Systems Inc., 1981 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ /* Interpret and otherwise manipulate the meters maintained by the HASP multiplexer for the major channel and its sub-channels */ /* Created: July 1981 by G. Palter */ hasp_meters_: procedure (); return; /* not an entrypoint */ /* Parameters */ dcl P_code fixed binary (35) parameter; dcl P_meters_ptr pointer parameter; /* allocate_*, free_*: -> the structure allocated/freed */ dcl P_area_ptr pointer parameter; /* allocate_*: -> the area to use */ dcl P_channel_name character (*) parameter; /* display_*, *_summary: the channel in question */ dcl P_channel_meters_ptr pointer parameter; /* display_*, *_summary: -> the metering data for the channel */ dcl P_iocb_ptr pointer parameter; /* display_*: the I/O switch to write results */ dcl P_flags bit (36) aligned parameter; /* display_*: controls format/content of the display */ dcl P_since_bootload bit (1) parameter; /* *_summary: ON => give results since bootload */ dcl P_summary_ptr pointer parameter; /* *_summary: -> summary of channels meters */ /* Local copies of parameters */ dcl the_area area based (the_area_ptr); dcl the_area_ptr pointer; dcl output_switch pointer; dcl metering_flags bit (36) aligned; dcl since_bootload bit (1) aligned; /* Remaining declarations */ dcl 1 mpx aligned, /* meters for a HASP multiplexer */ 2 metering_time fixed binary (71), /* amount of time metered */ 2 idle_interval fixed binary, /* # of seconds for each idle loop */ 2 fnp_meters, /* meters extracted from the FNP */ 3 input_naks fixed binary (35), 3 output_naks fixed binary (35), 3 input_timeouts fixed binary (35), 3 output_timeouts fixed binary (35), 3 idle_counter fixed binary (35), /* # of times through the idle loop */ 3 dia_busy_counter fixed binary (35), /* # of NAKs of input messages because DIA hadn't ... */ 2 meters like hasp_mpx_meters; /* ... finished sending the prvious message to Multics */ dcl 1 subchannel aligned, /* meters for a HASP multiplexer sub-channel */ 2 input bit (1) aligned, /* ON => sub-channel is an input (or input/output) device */ 2 output bit (1) aligned, /* ON => sub-channel is an output (or input/output) device */ 2 meters like hasp_subchannel_meters; dcl parent_is_fnp bit (1) aligned; dcl errors_only bit (1) aligned; dcl ONE_SECOND fixed binary (71) static options (constant) initial (1000000); dcl error_table_$noalloc fixed binary (35) external; dcl iox_$user_output pointer external; dcl ioa_$ioa_switch entry () options (variable); dcl meter_format_$picture entry (fixed binary (35), fixed binary) returns (character (15) varying); dcl meter_format_$quotient entry (fixed binary (71), fixed binary (71), character (*)) returns (character (12) varying); dcl area condition; dcl (addr, max, null) builtin; /* */ /* Allocate the metering structure for a HASP multiplexer channel */ allocate_mpx: entry (P_area_ptr, P_meters_ptr, P_code); the_area_ptr = P_area_ptr; P_code = 0; /* assume success */ on condition (area) begin; /* in case there's no room in the area */ P_code = error_table_$noalloc; go to RETURN_FROM_ALLOCATE_MPX; end; allocate hasp_mpx_meters_data in (the_area) set (hmmd_ptr); hasp_mpx_meters_data.version = HASP_MPX_METERS_DATA_VERSION_1; P_meters_ptr = hmmd_ptr; RETURN_FROM_ALLOCATE_MPX: return; /* Free the above structure */ free_mpx: entry (P_meters_ptr, P_code); free P_meters_ptr -> hasp_mpx_meters_data; P_meters_ptr = null (); /* be nice */ P_code = 0; /* always works */ return; /* */ /* Allocate the metering structure for a HASP multiplexer channel */ allocate_subchan: entry (P_area_ptr, P_meters_ptr, P_code); the_area_ptr = P_area_ptr; P_code = 0; /* assume success */ on condition (area) begin; /* in case there's no room in the area */ P_code = error_table_$noalloc; go to RETURN_FROM_ALLOCATE_SUBCHAN; end; allocate hasp_subchannel_meters_data in (the_area) set (hsmd_ptr); hasp_subchannel_meters_data.version = HASP_SUBCHANNEL_METERS_DATA_VERSION_1; P_meters_ptr = hsmd_ptr; RETURN_FROM_ALLOCATE_SUBCHAN: return; /* Free the above structure */ free_subchan: entry (P_meters_ptr, P_code); free P_meters_ptr -> hasp_subchannel_meters_data; P_meters_ptr = null (); /* be nice */ P_code = 0; /* always works */ return; /* */ /* Display the meters accumulated for a HASP multiplexer channel */ display_mpx: entry (P_channel_name, P_iocb_ptr, P_channel_meters_ptr, P_flags, P_code); if P_iocb_ptr ^= null () then /* check for default */ output_switch = P_iocb_ptr; else output_switch = iox_$user_output; chan_meterp = P_channel_meters_ptr; metering_flags = P_flags; P_code = 0; /* always succeeds */ if metering_flags & DISPLAY_MPX_SUMMARY then /* not handled here: let caller do it */ return; if metering_flags & DISPLAY_MPX_BRIEF then /* no brief meters for this multiplexer yet */ return; errors_only = ((metering_flags & DISPLAY_MPX_ERROR) = DISPLAY_MPX_ERROR); since_bootload = ((metering_flags & DISPLAY_MPX_SINCE_BOOT) = DISPLAY_MPX_SINCE_BOOT); call get_multiplexer_meters (); if parent_is_fnp & ^errors_only then /* make an estimate of how much the line is idling ... */ call ioa_$ioa_switch (output_switch, "Idle time^21t^a%", meter_format_$quotient ((100 * ONE_SECOND * mpx.idle_interval * mpx.idle_counter), mpx.metering_time, "^6.2f")); call ioa_$ioa_switch (output_switch, "^34tInput^52tOutput"); if parent_is_fnp then do; /* can report about NAKs and timeouts */ call ioa_$ioa_switch (output_switch, "Blocks NAKed^28t^a^8x^a", meter_format_$picture (mpx.input_naks, 11), meter_format_$picture (mpx.output_naks, 11)); call ioa_$ioa_switch (output_switch, "Transmission timeouts^28t^a^8x^a", meter_format_$picture (mpx.input_timeouts, 11), meter_format_$picture (mpx.output_timeouts, 11)); if ^errors_only then /* tell user about DIA being busy ... */ call ioa_$ioa_switch (output_switch, "NAKs for DIA backlog^28t^a^55tN/A", meter_format_$picture (mpx.dia_busy_counter, 11)); end; if ^errors_only then do; /* remaining meters are all non-error meters */ call ioa_$ioa_switch (output_switch, "All transmission suspended^28t^a^8x^a", meter_format_$picture (mpx.n_local_wab_set, 11), meter_format_$picture (mpx.n_foreign_wab_set, 11)); call ioa_$ioa_switch (output_switch, "Blocks transmitted^28t^a^8x^a", meter_format_$picture (mpx.n_input_blocks, 11), meter_format_$picture (mpx.n_output_blocks, 11)); call ioa_$ioa_switch (output_switch, "Records transmitted^28t^a^8x^a", meter_format_$picture (mpx.n_input_records, 11), meter_format_$picture (mpx.n_output_records, 11)); call ioa_$ioa_switch (output_switch, "^3xAverage records per block^31t^a^8x^a", meter_format_$quotient ((mpx.n_input_records), (mpx.n_input_blocks), "^11.2f"), meter_format_$quotient ((mpx.n_output_records), (mpx.n_output_blocks), "^11.2f")); call ioa_$ioa_switch (output_switch, ""); call ioa_$ioa_switch (output_switch, "Duplicate input blocks^28t^a", meter_format_$picture (mpx.n_duplicate_input_blocks, 11)); call ioa_$ioa_switch (output_switch, "Output reprocessing^28t^a", meter_format_$picture (mpx.n_wraparounds, 11)); call ioa_$ioa_switch (output_switch, "^3xBlocks reprocessed^28t^a", meter_format_$picture (mpx.n_wraparound_blocks, 11)); end; return; /* */ /* Provide the values for a HASP multiplxer channel used by channel_comm_meters -summary */ mpx_summary: entry (P_channel_meters_ptr, P_since_bootload, P_summary_ptr, P_code); chan_meterp = P_channel_meters_ptr; since_bootload = P_since_bootload; summary_ptr = P_summary_ptr; P_code = 0; /* always succeeds */ call get_multiplexer_meters (); if parent_is_fnp then /* all errors are detected by the FNP */ channel_summary.error_count = mpx.input_naks + mpx.output_naks + mpx.input_timeouts + mpx.output_timeouts; else channel_summary.error_count = 0; return; /* */ /* Display the meters accumulated for a HASP multiplexer sub-channel */ display_subchan: entry (P_channel_name, P_iocb_ptr, P_channel_meters_ptr, P_flags, P_code); if P_iocb_ptr ^= null () then /* check for default */ output_switch = P_iocb_ptr; else output_switch = iox_$user_output; chan_meterp = P_channel_meters_ptr; metering_flags = P_flags; P_code = 0; /* always succeeds */ if metering_flags & DISPLAY_MPX_SUMMARY then /* not handled here: let caller do it */ return; if metering_flags & DISPLAY_MPX_BRIEF then /* no brief meters for this multiplexer yet */ return; if metering_flags & DISPLAY_MPX_ERROR then /* no error data at the sub-channel level */ return; since_bootload = ((metering_flags & DISPLAY_MPX_SINCE_BOOT) = DISPLAY_MPX_SINCE_BOOT); call get_subchannel_meters (); call ioa_$ioa_switch (output_switch, "^/^34tInput^52tOutput"); call ioa_$ioa_switch (output_switch, "Transmission suspended^28t^[^a^;^36tN/A^s^]^8x^[^a^;^55tN/A^s^]", subchannel.input, meter_format_$picture (subchannel.device_n_local_wab_set, 11), subchannel.output, meter_format_$picture (subchannel.device_n_foreign_wab_set, 11)); call ioa_$ioa_switch (output_switch, "Files transmitted^28t^[^a^;^36tN/A^s^]^8x^[^a^;^55tN/A^s^]", subchannel.input, meter_format_$picture (subchannel.device_n_input_eof_records, 11), subchannel.output, meter_format_$picture (subchannel.device_n_output_eof_records, 11)); call ioa_$ioa_switch (output_switch, "Records transmitted^28t^[^a^;^36tN/A^s^]^8x^[^a^;^55tN/A^s^]", subchannel.input, meter_format_$picture (subchannel.device_n_input_records, 11), subchannel.output, meter_format_$picture (subchannel.device_n_output_records, 11)); call ioa_$ioa_switch (output_switch, "^3xAverage records per file^31t^[^a^;^36tN/A^3x^s^]^8x^[^a^;^55tN/A^s^]", subchannel.input, meter_format_$quotient ((subchannel.device_n_input_records), max (1, subchannel.device_n_input_eof_records), "^11.2f"), subchannel.output, meter_format_$quotient ((subchannel.device_n_output_records), max (1, subchannel.device_n_output_eof_records), "^11.2f")); return; /* */ /* Provide the values for a HASP multiplxer sub-channel used by channel_comm_meters -summary */ subchan_summary: entry (P_channel_meters_ptr, P_since_bootload, P_summary_ptr, P_code); summary_ptr = P_summary_ptr; channel_summary.error_count = 0; /* no errors occur at the sub-channel level */ P_code = 0; /* always succeeds */ return; /* */ /* Extract the meters for the multiplexer channel */ get_multiplexer_meters: procedure (); dcl 1 total_fnp_meters aligned like mpx.fnp_meters; dcl 1 saved_fnp_meters aligned like mpx.fnp_meters; dcl 1 real_total_fnp_meters aligned based (addr (fnp_chan_meter_struc.current_meters)) like fnp_sync_meters; dcl 1 real_saved_fnp_meters aligned based (addr (fnp_chan_meter_struc.saved_meters)) like fnp_sync_meters; hmmd_ptr = channel_meters.mpx_specific_meterp; if (channel_meters.parent_type = MCS_MPX) then do; /* a real HASP channel */ parent_is_fnp = "1"b; fnp_chan_meterp = channel_meters.parent_meterp; total_fnp_meters.input_naks = real_total_fnp_meters.counters (1); total_fnp_meters.input_timeouts = real_total_fnp_meters.counters (3); total_fnp_meters.output_naks = real_total_fnp_meters.counters (2); total_fnp_meters.output_timeouts = real_total_fnp_meters.counters (4); total_fnp_meters.idle_counter = real_total_fnp_meters.counters (5); total_fnp_meters.dia_busy_counter = real_total_fnp_meters.counters (6); saved_fnp_meters.input_naks = real_saved_fnp_meters.counters (1); saved_fnp_meters.input_timeouts = real_saved_fnp_meters.counters (3); saved_fnp_meters.output_naks = real_saved_fnp_meters.counters (2); saved_fnp_meters.output_timeouts = real_saved_fnp_meters.counters (4); saved_fnp_meters.idle_counter = real_saved_fnp_meters.counters (5); saved_fnp_meters.dia_busy_counter = real_saved_fnp_meters.counters (6); end; else do; parent_is_fnp = "0"b; total_fnp_meters, saved_fnp_meters = 0; end; mpx.idle_interval = hasp_mpx_meters_data.idle_interval; if hasp_mpx_meters_data.time_meters_copied = 0 then /* kludge: I'm not sure when copies happen */ hasp_mpx_meters_data.time_meters_copied = hasp_mpx_meters_data.time_mpx_booted; if since_bootload then do; /* report data since the multiplexer came up */ mpx.metering_time = clock () - hasp_mpx_meters_data.time_mpx_booted; mpx.fnp_meters = total_fnp_meters; mpx.meters = hasp_mpx_meters_data.current_meters; end; else do; /* since last dialup */ mpx.metering_time = clock () - hasp_mpx_meters_data.time_meters_copied; mpx.fnp_meters = total_fnp_meters - saved_fnp_meters; mpx.meters = hasp_mpx_meters_data.current_meters - hasp_mpx_meters_data.saved_meters; end; return; end get_multiplexer_meters; /* */ /* Extract the meters for a sub-channel of the multiplexer */ get_subchannel_meters: procedure (); hsmd_ptr = channel_meters.parent_meterp; subchannel.input = hasp_subchannel_meters_data.report_input_meters; subchannel.output = hasp_subchannel_meters_data.report_output_meters; if since_bootload then /* since the multiplexer came up, please */ subchannel.meters = hasp_subchannel_meters_data.current_meters; else subchannel.meters = hasp_subchannel_meters_data.current_meters - hasp_subchannel_meters_data.saved_meters; return; end get_subchannel_meters; /* */ %include channel_meters; %include comm_meters_disp_flags; %page; %include multiplexer_types; %page; %include hasp_mpx_meters; %page; %include hasp_subchannel_meters; %page; %include fnp_channel_meters; %page; %include channel_summary; end hasp_meters_;  ibm3270_dump_.pl1 01/02/85 2134.1r w 01/02/85 1518.9 60498 /* *********************************************************** * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ /* IBM3270_DUMP_ - Used by tty_dump for 3270 channels */ /* Written May 1979 by Larry Johnson */ ibm3270_dump_: proc (arg_ttybp, arg_ttyap, arg_mdp, arg_subchan, arg_brief_sw); /* Arguments */ dcl arg_ttybp ptr; dcl arg_ttyap ptr; dcl arg_mdp ptr; dcl arg_subchan fixed bin; dcl arg_brief_sw bit (1); /* Automatic */ dcl i fixed bin; dcl last_i fixed bin; dcl subchan fixed bin; dcl quit_key char (3); dcl formfeed_key char (5); /* External */ dcl (ioa_, ioa_$nnl) entry options (variable); dcl (addr, bin, null, rel, unspec) builtin; /* Start of tty_dump code */ ttybp = arg_ttybp; mdp = arg_mdp; subchan = arg_subchan; call ioa_ ("^/MPX DATA at ^o for ^a (devx ^o)", bin (rel (mdp)), md.name, md.devx); call ioa_ ("Boot process ^.3b, channel ^.3b", md.processid, unspec (md.event_channel)); call ioa_ ("Controller addr ^d, poll ^.3b, select ^.3b, general poll ^.3b", md.controller_address, unspec (md.controller_poll_address), unspec (md.controller_select_address), unspec (md.general_poll_address)); call ioa_ ("line type ^d, baud ^d, buf size ^d, buffer pad ^d", md.line_type, md.baud_rate, md.max_buf_size, md.buffer_pad); if md.quit_key = md.pa1 then quit_key = "pa1"; else if md.quit_key = md.pa2 then quit_key = "pa2"; else if md.quit_key = md.pa3 then quit_key = "pa3"; else quit_key = "?"; if md.formfeed_key = md.pa1 then formfeed_key = "pa1"; else if md.formfeed_key = md.pa2 then formfeed_key = "pa2"; else if md.formfeed_key = md.pa3 then formfeed_key = "pa3"; else if md.formfeed_key = md.clear then formfeed_key = "clear"; else formfeed_key = "?"; call ioa_ ("quit key is ""^a"", formfeed key is ""^a"".", quit_key, formfeed_key); call ioa_ (" ADDR SUBCHAN"); do i = 0 to 31; if md.chan_map (i) = -1 then call ioa_ ("^4d^-NONE (input recieved)", i); else if md.chan_map (i) > 0 then call ioa_ ("^4d^-^d", i, md.chan_map (i)); end; call ioa_ ("Last poll ^.3b, last select ^.3b", unspec (md.last_poll_address), unspec (md.last_select_address)); call ioa_$nnl ("Current write channel: ^d", md.cur_write_chan); if md.write_chain_ptr = null () then call ioa_ (""); else call ioa_ (" write chain at ^o", bin (rel (md.write_chain_ptr))); if md.input_chain_ptr ^= null () then call ioa_ ("input chain at ^o, length ^d", bin (rel (md.input_chain_ptr)), md.input_count); call ioa_ ("Flags:^[ ascii^]^[ debug^]^[ loading^]^[ loaded^]^[ started^]^[ poll_in_progress^]^[ output_in_progress^]^[ message_in_progress^]^[ eot_sent^]^[ send_output^]^[ allow_raw3270^]^[ allow_copy^]", md.ascii, md.debug, md.loading, md.loaded, md.started, md.poll_in_progress, md.output_in_progress, md.message_in_progress, md.eot_sent, md.send_output, md.allow_raw3270, md.allow_copy); if md.first_write_chan = 0 then last_i = 0; else do; call ioa_$nnl ("Write queue:"); do i = md.first_write_chan repeat (mde.next_write_chan) while (i ^= 0); mdep = addr (md.mde_entry (i)); call ioa_$nnl (" ^d", i); last_i = i; end; call ioa_ (""); end; if last_i ^= md.last_write_chan then call ioa_ ("Last write chan invalid: is ^d, should be ^d", md.last_write_chan, last_i); if md.first_poll_chan = 0 then last_i = 0; else do; call ioa_$nnl ("Poll queue:"); do i = md.first_poll_chan repeat (mde.next_poll_chan) while (i ^= 0); mdep = addr (md.mde_entry (i)); call ioa_$nnl (" ^d", i); last_i = i; end; call ioa_ (""); end; if last_i ^= md.last_poll_chan then call ioa_ ("Last poll chan invalid: is ^d, should be ^d", md.last_poll_chan, last_i); if md.first_control_chan = 0 then last_i = 0; else do; call ioa_$nnl ("Control queue:"); do i = md.first_control_chan repeat (mde.next_control_chan) while (i ^= 0); mdep = addr (md.mde_entry (i)); call ioa_$nnl (" ^d", i); last_i = i; end; call ioa_ (""); end; if last_i ^= md.last_control_chan then call ioa_ ("Last control chan invalid: is ^d, should be ^d", md.last_control_chan, last_i); if unspec (md.error_stat) ^= "0"b then do; call ioa_ ("Error statistics:"); if md.poll_failed ^= 0 then call ioa_ (" poll failures: ^d", md.poll_failed); if md.bad_output ^= 0 then call ioa_ (" bad output: ^d", md.bad_output); if md.write_eot ^= 0 then call ioa_ (" write eot: ^d", md.write_eot); if md.write_abort ^= 0 then call ioa_ (" write abort: ^d", md.write_abort); if md.select_failed ^= 0 then call ioa_ (" select failures: ^d", md.select_failed); if md.wack_select ^= 0 then call ioa_ (" wack select: ^d", md.wack_select); if md.nak_output ^= 0 then call ioa_ (" nak output: ^d", md.nak_output); if md.input_reject ^= 0 then call ioa_ (" input reject: ^d", md.input_reject); if md.needs_space ^= 0 then call ioa_ (" space needed: ^d", md.needs_space); if md.space_available ^= 0 then call ioa_ (" space available: ^d", md.space_available); if md.write_format_error ^= 0 then call ioa_ (" write format errors: ^d", md.write_format_error); end; if subchan = -1 then do subchan = 1 to md.nchan; call print_mde; end; else call print_mde; call ioa_ (""); return; print_mde: proc; mdep = addr (md.mde_entry (subchan)); call ioa_ ("^/Subchan ^a.^a (devx ^o) address ^.3b", md.name, mde.name, mde.devx, unspec (mde.device_address)); call ioa_ ("screen size ^d, line size ^d, position ^d", mde.screen_size, mde.line_size, mde.position); if mde.write_chain_ptr ^= null () then call ioa_ ("write chain at ^o", bin (rel (mde.write_chain_ptr))); call ioa_ ("Flags:^[ listen^]^[ dialed^]^[ printer^]^[ hndlquit^]^[ waiting_for_ready^]^[ erase_req^]^[ sound_alarm^]^[ control_queued^]^[ end_of_page^]^[ keyboard_restore^]^[ rawo^]^[ rawi^]^[ raw3270^]^[ raw3270_in_effect^]^[ write_queued^]", mde.listen, mde.dialed, mde.printer, mde.hndlquit, mde.waiting_for_ready, mde.erase_req, mde.sound_alarm, mde.control_queued, mde.end_of_page, mde.keyboard_restore, mde.rawo, mde.rawi, mde.raw3270, mde.raw3270_in_effect, mde.write_queued); return; end print_mde; %include tty_buf; %include ibm3270_mpx_data; %include ibm3270_meters; end ibm3270_dump_;  ibm3270_meters_.pl1 10/25/89 1156.0r w 10/25/89 1005.2 83835 /* *********************************************************** * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * *********************************************************** */ /* format: style4,delnl,insnl,^ifthendo */ ibm3270_meters_: procedure; /* This subroutine contains entries for allocating, freeing, and displaying meters for an IBM3270-type multiplexer. Only the _mpx entries are provided, since the ibm3270 multiplexer does not maintain meters on behalf of its subchannels. */ /* Written June 1981 by Robert Coren */ /* PARAMETERS */ dcl a_area_ptr ptr; dcl a_meterp ptr; dcl a_code fixed bin (35); dcl a_chan_name char (*); dcl a_iocbp ptr; dcl a_chan_meterp ptr; dcl a_flags bit (36) aligned; dcl a_since_boot bit (1); dcl a_summary_ptr ptr; /* AUTOMATIC */ dcl areap ptr; dcl code fixed bin (35); dcl iocbp ptr; dcl flags bit (36) aligned; dcl brief bit (1); dcl error bit (1); dcl since_boot bit (1); dcl parent_fnp bit (1); dcl ibm3270_meterp ptr; dcl current_meterp ptr; dcl saved_meterp ptr; dcl current_fnp_meterp ptr; dcl saved_fnp_meterp ptr; dcl poll_failed fixed bin (35); dcl select_failed fixed bin (35); dcl bad_output fixed bin (35); dcl bad_input fixed bin (35); dcl bad_device fixed bin (35); dcl write_format_error fixed bin (35); dcl input_naks fixed bin (35); dcl output_naks fixed bin (35); dcl timeouts fixed bin (35); dcl wack_received fixed bin (35); dcl sent_too_many_naks fixed bin (35); dcl recd_too_many_naks fixed bin (35); dcl eot_no_resp fixed bin (35); dcl total_poll_failed fixed bin (35); dcl total_select_failed fixed bin (35); dcl total_bad_output fixed bin (35); dcl total_bad_input fixed bin (35); dcl total_bad_device fixed bin (35); dcl total_write_format_error fixed bin (35); dcl total_input_naks fixed bin (35); dcl total_output_naks fixed bin (35); dcl total_timeouts fixed bin (35); dcl total_wack_received fixed bin (35); dcl total_sent_too_many_naks fixed bin (35); dcl total_recd_too_many_naks fixed bin (35); dcl total_eot_no_resp fixed bin (35); /* BASED */ dcl m_area area (100) based (areap); /* EXTERNAL STATIC */ dcl error_table_$noalloc external static fixed bin (35); dcl iox_$user_output external static ptr; /* ENTRIES */ dcl ioa_$ioa_switch entry options (variable); dcl meter_format_$picture entry (fixed bin (35), fixed bin) returns (char (15) varying); /* CONDITIONS & BUILTINS */ dcl area condition; dcl (addr, null) builtin; allocate_mpx: entry (a_area_ptr, a_meterp, a_code); areap = a_area_ptr; a_code = 0; on area begin; a_code = error_table_$noalloc; go to exit; end; allocate ibm3270_meter_struc in (m_area) set (a_meterp); a_meterp -> ibm3270_meter_struc.version = IBM3270_METERS_VERSION_1; exit: return; free_mpx: entry (a_meterp, a_code); free a_meterp -> ibm3270_meter_struc; a_code = 0; return; display_mpx: entry (a_chan_name, a_iocbp, a_chan_meterp, a_flags, a_code); iocbp = a_iocbp; if iocbp = null () then iocbp = iox_$user_output; chan_meterp = a_chan_meterp; flags = a_flags; a_code = 0; if flags & DISPLAY_MPX_SUMMARY /* we don't handle this */ then return; if flags & DISPLAY_MPX_BRIEF then brief = "1"b; else brief = "0"b; if flags & DISPLAY_MPX_ERROR then error = "1"b; if flags & DISPLAY_MPX_SINCE_BOOT then since_boot = "1"b; else since_boot = "0"b; if brief then return; /* no "brief" meters from this multiplexer */ call set_values; call ioa_$ioa_switch (iocbp, "^/Poll failures^32t^a", meter_format_$picture (poll_failed, 7)); call ioa_$ioa_switch (iocbp, "Select failures^32t^a", meter_format_$picture (select_failed, 7)); if parent_fnp then do; call ioa_$ioa_switch (iocbp, "Invalid input messages^28t^a", meter_format_$picture (input_naks, 11)); call ioa_$ioa_switch (iocbp, "NAK for output messages^28t^a", meter_format_$picture (output_naks, 11)); call ioa_$ioa_switch (iocbp, "FNP rejected output^28t^a", meter_format_$picture (bad_output, 11)); call ioa_$ioa_switch (iocbp, "Response timeouts^28t^a", meter_format_$picture (timeouts, 11)); call ioa_$ioa_switch (iocbp, "WACKs received^28t^a", meter_format_$picture (wack_received, 11)); call ioa_$ioa_switch (iocbp, "Invalid input limit exceeded^32t^a", meter_format_$picture (sent_too_many_naks, 7)); call ioa_$ioa_switch (iocbp, "Received NAK limit exceeded^32t^a", meter_format_$picture (recd_too_many_naks, 7)); call ioa_$ioa_switch (iocbp, "FNP sent EOT^32t^a", meter_format_$picture (eot_no_resp, 7)); end; call ioa_$ioa_switch (iocbp, "Incorrect output format^32t^a", meter_format_$picture (write_format_error, 7)); call ioa_$ioa_switch (iocbp, "Unrecognized input^32t^a", meter_format_$picture (bad_input, 7)); call ioa_$ioa_switch (iocbp, "Unrecognized device^32t^a", meter_format_$picture (bad_device, 7)); return; mpx_summary: entry (a_chan_meterp, a_since_boot, a_summary_ptr, a_code); /* entry to fill in values used by channel_comm_meters -summary */ a_code = 0; chan_meterp = a_chan_meterp; summary_ptr = a_summary_ptr; since_boot = a_since_boot; call set_values; channel_summary.error_count = poll_failed + select_failed + bad_input + bad_device; if parent_fnp then channel_summary.error_count = channel_summary.error_count + input_naks + output_naks + eot_no_resp; return; set_values: procedure; /* internal procedure to set metering values (either cumulative or since load */ ibm3270_meterp = channel_meters.mpx_specific_meterp; if channel_meters.parent_type = MCS_MPX /* if parent is an FNP */ then do; /* then we know something about the next level of metering */ fnp_chan_meterp = channel_meters.parent_meterp; current_fnp_meterp = addr (fnp_chan_meter_struc.current_meters); saved_fnp_meterp = addr (fnp_chan_meter_struc.saved_meters); parent_fnp = "1"b; end; else parent_fnp = "0"b; current_meterp = addr (ibm3270_meterp -> ibm3270_meter_struc.current_meters); saved_meterp = addr (ibm3270_meterp -> ibm3270_meter_struc.saved_meters); total_poll_failed = current_meterp -> ibm3270_meters.poll_failed; total_bad_output = current_meterp -> ibm3270_meters.bad_output; total_select_failed = current_meterp -> ibm3270_meters.select_failed; total_write_format_error = current_meterp -> ibm3270_meters.write_format_error; total_bad_input = current_meterp -> ibm3270_meters.bad_input; total_bad_device = current_meterp -> ibm3270_meters.bad_device; if parent_fnp then do; total_input_naks = current_fnp_meterp -> fnp_sync_meters.counters (1); total_output_naks = current_fnp_meterp -> fnp_sync_meters.counters (2); total_timeouts = current_fnp_meterp -> fnp_sync_meters.counters (3); total_sent_too_many_naks = current_fnp_meterp -> fnp_sync_meters.counters (4); total_wack_received = current_fnp_meterp -> fnp_sync_meters.counters (5); total_recd_too_many_naks = current_fnp_meterp -> fnp_sync_meters.counters (6); total_eot_no_resp = current_fnp_meterp -> fnp_sync_meters.counters (7); end; if since_boot then do; poll_failed = total_poll_failed; bad_output = total_bad_output; select_failed = total_select_failed; write_format_error = total_write_format_error; bad_input = total_bad_input; bad_device = total_bad_device; if parent_fnp then do; input_naks = total_input_naks; output_naks = total_output_naks; timeouts = total_timeouts; sent_too_many_naks = total_sent_too_many_naks; wack_received = total_wack_received; recd_too_many_naks = total_recd_too_many_naks; eot_no_resp = total_eot_no_resp; end; end; else do; poll_failed = total_poll_failed - saved_meterp -> ibm3270_meters.poll_failed; bad_output = total_bad_output - saved_meterp -> ibm3270_meters.bad_output; select_failed = total_select_failed - saved_meterp -> ibm3270_meters.select_failed; write_format_error = total_write_format_error - saved_meterp -> ibm3270_meters.write_format_error; bad_input = total_bad_input - saved_meterp -> ibm3270_meters.bad_input; bad_device = total_bad_device - saved_meterp -> ibm3270_meters.bad_device; if parent_fnp then do; input_naks = total_input_naks - saved_fnp_meterp -> fnp_sync_meters.counters (1); output_naks = total_output_naks - saved_fnp_meterp -> fnp_sync_meters.counters (2); timeouts = total_timeouts - saved_fnp_meterp -> fnp_sync_meters.counters (3); sent_too_many_naks = total_sent_too_many_naks - saved_fnp_meterp -> fnp_sync_meters.counters (4); wack_received = total_wack_received - saved_fnp_meterp -> fnp_sync_meters.counters (5); recd_too_many_naks = total_recd_too_many_naks - saved_fnp_meterp -> fnp_sync_meters.counters (6); eot_no_resp = total_eot_no_resp - saved_fnp_meterp -> fnp_sync_meters.counters (7); end; end; end set_values; %include multiplexer_types; %page; %include ibm3270_meters; %page; %include comm_meters_disp_flags; %page; %include channel_meters; %page; %include fnp_channel_meters; %page; %include channel_summary; end ibm3270_meters_;  lap_dump_.pl1 08/08/88 1522.2rew 08/08/88 1400.0 30771 /****^ ************************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1988 * * * * Copyright, (C) Massachusetts Institute of Technology, 1983 * * * ************************************************************** */ /* format: style4,delnl,insnl,ifthenstmt,indnoniterend */ lap_dump_: procedure (P_ttybp, P_areap, P_lap_data_ptr, P_subchannel, P_brief); /* Created 1983 February by Olin Sibert to support LAP multiplexers. */ /****^ HISTORY COMMENTS: 1) change(88-07-07,Beattie), approve(88-06-27,MCR7926), audit(88-07-22,Brunelle), install(88-08-08,MR12.2-1082): Prepared for installation. END HISTORY COMMENTS */ lap_data_ptr = P_lap_data_ptr; call ioa_ ("LAP channel ^a, devx ^d (subchannel devx ^d)", lap_data.name, lap_data.devx, lap_data.subchannel); call ioa_ ("State is ^[hungup^;listening^;active^]. Flags: ^[send_output ^]^[started ^]", (lap_data.state + 1), lap_data.send_output, lap_data.simplex_started); call ioa_ ("Activate order: ^24.3b", unspec (lap_data.activate_order)); call ioa_ ("Dialup info: ^24.3b", unspec (lap_data.dialup_info)); call ioa_ ("SC dialup info: ^24.3b", unspec (lap_data.sc_dialup_info)); call ioa_ ("Max frame size: ^d chars. ^[No frame pending.^;Pending frame:^]", lap_data.max_frame_size, (lap_data.frame_start = null ())); if (lap_data.frame_start ^= null ()) then do; call ioa_ ("Frame at ^p is ^d chars^[ ready for sending^]:", lap_data.frame_start, lap_data.frame_size, lap_data.frame_ready); call tty_dump$print_chain (P_ttybp, "", binary (rel (lap_data.frame_start), 18), (P_brief)); end; call ioa_ (""); return; %page; lap_analyze_: entry (P_ttybp, P_areap, P_devx, P_check_used, P_long); lctp = pointer (P_ttybp, rel (P_ttybp -> tty_buf.lct_ptr)); lctep = addr (lct.lcte_array (P_devx)); lap_data_ptr = pointer (P_ttybp, rel (lcte.data_base_ptr)); call lap_dump_ (P_ttybp, P_areap, lap_data_ptr, -1, (^P_long)); if (lap_data.frame_start ^= null ()) then do; buffer_offset = binary (rel (lap_data.frame_start), 18); do while ((buffer_offset ^= 0) & (buffer_offset < 261120)); blockp = pointer (P_ttybp, buffer_offset); buffer_offset = buffer.next; call P_check_used (blockp, (16 * (1 + binary (buffer.size_code, 3)))); end; end; call P_check_used (lap_data_ptr, size (lap_data)); return; %page; dcl P_ttybp pointer parameter; dcl P_areap pointer parameter; dcl P_lap_data_ptr pointer parameter; dcl P_subchannel fixed bin parameter; dcl P_brief bit (1) aligned parameter; dcl P_devx fixed bin parameter; dcl P_check_used entry (pointer, fixed bin) parameter; dcl P_long bit (1) aligned parameter; dcl buffer_offset fixed bin (18); dcl ioa_ entry () options (variable); dcl tty_dump$print_chain entry (ptr, char (*), fixed bin, bit (1)); dcl (addr, binary, null, pointer, rel, size, unspec) builtin; %page; %include lap_simplex_data; %page; %include lap_line_info; %page; %include mcs_interrupt_info; %page; %include tty_buf; %page; %include lct; %page; %include tty_buffer_block; end lap_dump_;  mcs_meters_.pl1 08/05/87 0757.9r 08/04/87 1540.7 232542 /* *********************************************************** * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ /* format: style4,delnl,insnl,^ifthendo */ mcs_meters_: procedure; /* This procedure contains entries to allocate and free metering structures, and to display meters, for MCS FNPs and their subchannels. */ /* Written February 1981 by Robert Coren */ /* Modified May 1981 by Robert Coren for new iom_data format */ /* Modified August 1981 by Robert Coren to add buffer preallocation information. */ /* Modified September 1981 by Robert Coren to add fnp-wide throughput statistics and to suppress mpx meters kept in FNP if all 0 */ return; /* main entry should never be called */ /* PARAMETERS */ dcl a_area_ptr pointer; /* pointer to area in which to perform allocations */ dcl a_meterp pointer; /* pointer to structure to be allocated/freed (OUTPUT for alloc, INPUT for free */ dcl a_chan_name char (32); /* for display entries */ dcl a_iocbp pointer; /* likewise */ dcl a_chan_meterp pointer; /* likewise, pointer to channel meters structure */ dcl a_flags bit (36) aligned; /* likewise */ dcl a_since_boot bit (1); /* for summary entry */ dcl a_summary_ptr pointer; /* likewise, structure to be filled in */ dcl a_code fixed bin (35); /* status code (OUTPUT) */ /* AUTOMATIC */ dcl areap pointer; dcl code fixed bin (35); dcl iocbp pointer; dcl flags bit (36) aligned; dcl brief bit (1); dcl error bit (1); dcl since_boot bit (1); dcl synchronous bit (1); dcl multiplexed bit (1); dcl pool fixed bin (35); dcl avg_space_available fixed bin (35); dcl fnp_meters_available bit (1); dcl time_up fixed bin (71); dcl input_chars fixed bin (35); dcl output_chars fixed bin (35); dcl meter_time fixed bin (71); dcl char_time char (10); dcl cur_ptrs (2) pointer; dcl prev_ptrs (2) pointer; dcl cpu_time fixed bin (71); dcl n_interrupts fixed bin (35); dcl interrupt_time fixed bin (71); dcl iom_data_len fixed bin (19); dcl iomx fixed bin; dcl current_meterp pointer; dcl saved_meterp pointer; dcl max_possible_idle_count fixed bin (35); dcl total_dia_q_len fixed bin (35); dcl total_dia_q_updates fixed bin (35); dcl total_pending_status fixed bin (35); dcl total_status_updates fixed bin (35); dcl total_output_overlaps fixed bin (35); dcl total_parity_errors fixed bin (35); dcl total_ssqo fixed bin (35); dcl total_hsqo fixed bin (35); dcl total_alloc_failures fixed bin (35); dcl total_input_messages fixed bin (35); dcl total_input_length fixed bin (35); dcl total_output_messages fixed bin (35); dcl total_output_length fixed bin (35); dcl total_pre_exhaust fixed bin (35); dcl total_exhaust fixed bin (35); dcl total_echo_overflows fixed bin (35); dcl total_xte fixed bin (35); dcl total_bell_quits fixed bin (35); dcl total_counters (8) fixed bin (35); dcl dia_q_len fixed bin (35); dcl dia_q_updates fixed bin (35); dcl pending_status fixed bin (35); dcl status_updates fixed bin (35); dcl output_overlaps fixed bin (35); dcl parity_errors fixed bin (35); dcl ssqo fixed bin (35); dcl hsqo fixed bin (35); dcl alloc_failures fixed bin (35); dcl input_messages fixed bin (35); dcl input_length fixed bin (35); dcl output_messages fixed bin (35); dcl output_length fixed bin (35); dcl pre_exhaust fixed bin (35); dcl exhaust fixed bin (35); dcl echo_overflows fixed bin (35); dcl xte fixed bin (35); dcl bell_quits fixed bin (35); dcl counters (8) fixed bin (35); /* BASED */ dcl m_area area (256) based (areap); dcl based_time fixed bin (71) based; /* ENTRIES */ dcl ioa_$ioa_switch entry options (variable); dcl meter_format_$time entry (fixed bin (71)) returns (char (10)); dcl meter_format_$picture entry (fixed bin (35), fixed bin) returns (char (15) varying); dcl meter_format_$quotient entry (fixed bin (71), fixed bin (71), char (*)) returns (char (12) varying); dcl metering_util_$define_regions entry options (variable); dcl metering_util_$fill_buffers entry (fixed bin, fixed bin (71), char (10), (*) pointer, (*) pointer, fixed bin (35)); dcl ring_zero_peek_$get_max_length entry (char (*), fixed bin (19), fixed bin (35)); /* EXTERNAL STATIC */ dcl iox_$user_output pointer external static; dcl error_table_$noalloc fixed bin (35) external static; /* INTERNAL STATIC */ dcl defined bit (1) internal static init ("0"b); /* indicates whether metering_util_$define_regions has been called */ dcl mu_index fixed bin internal static; /* CONDITIONS AND BUILTINS */ dcl area condition; dcl (clock, divide, bin, size, null, hbound, addr, unspec) builtin; allocate_subchan: entry (a_area_ptr, a_meterp, a_code); /* entry to allocate a fnp_channel_meters structure */ areap = a_area_ptr; a_code = 0; on area begin; a_code = error_table_$noalloc; go to exit; end; allocate fnp_chan_meter_struc in (m_area) set (a_meterp); a_meterp -> fnp_chan_meter_struc.version = FNP_CHANNEL_METERS_VERSION_1; exit: return; allocate_mpx: entry (a_area_ptr, a_meterp, a_code); /* entry to allocate a fnp_meters structure */ areap = a_area_ptr; a_code = 0; on area begin; a_code = error_table_$noalloc; go to exit; end; allocate fnp_meters in (m_area) set (a_meterp); a_meterp -> fnp_meters.version = FNP_METERS_VERSION_2; return; free_subchan: entry (a_meterp, a_code); /* entry to free the fnp_channel_meters structure */ fnp_chan_meterp = a_meterp; free fnp_chan_meter_struc; a_code = 0; return; free_mpx: entry (a_meterp, a_code); /* entry to free the fnp_meters structure */ fnp_meterp = a_meterp; free fnp_meters; a_code = 0; return; display_mpx: entry (a_chan_name, a_iocbp, a_chan_meterp, a_flags, a_code); /* entry to display meters for a whole FNP */ call setup_display; fnp_meterp = channel_meters.mpx_specific_meterp; fnp_meters_available = (unspec (fnp_meters.from_fnp) ^= "0"b); time_up = clock () - fnp_meters.from_fnp.time_booted; input_chars = channel_meters.cumulative.unconverted_input_chars; output_chars = channel_meters.cumulative.converted_output_chars; if ^error then do; if fnp_meters_available then do; if ^brief then call ioa_$ioa_switch (iocbp, "FNP has been up for^35t^a", meter_format_$time (time_up)); call ioa_$ioa_switch (iocbp, "Number of channels configured^35t^6d", fnp_meters.n_channels); call ioa_$ioa_switch (iocbp, "Average number dialed up^38t^a", meter_format_$quotient ((fnp_meters.from_fnp.channels_dialed_cum), (fnp_meters.from_fnp.channels_dialed_updates), "^5.1f")); max_possible_idle_count = fnp_meters.from_fnp.max_idle_count * fnp_meters.from_fnp.idle_count_updates; call ioa_$ioa_switch (iocbp, "FNP idle^39t^a%", meter_format_$quotient (100 * fnp_meters.from_fnp.total_idle_count, (max_possible_idle_count), "^4.1f")); call ioa_$ioa_switch (iocbp, "Idle at peak load^39t^a%", meter_format_$quotient (100 * fnp_meters.from_fnp.min_idle_count, (fnp_meters.from_fnp.max_idle_count), "^4.1f")); end; call ioa_$ioa_switch (iocbp, "^/^37tInput^52tOutput"); call ioa_$ioa_switch (iocbp, "Characters transmitted^30t^a^46t^a", meter_format_$picture (input_chars, 11), meter_format_$picture (output_chars, 11)); call ioa_$ioa_switch (iocbp, "Characters per second^30t^a^46t^a^/", meter_format_$picture (divide (1000000 * input_chars, time_up, 35, 0), 11), meter_format_$picture (divide (1000000 * output_chars, time_up, 35, 0), 11)); end; if ^brief & fnp_meters_available then do; call ioa_$ioa_switch (iocbp, "Abnormal DIA status ^35t^a", meter_format_$picture ((fnp_meters.from_fnp.abnormal_dia_status), 6)); call ioa_$ioa_switch (iocbp, "Memory EDAC errors^35t^a", meter_format_$picture (fnp_meters.from_fnp.memory_parity_errors, 6)); end; if ^error then call ioa_$ioa_switch (iocbp, "^/Memory size^38t^3dK", divide (fnp_meters.fnp_mem_size, 1024, 17, 0)); if fnp_meters_available then do; if ^error then do; pool = fnp_meters.from_fnp.buffer_pool; call ioa_$ioa_switch (iocbp, "Total available buffer pool^35t^a words", meter_format_$picture (pool, 6)); avg_space_available = divide (fnp_meters.from_fnp.space_available_cum, fnp_meters.from_fnp.space_available_updates, 35, 0); call ioa_$ioa_switch (iocbp, "Avg. amount of free space^35t^a words", meter_format_$picture (avg_space_available, 6)); call ioa_$ioa_switch (iocbp, "Average % of buffer pool available^38t^a", meter_format_$quotient (100 * avg_space_available, (pool), "^5.1f")); call ioa_$ioa_switch (iocbp, "Number of buffer allocations^32t^a", meter_format_$picture (fnp_meters.from_fnp.buffer_allocations, 9)); call ioa_$ioa_switch (iocbp, "Number of buffers preallocated^32t^a (^a% of allocations)", meter_format_$picture (fnp_meters.from_fnp.buffers_preallocated, 9), meter_format_$quotient (100 * fnp_meters.from_fnp.buffers_preallocated, (fnp_meters.from_fnp.buffer_allocations), "^5.1f")); call ioa_$ioa_switch (iocbp, "Used preallocated buffer^32t^a", meter_format_$picture (fnp_meters.from_fnp.used_preallocated_buffer, 9)); end; call ioa_$ioa_switch (iocbp, "No preallocated buffer available^35t^a", meter_format_$picture (fnp_meters.from_fnp.no_preallocated_available, 6)); call ioa_$ioa_switch (iocbp, "Buffer allocation failures^35t^a", meter_format_$picture ((fnp_meters.from_fnp.space_alloc_failures), 6)); end; if ^brief then do; call ioa_$ioa_switch (iocbp, "Output restricted by space^35t^a", meter_format_$picture ((fnp_meters.fnp_space_restricted_output), 6)); if ^error then do; if ^defined /* if we've never gotten this info before */ then do; call ring_zero_peek_$get_max_length ("iom_data", iom_data_len, code); call metering_util_$define_regions (mu_index, code, "tc_data", "processor_time", 2, "iom_data", 0, iom_data_len); if code = 0 then defined = "1"b; end; call metering_util_$fill_buffers (mu_index, meter_time, char_time, cur_ptrs, prev_ptrs, code); if code = 0 then cpu_time = cur_ptrs (1) -> based_time; else cpu_time = 0; /* an unlikely screwup -- metering_util_ would call sub_err_ */ /* now get the interupt traffic information for the IOM channel the FNP is on */ n_interrupts, interrupt_time = 0; iom_data_ptr = cur_ptrs (2); iomx = iom_data.per_iom (fnp_meters.iom_number).chantab (fnp_meters.iom_chan_no); if iomx ^= 0 /* it had better not be */ then do; n_interrupts = iom_data.per_device (iomx).interrupts; interrupt_time = iom_data.per_device (iomx).interrupt_time; end; call ioa_$ioa_switch (iocbp, "^/Number of interrupts from this FNP^38t^a", meter_format_$picture (n_interrupts, 11)); call ioa_$ioa_switch (iocbp, "Avg. time/interrupt (ms)^38t^a", meter_format_$quotient (interrupt_time, 1000 * n_interrupts, "^6.1f")); call ioa_$ioa_switch (iocbp, "% of total CPU time^38t^a", meter_format_$quotient (100 * interrupt_time, cpu_time, "^6.1f")); call ioa_$ioa_switch (iocbp, "^/Mailbox transactions:^/^3xInput data^36t^a", meter_format_$picture (fnp_meters.input_data_transactions, 10)); call ioa_$ioa_switch (iocbp, "^3xOutput data^36t^a", meter_format_$picture (fnp_meters.output_data_transactions, 10)); call ioa_$ioa_switch (iocbp, "^3xInput control^36t^a", meter_format_$picture (fnp_meters.input_control_transactions, 10)); call ioa_$ioa_switch (iocbp, "^3xOutput control^36t^a", meter_format_$picture (fnp_meters.output_control_transactions, 10)); call ioa_$ioa_switch (iocbp, "^60(-^)^/^3xTotal^36t^a", meter_format_$picture (fnp_meters.input_data_transactions + fnp_meters.output_data_transactions + fnp_meters.input_control_transactions + fnp_meters.output_control_transactions, 10)); if fnp_meters_available then call ioa_$ioa_switch (iocbp, "^/Average inbound mailboxes in use^39t^a", meter_format_$quotient ((fnp_meters.from_fnp.input_mbx_in_use_cum), (fnp_meters.from_fnp.input_mbx_updates), "^4.1f")); call ioa_$ioa_switch (iocbp, "Average outbound mailboxes in use^39t^a", meter_format_$quotient ((fnp_meters.output_mbx_in_use_cum), (fnp_meters.output_mbx_updates), "^4.1f")); call ioa_$ioa_switch (iocbp, "Maximum outbound mailboxes in use^39t^2d", fnp_meters.max_output_mbx_in_use); end; call ioa_$ioa_switch (iocbp, "No outbound mailbox available^36t^a", meter_format_$picture (fnp_meters.output_mbx_unavailable, 5)); call ioa_$ioa_switch (iocbp, "Input rejects^36t^a", meter_format_$picture ((fnp_meters.input_rejects), 5)); call ioa_$ioa_switch (iocbp, "% of input transactions rejected^38t^a", meter_format_$quotient (100 * fnp_meters.input_rejects, (fnp_meters.input_data_transactions), "^5.2f") ); end; return; display_subchan: entry (a_chan_name, a_iocbp, a_chan_meterp, a_flags, a_code); /* entry to display meters kept by an FNP for one of its subchannels */ call setup_display; if flags & DISPLAY_MPX_SINCE_BOOT then since_boot = "1"b; else since_boot = "0"b; call set_subchan_values; if synchronous then do; if ^error then do; call ioa_$ioa_switch (iocbp, "^/^34tinput^45toutput"); call ioa_$ioa_switch (iocbp, "Messages transmitted^28t^a^40t^a", meter_format_$picture (input_messages, 11), meter_format_$picture (output_messages, 11)); call ioa_$ioa_switch (iocbp, "Minimum message length^34t^a^46t^a", meter_format_$picture ((current_meterp -> fnp_sync_meters.input.min_length), 5), meter_format_$picture ((current_meterp -> fnp_sync_meters.output.min_length), 5)); call ioa_$ioa_switch (iocbp, "Maximum message length^32t^a^44t^a", meter_format_$picture ((current_meterp -> fnp_sync_meters.input.max_length), 7), meter_format_$picture ((current_meterp -> fnp_sync_meters.output.max_length), 7)); call ioa_$ioa_switch (iocbp, "Average message length^32t^a^44t^a", meter_format_$quotient ((input_length), (input_messages), "^9.2f"), meter_format_$quotient ((output_length), (output_messages), "^9.2f")); end; if ^multiplexed then do; call ioa_$ioa_switch (iocbp, "Invalid input messages^28t^a (^a% of messages)", meter_format_$picture (counters (1), 11), meter_format_$quotient (counters (1) * 100, (input_messages), "^.2f")); call ioa_$ioa_switch (iocbp, "Rejected output messages^28t^a (^a% of messages)", meter_format_$picture (counters (2), 11), meter_format_$quotient (counters (2) * 100, (output_messages), "^.2f")); call ioa_$ioa_switch (iocbp, "Timeouts^28t^a", meter_format_$picture (counters (3), 11)); if ^brief then do; if channel_meters.line_type = LINE_G115 then do; call ioa_$ioa_switch (iocbp, "Input busy^30t^a", meter_format_$picture (counters (4), 9)); call ioa_$ioa_switch (iocbp, "Output retries exceeded limit^32t^a", meter_format_$picture (counters (5), 7)); call ioa_$ioa_switch (iocbp, "No SOH or ETX in message^32t^a", meter_format_$picture (counters (6), 7)); call ioa_$ioa_switch (iocbp, "Output message too long^32t^a", meter_format_$picture (counters (7), 7)); call ioa_$ioa_switch (iocbp, "Failure to build message^32t^a", meter_format_$picture (counters (8), 7)); end; else if channel_meters.line_type = LINE_BSC then do; if ^error then do; call ioa_$ioa_switch (iocbp, "WACKs sent^30t^a", meter_format_$picture (counters (4), 9)); call ioa_$ioa_switch (iocbp, "WACKs received^30t^a", meter_format_$picture (counters (5), 9)); end; call ioa_$ioa_switch (iocbp, "Output retries exceeded limit^32t^a", meter_format_$picture (counters (6), 7)); call ioa_$ioa_switch (iocbp, "Unrecognized or missing response^30t^a", meter_format_$picture (counters (7), 9)); call ioa_$ioa_switch (iocbp, "Line bid failed^32t^a", meter_format_$picture (counters (8), 7)); end; end; end; end; if channel_meters.line_type = LINE_X25LAP then do; call ioa_$ioa_switch (iocbp, "^/Frames dumped:^32t^a", meter_format_$picture (counters (3), 7)); call ioa_$ioa_switch (iocbp, "Frames retransmitted:^32t^a", meter_format_$picture (counters (1), 7)); call ioa_$ioa_switch (iocbp, "Receiver reset request:^32t^a", meter_format_$picture (counters (4), 7)); call ioa_$ioa_switch (iocbp, "Transmitter reset:^32t^a", meter_format_$picture (counters (2), 7)); call ioa_$ioa_switch (iocbp, "Frame check errors:^32t^a", meter_format_$picture (counters (5), 7)); call ioa_$ioa_switch (iocbp, "Frame aborts received:^32t^a", meter_format_$picture (counters (6), 7)); end; if ^error & ^brief then do; call ioa_$ioa_switch (iocbp, "^/Output overlaps in FNP^33t^a", meter_format_$picture (output_overlaps, 7)); call ioa_$ioa_switch (iocbp, "Average length of DIA request queue^36t^a", meter_format_$quotient ((dia_q_len), (dia_q_updates), "^4.1f")); end; if brief then return; /* everything else is ^brief */ else call ioa_$ioa_switch (iocbp, ""); call ioa_$ioa_switch (iocbp, "Exhaust status^31t^a", meter_format_$picture (exhaust, 9)); call ioa_$ioa_switch (iocbp, "Software transfer timing error^31t^a", meter_format_$picture (xte, 9)); if ^synchronous then do; if ^error then call ioa_$ioa_switch (iocbp, "Pre-exhaust status^31t^a", meter_format_$picture (pre_exhaust, 9)); call ioa_$ioa_switch (iocbp, "Bell/quits^31t^a", meter_format_$picture (bell_quits, 9)); call ioa_$ioa_switch (iocbp, "Echo buffer overflows^31t^a", meter_format_$picture (echo_overflows, 9)); end; call ioa_$ioa_switch (iocbp, "Parity errors^31t^a^/", meter_format_$picture (parity_errors, 9)); if ^error then call ioa_$ioa_switch (iocbp, "Avg. number of pending status events^38t^a", meter_format_$quotient ((pending_status), (status_updates), "^4.1f")); call ioa_$ioa_switch (iocbp, "Software status queue overflows^34t^a", meter_format_$picture (ssqo, 6)); call ioa_$ioa_switch (iocbp, "Hardware status queue overflows^34t^a", meter_format_$picture (hsqo, 6)); call ioa_$ioa_switch (iocbp, "Input buffer allocation failures^34t^a", meter_format_$picture (alloc_failures, 6)); return; subchan_summary: entry (a_chan_meterp, a_since_boot, a_summary_ptr, a_code); /* entry to fill in values used by channel_comm_meters -summary */ a_code = 0; chan_meterp = a_chan_meterp; summary_ptr = a_summary_ptr; since_boot = a_since_boot; call set_subchan_values; channel_summary.error_count = 0; if ^synchronous then do; channel_summary.pre_exhaust = (pre_exhaust ^= 0); channel_summary.bell_quit = (bell_quits ^= 0); channel_summary.echo_overflow = (echo_overflows ^= 0); channel_summary.error_count = exhaust + xte + bell_quits + echo_overflows; end; else do; channel_summary.invalid_input = (counters (1) ^= 0); channel_summary.output_re_xmit = (counters (2) ^= 0); channel_summary.timeout = (counters (3) ^= 0); if ^multiplexed then channel_summary.error_count = sum (counters); end; channel_summary.exhaust = (exhaust ^= 0); channel_summary.xte = (xte ^= 0); channel_summary.parity = (parity_errors ^= 0); channel_summary.ssqo = (ssqo ^= 0); channel_summary.hsqo = (hsqo ^= 0); channel_summary.alloc_failure = (alloc_failures ^= 0); channel_summary.synchronous = synchronous; channel_summary.error_count = channel_summary.error_count + parity_errors + ssqo + hsqo + alloc_failures; return; set_subchan_values: procedure; /* internal procedure to set values for use by display_subchan and subchan_summary */ dcl i fixed bin; multiplexed = (channel_meters.multiplexer_type ^= 0); fnp_chan_meterp = channel_meters.parent_meterp; synchronous = fnp_chan_meter_struc.synchronous; current_meterp = addr (fnp_chan_meter_struc.current_meters); /* get total values from current meters */ total_dia_q_len = current_meterp -> fnp_channel_meters.dia_request_q_len; total_dia_q_updates = current_meterp -> fnp_channel_meters.dia_rql_updates; total_pending_status = current_meterp -> fnp_channel_meters.pending_status; total_status_updates = current_meterp -> fnp_channel_meters.pending_status_updates; total_output_overlaps = current_meterp -> fnp_channel_meters.output_overlaps; total_parity_errors = current_meterp -> fnp_channel_meters.parity_errors; total_ssqo = current_meterp -> fnp_channel_meters.software_status_overflows; total_hsqo = current_meterp -> fnp_channel_meters.hardware_status_overflows; total_alloc_failures = current_meterp -> fnp_channel_meters.input_alloc_failures; total_exhaust = current_meterp -> fnp_channel_meters.exhaust; total_xte = current_meterp -> fnp_channel_meters.software_xte; if synchronous then do; total_input_messages = current_meterp -> fnp_sync_meters.input.message_count; total_input_length = current_meterp -> fnp_sync_meters.input.cum_length; total_output_messages = current_meterp -> fnp_sync_meters.output.message_count; total_output_length = current_meterp -> fnp_sync_meters.output.cum_length; do i = 1 to hbound (current_meterp -> fnp_sync_meters.counters, 1); total_counters (i) = current_meterp -> fnp_sync_meters.counters (i); end; end; else do; total_pre_exhaust = current_meterp -> fnp_async_meters.pre_exhaust; total_echo_overflows = current_meterp -> fnp_async_meters.echo_buf_overflow; total_bell_quits = current_meterp -> fnp_async_meters.bell_quits; end; if since_boot then do; /* totals are values to use */ dia_q_len = total_dia_q_len; dia_q_updates = total_dia_q_updates; pending_status = total_pending_status; status_updates = total_status_updates; output_overlaps = total_output_overlaps; parity_errors = total_parity_errors; ssqo = total_ssqo; hsqo = total_hsqo; alloc_failures = total_alloc_failures; exhaust = total_exhaust; xte = total_xte; if synchronous then do; input_messages = total_input_messages; input_length = total_input_length; output_messages = total_output_messages; output_length = total_output_length; do i = 1 to hbound (current_meterp -> fnp_sync_meters.counters, 1); counters (i) = total_counters (i); end; end; else do; pre_exhaust = total_pre_exhaust; echo_overflows = total_echo_overflows; bell_quits = total_bell_quits; end; end; else do; /* have to subtract saved values */ saved_meterp = addr (fnp_chan_meter_struc.saved_meters); dia_q_len = total_dia_q_len - saved_meterp -> fnp_channel_meters.dia_request_q_len; dia_q_updates = total_dia_q_updates - saved_meterp -> fnp_channel_meters.dia_rql_updates; pending_status = total_pending_status - saved_meterp -> fnp_channel_meters.pending_status; status_updates = total_status_updates - saved_meterp -> fnp_channel_meters.pending_status_updates; output_overlaps = total_output_overlaps - saved_meterp -> fnp_channel_meters.output_overlaps; parity_errors = total_parity_errors - saved_meterp -> fnp_channel_meters.parity_errors; ssqo = total_ssqo - saved_meterp -> fnp_channel_meters.software_status_overflows; hsqo = total_hsqo - saved_meterp -> fnp_channel_meters.hardware_status_overflows; alloc_failures = total_alloc_failures - saved_meterp -> fnp_channel_meters.input_alloc_failures; exhaust = total_exhaust - saved_meterp -> fnp_channel_meters.exhaust; xte = total_xte - saved_meterp -> fnp_channel_meters.software_xte; if synchronous then do; input_messages = total_input_messages - saved_meterp -> fnp_sync_meters.input.message_count; input_length = total_input_length - saved_meterp -> fnp_sync_meters.input.cum_length; output_messages = total_output_messages - saved_meterp -> fnp_sync_meters.output.message_count; output_length = total_output_length - saved_meterp -> fnp_sync_meters.output.cum_length; do i = 1 to hbound (saved_meterp -> fnp_sync_meters.counters, 1); counters (i) = total_counters (i) - saved_meterp -> fnp_sync_meters.counters (i); end; end; else do; pre_exhaust = total_pre_exhaust - saved_meterp -> fnp_async_meters.pre_exhaust; echo_overflows = total_echo_overflows - saved_meterp -> fnp_async_meters.echo_buf_overflow; bell_quits = total_bell_quits - saved_meterp -> fnp_async_meters.bell_quits; end; end; return; end set_subchan_values; setup_display: procedure; /* internal procedure to set up local variables for display entries */ iocbp = a_iocbp; if iocbp = null () then iocbp = iox_$user_output; chan_meterp = a_chan_meterp; flags = a_flags; a_code = 0; if flags & DISPLAY_MPX_SUMMARY /* we don't handle this */ then return; if flags & DISPLAY_MPX_BRIEF then brief = "1"b; else brief = "0"b; if flags & DISPLAY_MPX_ERROR then error = "1"b; else error = "0"b; return; end setup_display; %include fnp_meters; %page; %include fnp_channel_meters; %page; %include channel_meters; %page; %include comm_meters_disp_flags; %page; %include line_types; %page; %include iom_data; %page; %include channel_summary; end mcs_meters_;  meter_fnp_idle.pl1 04/09/85 1715.2r w 04/08/85 1134.0 148905 /* *********************************************************** * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ /* format: style4,delnl,insnl,^ifthendo */ meter_fnp_idle: procedure; /* This command causes the process to wake up at specified intervals and record the specified FNP's idle time for the most recent interval. This data is stored away in a segment where the display_fnp_idle command can find it. If the FNP crashes and reloads while the command is runninmg, a new data segment is started. */ /* Coded January 1982 by Robert Coren */ /* Modified March 1982 by Robert Coren to correct time slippage. */ dcl fnp_name char (1); dcl minutes fixed bin; dcl stop bit (1); dcl non_stop bit (1); dcl dirname char (168); dcl entryname char (32); dcl code fixed bin (35); dcl nargs fixed bin; dcl iarg fixed bin; dcl infop pointer; dcl fnp_no fixed bin; dcl event_message fixed bin (71); dcl comm_meters_chan_name (1) char (1); dcl areap pointer; dcl meter_time fixed bin (71); dcl next_entry fixed bin; dcl idle_count fixed bin (35); dcl idle_updates fixed bin (35); dcl delta_idle fixed bin (35); dcl argp pointer; dcl argl fixed bin (21); dcl arg char (argl) based (argp); dcl cu_$arg_count entry (fixed bin, fixed bin (35)); dcl com_err_ entry () options (variable); dcl com_err_$suppress_name entry () options (variable); dcl continue_to_signal_ entry (fixed bin (35)); dcl cu_$arg_ptr entry (fixed bin, ptr, fixed bin (21), fixed bin (35)); dcl cv_dec_check_ entry (char (*), fixed bin (35)) returns (fixed bin); dcl find_condition_info_ entry (ptr, ptr, fixed bin (35)); dcl expand_pathname_ entry (char (*), char (*), char (*), fixed bin (35)); dcl pathname_ entry (char (*), char (*)) returns (char (168)); dcl get_process_id_ entry returns (bit (36)); dcl parse_fnp_name_ entry (char (*), fixed bin); dcl ipc_$create_ev_chn entry (fixed bin (71), fixed bin (35)); dcl convert_ipc_code_ entry (fixed bin (35)); dcl ipc_$decl_ev_call_chn entry (fixed bin (71), ptr, ptr, fixed bin, fixed bin (35)); dcl hcs_$wakeup entry (bit (*), fixed bin (71), fixed bin (71), fixed bin (35)); dcl get_system_free_area_ entry () returns (ptr); dcl comm_meters_ entry ((*) char (*), fixed bin, ptr, fixed bin, ptr, fixed bin (35)); dcl comm_meters_$free entry (ptr, ptr, fixed bin (35)); dcl timer_manager_$alarm_wakeup entry (fixed bin (71), bit (2), fixed bin (71)); dcl ( error_table_$action_not_performed, error_table_$inconsistent, error_table_$too_many_args, error_table_$noarg, error_table_$badopt ) fixed bin (35) external static; dcl COMMAND_NAME char (14) internal static options (constant) init ("meter_fnp_idle"); dcl static_dirname char (168) internal static; dcl 1 meter_fnp_idle_info_array (8) internal static aligned like meter_fnp_idle_info; dcl 1 meter_fnp_idle_info aligned based (infop), 2 event_channel_name fixed bin (71), 2 next_cycle_sched fixed bin (71), 2 interval fixed bin (71), 2 data_seg_ptr pointer, 2 fnp_name char (1), 2 minutes fixed bin, 2 flags, 3 running bit (1) unaligned, 3 suspended bit (1) unaligned, 3 stop_requested bit (1) unaligned, 3 pad bit (33) unaligned; dcl (cleanup, sub_error_) condition; fnp_name = ""; minutes = 0; dirname = ""; stop, non_stop = "0"b; call cu_$arg_count (nargs, code); if code ^= 0 then do; call com_err_ (code, COMMAND_NAME); return; end; if nargs = 0 then do; call com_err_$suppress_name (0, COMMAND_NAME, "Usage: meter_fnp_idle fnp_name {-stop | -interval MINUTES}") ; return; end; do iarg = 1 to nargs; call cu_$arg_ptr (iarg, argp, argl, code); if code ^= 0 then do; call com_err_ (code, COMMAND_NAME); return; end; if substr (arg, 1, 1) ^= "-" then do; /* not a control arg, must be FNP name */ call parse_fnp_name_ (arg, fnp_no); if fnp_no < 0 then do; call com_err_ (0, COMMAND_NAME, "^a is not a valid FNP name.", arg); return; end; else if fnp_name ^= "" then do; call com_err_ (error_table_$inconsistent, COMMAND_NAME, "More than one FNP name specified: ^a and ^a", fnp_name, arg); return; end; fnp_name = arg; end; else if arg = "-stop" | arg = "-sp" then if non_stop then do; STOP_ERROR: call com_err_ (error_table_$inconsistent, COMMAND_NAME, "-stop cannot be specified with any other control argument."); return; end; else stop = "1"b; else if stop then go to STOP_ERROR; else do; non_stop = "1"b; if arg = "-directory" | arg = "-dr" then do; iarg = iarg + 1; call cu_$arg_ptr (iarg, argp, argl, code); if code ^= 0 then do; NO_DIR: call com_err_ (code, COMMAND_NAME, "No directory pathname specified."); return; end; if substr (arg, 1, 1) = "-" then do; code = error_table_$noarg; go to NO_DIR; end; call expand_pathname_ (arg, dirname, entryname, code); if code ^= 0 then do; call com_err_ (code, COMMAND_NAME, arg); return; end; dirname = pathname_ (dirname, entryname); end; else if arg = "-interval" then do; if minutes ^= 0 then do; call com_err_ (error_table_$inconsistent, COMMAND_NAME, "More than one interval specified.") ; return; end; iarg = iarg + 1; call cu_$arg_ptr (iarg, argp, argl, code); if code ^= 0 then do; NO_INTERVAL: call com_err_ (code, COMMAND_NAME, "Interval value not supplied."); return; end; if substr (arg, 1, 1) = "-" then do; code = error_table_$noarg; go to NO_INTERVAL; end; minutes = cv_dec_check_ (arg, code); if code ^= 0 then do; call com_err_ (0, COMMAND_NAME, "^a is not a valid interval specification.", arg); return; end; end; else do; call com_err_ (error_table_$badopt, COMMAND_NAME, arg); return; end; end; end; if fnp_name = "" then do; call com_err_ (error_table_$noarg, COMMAND_NAME, "No FNP name specified."); return; end; static_dirname = dirname; infop = addr (meter_fnp_idle_info_array (fnp_no)); if stop then do; if ^meter_fnp_idle_info.running then call com_err_ (0, COMMAND_NAME, "This process is not metering FNP ^a.", fnp_name); else meter_fnp_idle_info.stop_requested = "1"b; return; end; if meter_fnp_idle_info.running then do; call com_err_ (error_table_$action_not_performed, COMMAND_NAME, "This process is already metering FNP ^a.", fnp_name); return; end; if minutes = 0 then minutes = 1; /* default to one minute interval */ meter_fnp_idle_info.minutes = minutes; /* for forming pathname */ meter_fnp_idle_info.next_cycle_sched = 0; meter_fnp_idle_info.interval = 60000000 * minutes;/* convert to microseconds */ meter_fnp_idle_info.data_seg_ptr = null (); meter_fnp_idle_info.fnp_name = fnp_name; string (meter_fnp_idle_info.flags) = "0"b; call ipc_$create_ev_chn (meter_fnp_idle_info.event_channel_name, code); if code ^= 0 then do; call convert_ipc_code_ (code); call com_err_ (code, COMMAND_NAME, "Unable to create event channel."); return; end; call ipc_$decl_ev_call_chn (meter_fnp_idle_info.event_channel_name, codeptr (idle_wakeup), infop, 30, code); if code ^= 0 then do; call convert_ipc_code_ (code); call com_err_ (code, COMMAND_NAME, "Unable to set up event call channel."); return; end; event_message = fnp_no; meter_fnp_idle_info.running = "1"b; call hcs_$wakeup (get_process_id_ (), meter_fnp_idle_info.event_channel_name, event_message, code); if code ^= 0 then do; call convert_ipc_code_ (code); call com_err_ (code, COMMAND_NAME, "Unable to send initial wakeup."); end; return; idle_wakeup: entry (arg_event_call_info_ptr); /* this entry, which reschedules itself for the next metering interval, does all the real work */ dcl arg_event_call_info_ptr pointer; event_call_info_ptr = arg_event_call_info_ptr; infop = event_call_info.data_ptr; if event_call_info.channel_id ^= meter_fnp_idle_info.event_channel_name then return; /* not the right wakeup */ meter_time = clock (); if meter_fnp_idle_info.next_cycle_sched = 0 then meter_fnp_idle_info.next_cycle_sched = meter_time; meter_fnp_idle_info.next_cycle_sched = meter_fnp_idle_info.next_cycle_sched + meter_fnp_idle_info.interval; if meter_fnp_idle_info.stop_requested then do; /* finished with this one */ call wrapup_data_segment; meter_fnp_idle_info.stop_requested, meter_fnp_idle_info.running = "0"b; return; end; on sub_error_ begin; /* this is here because comm_meters_ calls sub_err_ in case of problems. Since it also returns a useful error code if called with a single channel name, this handler doesn't have to explain anything */ dcl code fixed bin (35); dcl pass_on bit (1); dcl 1 auto_cond_info aligned like condition_info; pass_on = "0"b; condition_info_ptr = addr (auto_cond_info); call find_condition_info_ (null (), condition_info_ptr, code); if code ^= 0 /* rather unlikely */ then pass_on = "1"b; /* but we'll let someone else worry about it */ else if condition_info.info_ptr = null () | condition_info.condition_name ^= "sub_error_" /* we're not about to deal with this */ then pass_on = "1"b; else do; sub_error_info_ptr = condition_info.info_ptr; if sub_error_info.name ^= "comm_meters_" /* not someone we know */ then pass_on = "1"b; end; if pass_on then call continue_to_signal_ (code); end; comm_meters_chan_name (1) = meter_fnp_idle_info.fnp_name; areap = get_system_free_area_ (); call comm_meters_ (comm_meters_chan_name, CHANNEL_METERS_VERSION_1, areap, (0), chan_meterp, code); if code = 0 /* we got meters */ then do; on cleanup call comm_meters_$free (areap, chan_meterp, (0)); fnp_meterp = channel_meters.mpx_specific_meterp; if unspec (fnp_meters.from_fnp) = "0"b then call wrapup_data_segment; /* oops, nothing useful */ else do; fnp_idle_data_ptr = meter_fnp_idle_info.data_seg_ptr; if fnp_idle_data_ptr = null () then do; /* no segment active at the moment */ call setup_data_segment (code); /* so start one */ if code ^= 0 then do; meter_fnp_idle_info.running = "1"b; return; /* we couldn't, forget it */ end; end; if fnp_idle_data.entries_used >= fnp_idle_data.max_entries /* we've filled this one */ then do; call wrapup_data_segment; call setup_data_segment (code); /* start a new one */ if code ^= 0 then do; meter_fnp_idle_info.running = "0"b; return; end; end; next_entry = fnp_idle_data.entries_used + 1; idle_count = fnp_meters.from_fnp.total_idle_count; idle_updates = fnp_meters.from_fnp.idle_count_updates; delta_idle = idle_count - fnp_idle_data.latest_idle_count; fnp_idle_data.entries (next_entry).idle_count = idle_count; fnp_idle_data.entries (next_entry).sample_count = idle_updates; fnp_idle_data.maximum_idle_count = fnp_meters.from_fnp.max_idle_count; if fnp_idle_data.minimum_idle_count = 0 | fnp_meters.from_fnp.min_idle_count < fnp_idle_data.minimum_idle_count then do; fnp_idle_data.minimum_idle_count = fnp_meters.from_fnp.min_idle_count; fnp_idle_data.time_of_minimum_sample = meter_time; end; if fnp_idle_data.minimum_delta_idle = 0 | delta_idle < fnp_idle_data.minimum_delta_idle then do; fnp_idle_data.minimum_delta_idle = delta_idle; fnp_idle_data.time_of_minimum_average = meter_time; end; fnp_idle_data.latest_idle_count = idle_count; fnp_idle_data.latest_sample_count = idle_updates; fnp_idle_data.entries_used = next_entry; fnp_idle_data.last_time = meter_time; call comm_meters_$free (areap, chan_meterp, code); revert cleanup; end; end; else call wrapup_data_segment; call timer_manager_$alarm_wakeup (meter_fnp_idle_info.next_cycle_sched, "00"b, meter_fnp_idle_info.event_channel_name); return; setup_data_segment: procedure (a_code); /* This subroutine creates and initializes a data segment for storing the meters accumulated consecutively for a single FNP. The entryname of the segment is fnp_idle_data.FNPNAME.YYMMDD.HHMMSS.INTERVAL, which makes them easy to sort. */ dcl a_code fixed bin (35); dcl dirname char (168); dcl entryname char (32); dcl month fixed bin; dcl day fixed bin; dcl year fixed bin; dcl hour fixed bin; dcl minute fixed bin; dcl second fixed bin; dcl pic_month pic "99"; dcl pic_day pic "99"; dcl pic_year pic "99"; dcl pic_hour pic "99"; dcl pic_minute pic "99"; dcl pic_second pic "99"; dcl code fixed bin (35); dcl decode_clock_value_$date_time entry (fixed bin (71), fixed bin, fixed bin, fixed bin, fixed bin, fixed bin, fixed bin, fixed bin (71), fixed bin, char (3), fixed bin (35)); dcl ioa_$rsnnl entry () options (variable); dcl get_wdir_ entry () returns (char (168)); dcl hcs_$make_seg entry (char (*), char (*), char (*), fixed bin (5), ptr, fixed bin (35)); dcl hcs_$truncate_seg entry (ptr, fixed bin (19), fixed bin (35)); dcl hcs_$set_max_length_seg entry (ptr, fixed bin (19), fixed bin (35)); dcl hcs_$terminate_noname entry (ptr, fixed bin (35)); dcl error_table_$namedup fixed bin (35) external static; if static_dirname = "" then dirname = get_wdir_ (); else dirname = static_dirname; call decode_clock_value_$date_time (meter_time, month, day, year, hour, minute, second, (0), (0), (""), (0)); pic_month = month; pic_day = day; pic_year = mod (year, 100); pic_hour = hour; pic_minute = minute; pic_second = second; call ioa_$rsnnl ("fnp_idle_data.^a.^a^a^a.^a^a^a.^d", entryname, (0), meter_fnp_idle_info.fnp_name, pic_year, pic_month, pic_day, pic_hour, pic_minute, pic_second, meter_fnp_idle_info.minutes); call hcs_$make_seg (dirname, entryname, "", RW_ACCESS_BIN, fnp_idle_data_ptr, code); if fnp_idle_data_ptr = null () then do; call com_err_ (code, COMMAND_NAME, "Could not create ^a", pathname_ (dirname, entryname)); a_code = code; return; end; if code = error_table_$namedup then do; call com_err_ (code, COMMAND_NAME, "^a exists. FNP ^a is already being metered.", pathname_ (dirname, entryname), meter_fnp_idle_info.fnp_name); a_code = code; call hcs_$terminate_noname (fnp_idle_data_ptr, code); fnp_idle_data_ptr = null (); return; end; call hcs_$set_max_length_seg (fnp_idle_data_ptr, 65536, code); if code ^= 0 then do; call com_err_ (code, COMMAND_NAME, "Could not set max. length of ^a", pathname_ (dirname, entryname)); a_code = code; call hcs_$terminate_noname (fnp_idle_data_ptr, code); return; end; fnp_idle_data.version = FNP_IDLE_DATA_VERSION_1; fnp_idle_data.time_started = meter_time; fnp_idle_data.sample_interval = meter_fnp_idle_info.interval; fnp_idle_data.max_entries = divide (65536 - bin (rel (addr (fnp_idle_data.entries (1))), 18), size (fnp_idle_data_ptr -> fnp_idle_entry), 17, 0); meter_fnp_idle_info.data_seg_ptr = fnp_idle_data_ptr; meter_fnp_idle_info.suspended = "0"b; meter_fnp_idle_info.running = "1"b; a_code = 0; return; end setup_data_segment; wrapup_data_segment: procedure; dcl hcs_$terminate_noname entry (ptr, fixed bin (35)); dcl code fixed bin (35); call hcs_$terminate_noname (meter_fnp_idle_info.data_seg_ptr, code); meter_fnp_idle_info.data_seg_ptr = null (); if ^meter_fnp_idle_info.stop_requested then meter_fnp_idle_info.suspended = "1"b; return; end wrapup_data_segment; %include fnp_idle_data; %page; %include access_mode_values; %page; %include sub_error_info; %page; %include condition_info; %page; %include condition_info_header; %page; %include channel_meters; %page; %include fnp_meters; %page; %include event_call_info; end meter_fnp_idle;  meter_format_.pl1 11/15/82 1813.1rew 11/15/82 1459.8 24822 /* *********************************************************** * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ /* format: style4,delnl,insnl,^ifthendo */ meter_format_: procedure; /* collection of routines to return nicely formatted numbers for metering commands */ /* PARAMETERS */ dcl number fixed bin (35); dcl width fixed bin; dcl dividend fixed bin (71); dcl divisor fixed bin (71); dcl format char (*); dcl interval fixed bin (71); /* AUTOMATIC */ dcl picture pic "zzz,zzz,zzz,zz9"; dcl result char (15) varying; dcl qresult float bin (27); dcl retval char (12) varying; dcl hours pic "zzz9"; dcl minutes pic "99"; dcl seconds pic "99"; dcl all_seconds fixed bin (35); /* ENTRIES */ dcl ioa_$rsnnl entry options (variable); /* BUILTINS & CONDITIONS */ dcl (size, zerodivide) condition; dcl (divide, ltrim, copy, max, length, float) builtin; picture: entry (number, width) returns (char (15) varying); /* a function that, given a fixed bin number, returns it with commas, right-justified in a field of a given width */ picture = number; /* this does the magic conversion */ result = ltrim (picture); /* get rid of leading blanks */ /* and then restore the right number of them */ return (copy (" ", max (0, width - length (result))) || result); quotient: entry (dividend, divisor, format) returns (char (12) varying); /* a function that divides 2 fixed bins to get a floating result, and then returns it formatted as specified. Returns a nice character string in case of division by 0. */ on zerodivide go to quotient_error; qresult = float (dividend) / float (divisor); call ioa_$rsnnl (format, retval, (0), qresult); return (retval); quotient_error: return ("No data."); time: entry (interval) returns (char (10)); /* a function that, given a time interval in microseconds, returns it in character string form as hours:minutes:seconds */ on size go to time_error; all_seconds = divide (interval, 1000000, 35, 0); /* elapsed time in seconds */ hours = divide (all_seconds, 3600, 35, 0); minutes = divide (all_seconds, 60, 35, 0) - 60 * hours; /* residual minutes */ seconds = all_seconds - 3600 * hours - 60 * minutes; /* residual seconds */ return (hours || ":" || minutes || ":" || seconds); time_error: return ("No data."); end meter_format_;  sty_dump_.pl1 09/21/83 1223.9rew 09/21/83 1222.9 20952 /* *********************************************************** * * * Copyright, (C) Honeywell Information Systems Inc., 1983 * * * *********************************************************** */ /* format: style4,delnl,insnl,ifthenstmt,indnoniterend */ sty_dump_: procedure (Ttybp, Areap, Dp, Sc, Brief); /* Debugging display for STY channels. */ /* Written July 1981 by C. Hornig */ /* Modified April 1983 by Robert Coren to print access class if present */ dcl (Ttybp, Areap, Dp) ptr parameter; dcl Sc fixed bin parameter; dcl Brief bit (1) aligned parameter; dcl convert_authorization_$to_string entry (bit (72) aligned, char (*), fixed bin (35)); dcl ioa_ entry options (variable); dcl mode_string_$get entry (ptr, char (*), fixed bin (35)); dcl tty_dump$print_chain entry (ptr, char (*), fixed bin, bit (1)); dcl her_sc fixed bin; dcl code fixed bin (35); dcl modes char (512); dcl access_class_string char (864); dcl (pointer, rel) builtin; %page; sty_mpx_data_ptr = pointer (Areap, rel (Dp)); if Sc > 0 then do; pdep = addr (sty_mpx_data.pdes (Sc)); her_sc = 1 + mod (Sc - 1 + sty_mpx_data.n_pairs, sty_mpx_data.n_channels); call ioa_ ("^d(^o) -> ^d(^o): ^d words^[ listening^]^[ wru^]^[ eop^]^[ notify_modes^]^[ output_ready^]", Sc, pde.devx, her_sc, sty_mpx_data.pdes (her_sc).devx, pde.words, pde.flags.listen, pde.flags.wru, pde.flags.end_of_page, pde.flags.notify_modes, pde.flags.output_ready); if pde.mode_ptr ^= null () then do; call mode_string_$get (pointer (Areap, rel (pde.mode_ptr)), modes, code); if code ^= 0 then modes = "???"; call ioa_ ("^-modes: ^a", modes); end; if pde.access_class_set then do; call convert_authorization_$to_string (pde.access_class, access_class_string, code); if code ^= 0 then call ioa_ ("^-access class: ^b3", pde.access_class); else call ioa_ ("^-access class: ^a", access_class_string); end; call tty_dump$print_chain (Ttybp, "", (pde.head), (Brief)); end; else do; call ioa_ ("STY MPX devx ^o, ^d channels.", sty_mpx_data.devx, sty_mpx_data.n_channels); end; return; %page; %include sty_mpx_data; %include mode_string_info; end sty_dump_;  system_comm_meters.pl1 10/25/89 1156.0r w 10/25/89 1005.2 200385 /* *********************************************************** * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ /* format: style4,delnl,insnl,^ifthendo */ system_comm_meters: tty_meters: procedure; /* This is a command to output statistics describing the performance and general behavior of the ring-0 communications software. Usage: system_comm_meters {-reset | -report_reset} */ /* Written March 1981 by Robert Coren */ /* Modified December 1984 by Robert Coren to remove tty_area from metering region (it wasn't used) */ /* AUTOMATIC */ dcl code fixed bin (35); dcl reset bit (1); dcl report bit (1); dcl char_time char (10); /* metering time formatted by metering_util_ */ dcl meter_time fixed bin (71); dcl cur_ptrs (2) ptr; dcl prev_ptrs (2) ptr; dcl total_timep ptr; dcl old_ttybp ptr; /* pointer to older copy of tty_buf */ dcl old_total_timep ptr; dcl in_interrupts fixed bin (35); dcl out_interrupts fixed bin (35); dcl control_interrupts fixed bin (35); dcl in_interrupt_time fixed bin (71); dcl out_interrupt_time fixed bin (71); dcl control_interrupt_time fixed bin (71); dcl read_calls fixed bin (35); dcl write_calls fixed bin (35); dcl read_time fixed bin (71); dcl write_time fixed bin (71); dcl in_bytes fixed bin (35); /* characters in through channel_manager */ dcl in_messages fixed bin (35); /* input interrupts through channel manager */ dcl out_bytes fixed bin (35); dcl out_messages fixed bin (35); dcl mpx_channels fixed bin; dcl devx fixed bin; dcl cpu_time fixed bin (71); dcl in_before_conv fixed bin (35); dcl out_before_conv fixed bin (35); dcl in_after_conv fixed bin (35); dcl out_after_conv fixed bin (35); dcl preconverted fixed bin (35); dcl net_read_calls fixed bin (35); dcl net_write_calls fixed bin (35); dcl net_read_time fixed bin (71); dcl net_write_time fixed bin (71); dcl net_input_ints fixed bin (35); dcl net_output_ints fixed bin (35); dcl net_control_ints fixed bin (35); dcl net_in_int_time fixed bin (71); dcl net_out_int_time fixed bin (71); dcl net_control_int_time fixed bin (71); dcl pool_size fixed bin (35); dcl avg_input_space fixed bin; dcl avg_output_space fixed bin; dcl avg_control_space fixed bin; dcl alloc_calls fixed bin (35); dcl free_calls fixed bin (35); dcl alloc_time fixed bin (71); dcl free_time fixed bin (71); dcl ttyb_loop_locks fixed bin (35); dcl ttyb_loop_lock_time fixed bin (71); dcl alloc_failures fixed bin (35); dcl tty_lock_calls fixed bin (35); dcl tty_lock_waits fixed bin (35); dcl queued_ints fixed bin (35); dcl found_lock_locked fixed bin (35); dcl echoed_by_r0 fixed bin (35); dcl echoed_by_fnp fixed bin (35); dcl in_restarts fixed bin (35); dcl out_restarts fixed bin (35); dcl out_overflows fixed bin (35); dcl nargs fixed bin; dcl argp ptr; dcl argl fixed bin (21); dcl arg char (argl) based (argp); /* BASED */ dcl time fixed bin (71) based; /* CPU time from tc_data */ /* INTERNAL STATIC */ dcl first_time bit (1) int static init ("1"b); /* indicates first call in this process */ dcl tty_buf_len fixed bin (19) int static; dcl tty_area_len fixed bin (19) int static; dcl mu_index fixed bin int static; /* unique index used by metering_util_ */ /* The following are copies of previous values of the above, set at "reset" time, and used for calculating increments over the metering interval */ dcl old_in_interrupts fixed bin (35) int static init (0); dcl old_out_interrupts fixed bin (35) int static init (0); dcl old_control_interrupts fixed bin (35) int static init (0); dcl old_in_interrupt_time fixed bin (71) int static init (0); dcl old_out_interrupt_time fixed bin (71) int static init (0); dcl old_control_interrupt_time fixed bin (71) int static init (0); dcl old_read_calls fixed bin (35) int static init (0); dcl old_write_calls fixed bin (35) int static init (0); dcl old_read_time fixed bin (71) int static init (0); dcl old_write_time fixed bin (71) int static init (0); dcl old_in_bytes fixed bin (35) int static init (0); dcl old_in_messages fixed bin (35) int static init (0); dcl old_out_bytes fixed bin (35) int static init (0); dcl old_out_messages fixed bin (35) int static init (0); dcl CMD_NAME char (18) int static options (constant) init ("system_comm_meters"); /* ENTRIES */ dcl ring_zero_peek_$get_max_length entry (char (*), fixed bin (19), fixed bin (35)); dcl meter_format_$picture entry (fixed bin (35), fixed bin) returns (char (15) varying); dcl meter_format_$quotient entry (fixed bin (71), fixed bin (71), char (*)) returns (char (12) varying); dcl metering_util_$define_regions entry options (variable); dcl metering_util_$fill_buffers entry (fixed bin, fixed bin (71), char (*), (*) ptr, (*) ptr, fixed bin (35)); dcl metering_util_$reset entry (fixed bin, fixed bin (35)); dcl com_err_ entry () options (variable); dcl ioa_ entry () options (variable); dcl ioa_$rsnnl entry () options (variable); dcl cu_$arg_count entry (fixed bin, fixed bin (35)); dcl cu_$arg_ptr entry (fixed bin, ptr, fixed bin (21), fixed bin (35)); /* EXTERNAL STATIC */ dcl ( error_table_$wrong_no_of_args, error_table_$badopt ) fixed bin (35) external static; /* BUILTINS */ dcl (addrel, rel, addr, divide, bin, currentsize, float, ltrim, copy, length) builtin; call cu_$arg_count (nargs, code); if code ^= 0 then do; call com_err_ (code, CMD_NAME, "From cu_$arg_count"); return; end; if nargs = 0 then do; reset = "0"b; report = "1"b; end; else do; if nargs ^= 1 /* only 1 is allowed */ then do; call com_err_ (error_table_$wrong_no_of_args, CMD_NAME, "^/Usage: system_comm_meters {-reset | -report_reset}"); return; end; call cu_$arg_ptr (1, argp, argl, code); if arg = "-reset" | arg = "-rs" then do; reset = "1"b; report = "0"b; end; else if arg = "-report_reset" | arg = "-rr" then do; reset = "1"b; report = "1"b; end; else do; call com_err_ (error_table_$badopt, CMD_NAME, arg); return; end; end; if first_time /* have we initialized already? */ then do; /* if not, do it now */ call ring_zero_peek_$get_max_length ("tty_buf", tty_buf_len, code); if code = 0 then call ring_zero_peek_$get_max_length ("tty_area", tty_area_len, code); if code ^= 0 then do; call com_err_ (code, CMD_NAME, "From ring_zero_peek_$get_max_length"); return; end; call metering_util_$define_regions (mu_index, code, "tty_buf", 0, tty_buf_len, "tc_data", "processor_time", 2); if code ^= 0 then do; call com_err_ (code, CMD_NAME, "From metering_util_$define_regions"); return; end; first_time = "0"b; /* we're initialized now */ end; /* We have to calculate certain things in any case, to report them and/or to update the "old" values in case of reset */ call metering_util_$fill_buffers (mu_index, meter_time, char_time, cur_ptrs, prev_ptrs, code); if code ^= 0 then do; call com_err_ (code, CMD_NAME, "From metering_util_$fill_buffers"); return; end; call ioa_ ("^/Total metering time ^a", char_time); ttybp = cur_ptrs (1); total_timep = cur_ptrs (2); old_ttybp = prev_ptrs (1); old_total_timep = prev_ptrs (2); in_interrupts, out_interrupts, control_interrupts, in_interrupt_time, out_interrupt_time, control_interrupt_time, read_calls, write_calls, read_time, write_time, in_bytes, in_messages, out_bytes, out_messages = 0; /* thumb through LCT to sum statistics over all channels */ lctp = addrel (ttybp, rel (tty_buf.lct_ptr)); mpx_channels = 0; do devx = 1 to lct.max_no_lctes; lctep = addr (lct.lcte_array (devx)); if lcte.entry_in_use then do; in_interrupts = in_interrupts + lcte.in.interrupts; out_interrupts = out_interrupts + lcte.out.interrupts; control_interrupts = control_interrupts + lcte.control.interrupts; if lcte.major_channel_devx ^= 0 /* if there's a parent */ then if addr (lct.lcte_array (lcte.major_channel_devx)) -> lcte.major_channel_devx = 0 /* who is a top-level multiplexer */ then do; /* only count interrupt time for these to avoid duplication */ in_interrupt_time = in_interrupt_time + lcte.in.interrupt_time; out_interrupt_time = out_interrupt_time + lcte.out.interrupt_time; control_interrupt_time = control_interrupt_time + lcte.control.interrupt_time; end; if lcte.channel_type = TTY_MPX /* get some additional stuff for non-multiplexed channels */ then do; in_bytes = in_bytes + lcte.in_bytes; in_messages = in_messages + lcte.in.interrupts; out_bytes = out_bytes + lcte.out_bytes; out_messages = out_messages + lcte.out.calls; end; else mpx_channels = mpx_channels + 1; /* this is a multiplexed channel, count it */ end; end; read_calls = tty_buf.read_calls; write_calls = tty_buf.write_calls; read_time = tty_buf.read_time; write_time = tty_buf.write_time; if report /* If user wanted to know anything */ then do; cpu_time = total_timep -> time - old_total_timep -> time; call ioa_ ("^/THROUGHPUT^/^30tbefore conversion^50tafter conversion^68tratio"); in_before_conv = tty_buf.nrawread - old_ttybp -> tty_buf.nrawread; in_after_conv = tty_buf.ninchars - old_ttybp -> tty_buf.ninchars; call ioa_ ("Total characters input^30t^a^50t^a^68t^a", meter_format_$picture (in_before_conv, 13), meter_format_$picture (in_after_conv, 13), meter_format_$quotient ((in_after_conv), (in_before_conv), "^5.2f")); out_before_conv = tty_buf.noutchars - old_ttybp -> tty_buf.noutchars; out_after_conv = tty_buf.nrawwrite - old_ttybp -> tty_buf.nrawwrite; call ioa_ ("Total characters output^30t^a^50t^a^68t^a", meter_format_$picture (out_before_conv, 13), meter_format_$picture (out_after_conv, 13), meter_format_$quotient ((out_after_conv), (out_before_conv), "^5.2f")); call ioa_ ("Average length of input^34t^a characters", meter_format_$quotient (in_bytes - old_in_bytes, in_messages - old_in_messages, "^5.1f")); call ioa_ ("Average length of output^34t^a characters", meter_format_$quotient (out_bytes - old_out_bytes, out_messages - old_out_messages, "^5.1f")); preconverted = tty_buf.preconverted - old_ttybp -> tty_buf.preconverted; call ioa_ ("Input characters preconverted^30t^a (^a% of total)", meter_format_$picture (preconverted, 13), meter_format_$quotient (100 * preconverted, (in_before_conv), "^.1f")); net_read_calls = read_calls - old_read_calls; net_write_calls = write_calls - old_write_calls; net_read_time = divide (read_time - old_read_time, 1000, 35, 0); net_write_time = divide (write_time - old_write_time, 1000, 35, 0); call ioa_ ("^/^30tread^50twrite"); call ioa_ ("Number of calls^27t^a^47t^a", meter_format_$picture (net_read_calls, 11), meter_format_$picture (net_write_calls, 11)); call ioa_ ("Average time per call^27t^a msec.^50t^a msec.", meter_format_$quotient (net_read_time, (net_read_calls), "^5.2f"), meter_format_$quotient (net_write_time, (net_write_calls), "^5.2f")); call ioa_ ("Average chars. processed^29t^a^49t^a", meter_format_$quotient ((in_before_conv), (net_read_calls), "^5.1f"), meter_format_$quotient ((out_before_conv), (net_write_calls), "^5.1f")); call ioa_ ("Average chars. per msec.^29t^a^49t^a", meter_format_$quotient ((in_before_conv), net_read_time, "^5.1f"), meter_format_$quotient ((out_before_conv), net_write_time, "^5.1f")); call ioa_ ("^2/CHANNEL INTERRUPTS^/^27tinput^42toutput^57tother^72ttotal"); net_input_ints = in_interrupts - old_in_interrupts; net_output_ints = out_interrupts - old_out_interrupts; net_control_ints = control_interrupts - old_control_interrupts; net_in_int_time = divide (in_interrupt_time - old_in_interrupt_time, 1000, 35, 0); net_out_int_time = divide (out_interrupt_time - old_out_interrupt_time, 1000, 35, 0); net_control_int_time = divide (control_interrupt_time - old_control_interrupt_time, 1000, 35, 0); call ioa_ ("software ""interrupts""^25t^a^40t^a^55t^a^69t^a", meter_format_$picture (net_input_ints, 8), meter_format_$picture (net_output_ints, 8), meter_format_$picture (net_control_ints, 8), meter_format_$picture (net_input_ints + net_output_ints + net_control_ints, 9)); call ioa_ ("average time (msec.)^25t^a^40t^a^55t^a^70t^a", meter_format_$quotient (net_in_int_time, (net_input_ints), "^6.2f"), meter_format_$quotient (net_out_int_time, (net_output_ints), "^6.2f"), meter_format_$quotient (net_control_int_time, (net_control_ints), "^6.2f"), meter_format_$quotient (net_in_int_time + net_out_int_time + net_control_int_time, net_input_ints + net_output_ints + net_control_ints, "^6.2f")); call ioa_ ("^2/TTY_BUF SPACE MANAGEMENT^/"); pool_size = tty_buf_len - (bin (rel (addr (tty_buf.free_space))) - bin (rel (ttybp))) - currentsize (lct); call ioa_ ("Total size of buffer pool ^30t^a words", meter_format_$picture (pool_size, 7)); call ioa_ ("Number of channels configured^30t^7d^/Number of multiplexed channels^30t^7d", lct.max_no_lctes, mpx_channels); if tty_buf.input_space_updates = old_ttybp -> tty_buf.input_space_updates then avg_input_space = divide (tty_buf.cumulative_input_space, tty_buf.input_space_updates, 35, 0); else avg_input_space = divide (tty_buf.cumulative_input_space - old_ttybp -> tty_buf.cumulative_input_space, tty_buf.input_space_updates - old_ttybp -> tty_buf.input_space_updates, 35, 0); if tty_buf.output_space_updates = old_ttybp -> tty_buf.output_space_updates then avg_output_space = divide (tty_buf.cumulative_output_space, tty_buf.output_space_updates, 35, 0); else avg_output_space = divide (tty_buf.cumulative_output_space - old_ttybp -> tty_buf.cumulative_output_space, tty_buf.output_space_updates - old_ttybp -> tty_buf.output_space_updates, 35, 0); if tty_buf.control_space_updates = old_ttybp -> tty_buf.control_space_updates then avg_control_space = divide (tty_buf.cumulative_control_space, tty_buf.control_space_updates, 35, 0); else avg_control_space = divide (tty_buf.cumulative_control_space - old_ttybp -> tty_buf.cumulative_control_space, tty_buf.control_space_updates - old_ttybp -> tty_buf.control_space_updates, 35, 0); call ioa_ ("^/% of buffer pool in use^30tcurrent^42taverage"); call ioa_ ("^4tinput^32t^4.1f^44t^4.1f", 1e2 * float (tty_buf.current_input_space) / float (pool_size), 1e2 * float (avg_input_space) / float (pool_size)); call ioa_ ("^4toutput^32t^4.1f^44t^4.1f", 1e2 * float (tty_buf.current_output_space) / float (pool_size), 1e2 * float (avg_output_space) / float (pool_size)); call ioa_ ("^4tcontrol structures^32t^4.1f^44t^4.1f", 1e2 * float (tty_buf.current_control_space) / float (pool_size), 1e2 * float (avg_control_space) / float (pool_size)); call ioa_ ("^4t^44(-^)"); call ioa_ ("^4ttotal^32t^4.1f^44t^4.1f", 1e2 * float (tty_buf.current_input_space + tty_buf.current_output_space + tty_buf.current_control_space) / float (pool_size), 1e2 * float (avg_input_space + avg_output_space + avg_control_space) / float (pool_size)); call ioa_ ("^/Smallest amount of free space ever^32t^a words (^d% of buffer pool)", meter_format_$picture ((tty_buf.minimum_free_space), 6), divide (100 * tty_buf.minimum_free_space, pool_size, 17, 0)); alloc_calls = tty_buf.alloc_calls - old_ttybp -> tty_buf.alloc_calls; free_calls = tty_buf.free_calls - old_ttybp -> tty_buf.free_calls; alloc_time = tty_buf.alloc_time - old_ttybp -> tty_buf.alloc_time; free_time = tty_buf.free_time - old_ttybp -> tty_buf.free_time; alloc_failures = tty_buf.alloc_failures - old_ttybp -> tty_buf.alloc_failures; ttyb_loop_locks = tty_buf.space_lock_wait_count - old_ttybp -> tty_buf.space_lock_wait_count; ttyb_loop_lock_time = tty_buf.space_lock_wait_time - old_ttybp -> tty_buf.space_lock_wait_time; call ioa_ ("^/^27tallocate^44tfree^61ttotal"); call ioa_ ("Number of calls^26t^a^43t^a^60t^a", meter_format_$picture (alloc_calls, 11), meter_format_$picture (free_calls, 11), meter_format_$picture (alloc_calls + free_calls, 11)); call ioa_ ("Average time per call (msec.)^31t^a^48t^a^65t^a", meter_format_$quotient ((alloc_time), 1000 * alloc_calls, "^4.1f"), meter_format_$quotient ((free_time), 1000 * free_calls, "^4.1f"), meter_format_$quotient (alloc_time + free_time, 1000 * (alloc_calls + free_calls), "^4.1f")); call ioa_ ("% of total CPU^31t^4.1f^48t^4.1f^65t^4.1f", 1e2 * float (alloc_time) / float (cpu_time), 1e2 * float (free_time) / float (cpu_time), 1e2 * float (alloc_time + free_time) / float (cpu_time)); call ioa_ ("Calls requiring loop on tty_buf lock^41t^a^52t(^a% of total)", meter_format_$picture (ttyb_loop_locks, 10), meter_format_$quotient (100 * ttyb_loop_locks, alloc_calls + free_calls, "^.2f")); call ioa_ ("average time spent looping on lock^41t^a msec.^52t(^.2f% of total CPU)", meter_format_$quotient (divide (ttyb_loop_lock_time, 1000, 35, 0), (ttyb_loop_locks), "^.2f"), 1e2 * float (ttyb_loop_lock_time) / float (cpu_time)); call ioa_ ("Number of allocation failures^41t^a^52t(^a% of attempts)", meter_format_$picture (alloc_failures, 10), meter_format_$quotient (100 * alloc_failures, (alloc_calls), "^.2f")); tty_lock_calls = tty_buf.tty_lock_calls - old_ttybp -> tty_buf.tty_lock_calls; tty_lock_waits = tty_buf.found_channel_locked - old_ttybp -> tty_buf.found_channel_locked; queued_ints = tty_buf.n_queued_interrupts - old_ttybp -> tty_buf.n_queued_interrupts; found_lock_locked = tty_lock_waits + queued_ints; call ioa_ ("^2/CHANNEL LOCK CONTENTION^2/Number of calls to tty_lock^45t^a", meter_format_$picture (tty_lock_calls, 11)); if tty_lock_calls > 0 then do; call ioa_ ("Times channel lock found locked^45t^a (^d% of attempts)", meter_format_$picture (found_lock_locked, 11), divide (100 * found_lock_locked, tty_lock_calls, 17, 0)); call ioa_ ("Average time spent waiting for lock^45t^a msec.", meter_format_$quotient (tty_buf.total_wait_time - old_ttybp -> tty_buf.total_wait_time, 1000 * tty_lock_waits, "^.2f")); call ioa_ ("Maximum time spent waiting for lock^45t^.2f msec.", 1e-3 * float (tty_buf.max_wait_time)); end; if net_input_ints + net_output_ints + net_control_ints > 0 then call ioa_ ("Interrupts queued because channel locked^45t^a (^.1f% of interrupts)", meter_format_$picture (queued_ints, 11), 1e2 * float (queued_ints) / float (net_input_ints + net_output_ints + net_control_ints)); echoed_by_r0 = tty_buf.echo_neg_r0_chars - old_ttybp -> tty_buf.echo_neg_r0_chars; echoed_by_fnp = tty_buf.echo_neg_mux_chars - old_ttybp -> tty_buf.echo_neg_mux_chars; call ioa_ ("^2/ECHO NEGOTIATION^2/Average time of transaction^40t^a msec.", meter_format_$quotient (tty_buf.echo_neg_time - old_ttybp -> tty_buf.echo_neg_time, 1000 * (tty_buf.echo_neg_interrupts - old_ttybp -> tty_buf.echo_neg_interrupts), "^.1f")); if in_before_conv > 0 then do; call ioa_ ("Chars. echoed by supervisor^37t^a (^5.2f% of input chars)", meter_format_$picture (echoed_by_r0, 11), 1e2 * float (echoed_by_r0) / float (in_before_conv)); call ioa_ ("Chars. echoed by FNPs^37t^a (^5.2f% of input chars)", meter_format_$picture (echoed_by_fnp, 11), 1e2 * float (echoed_by_fnp) / float (in_before_conv)); end; in_restarts = tty_buf.input_restart - old_ttybp -> tty_buf.input_restart; out_restarts = tty_buf.output_restart - old_ttybp -> tty_buf.output_restart; out_overflows = tty_buf.output_buffer_overflow - old_ttybp -> tty_buf.output_buffer_overflow; call ioa_ ("^2/ABNORMAL EVENTS^2/Input restarts^30t^a (^a% of read calls)", meter_format_$picture (in_restarts, 10), meter_format_$quotient (100 * in_restarts, (net_read_calls), "^.2f")); call ioa_ ("Output restarts^30t^a (^a% of write calls)", meter_format_$picture (out_restarts, 10), meter_format_$quotient (100 * out_restarts, (net_write_calls), "^.2f")); call ioa_ ("Output space overflows^30t^a (^a% of write calls)", meter_format_$picture (out_overflows, 10), meter_format_$quotient (100 * out_overflows, (net_write_calls), "^.2f")); call ioa_ ("""needs_space"" calls^30t^a", meter_format_$picture (tty_buf.space_needed_calls - old_ttybp -> tty_buf.space_needed_calls, 10)); call ioa_ (""); /* put out an extra blank line at end */ end; /* of reporting output */ if reset then do; call metering_util_$reset (mu_index, code); /* this does most of the work */ if code ^= 0 then call com_err_ (code, CMD_NAME, "From metering_util_$reset"); else do; /* copy all the hard-to-calculate stuff */ old_in_interrupts = in_interrupts; old_in_interrupt_time = in_interrupt_time; old_out_interrupts = out_interrupts; old_out_interrupt_time = out_interrupt_time; old_control_interrupts = control_interrupts; old_control_interrupt_time = control_interrupt_time; old_read_calls = read_calls; old_read_time = read_time; old_write_calls = write_calls; old_write_time = write_time; old_in_bytes = in_bytes; old_out_bytes = out_bytes; old_in_messages = in_messages; old_out_messages = out_messages; end; end; /* of resetting code */ return; /* done! */ %include tty_buf; %include lct; %include wtcb; %include tcb; %include multiplexer_types; end system_comm_meters;  tty_analyze.pl1 10/25/89 1156.0r w 10/25/89 1000.0 187407 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1988 * * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ /* format: style4,delnl,insnl,^ifthendo */ /* Procedure to analyze contents of tty_buf which has been extracted from a dump */ /* Revised Oct. 1978 by Robert Coren for multiplexed channels */ /* Revised Feb. 1980 by Robert Coren to start with any level-1 multiplexer and to use copy_erf_seg_ instead of the extract command */ /* Modified: 19 December 1981 by G. Palter to add formatting control arguments */ /* Modified: 7 Sept 1984 by C Spitzer. correct format for call to dump_segment_ */ /* Modified September 1984 by Robert Coren to use include file for delay queue entries */ /* Modified: October 1984 by Greg Texada for new calling sequence for copy_erf_seg_ */ /* Modified December 1984 by Robert Coren to report line_status_disabled flag */ /****^ HISTORY COMMENTS: 1) change(88-06-24,Parisek), approve(88-06-24,MCR7928), audit(88-07-08,Beattie), install(88-07-19,MR12.2-1061): Added support of the UNCP multiplexer. UNCP_MPX treated like MCS_MPX. END HISTORY COMMENTS */ tty_analyze: procedure options (variable, separate_static); dcl ttybuf_size fixed bin (19) unsigned; dcl used_pattern bit (18) aligned int static options (constant) init ("111000111000111000"b); dcl (i, buf, devx) fixed bin; dcl flagarray char (200) varying; dcl tty_areap ptr; dcl chanx fixed bin; dcl copy_pcb_ap ptr; dcl chan_name char (32); dcl analyze_entry_name char (32); dcl erfno char (32); dcl code fixed bin (35); dcl longsw bit (1); dcl q_count fixed bin; dcl q_last fixed bin; dcl q_off fixed bin; dcl q_ptr ptr; dcl block_orig fixed bin; dcl input_cnt fixed bin; dcl output_cnt fixed bin; dcl 1 ds_format aligned, /* dump_segment_ control word */ 2 (address, offset, short, bcd, ascii, long, ebcdic9, ebcdic8, four_bit, hex8, hex9) bit (1) unaligned, 2 mbz bit (25) unaligned; dcl q_entry_overlay (size (fnp_queue_entry)) bit (36) aligned based; dcl 1 used_block aligned based, 2 used_marker bit (18) unal, /* filled in with used_pattern after checking */ 2 next fixed bin (18) unsigned unal; /* offset of next unused place */ dcl argp pointer; dcl arg char (argl) based (argp); dcl argl fixed bin (21); dcl n_arguments fixed binary; dcl DCW_LIST_SIZE fixed bin int static options (constant) init (16); dcl prog_name char (11) int static options (constant) init ("tty_analyze"); dcl temp_segs (3) ptr int static; dcl have_segs bit (1) int static init ("0"b); dcl (addr, addrel, bin, fixed, hbound, index, length, mod, null, pointer, ptr, rel, rtrim, size, string, substr) builtin; dcl ( error_table_$badopt, error_table_$too_many_args ) fixed binary (35) external; dcl ioa_ entry () options (variable); dcl ( com_err_, com_err_$suppress_name ) entry () options (variable); dcl cu_$arg_ptr entry (fixed bin, ptr, fixed bin (21), fixed bin (35)); dcl cu_$arg_count entry (fixed bin, fixed bin (35)); dcl cv_entry_ entry (char (*), ptr, fixed bin (35)) returns (entry); dcl analyze_entry entry (ptr, ptr, fixed bin, entry, bit (1)) variable; dcl get_temp_segments_ entry (char (*), (*) pointer, fixed bin (35)); dcl copy_erf_seg_$name entry (char (*), char (*), pointer, fixed bin (19) unsigned, fixed bin (35)); dcl match_star_name_ entry (char (*), char (*), fixed bin (35)); dcl tty_dump$print_chain entry (pointer, character (*), fixed binary, bit (1)); dcl tty_dump$set_static_for_analyze entry (fixed binary (19) unsigned, 1 aligned like ds_format); /* */ call cu_$arg_count (n_arguments, code); if code ^= 0 then do; call com_err_ (code, prog_name); return; end; if n_arguments = 0 then do; USAGE: call com_err_$suppress_name (0, prog_name, "Usage: ^a erf_number {-control_args}", prog_name); return; end; erfno = "-1"; /* no ERF yet */ longsw = "0"b; string (ds_format) = ""b; /* defaults to no interpretation */ do i = 1 to n_arguments; call cu_$arg_ptr (i, argp, argl, code); if code ^= 0 then do; call com_err_ (code, prog_name, "Fetching argument #^d.", i); return; end; if arg = "-long" | arg = "-lg" then longsw = "1"b; else if arg = "-brief" | arg = "-bf" then longsw = "0"b; else if arg = "-character" | arg = "-ch" | arg = "-ascii" then do; longsw, ds_format.ascii = "1"b; /* implies -long */ ds_format.ebcdic8, ds_format.ebcdic9 = "0"b; end; else if arg = "-ebcdic8" then do; longsw, ds_format.ebcdic8 = "1"b; ds_format.ascii, ds_format.ebcdic9 = "0"b; end; else if arg = "-ebcdic9" then do; longsw, ds_format.ebcdic9 = "1"b; ds_format.ascii, ds_format.ebcdic8 = "0"b; end; else if arg = "-octal" then do; longsw = "1"b; /* implies -long */ ds_format.hex8, ds_format.hex9 = "0"b; end; else if arg = "-hex8" then do; longsw, ds_format.hex8 = "1"b; ds_format.hex9 = "0"b; end; else if arg = "-hex9" then do; longsw, ds_format.hex9 = "1"b; ds_format.hex8 = "0"b; end; else if index (arg, "-") = 1 then do; call com_err_ (error_table_$badopt, prog_name, """^a""", arg); return; end; else do; /* must be the ERF number */ if erfno ^= "-1" then do; call com_err_ (error_table_$too_many_args, prog_name, "Only one ERF number may be supplied. ^a", arg); return; end; erfno = arg; end; end; if erfno = "-1" /* a dump must be supplied */ then go to USAGE; if ds_format.ascii | ds_format.ebcdic8 | ds_format.ebcdic9 then ds_format.long = "0"b; /* if interpreting only four words per line */ else ds_format.long = "1"b; /* otherwise, eight will fit */ if ^have_segs then do; call get_temp_segments_ (prog_name, temp_segs, code); if code ^= 0 then do; call com_err_ (code, prog_name, "Getting temporary segments."); return; end; have_segs = "1"b; end; ttybp = temp_segs (1); infop = temp_segs (2); tty_areap = temp_segs (3); call copy_erf_seg_$name (erfno, "tty_buf", ttybp, ttybuf_size, code); if code ^= 0 then go to bad_copy; call copy_erf_seg_$name (erfno, "dn355_data", infop, (0), code); if code ^= 0 then go to bad_copy; call copy_erf_seg_$name (erfno, "tty_area", tty_areap, (0), code); if code ^= 0 then do; bad_copy: call com_err_ (code, prog_name, "Could not copy data from ERF ^a", erfno); return; end; call tty_dump$set_static_for_analyze (ttybuf_size, ds_format); call ioa_ ("Begin analysis of ERF ^a", erfno); call ioa_ ("^/^/Header Values:^/^-bleft ^d, free ^o", bleft, fixed (free, 18)); /* Find all physical FNP channels; for each one, analyze it and all its subchannels */ lctp = ptr (ttybp, rel (tty_buf.lct_ptr)); lcntp = ptr (tty_areap, rel (lct.lcnt_ptr)); do i = 1 to lct.max_no_lctes; lctep = addr (lcte_array (i)); if lcte.entry_in_use then if lcte.major_channel_devx = 0 then call walk_channel_tree (i, lcnt.names (i)); /* track down all the subchannels */ end; do i = 1 to lct.max_no_lctes; /* track down all unmarked LCTEs */ lctep = addr (lcte_array (i)); if substr (lcte.lock, 1, 18) ^= used_pattern then do; if lcte.entry_in_use /* this shouldn't have happened */ then call ioa_ ("^/LCTE at ^o marked in use, but has not been processed^/", bin (rel (lctep))); call check_used (lctep, size (lcte)); /* mark it now in any case */ end; end; call check_used (lctp, bin (rel (addr (lct.lcte_array (1)))) - bin (rel (lctp))); /* mark lct header */ call ioa_ ("^3/Begin free chain trace"); buf = fixed (free, 18); /* get free pointer */ if buf = 0 then if bleft ^= 0 then do; /* error */ call ioa_ ("^2/FREE = 0 BUT BLEFT ^= 0"); go to check_unstrung_buffers; /* can't check free chain obviously */ end; if buf = 0 then go to check_unstrung_buffers; /* nothing more to check */ do while (buf ^= 0); free_blockp = addrel (ttybp, buf); /* make pointer to next buffer */ call ioa_ ("^o (^o words)", buf, free_block.size); buf = bin (free_block.next); /* get addr of next buffer */ call check_used (free_blockp, free_block.size); /* check if buffer used - set it used */ if buf ^= 0 then if buf < fixed (borig, 18) then do; /* bad buffer addr */ bad_free_chain: call ioa_ ("^2/BAD BUFFER ADDR IN FREE CHAIN ^o -> ^o^2/", fixed (rel (blockp), 18), buf); go to check_unstrung_buffers; end; if buf > ttybuf_size then go to bad_free_chain; /* out of bounds addr - stop free chain search */ bleft = bleft - free_block.size; /* decrement count of free buffers */ end; if bleft ^= 0 then /* bleft is screwed up */ call ioa_ ("^2/BLEFT NOT EXHAUSTED (= ^o) AT END OF FREE CHAIN TRACE^2/", bleft); check_unstrung_buffers: call ioa_ ("^/Begin unthreaded space check"); /* see if any buffers not marked with used patern */ blockp = ptr (ttybp, borig); /* get ptr to first buffer */ do while (bin (rel (blockp)) < ttybuf_size); if blockp -> used_block.used_marker ^= used_pattern then do; block_orig = bin (rel (blockp)); do while (blockp -> used_block.used_marker ^= used_pattern & bin (rel (blockp)) < ttybuf_size); blockp = addrel (blockp, 2); end; call ioa_ ("^o (^o words)", block_orig, bin (rel (blockp)) - block_orig); end; else blockp = ptr (ttybp, blockp -> used_block.next); end; return; /* */ walk_channel_tree: proc (a_devx, a_chan_name); /* internal procedure (called recursively) to find all subchannels of a * given channel, print each one's LCT entry, and call the special-purpose entry to * print its data bases */ dcl a_devx fixed bin; dcl a_chan_name char (*); dcl chan_name char (32); dcl star_name char (32); dcl local_lctep ptr; /* copy of lctep for this procedure */ dcl i fixed bin; dcl code fixed bin (35); devx = a_devx; chan_name = a_chan_name; lctep, local_lctep = addr (lct.lcte_array (devx)); if lcte.entry_in_use & lcte.initialized then do; /* only if there's anything to look at */ if lcte.queue_head then call print_channel_queue; if lcte.channel_type = TTY_MPX then call analyze_wtcb (devx); /* this is the end of the chain */ else if lcte.channel_type = MCS_MPX | lcte.channel_type = UNCP_MPX then do; if lcte.channel_type = UNCP_MPX then call ioa_ ("^/multiplexer type: ^a", mpx_types (lcte.channel_type)); call analyze_fnp; end; else do; call ioa_ ("^/multiplexer type: ^a", mpx_types (lcte.channel_type)); call mpx_analyze_entry; star_name = rtrim (chan_name) || ".*"; /* now hunt for subnames */ do i = 1 to lct.max_no_lctes; call match_star_name_ (lcnt.names (i), star_name, code); if code = 0 /* this is one */ then if lct.lcte_array (i).entry_in_use then do; call ioa_ ("^/Subchannel: ^a, devx ^o", lcnt.names (i), i); call walk_channel_tree (i, lcnt.names (i)); end; end; end; end; call check_used (local_lctep, size (lcte)); return; end walk_channel_tree; /* */ analyze_fnp: proc; dcl subchan_lctep ptr; fnpp = ptr (infop, rel (lcte.data_base_ptr)); if fnp_info.no_of_channels > 0 then do; n_pcbs = fnp_info.no_of_channels; copy_pcb_ap = ptr (ttybp, rel (fnp_info.pcb_array_ptr)); do chanx = 1 to n_pcbs; pcbp = addr (copy_pcb_ap -> pcb_array (chanx)); devx = pcb.devx; chan_name = lcnt.names (devx); subchan_lctep = addr (lct.lcte_array (devx)); call ioa_ ("^2/Physical channel ^a, ^d baud, devx ^o, pcb ^o, lcte ^o, line type ^a", chan_name, pcb.baud_rate, devx, bin (rel (pcbp)), bin (rel (subchan_lctep)), line_types (pcb.line_type)); call ioa_ ( "flags: ^[listen ^;^]^[dialed ^;^]^[send_output ^;^]^[high_speed ^;^]^[sync_line ^;^]^[end_frame ^;^]^[hndlquit ^;^]^[output_mbx_pending ^;^]^[copied_meters_ready ^;^]^[get_meters_waiting ^;^]^[tandd_attached ^;^]" , pcb.listen, pcb.dialed, pcb.send_output, pcb.high_speed, pcb.sync_line, pcb.end_frame, pcb.hndlquit, pcb.output_mbx_pending, pcb.copied_meters_ready, pcb.get_meters_waiting, pcb.tandd_attached); input_cnt = subchan_lctep -> lcte.input_words; output_cnt = subchan_lctep -> lcte.output_words; if pcb.write_first >= bin (borig, 18) then do; /* trace write chain */ call ioa_ ("Write chain trace"); call buffer_trace ((pcb.write_first), "WRITE_FIRST"); /* trace write chain */ end; call walk_channel_tree (devx, chan_name); /* do its subchannels now */ if output_cnt ^= 0 then /* output count is goofed up */ call ioa_ ("^2/OUTPUT COUNT RESIDUAL (^d) DOESN'T AGREE WITH BUFFER CHAIN TRACE^2/", output_cnt); if input_cnt ^= 0 then /* input count is goofed up */ call ioa_ ("^2/INPUT COUNT RESIDUAL (^d) DOESN'T AGREE WITH BUFFER CHAIN TRACE^2/", input_cnt); call check_used (pcbp, size (pcb)); end; call check_used (ptr (ttybp, rel (fnp_info.dcw_list_array_ptr)), 8 * DCW_LIST_SIZE); /* mark the DCW list area */ end; if fnp_info.running then do; if fnp_info.cur_ptr ^= 0 /* if there's a delay queue */ then do; q_count = fnp_info.count; q_off = fnp_info.cur_ptr; q_last = fnp_info.last_ptr; call ioa_ ("^3/Delay queue for FNP ^a", fnp_info.fnp_tag); do while (q_off ^= 0); q_ptr = ptr (ttybp, q_off); call ioa_ ("^o", q_off); if longsw then call ioa_ ("^(^8(^w ^)^/^)", q_ptr -> q_entry_overlay); call check_used (q_ptr, size (fnp_queue_entry)); q_off = q_ptr -> fnp_queue_entry.next; q_count = q_count - 1; end; if bin (rel (q_ptr), 18) ^= q_last then call ioa_ ("last_ptr (^o) does not point to last queue block (^o)", q_last, bin (rel (q_ptr), 18)); if q_count ^= 0 then call ioa_ ("^d queue entries unaccounted for", q_count); end; end; return; end analyze_fnp; /* */ analyze_wtcb: proc (a_devx); /* subroutine to interpret the contents of a wtcb */ dcl a_devx fixed bin; if bin (rel (lcte.data_base_ptr), 18) < bin (borig, 18) then return; wtcbp = ptr (ttybp, rel (lcte.data_base_ptr)); flagarray = ""; /* make a string listing all flags that are on */ if wtcb.flags.listen then flagarray = flagarray || "listen,"; if wtcb.flags.dialed then flagarray = flagarray || "dialed,"; if wtcb.flags.send_output then flagarray = flagarray || "send_output,"; if wtcb.flags.qenable then flagarray = flagarray || "qenable,"; if wtcb.flags.qflag then flagarray = flagarray || "qflag,"; if wtcb.flags.end_frame then flagarray = flagarray || "end_frame,"; if wtcb.flags.notify_reqd then flagarray = flagarray || "notify_reqd,"; if wtcb.flags.work_reqd then flagarray = flagarray || "work_reqd,"; if wtcb.flags.dialing then flagarray = flagarray || "dialing,"; if wtcb.flags.dial_status_valid then flagarray = flagarray || "dial_status,"; if wtcb.flags.line_status_present then flagarray = flagarray || "line_status,"; if wtcb.flags.wru then flagarray = flagarray || "wru,"; if wtcb.flags.hndlquit then flagarray = flagarray || "hndlquit,"; if wtcb.flags.count_lines then flagarray = flagarray || "count_lines,"; if wtcb.flags.sync_line then flagarray = flagarray || "sync_line,"; if wtcb.flags.breakall then flagarray = flagarray || "breakall,"; if wtcb.flags.scroll then flagarray = flagarray || "scroll,"; if wtcb.flags.negotiating_echo then flagarray = flagarray || "negotiating_echo,"; if wtcb.flags.wake_tbl then flagarray = flagarray || "wake_tbl,"; if wtcb.flags.allow_wakeup then flagarray = flagarray || "allow_wakeup,"; if wtcb.flags.receive_mode_device then flagarray = flagarray || "receive_mode_device,"; if length (flagarray) > 0 then substr (flagarray, length (flagarray), 1) = " "; call ioa_ ("wtcb at ^o^/flags: ^a", bin (rel (wtcbp)), flagarray); call ioa_ ("more_flags: ^[line_status_disabled^;^]", wtcb.line_status_disabled); if wtcb.wflag then call ioa_ ("blocked for output"); if wtcb.rflag then call ioa_ ("blocked for input"); if wtcb.fblock ^= 0 then do; call ioa_ ("Read chain trace"); call buffer_trace ((wtcb.fblock), "FBLOCK"); /* go trace read chain */ end; if wtcb.write_first ^= 0 then do; call ioa_ ("Write chain trace"); call buffer_trace ((wtcb.write_first), "WRITE_FIRST"); end; if wtcb.echdp ^= "0"b then call check_used (ptr (ttybp, wtcb.echdp), size (echo_data)); if wtcb.waketp ^= "0"b then call check_used (ptr (ttybp, wtcb.waketp), size (wakeup_table)); call check_used (wtcbp, size (wtcb)); return; end analyze_wtcb; /* */ mpx_analyze_entry: proc; /* procedure to find and call entry for analyzing a particular channel type */ analyze_entry_name = rtrim (mpx_types (lcte.channel_type)) || "_analyze_"; analyze_entry = cv_entry_ (analyze_entry_name, null (), code); if code ^= 0 then call com_err_ (code, "tty_analyze", "Cannot get pointer to ^a", analyze_entry_name); else call analyze_entry (ttybp, tty_areap, devx, check_used, longsw); return; end mpx_analyze_entry; print_channel_queue: proc; dcl next_queue bit (18); dcl queue_ptr ptr; dcl interrupt fixed bin; dcl 1 channel_q aligned based (queue_ptr), 2 next bit (18) unal, 2 pad bit (18) unal, 2 int_type fixed bin, 2 data (2) fixed bin; dcl interrupt_name (12) char (16) int static options (constant) init ("DIALUP", "HANGUP", "CRASH", "SEND_OUTPUT", "INPUT_AVAILABLE", "ACCEPT_INPUT", "INPUT_REJECTED", "QUIT", "LINE_STATUS", "DIAL_STATUS", "WRU_TIMEOUT", "SPACE_AVAILABLE"); call ioa_ ("^/channel queue:"); next_queue = lcte.queue_head; do while (next_queue ^= "0"b); queue_ptr = ptr (ttybp, next_queue); interrupt = channel_q.int_type; call ioa_ ("^-^6o^3x^[^a^s^;^s^d^]^13o^13o", bin (next_queue), (interrupt > 0 & interrupt <= hbound (interrupt_name, 1)), interrupt_name (interrupt), interrupt, channel_q.data); next_queue = channel_q.next; call check_used (queue_ptr, size (channel_q)); end; if rel (queue_ptr) ^= lcte.queue_tail then call ioa_ ("End of queue (^o) differs from lcte.queue_tail (^o)", bin (rel (queue_ptr)), bin (lcte.queue_tail)); return; end print_channel_queue; /* */ buffer_trace: proc (buf_offset, name); /* Subroutine to trace a buffer chain. */ dcl buf_offset fixed bin; dcl name char (*); dcl buf_size fixed bin; call tty_dump$print_chain (ttybp, name, buf_offset, ^longsw); do while (buf_offset ^= 0); if buf_offset < bin (tty_buf.borig, 18) then do; call ioa_ ("^2/^a (^o^) < borig^2/", name, buf_offset); return; end; if buf_offset > ttybuf_size then do; call ioa_ ("^2/^a (^o) > tty_buf size", name, buf_offset); return; end; blockp = pointer (ttybp, buf_offset); buf_size = 16 * (bin (buffer.size_code, 3) + 1); if name = "FBLOCK" then input_cnt = input_cnt - buf_size; else output_cnt = output_cnt - buf_size; buf_offset = buffer.next; call check_used (blockp, buf_size); end; return; end buffer_trace; /* Subroutine to see if buffer has used pattern in it - if not mark it used */ check_used: proc (buffp, nwords); dcl buffp pointer; dcl nwords fixed bin; if buffp -> used_block.used_marker = used_pattern then /* opps - already marked used */ call ioa_ ("^2/BUFFER ^o ALREADY USED BY SOMEONE ELSE", fixed (rel (buffp), 18)); buffp -> used_block.used_marker = used_pattern; /* mark buffer used */ buffp -> used_block.next = bin (rel (buffp)) + nwords + mod (nwords, 2); return; end check_used; /* */ %include tty_buf; %include dn355_data; %include dn355_mailbox; %include tty_buffer_block; %include pcb; %include fnp_queue_entry; %include lct; %include wtcb; %include line_types; %include multiplexer_types; %include mailbox_ops; %include mcs_echo_neg_sys; %include set_wakeup_table_info; end tty_analyze;  tty_dump.pl1 10/25/89 1156.0r w 10/25/89 1000.0 258210 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1984 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ /* format: style4,delnl,insnl,^ifthendo */ /* To dump info about a communications channel */ /* Modified: December 1984 by Robert Coren to report line_status_disabled flag */ /* Modified: October 1984 by Greg Texada to use new calling sequence to copy_erf_seg_ */ /* Modified: 7 Sept 1984 by C Spitzer. correct format for call to dump_segment_ */ /* Modified: 16 August 1983 by Robert Coren to print a message if the channel is not up, and not to fault if the database pointer is 0. */ /* Modified: 5 January 1982 by G. Palter to allow the channel name to be a starname */ /* Modified: 29 December 1981 by G. Palter to use dump_segment_, accept format control arguments (-ascii, -ebcdic9), and add an entrypoint for tty_analyze to set static needed to allow multiplexer analyzers call print_chain */ /* Modified: November 1981 by E. N. Kittlitz for user_table_entry conversion */ /* Modified: 12 November 1980 by G. Palter to support can_type */ /* Modified January 1980 by C. Hornig for MCM tracing */ /* modified 10/20/78 by Robert Coren to work on dumps as well as live systems */ /* largely rewritten 10/16/78 by Robert S. Coren for new formats associated with demultiplexing */ /* modified 3/10/78 by Robert S. Coren for variable-size buffers */ /* modified 5/3/77 by J. Stern to introduce WTCBs and TCBs */ /****^ HISTORY COMMENTS: 1) change(86-04-23,Coren), approve(86-04-23,MCR7300), audit(86-05-19,Beattie), install(86-07-08,MR12.0-1089): To know about 256-bit echo break tables. 2) change(87-04-26,GDixon), approve(87-07-13,MCR7741), audit(87-07-24,Hartogs), install(87-08-04,MR12.1-1055): Upgraded for change to answer_table.incl.pl1 and user_table_entry.incl.pl1 3) change(87-07-24,GDixon), approve(87-07-24,MCR7741), audit(87-07-24,Hartogs), install(87-08-04,MR12.1-1055): A) Correct several stringsize conditions. 4) change(88-06-24,Parisek), approve(88-06-24,MCR7928), audit(88-07-08,Beattie), install(88-07-19,MR12.2-1061): Added support of the UNCP multiplexer. UNCP_MPX treated like MCS_MPX. END HISTORY COMMENTS */ %page; tty_dump: td: procedure options (separate_static, variable); dcl name char (32); dcl (i, tablex, idx, devx, childs_devx, subchan) fixed bin; dcl code fixed bin (35); dcl last_erf char (32) int static init ("-1"); dcl have_segs bit aligned static init ("0"b); dcl temp_segs (3) pointer static init ((3) null ()); dcl ttyb_len fixed bin (19) unsigned int static init (0); dcl n_args fixed bin; dcl iarg fixed bin; dcl argp ptr; dcl argl fixed bin; dcl arg char (argl) based (argp); dcl erfno char (32); dcl areap ptr; dcl found bit (1); dcl (brief_sw, all_sw, subchan_sw, saved_subchan_sw, lcte_sw) bit (1); dcl person char (24); dcl project char (12); dcl group_id char (32); dcl short_message char (8) aligned; dcl long_message char (100) aligned; dcl print_entry entry (ptr, ptr, ptr, fixed bin, bit (1)) variable; dcl system_area area based (get_system_free_area_ ()); dcl 1 ds_format aligned internal static, /* dump_segment_ control word */ 2 (address, offset, short, bcd, ascii, long, ebcdic9, ebcdic8, four_bit, hex8, hex9) bit (1) unaligned; dcl 1 flags (lct.max_no_lctes) aligned based (flags_ptr), 2 printed_lcte bit (1) unaligned, 2 printed_subchan bit (1) unaligned, 2 printed_major bit (1) unaligned, 2 pad bit (35) unaligned; dcl flags_ptr pointer; dcl prog_name char (8) int static options (constant) init ("tty_dump"); dcl ( error_table_$badopt, error_table_$inconsistent, error_table_$noarg, error_table_$nomatch, error_table_$too_many_args ) external fixed binary (35); dcl iox_$user_output pointer external; dcl (addr, bin, codeptr, fixed, hbound, index, lbound, length, null, pointer, ptr, rel, rtrim, string, substr, unspec) builtin; dcl cu_$arg_count entry (fixed bin, fixed bin (35)); dcl cu_$arg_ptr entry (fixed bin, ptr, fixed bin, fixed bin (35)); dcl cv_entry_ entry (char (*), ptr, fixed bin (35)) returns (entry); dcl copy_erf_seg_$name entry (char (*), char (*), ptr, fixed bin (19) uns, fixed bin (35)); dcl dump_segment_ entry (ptr, ptr, fixed bin, fixed bin (18), fixed bin (18), bit (*)); dcl get_system_free_area_ entry () returns (pointer); dcl get_temp_segments_ entry (char (*), (*) ptr, fixed bin (35)); dcl release_temp_segments_ entry (char (*), (*) ptr, fixed bin (35)); dcl hcs_$initiate entry (char (*), char (*), char (*), fixed bin, fixed bin, ptr, fixed bin (35)); dcl hcs_$terminate_noname entry (pointer, fixed binary (35)); dcl ( com_err_, com_err_$suppress_name, ioa_ ) entry () options (variable); dcl get_userid_ entry (bit (36) aligned, char (*), char (*), fixed bin, fixed bin, fixed bin (35)); dcl check_star_name_$entry entry (char (*), fixed bin (35)); dcl match_star_name_ entry (char (*), char (*), fixed bin (35)); dcl convert_status_code_ entry (fixed bin (35), char (8) aligned, char (100) aligned); dcl cleanup condition; /* */ call cu_$arg_count (n_args, code); if code ^= 0 then do; /* doesn't work as an active function */ call com_err_ (code, prog_name); return; end; if n_args < 1 then do; /* should be at least 1 arg */ call com_err_$suppress_name (0, prog_name, "Usage: ^a channel_name {-control_args}", prog_name); return; end; brief_sw, all_sw, subchan_sw, lcte_sw = "0"b; string (ds_format) = ""b; /* default is -octal */ erfno = "-1"; name, group_id = ""; /* so we can tell after if arguments were supplied */ do iarg = 1 to n_args; call cu_$arg_ptr (iarg, argp, argl, code); if code ^= 0 then do; CANT_GET_ARGUMENT: call com_err_ (code, prog_name, "Fetching argument #^d", iarg); return; end; if arg = "-dump" | arg = "-erf" then do; /* wants to look at a dump */ if erfno ^= "-1" then do; /* but already said so */ call com_err_ (error_table_$too_many_args, prog_name, "More than one ERF number given. ^a and ^a", erfno, arg); return; end; iarg = iarg + 1; /* next arg should be ERF number */ if iarg > n_args then do; call com_err_ (error_table_$noarg, prog_name, "ERF number after ""^a"".", arg); return; end; call cu_$arg_ptr (iarg, argp, argl, code); if code ^= 0 then go to CANT_GET_ARGUMENT; erfno = arg; end; else if arg = "-user" then do; if group_id ^= "" then do; call com_err_ (error_table_$too_many_args, prog_name, "More than one use of ""-user"". ""^a"" and ""^a""", group_id, arg); return; end; iarg = iarg + 1; if iarg > n_args then do; call com_err_ (error_table_$noarg, prog_name, "User name after ""^a"".", arg); return; end; call cu_$arg_ptr (iarg, argp, argl, code); if code ^= 0 then go to CANT_GET_ARGUMENT; group_id = arg; if index (group_id, ".") = 0 then group_id = rtrim (group_id) || ".*"; call check_star_name_$entry (group_id, code); if (code ^= 0) & (code ^= 1) & (code ^= 2) then do; /* invalid starname */ call com_err_ (code, prog_name, "^a", arg); return; end; end; else if arg = "-bf" | arg = "-brief" then brief_sw = "1"b; else if arg = "-long" | arg = "-lg" then brief_sw = "0"b; else if arg = "-all" | arg = "-a" then all_sw = "1"b; else if arg = "-subchan" | arg = "-sbc" | arg = "-sc" then subchan_sw = "1"b; else if arg = "-lcte" then lcte_sw = "1"b; else if arg = "-character" | arg = "-ch" | arg = "-ascii" then do; ds_format.ascii = "1"b; /* implies -long */ brief_sw, ds_format.ebcdic8, ds_format.ebcdic9 = "0"b; end; else if arg = "-ebcdic8" then do; ds_format.ebcdic8 = "1"b; brief_sw, ds_format.ascii, ds_format.ebcdic9 = "0"b; end; else if arg = "-ebcdic9" then do; ds_format.ebcdic9 = "1"b; brief_sw, ds_format.ascii, ds_format.ebcdic8 = "0"b; end; else if arg = "-octal" /* implies -long */ then brief_sw, ds_format.hex8, ds_format.hex9 = "0"b; else if arg = "-hex8" then do; ds_format.hex8 = "1"b; brief_sw, ds_format.hex9 = "0"b; end; else if arg = "-hex9" then do; ds_format.hex9 = "1"b; brief_sw, ds_format.hex8 = "0"b; end; else if index (arg, "-") = 1 then do; call com_err_ (error_table_$badopt, prog_name, "^a", arg); return; end; else if name ^= "" /* already specified name */ then do; call com_err_ (error_table_$too_many_args, prog_name, "More than one channel name given. ""^a"" and ""^a""", name, arg); return; end; else do; /* not control argument, must be channel name */ name = arg; call check_star_name_$entry (name, code); if (code ^= 0) & (code ^= 1) & (code ^= 2) then do; /* illegal starname */ call com_err_ (code, prog_name, "^a", arg); return; end; end; end; if (group_id = "") & (name = "") then do; /* never specified channel name at all */ call com_err_ (error_table_$noarg, prog_name, "No channel name suppplied."); return; end; if group_id ^= "" then do; if name ^= "" then do; call com_err_ (error_table_$inconsistent, prog_name, "Channel name (""^a"") and ""-user ^a"".", name, group_id); return; end; if erfno ^= "-1" then do; call com_err_ (error_table_$inconsistent, prog_name, """-user"" and ""-erf"""); return; end; end; if ds_format.ascii | ds_format.ebcdic8 | ds_format.ebcdic9 then ds_format.long = "0"b; /* if interpreting only four words per line */ else ds_format.long = "1"b; /* otherwise, eight will fit */ flags_ptr, ansp, cdtp = null (); /* for cleanup handler */ on condition (cleanup) begin; if flags_ptr ^= null () then free flags in (system_area); if ansp ^= null () then call hcs_$terminate_noname (ansp, (0)); if cdtp ^= null () then call hcs_$terminate_noname (cdtp, (0)); end; if ^have_segs then do; /* get some temp segs */ call get_temp_segments_ (prog_name, temp_segs, code); if code ^= 0 then do; call com_err_ (code, prog_name, "Getting temporary segments."); return; end; have_segs = "1"b; end; ttybp = temp_segs (1); areap = temp_segs (2); infop = temp_segs (3); if erfno = "-1" | last_erf ^= erfno then do; /* copy data if necessary */ call copy_erf_seg_$name (erfno, "tty_area", areap, (0), code); if code ^= 0 then goto bad_copy; call copy_erf_seg_$name (erfno, "tty_buf", ttybp, ttyb_len, code); if code ^= 0 then goto bad_copy; call copy_erf_seg_$name (erfno, "dn355_data", infop, (0), code); if code ^= 0 then do; bad_copy: call com_err_ (code, prog_name, "Unable to copy information."); return; end; last_erf = erfno; end; lctp = ptr (ttybp, rel (tty_buf.lct_ptr)); lcntp = ptr (areap, rel (lct.lcnt_ptr)); allocate flags in (system_area) set (flags_ptr); unspec (flags) = ""b; /* Search the logical channel name table for matching channels */ if name ^= "" then do; found = "0"b; do tablex = 1 to lct.max_no_lctes; call match_star_name_ (lcnt.names (tablex), name, code); if code = 0 then if lct.lcte_array (tablex).entry_in_use then do; found = "1"b; devx = tablex; saved_subchan_sw = subchan_sw; call print_info; subchan_sw = saved_subchan_sw; end; end; if ^found then call com_err_ (error_table_$nomatch, prog_name, "^a in the LCT", name); end; if group_id ^= "" then do; call hcs_$initiate (">system_control_dir", "cdt", "", 0, 0, cdtp, code); if cdtp = null () then do; call com_err_ (code, prog_name, "Unable to initiate CDT."); goto RETURN_FROM_TTY_DUMP; end; call hcs_$initiate (">system_control_dir", "answer_table", "", 0, 0, ansp, code); if ansp = null () then do; call com_err_ (code, prog_name, "Unable to initiate answer table.."); goto RETURN_FROM_TTY_DUMP; end; do tablex = 1 to cdt.current_size; cdtep = addr (cdt.cdt_entry (tablex)); if cdte.state = TTY_DIALED then do; if cdte.process ^= null () then do; utep = pointer (ansp, rel (cdte.process)); person = ute.person; project = ute.project; end; else do; call get_userid_ (cdte.dialed_to_procid, person, project, 0, 0, code); if code ^= 0 then person, project = ""; end; call match_star_name_ (rtrim (person) || "." || rtrim (project), group_id, code); if code = 0 then do; devx = cdte.twx; saved_subchan_sw = subchan_sw; call print_info; subchan_sw = saved_subchan_sw; end; end; end; end; RETURN_FROM_TTY_DUMP: if flags_ptr ^= null () then free flags in (system_area); if ansp ^= null () then call hcs_$terminate_noname (ansp, (0)); if cdtp ^= null () then call hcs_$terminate_noname (cdtp, (0)); if erfno = "-1" then do; /* nothing useful in them now */ have_segs = "0"b; call release_temp_segments_ (prog_name, temp_segs, code); end; return; /* */ /* Print all information for a channel */ print_info: procedure (); lctep = addr (lct.lcte_array (devx)); subchan = -1; /* if starting chan is multiplexed, print all subchans */ do while (devx ^= 0); if ^subchan_sw then do; if lcte_sw then call print_lcte; call find_entry_type; end; childs_devx = devx; subchan = lcte.subchannel; devx = lcte.major_channel_devx; /* go up one level */ if devx ^= 0 then lctep = addr (lct.lcte_array (devx)); /* get new LCTE pointer */ if ^all_sw & ^subchan_sw then devx = 0; subchan_sw = "0"b; end; return; end print_info; /* */ /* Finds the appropriate procedure to print data about a channel and invokes it */ find_entry_type: procedure (); dcl print_entry_name char (32); /* name of the procedure that prints contents of a data base */ if lcte.channel_type < lbound (mpx_types, 1) | lcte.channel_type > hbound (mpx_types, 1) then do; call com_err_ (0, prog_name, "Invalid channel type for channel ^a (devx = ^d). ^d", lcnt.names (devx), devx, lcte.channel_type); go to RETURN_FROM_TTY_DUMP; end; if (subchan = -1) & flags (devx).printed_major /* do not make the same call more than once */ then return; if (subchan ^= -1) then if flags (childs_devx).printed_subchan then return; if lcte.data_base_ptr = null | rel (lcte.data_base_ptr) = "0"b then do; call ioa_ ("No data base for ^a .", lcnt.names (devx)); return; end; if lcte.channel_type = 0 then call print_wtcb; else if lcte.channel_type = MCS_MPX | lcte.channel_type = UNCP_MPX then call print_pcb; else do; print_entry_name = rtrim (mpx_types (lcte.channel_type)) || "_dump_"; print_entry = cv_entry_ (print_entry_name, codeptr (tty_dump), code); if code ^= 0 then call com_err_ (code, prog_name, "Cannot get pointer to ^a", print_entry_name); else call print_entry (ttybp, areap, ptr (ttybp, rel (lcte.data_base_ptr)), subchan, brief_sw); end; if subchan = -1 then flags (devx).printed_major = "1"b; else flags (childs_devx).printed_subchan = "1"b; return; end find_entry_type; /* */ /* Prints contents of an LCTE */ print_lcte: procedure (); if flags (devx).printed_lcte /* only once per call, please */ then return; call ioa_ ("^/LCTE at ^o, channel ^a, devx ^o", bin (rel (lctep)), lcnt.names (devx), devx); call ioa_ ( "channel type: ^a (^d)^/flags: ^[in_use ^]^[initialized ^]^[notify_reqd ^]^[locked_for_interrupt ^]^[space_needed ^]^[special_lock ^]^/physical channel devx ^o, major channel devx ^o, subchannel ^o" , mpx_types (lcte.channel_type), lcte.channel_type, lcte.entry_in_use, lcte.initialized, lcte.notify_reqd, lcte.locked_for_interrupt, lcte.space_needed, lcte.special_lock, lcte.physical_channel_devx, lcte.major_channel_devx, lcte.subchannel); call ioa_ ("^[queue_head ^o, queue_tail ^o^/^;^2s^]input_words ^d, output_words ^d", lcte.queue_head ^= ""b, bin (lcte.queue_head), bin (lcte.queue_tail), lcte.input_words, lcte.output_words); if lcte.data_base_ptr = null then call ioa_ ("No data base allocated."); else call ioa_ ("data base at ^o", bin (rel (lcte.data_base_ptr))); flags (devx).printed_lcte = "1"b; return; end print_lcte; /* */ /* Displays the contents of the WTCB */ print_wtcb: procedure (); dcl two_words (2) fixed bin (35) based; dcl break_table_words (WORDS_IN_ECHO_BREAK_TABLE) bit (36) aligned based; dcl mode char (256); dcl flag_array char (128) varying; dcl mode_bits bit (36) aligned; dcl tablep ptr; dcl 1 table_arrays aligned based (tablep), 2 table (6) fixed bin (17) unal, 2 default_table (6) fixed bin (17) unal; dcl table_names (6) char (18) int static options (constant) init ("input_translation", "output_translation", "input_conversion", "output_conversion", "special", "delay"); wtcbp = ptr (ttybp, rel (lcte.data_base_ptr)); call ioa_ ("^/WTCB at ^o, channel ^a, devx ^o^/line type = ^a, baud rate = ^d", bin (rel (wtcbp)), lcnt.names (devx), devx, line_types (wtcb.line_type), wtcb.baud_rate); flag_array = ""; /* init flag string */ if wtcb.flags.listen then flag_array = flag_array || "listen,"; if wtcb.flags.dialed then flag_array = flag_array || "dialed,"; if wtcb.flags.send_output then flag_array = flag_array || "send_output,"; if wtcb.flags.qenable then flag_array = flag_array || "qenable,"; if wtcb.flags.qflag then flag_array = flag_array || "qflag,"; if wtcb.flags.end_frame then flag_array = flag_array || "end_frame,"; if wtcb.flags.notify_reqd then flag_array = flag_array || "notify_reqd,"; if wtcb.flags.work_reqd then flag_array = flag_array || "work_reqd,"; if wtcb.flags.dialing then flag_array = flag_array || "dialing,"; if wtcb.flags.dial_status_valid then flag_array = flag_array || "dial_status,"; if wtcb.flags.line_status_present then flag_array = flag_array || "line_status,"; if wtcb.flags.input_available then flag_array = flag_array || "input_available,"; if wtcb.flags.tcb_initialized then flag_array = flag_array || "tcb_initialized,"; if wtcb.flags.hndlquit then flag_array = flag_array || "hndlquit,"; if wtcb.flags.count_lines then flag_array = flag_array || "count_lines,"; if wtcb.flags.sync_line then flag_array = flag_array || "sync_line,"; if wtcb.flags.breakall then flag_array = flag_array || "breakall,"; if wtcb.flags.negotiating_echo then flag_array = flag_array || "negotiating_echo,"; if wtcb.flags.wake_tbl then flag_array = flag_array || "wake_tbl,"; if wtcb.flags.allow_wakeup then flag_array = flag_array || "allow_wakeup,"; if wtcb.flags.receive_mode_device then flag_array = flag_array || "receive_mode_device,"; if wtcb.flags.mark_set then flag_array = flag_array || "mark_set,"; if wtcb.flags.masked then flag_array = flag_array || "masked,"; if length (flag_array) ^= 0 then substr (flag_array, length (flag_array), 1) = " "; /* zap last comma */ call ioa_ ("flags: ^a", flag_array); call ioa_ ("more_flags: ^[line_status_disabled^;^]", wtcb.line_status_disabled); if wtcb.uproc ^= ""b then do; call get_userid_ ((wtcb.uproc), person, project, 0, 0, code); if code = 0 then call ioa_ ("User name = ^a.^a", person, project); end; call ioa_ ("hevent = ^w ^w, event = ^w ^w", addr (wtcb.hevent) -> two_words, addr (wtcb.event) -> two_words); if wtcb.wflag then call ioa_ ("process blocked on output"); if wtcb.rflag then call ioa_ ("process blocked on input"); if wtcb.wru then call ioa_ ("reading answerback"); call ioa_ ( "^[dial_status_code = ^o^/^;^s^]fblock = ^o, lblock = ^o, fchar = ^o^/at line ^d, column ^d, white_col = ^d^/^d read-ahead messages^/write_first = ^o, write_last = ^o^/maximum buffer size = ^d, buffer pad = ^d" , wtcb.dial_status_valid, wtcb.dial_status_code, wtcb.fblock, wtcb.lblock, wtcb.fchar, wtcb.actline, wtcb.actcol, wtcb.white_col, wtcb.nramsgs, wtcb.write_first, wtcb.write_last, wtcb.max_buf_size, wtcb.buffer_pad); if wtcb.error_code ^= 0 then do; call convert_status_code_ (wtcb.error_code, short_message, long_message); call ioa_ ("error code = ^w (^a)", wtcb.error_code, long_message); end; call ioa_ ("^[echo negotiation data at ^o^/^;^s^]^[wakeup table at ^o^/^;^s^]^[prompt string: ^va^;^]", (wtcb.echdp ^= "0"b), wtcb.echdp, (wtcb.waketp ^= "0"b), wtcb.waketp, (wtcb.prompt_len > 0), wtcb.prompt_len, substr (wtcb.prompt, 1, wtcb.prompt_len)); call ioa_ ("line delimiter = ""^a""", wtcb.line_delimiter); if wtcb.devx ^= devx then call ioa_ ("wtcb.devx = ^o (differs from index in LCT)", wtcb.devx); if ^wtcb.flags.tcb_initialized /* if a control block */ then return; tcbp = ptr (areap, rel (wtcb.tcb_ptr)); call ioa_ ("^/TCB at ^o", bin (rel (tcbp))); call ioa_ ("terminal type = ^a, old type = ^d", tcb.terminal_type, tcb.old_type); mode = ""; /* init mode string */ idx = 1; mode_bits = string (tcb.modes); do i = 1 to n_modes; /* get all the mode bits */ if substr (mode_bits, i, 1) then do; substr (mode, idx) = modestr (i); idx = index (mode, " ") + 1; /* replace first blank with comma */ substr (mode, idx - 1, 1) = ","; end; end; if (tcb.can_type < lbound (CAN_TYPE_NAMES, 1)) | (tcb.can_type > hbound (CAN_TYPE_NAMES, 1)) then substr (mode, idx) = "can_type=unknown"; else substr (mode, idx) = CAN_TYPE_NAMES (tcb.can_type); call ioa_ ("modes: ^a", mode); call ioa_ ( "flags: ^[breakall_enabled ^;^]^[dont_count_next ^;^]^[keyboard_locking ^;^]^[no_printer_off ^;^]^[break_char_pending ^;^]^[uproc_attached ^;^]^[block_acknowledge ^;^]" , tcb.breakall_enabled, tcb.dont_count_next, tcb.keyboard_locking, tcb.no_printer_off, tcb.break_char_pending, tcb.uproc_attached, tcb.block_acknowledge); call ioa_ ( "shift state = ^b (^[none^;lower^;upper^;unknown^]) ll = ^d, pl = ^d^/answerback id = ^a^/erase ^a, kill ^a, frame_begin ^a, frame_end ^a^/input message size ^d characters" , tcb.actshift, bin (tcb.actshift) + 1, tcb.colmax, tcb.linemax, tcb.id, tcb.erase, tcb.kill, tcb.frame_begin, tcb.frame_end, tcb.input_msg_size); if tcb.input_suspend_seq.count > 0 then call ioa_ ("input_suspend: ^a", substr (tcb.input_suspend_seq.chars, 1, tcb.input_suspend_seq.count)); if tcb.input_resume_seq.count > 0 then call ioa_ ("input_resume: ^a", substr (tcb.input_resume_seq.chars, 1, tcb.input_resume_seq.count)); if tcb.output_suspend_etb_seq.count > 0 then call ioa_ ("output_^[end_of_block^;suspend^]: ^a", tcb.block_acknowledge, substr (tcb.output_suspend_etb_seq.chars, 1, tcb.output_suspend_etb_seq.count)); if tcb.output_resume_ack_seq.count > 0 then call ioa_ ("output_^[acknowledge^;resume^]: ^a", tcb.block_acknowledge, substr (tcb.output_resume_ack_seq.chars, 1, tcb.output_resume_ack_seq.count)); if tcb.max_output_block ^= 0 then call ioa_ ("maximum output block size = ^d characters", tcb.max_output_block); tablep = addr (tcb.tables); do i = 1 to 6; call ioa_ ("^a ^o ^[default ^o;^s^]", table_names (i), table_arrays.table (i), table_arrays.default_table (i)); end; if wtcb.echdp ^= "000000"b3 then do; echo_datap = ptr (wtcbp, wtcb.echdp); call ioa_ ("^/Echo Negotiation Data at ^o:^/", bin (rel (echo_datap))); call ioa_ ("Line length left = ^d, ^d chars r0 echoed.", echo_data.horiz_room_left, echo_data.chars_echoed) ; call ioa_ ("Flags:^[ synchronized^]^[ mux_will_echnego^]^[ esps^] ^[ start_wait^]^[ stop_wait^]", echo_data.synchronized, echo_data.mux_will_echnego, echo_data.echo_start_pending_sndopt, echo_data.awaiting_start_sync, echo_data.awaiting_stop_sync); call ioa_ ("Mux sync ctr = ^d dec, ^o octal.", echo_data.sync_ctr, echo_data.sync_ctr); call ioa_ ("Break table^( ^w^)^/", addr (echo_data.break) -> break_table_words); end; call ptchain ("read", (wtcb.fblock)); /* print read chain */ call ptchain ("WTCB write", (wtcb.write_first)); return; end print_wtcb; /* */ /* Displays the contents of a PCB */ print_pcb: procedure (); dcl dn355_no fixed bin; dcl line_no bit (12); dn355_no = index ("abcdefgh", substr (lcnt.names (devx), 1, 1)); fnpp = addr (datanet_info.per_datanet (dn355_no)); n_pcbs = fnp_info.no_of_channels; if subchan < 0 then do; call ioa_ ("FNP ^a: ^d subchannels.", fnp_info.fnp_tag, n_pcbs); end; else do; pcbp = addr (ptr (ttybp, rel (fnp_info.pcb_array_ptr)) -> pcb_array (subchan)); line_no = "00"b || string (pcb.line_number); call ioa_ ( "^/PCB at ^o, channel ^a, devx ^o^/line number ^4.3b, logical subchannel ^o^/write_first ^o, write_last ^o, write_cnt ^d^/baud rate ^d, line type ^a, max_buf_size ^d" , bin (rel (pcbp)), lcnt.names (pcb.devx), pcb.devx, line_no, pcb.subchan, pcb.write_first, pcb.write_last, pcb.write_cnt, pcb.baud_rate, line_types (pcb.line_type), pcb.max_buf_size); call ioa_ ( "flags: ^[listen ^;^]^[dialed ^;^]^[send_output ^;^]^[high_speed ^;^]^[sync_line ^;^]^[end_frame ^;^]^[hndlquit ^;^]^[breakall_enabled ^;^]^[output_mbx_pending ^;^]^[copied_meters_ready ^;^]^[get_meters_waiting ^;^]^[tandd_attached ^;^]" , pcb.listen, pcb.dialed, pcb.send_output, pcb.high_speed, pcb.sync_line, pcb.end_frame, pcb.hndlquit, pcb.breakall_enabled, pcb.output_mbx_pending, pcb.copied_meters_ready, pcb.get_meters_waiting, pcb.tandd_attached); call ptchain ("PCB write", (pcb.write_first)); end; return; end print_pcb; /* */ /* Prints a buffer chain optionally calling dump_segment_ to display the contents */ ptchain: proc (chname, chst); dcl or fixed bin (18), chst fixed bin, chname char (*); dcl bsize fixed bin (18); or = fixed (chst, 18); if or = 0 /* if no chain */ then return; call ioa_ ("^a", chname); /* print header */ do while (or ^= 0); /* loop through chain */ if or < bin (tty_buf.borig, 18) | or > ttyb_len then do; call ioa_ ("bad block offset: ^6o", or); return; end; blockp = ptr (ttybp, or); bsize = (bin (buffer.size_code, 3) + 1) * 16; call ioa_ ("^6o size = ^d, tally = ^d, flags:^[ eop^]^[ conv^]^[ break^]", or, bsize, bin (buffer.tally, 9), buffer.end_of_page, buffer.converted, buffer.break); if ^brief_sw then call dump_segment_ (iox_$user_output, blockp, 0, or, bsize, string (ds_format)); or = buffer.next; end; return; end ptchain; /* Special entry called by multiplexer dump routines to print a buffer chain */ print_chain: entry (pm_ttybp, pm_chname, pm_chst, pm_brief_sw); dcl pm_ttybp ptr; dcl pm_chname char (*); dcl pm_chst fixed bin; dcl pm_brief_sw bit (1); ttybp = pm_ttybp; brief_sw = pm_brief_sw; call ptchain (pm_chname, pm_chst); return; /* Called by tty_analyze to allow multiplexer analyzer entries to call print_chain properly */ set_static_for_analyze: entry (pm_tty_buf_len, pm_ds_format); dcl pm_tty_buf_len fixed binary (19) unsigned parameter; dcl 1 pm_ds_format aligned parameter like ds_format; ttyb_len = pm_tty_buf_len; ds_format = pm_ds_format; return; %include answer_table; %include author_dcl; %include cdt; %include dialup_values; %include dn355_data; %include lct; %include line_types; %include mcs_echo_neg_sys; %include multiplexer_types; %include pcb; %include tcb; %include tty_buf; %include tty_buffer_block; %include tty_can_types; %include tty_mode_names; %include user_attributes; %include user_table_entry; %include user_table_header; %include wtcb; end tty_dump;  tty_meters_.pl1 11/15/82 1813.1rew 11/15/82 1449.2 93726 /* *********************************************************** * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ /* format: style4,delnl,insnl,^ifthendo */ tty_meters_: procedure; /* This procedure contains entries to allocate and free metering structures, and display meters, for tty-type (non-multiplexed) channels. Only the _mpx entries are needed; a tty channel can never be a parent. */ /* Written February 1981 by Robert Coren */ return; /* main entry should never be called */ /* PARAMETERS */ dcl a_area_ptr pointer; /* pointer to area in which to perform allocations */ dcl a_tty_meterp pointer; /* pointer to structure to be allocated/freed (OUTPUT for alloc, INPUT for free */ dcl a_chan_name char (*); /* name of channel for display_mpx entry */ dcl a_iocbp pointer; /* pointer to IOCB for display_mpx */ dcl a_chan_meterp pointer; /* pointer to channel_meters structure, for display_mpx */ dcl a_flags bit (36) aligned; /* indicates what options were specified */ dcl a_since_boot bit (1); /* indicates -since_bootload specified (summary entry) */ dcl a_summary_ptr pointer; /* pointer to structure used by summary entry */ dcl a_code fixed bin (35); /* status code (OUTPUT) */ /* AUTOMATIC */ dcl areap pointer; dcl code fixed bin (35); dcl chan_name char (32); dcl iocbp pointer; dcl flags bit (36) aligned; dcl brief bit (1); dcl since_boot bit (1); dcl total_in_before_conv fixed bin (35); dcl total_in_after_conv fixed bin (35); dcl total_out_before_conv fixed bin (35); dcl total_out_after_conv fixed bin (35); dcl total_read_calls fixed bin (35); dcl total_write_calls fixed bin (35); dcl total_control_calls fixed bin (35); dcl total_read_time fixed bin (71); dcl total_write_time fixed bin (71); dcl total_control_time fixed bin (71); dcl total_ints fixed bin (35); dcl total_int_time fixed bin (71); dcl in_before_conv fixed bin (35); dcl in_after_conv fixed bin (35); dcl out_before_conv fixed bin (35); dcl out_after_conv fixed bin (35); dcl read_calls fixed bin (35); dcl write_calls fixed bin (35); dcl control_calls fixed bin (35); dcl read_time fixed bin (71); dcl write_time fixed bin (71); dcl control_time fixed bin (71); dcl interrupts fixed bin (35); dcl int_time fixed bin (71); dcl start_time fixed bin (71); dcl elapsed_time fixed bin (71); /* BASED */ dcl m_area area (256) based (areap); /* ENTRIES */ dcl ioa_$ioa_switch entry options (variable); dcl system_info_$timeup entry (fixed bin (71)); dcl meter_format_$picture entry (fixed bin (35), fixed bin) returns (char (15) varying); dcl meter_format_$quotient entry (fixed bin (71), fixed bin (71), char (*)) returns (char (12) varying); /* EXTERNAL STATIC */ dcl error_table_$noalloc fixed bin (35) external static; dcl iox_$user_output pointer external static; /* CONDITIONS */ dcl area condition; allocate_mpx: entry (a_area_ptr, a_tty_meterp, a_code); /* entry to allocate a tty_channel_meters structure */ areap = a_area_ptr; a_code = 0; on area begin; a_code = error_table_$noalloc; go to exit; end; allocate tty_channel_meters in (m_area) set (a_tty_meterp); a_tty_meterp -> tty_channel_meters.version = TTY_CHANNEL_METERS_VERSION_1; exit: return; free_mpx: entry (a_tty_meterp, a_code); /* entry to free the tty_meters structure */ tty_meterp = a_tty_meterp; free tty_channel_meters; a_code = 0; return; display_mpx: entry (a_chan_name, a_iocbp, a_chan_meterp, a_flags, a_code); chan_name = a_chan_name; iocbp = a_iocbp; if iocbp = null () then iocbp = iox_$user_output; chan_meterp = a_chan_meterp; flags = a_flags; a_code = 0; tty_meterp = channel_meters.mpx_specific_meterp; if flags & DISPLAY_MPX_SUMMARY /* this routine doesn't do anything for summary */ then return; if flags & DISPLAY_MPX_ERROR /* this routine doesn't display any error conditions */ then return; brief = flags & DISPLAY_MPX_BRIEF; total_in_before_conv = channel_meters.cumulative.unconverted_input_chars; total_in_after_conv = tty_channel_meters.current_meters.read_chars; total_out_before_conv = tty_channel_meters.current_meters.write_chars; total_out_after_conv = channel_meters.cumulative.converted_output_chars; total_read_calls = tty_channel_meters.current_meters.read_calls; total_write_calls = tty_channel_meters.current_meters.write_calls; total_control_calls = channel_meters.cumulative.control_calls; total_read_time = tty_channel_meters.current_meters.read_time; total_write_time = tty_channel_meters.current_meters.write_time; total_control_time = channel_meters.cumulative.control_call_time; total_ints = channel_meters.cumulative.software_interrupts; total_int_time = channel_meters.cumulative.interrupt_time; if flags & DISPLAY_MPX_SINCE_BOOT then do; /* totals are the numbers we want */ in_before_conv = total_in_before_conv; in_after_conv = total_in_after_conv; out_before_conv = total_out_before_conv; out_after_conv = total_out_after_conv; read_calls = total_read_calls; write_calls = total_write_calls; control_calls = total_control_calls; read_time = total_read_time; write_time = total_write_time; control_time = total_control_time; interrupts = total_ints; int_time = total_int_time; call system_info_$timeup (start_time); end; else do; in_before_conv = total_in_before_conv - channel_meters.saved.unconverted_input_chars; in_after_conv = total_in_after_conv - tty_channel_meters.saved_meters.read_chars; out_before_conv = total_out_before_conv - tty_channel_meters.saved_meters.write_chars; out_after_conv = total_out_after_conv - channel_meters.saved.converted_output_chars; read_calls = total_read_calls - tty_channel_meters.saved_meters.read_calls; write_calls = total_write_calls - tty_channel_meters.saved_meters.write_calls; control_calls = total_control_calls - channel_meters.saved.control_calls; read_time = total_read_time - tty_channel_meters.saved_meters.read_time; write_time = total_write_time - tty_channel_meters.saved_meters.write_time; control_time = total_control_time - channel_meters.saved.control_call_time; interrupts = total_ints - channel_meters.saved.software_interrupts; int_time = total_int_time - channel_meters.saved.interrupt_time; start_time = tty_channel_meters.last_dialed_time; end; elapsed_time = clock () - start_time; call ioa_$ioa_switch (iocbp, "^25tbefore conversion^45tafter conversion^64tratio"); call ioa_$ioa_switch (iocbp, "Total characters input^25t^a^45t^a^65t^a", meter_format_$picture (in_before_conv, 9), meter_format_$picture (in_after_conv, 9), meter_format_$quotient ((in_after_conv), (in_before_conv), "^.2f")); call ioa_$ioa_switch (iocbp, "Total characters output^25t^a^45t^a^65t^a", meter_format_$picture (out_before_conv, 9), meter_format_$picture (out_after_conv, 9), meter_format_$quotient ((out_after_conv), (out_before_conv), "^.2f")); call ioa_$ioa_switch (iocbp, "Average length of input^29t^a^49t^a", meter_format_$quotient ((in_before_conv), (read_calls), "^5.1f"), meter_format_$quotient ((in_after_conv), (read_calls), "^5.1f")); call ioa_$ioa_switch (iocbp, "Average length of output^29t^a^49t^a", meter_format_$quotient ((out_before_conv), (write_calls), "^5.1f"), meter_format_$quotient ((out_after_conv), (write_calls), "^5.1f")); if ^brief then do; call ioa_$ioa_switch (iocbp, "^/^34tread^45twrite^56tcontrol^64ttotal"); call ioa_$ioa_switch (iocbp, "Number of calls^34t^a^45t^a^56t^a^65t^a", meter_format_$picture (read_calls, 5), meter_format_$picture (write_calls, 5), meter_format_$picture (control_calls, 5), meter_format_$picture (read_calls + write_calls + control_calls, 5)); call ioa_$ioa_switch (iocbp, "Average time per call (msec.)^35t^a^46t^a^57t^a^66t^a", meter_format_$quotient (read_time, 1000 * read_calls, "^4.1f"), meter_format_$quotient (write_time, 1000 * write_calls, "^4.1f"), meter_format_$quotient (control_time, 1000 * control_calls, "^4.1f"), meter_format_$quotient (read_time + write_time + control_time, 1000 * (read_calls + write_calls + control_calls), "^4.1f")); call ioa_$ioa_switch (iocbp, "Average chars. processed per call^34t^a^45t^a", meter_format_$quotient ((in_before_conv), (read_calls), "^5.1f"), meter_format_$quotient ((out_before_conv), (write_calls), "^5.1f")); call ioa_$ioa_switch (iocbp, "Number of software interrupts^34t^a", meter_format_$picture (interrupts, 9)); call ioa_$ioa_switch (iocbp, "Average time per interrupt (msec.)^35t^a^/", meter_format_$quotient (int_time, 1000 * interrupts, "^4.1f")); end; call ioa_$ioa_switch (iocbp, "^/^34tinput^45toutput"); call ioa_$ioa_switch (iocbp, "Effective speed (cps)^34t^a^45t^a", meter_format_$quotient (1000000 * in_before_conv, elapsed_time, "^7.1f"), meter_format_$quotient (1000000 * out_before_conv, elapsed_time, "^7.1f")); return; mpx_summary: entry (a_chan_meterp, a_since_boot, a_summary_ptr, a_code); /* entry to fill in structure used by channel_comm_meters -summary */ a_code = 0; /* no errors are possible */ summary_ptr = a_summary_ptr; chan_meterp = a_chan_meterp; since_boot = a_since_boot; tty_meterp = channel_meters.mpx_specific_meterp; channel_summary.baud_rate = tty_channel_meters.baud_rate; channel_summary.user_process = tty_channel_meters.user_process; if tty_channel_meters.last_dialed_time ^= 0 then channel_summary.time_since_dial = clock () - tty_channel_meters.last_dialed_time; channel_summary.breakall = tty_channel_meters.breakall; channel_summary.echoplex = tty_channel_meters.echoplex; return; %include tty_channel_meters; %page; %include tcb; %page; %include channel_meters; %page; %include comm_meters_disp_flags; %page; %include channel_summary; end tty_meters_;  vip7760_dump_.pl1 07/20/88 1256.8r w 07/19/88 1537.4 55215 /* *********************************************************** * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ vip7760_dump_: proc (pm_ttybp, pm_ttyap, pm_pvmdp, pm_subchan, pm_brief_sw); /* Called by tty_dump and tty_analyze to interpret a polled vip multiplexer data base */ /* Coded 1/4/79 by J. Stern */ /* Modified 5/1/79 by J. Stern to add vip7760_analyze_ entry */ /* Parameters */ dcl pm_brief_sw bit (1); /* ON for brief output format */ dcl pm_check_used_proc entry variable; /* entry called to tally tty_buf space used */ dcl pm_devx fixed bin; /* device index of multiplexer channel */ dcl pm_long_sw bit (1); /* ON for long output format */ dcl pm_pvmdp ptr; /* ptr to polled vip multiplexer data base */ dcl pm_subchan fixed bin; /* subchannel number */ dcl pm_ttyap ptr; /* ptr to tty_area segment */ dcl pm_ttybp ptr; /* ptr to tty_buf segment */ /* Automatic */ dcl brief_sw bit (1); dcl check_used_proc entry (ptr, fixed bin) variable; dcl devx fixed bin; dcl subchan fixed bin; /* Builtins */ dcl (addr, bin, ptr, rel, size, null, unspec) builtin; /* Entries */ dcl ioa_ entry options (variable); dcl tty_dump$print_chain entry (ptr, char (*), fixed bin, bit (1)); %include polled_vip_mpx_data; %include polled_vip_mpx_meters; %include pvip_subchan_meters; %include tty_buf; %include lct; %include tty_buffer_block; ttybp = pm_ttybp; pvmdp = pm_pvmdp; subchan = pm_subchan; brief_sw = pm_brief_sw; /* Print major channel data */ call ioa_ ("^/PVMD at ^o, channel ^a, devx ^o", bin (rel (pvmdp), 18), pvmd.name, pvmd.devx); call ioa_ ("nchan = ^d, nstation = ^d, station_mask = ^w", pvmd.nchan, pvmd.nstation, unspec (pvmd.station_mask)); if pvmd.cur_nstation ^= pvmd.nstation then call ioa_ ("cur_nstation = ^d, cur_station_mask = ^w", pvmd.cur_nstation, unspec (pvmd.cur_station_mask)); call ioa_ ("load_proc_id = ^.3b, load_ev_chan = ^.3b", pvmd.load_proc_id, unspec (pvmd.load_ev_chan)); call ioa_ ("pause_time = ^d, max_text_len = ^d, max_message_len = ^d, quit = ^a, formfeed = ^a", pvmd.pause_time, pvmd.max_text_len, pvmd.max_message_len, pvmd.quit, pvmd.formfeed); call ioa_ ( "flags: ^[ send_output^]^[ mpx_started^]^[ mpx_loading^]^[ mpx_loaded^]^[ polling_started^]^[ controller_poll^]^[ partial_frame^]^[ crlf_echo^]^[ omit_nl^]^[ omit_ff^]^[ gcos_break^]^[ etb_mode^]" , pvmd.send_output, pvmd.mpx_started, pvmd.mpx_loading, pvmd.mpx_loaded, pvmd.polling_started, pvmd.controller_poll, pvmd.partial_frame, pvmd.crlf_echo, pvmd.omit_nl, pvmd.omit_ff, pvmd.gcos_break, pvmd.etb_mode); if pvmd.writep ^= null then call ioa_ ("writep = ^p", pvmd.writep); if pvmd.write_chan ^= 0 then call ioa_ ("write_chan = ^d", pvmd.write_chan); if pvmd.writep ^= null then call tty_dump$print_chain (ttybp, "WRITE_CHAIN", bin (rel (pvmd.writep)), brief_sw); /* Print subchannel data */ if subchan = -1 /* means we should dump all subchans */ then do subchan = 1 to pvmd.nchan; call print_subchan; end; else call print_subchan; return; print_subchan: proc; dcl i fixed bin; pvstep = addr (pvmd.subchan_table (subchan)); call ioa_ ("^/PVSTE at ^o, channel ^a.^a, devx ^o, subchan ^o, station_addr ^o", bin (rel (pvstep), 18), pvmd.name, pvste.name, pvste.devx, subchan, pvste.station_addr); if pvste.printer then i = pvmd.station_to_subchan (pvste.station_addr).printer; else i = pvmd.station_to_subchan (pvste.station_addr).display; if i ^= subchan then call ioa_ ("ERROR: ^[printer^;display^] station ^d maps to subchan ^d", pvste.printer, pvste.station_addr, i); call ioa_ ("flags: ^[ printer^]^[ hold_output^]^[ eop^]^[ hndlquit^]^[ listen^]^[ dialed^]^[ slave^]", pvste.printer, pvste.hold_output, pvste.eop, pvste.hndlquit, pvste.listen, pvste.dialed, pvste.slave); ; if pvste.printer then call ioa_ ("baud_rate = ^d", pvste.baud_rate); if pvste.pgofs + pvste.writes ^= 0 then call ioa_ ("pgofs = ^d, writes = ^d", pvste.pgofs, pvste.writes); if pvste.naks ^= 0 then call ioa_ ("naks = ^d", pvste.naks); if pvste.write_chain ^= 0 /* there's a write chain to print */ then call tty_dump$print_chain (ttybp, "WRITE CHAIN", (pvste.write_chain), brief_sw); end; vip7760_analyze_: entry (pm_ttybp, pm_ttyap, pm_devx, pm_check_used_proc, pm_long_sw); ttybp = pm_ttybp; devx = pm_devx; check_used_proc = pm_check_used_proc; brief_sw = ^pm_long_sw; /* get ptr to polled vip multiplexer data base for specified devx */ lctp = ptr (ttybp, rel (tty_buf.lct_ptr)); lctep = addr (lct.lcte_array (devx)); pvmdp = ptr (ttybp, rel (lcte.data_base_ptr)); /* display data base contents */ call vip7760_dump_ (ttybp, pm_ttyap, pvmdp, -1, brief_sw); /* account for all tty_buf space used by multiplexer */ pvmd_nchan = pvmd.nchan; call check_used_proc (pvmdp, size (pvmd)); call trace_chain (bin (rel (pvmd.writep))); do subchan = 1 to pvmd.nchan; /* examine all subchans */ pvstep = addr (pvmd.subchan_table (subchan)); call trace_chain ((pvste.write_chain)); end; return; /* subroutine to trace a buffer chain and account for space used */ trace_chain: proc (chain_offset); dcl chain_offset fixed bin (18); dcl buf_offset fixed bin (18); buf_offset = chain_offset; do while (buf_offset ^= 0); if buf_offset < bin (tty_buf.borig, 18) then return; /* give up on bad chain */ blockp = ptr (ttybp, buf_offset); buf_offset = buffer.next; call check_used_proc (blockp, 16 * (bin (buffer.size_code, 3) + 1)); end; end; end; /* vip7760_dump_ */  vip7760_meters_.pl1 10/25/89 1156.0r w 10/25/89 1005.2 106011 /* *********************************************************** * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * *********************************************************** */ /* format: style4,delnl,insnl,^ifthendo */ vip7760_meters_: proc; /* This subroutine contains entries for allocating, freeing, and displaying meters for a polled VIP multiplexer and its subchannels. */ /* Written June 1981 by Robert Coren */ /* PARAMETERS */ dcl a_area_ptr ptr; dcl a_meterp ptr; dcl a_code fixed bin (35); dcl a_chan_name char (*); dcl a_iocbp ptr; dcl a_chan_meterp ptr; dcl a_flags bit (36) aligned; dcl a_since_boot bit (1); dcl a_summary_ptr ptr; /* AUTOMATIC */ dcl areap ptr; dcl code fixed bin (35); dcl iocbp ptr; dcl flags bit (36) aligned; dcl brief bit (1); dcl error bit (1); dcl since_boot bit (1); dcl printer bit (1); dcl parent_fnp bit (1); dcl pvip_meterp ptr; dcl current_meterp ptr; dcl saved_meterp ptr; dcl current_fnp_meterp ptr; dcl saved_fnp_meterp ptr; dcl input_naks fixed bin (35); dcl output_naks fixed bin (35); dcl timeouts fixed bin (35); dcl timeout_limit fixed bin (35); dcl inc_frame fixed bin (35); dcl input_frames_lost fixed bin (35); dcl output_frames_lost fixed bin (35); dcl bad_output_frames fixed bin (35); dcl output_timeouts fixed bin (35); dcl printer_naks fixed bin (35); dcl discarded_printer_frames fixed bin (35); dcl display_pgofs fixed bin (35); dcl pgof_limit_reached fixed bin (35); dcl total_input_naks fixed bin (35); dcl total_output_naks fixed bin (35); dcl total_timeouts fixed bin (35); dcl total_timeout_limit fixed bin (35); dcl total_inc_frame fixed bin (35); dcl total_input_frames_lost fixed bin (35); dcl total_output_frames_lost fixed bin (35); dcl total_bad_output_frames fixed bin (35); dcl total_output_timeouts fixed bin (35); dcl total_printer_naks fixed bin (35); dcl total_discarded_printer_frames fixed bin (35); dcl total_display_pgofs fixed bin (35); dcl total_pgof_limit_reached fixed bin (35); /* BASED */ dcl m_area area (100) based (areap); /* EXTERNAL STATIC */ dcl error_table_$noalloc external static fixed bin (35); dcl iox_$user_output external static ptr; /* ENTRIES */ dcl ioa_$ioa_switch entry options (variable); dcl meter_format_$picture entry (fixed bin (35), fixed bin) returns (char (15) varying); /* CONDITIONS & BUILTINS */ dcl area condition; dcl (addr, null) builtin; allocate_mpx: entry (a_area_ptr, a_meterp, a_code); areap = a_area_ptr; a_code = 0; on area begin; a_code = error_table_$noalloc; go to exit; end; allocate pvip_mpx_meter_struc in (m_area) set (a_meterp); a_meterp -> pvip_mpx_meter_struc.version = PVIP_MPX_METERS_VERSION_1; exit: return; free_subchan: entry (a_meterp, a_code); free a_meterp -> pvip_subchan_meter_struc; a_code = 0; return; allocate_subchan: entry (a_area_ptr, a_meterp, a_code); areap = a_area_ptr; a_code = 0; on area begin; a_code = error_table_$noalloc; go to exit; end; allocate pvip_subchan_meter_struc in (m_area) set (a_meterp); a_meterp -> pvip_subchan_meter_struc.version = PVIP_SUBCHAN_METERS_VERSION_1; return; free_mpx: entry (a_meterp, a_code); free a_meterp -> pvip_mpx_meter_struc; a_code = 0; return; display_mpx: entry (a_chan_name, a_iocbp, a_chan_meterp, a_flags, a_code); iocbp = a_iocbp; if iocbp = null () then iocbp = iox_$user_output; chan_meterp = a_chan_meterp; flags = a_flags; a_code = 0; if flags & DISPLAY_MPX_SUMMARY /* we don't handle this */ then return; if flags & DISPLAY_MPX_BRIEF then brief = "1"b; else brief = "0"b; if flags & DISPLAY_MPX_ERROR then error = "1"b; if flags & DISPLAY_MPX_SINCE_BOOT then since_boot = "1"b; else since_boot = "0"b; if brief then return; /* no "brief" meters from this multiplexer */ call set_mpx_values; if parent_fnp then do; call ioa_$ioa_switch (iocbp, "Invalid input messages^28t^a", meter_format_$picture (input_naks, 11)); call ioa_$ioa_switch (iocbp, "NAK for output messages^28t^a", meter_format_$picture (output_naks, 11)); if ^error then do; call ioa_$ioa_switch (iocbp, "Response timeouts^28t^a", meter_format_$picture (timeouts, 11)); call ioa_$ioa_switch (iocbp, "Incomplete frame from host^28t^a", meter_format_$picture (inc_frame, 11)); end; end; call ioa_$ioa_switch (iocbp, "No response after 3 tries^30t^a", meter_format_$picture (timeout_limit, 9)); call ioa_$ioa_switch (iocbp, "Lost input frames^30t^a", meter_format_$picture (input_frames_lost, 9)); call ioa_$ioa_switch (iocbp, "Lost output frames^30t^a", meter_format_$picture (output_frames_lost, 9)); call ioa_$ioa_switch (iocbp, "Bad output frame format^28t^a", meter_format_$picture (bad_output_frames, 7)); call ioa_$ioa_switch (iocbp, "Output frame not completed in time^28t^a", meter_format_$picture (output_timeouts, 7)); return; display_subchan: entry (a_chan_name, a_iocbp, a_chan_meterp, a_flags, a_code); iocbp = a_iocbp; if iocbp = null () then iocbp = iox_$user_output; chan_meterp = a_chan_meterp; flags = a_flags; a_code = 0; if flags & DISPLAY_MPX_SUMMARY /* we don't handle this */ then return; if flags & DISPLAY_MPX_BRIEF then brief = "1"b; else brief = "0"b; if flags & DISPLAY_MPX_ERROR then error = "1"b; if flags & DISPLAY_MPX_SINCE_BOOT then since_boot = "1"b; else since_boot = "0"b; if brief then return; /* no "brief" meters from this multiplexer */ call set_subchan_values; if printer then do; call ioa_$ioa_switch (iocbp, "NAK from printer^28t^a", meter_format_$picture (printer_naks, 11)); call ioa_$ioa_switch (iocbp, "Discarded printer frames^28t^a", meter_format_$picture (discarded_printer_frames, 11)); end; else do; if ^error then call ioa_$ioa_switch (iocbp, "Page overflows^28t^a", meter_format_$picture (display_pgofs, 11)); call ioa_$ioa_switch (iocbp, "Exceeded page overflow limit^32t^a", meter_format_$picture (pgof_limit_reached, 7)); end; return; mpx_summary: entry (a_chan_meterp, a_since_boot, a_summary_ptr, a_code); /* entry to fill in values used by channel_comm_meters -summary */ a_code = 0; chan_meterp = a_chan_meterp; summary_ptr = a_summary_ptr; since_boot = a_since_boot; call set_mpx_values; channel_summary.error_count = timeout_limit; if parent_fnp then channel_summary.error_count = channel_summary.error_count + input_naks + output_naks; return; subchan_summary: entry (a_chan_meterp, a_since_boot, a_summary_ptr, a_code); /* entry to fill in values used by channel_comm_meters -summary */ a_code = 0; chan_meterp = a_chan_meterp; summary_ptr = a_summary_ptr; since_boot = a_since_boot; call set_subchan_values; if printer then channel_summary.error_count = printer_naks; else channel_summary.error_count = 0; return; set_mpx_values: procedure; /* internal procedure to set metering values (either cumulative or since load) for multiplexer channel */ pvip_meterp = channel_meters.mpx_specific_meterp; if channel_meters.parent_type = MCS_MPX /* if parent is an FNP */ then do; /* then we know something about the next level of metering */ fnp_chan_meterp = channel_meters.parent_meterp; current_fnp_meterp = addr (fnp_chan_meter_struc.current_meters); saved_fnp_meterp = addr (fnp_chan_meter_struc.saved_meters); parent_fnp = "1"b; end; else parent_fnp = "0"b; current_meterp = addr (pvip_meterp -> pvip_mpx_meter_struc.current_meters); saved_meterp = addr (pvip_meterp -> pvip_mpx_meter_struc.saved_meters); total_timeout_limit = current_meterp -> pvip_mpx_meters.input_timeouts; total_input_frames_lost = current_meterp -> pvip_mpx_meters.input_frames_lost; total_output_frames_lost = current_meterp -> pvip_mpx_meters.output_frames_lost; total_bad_output_frames = current_meterp -> pvip_mpx_meters.bad_output_frames; total_output_timeouts = current_meterp -> pvip_mpx_meters.output_timeouts; if parent_fnp then do; total_input_naks = current_fnp_meterp -> fnp_sync_meters.counters (1); total_output_naks = current_fnp_meterp -> fnp_sync_meters.counters (2); total_timeouts = current_fnp_meterp -> fnp_sync_meters.counters (3); total_inc_frame = current_fnp_meterp -> fnp_sync_meters.counters (4); end; if since_boot then do; timeout_limit = total_timeout_limit; input_frames_lost = total_input_frames_lost; output_frames_lost = total_output_frames_lost; bad_output_frames = total_bad_output_frames; output_timeouts = total_output_timeouts; if parent_fnp then do; input_naks = total_input_naks; output_naks = total_output_naks; timeouts = total_timeouts; inc_frame = total_inc_frame; end; end; else do; timeout_limit = total_timeout_limit - saved_meterp -> pvip_mpx_meters.input_timeouts; input_frames_lost = total_input_frames_lost - saved_meterp -> pvip_mpx_meters.input_frames_lost; output_frames_lost = total_output_frames_lost - saved_meterp -> pvip_mpx_meters.output_frames_lost; bad_output_frames = total_bad_output_frames - saved_meterp -> pvip_mpx_meters.bad_output_frames; output_timeouts = total_output_timeouts - saved_meterp -> pvip_mpx_meters.output_timeouts; if parent_fnp then do; input_naks = total_input_naks - saved_fnp_meterp -> fnp_sync_meters.counters (1); output_naks = total_output_naks - saved_fnp_meterp -> fnp_sync_meters.counters (2); timeouts = total_timeouts - saved_fnp_meterp -> fnp_sync_meters.counters (3); inc_frame = total_inc_frame - saved_fnp_meterp -> fnp_sync_meters.counters (4); end; end; end set_mpx_values; set_subchan_values: procedure; /* internal procedure to set metering values (either cumulative or since dialup) for subchannel */ pvip_meterp = channel_meters.parent_meterp; current_meterp = addr (pvip_meterp -> pvip_subchan_meter_struc.current_meters); saved_meterp = addr (pvip_meterp -> pvip_subchan_meter_struc.saved_meters); printer = pvip_meterp -> pvip_subchan_meter_struc.printer; if printer then do; total_printer_naks = current_meterp -> pvip_subchan_meters.printer_naks; total_discarded_printer_frames = current_meterp -> pvip_subchan_meters.discarded_printer_frame; end; else do; total_display_pgofs = current_meterp -> pvip_subchan_meters.display_pgofs; total_pgof_limit_reached = current_meterp -> pvip_subchan_meters.pgof_limit_reached; end; if since_boot then if printer then do; printer_naks = total_printer_naks; discarded_printer_frames = total_discarded_printer_frames; end; else do; display_pgofs = total_display_pgofs; pgof_limit_reached = total_pgof_limit_reached; end; else if printer then do; printer_naks = total_printer_naks - saved_meterp -> pvip_subchan_meters.printer_naks; discarded_printer_frames = total_discarded_printer_frames - saved_meterp -> pvip_subchan_meters.discarded_printer_frame; end; else do; display_pgofs = total_display_pgofs - saved_meterp -> pvip_subchan_meters.display_pgofs; pgof_limit_reached = total_pgof_limit_reached - saved_meterp -> pvip_subchan_meters.pgof_limit_reached; end; end set_subchan_values; %include channel_meters; %page; %include multiplexer_types; %page; %include polled_vip_mpx_meters; %page; %include pvip_subchan_meters; %page; %include fnp_channel_meters; %page; %include comm_meters_disp_flags; %page; %include channel_summary; end vip7760_meters_;  x25_analyze_.pl1 10/25/89 1156.0r w 10/25/89 1003.8 21789 /* *********************************************************** * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ /* subroutine called by tty_analyze for X.25 multiplexers */ /* Written sometime-or-other by Charles Hornig */ /* Modified July 1983 by Robert Coren to make print_chain subroutine check for null chain pointer. */ /* format: style4,delnl,insnl,tree,ifthenstmt,indnoniterend */ x25_analyze_: procedure (Ttybp, Areap, Devx, Check_used, Long); dcl (Ttybp, Areap) ptr parameter; dcl Devx fixed bin parameter; dcl Check_used entry (ptr, fixed bin) parameter; dcl Long bit (1) aligned parameter; dcl x25_dump_ entry (ptr, ptr, ptr, fixed bin, bit (1) aligned); dcl i fixed bin; dcl (addr, binary, currentsize, pointer, rel) builtin; %page; x25_data_ptr = pointer (Ttybp, rel (addr (pointer (Ttybp, rel (Ttybp -> tty_buf.lct_ptr)) -> lct.lcte_array (Devx)) -> lcte.data_base_ptr) ); call x25_dump_ (Ttybp, Areap, x25_data_ptr, -1, ^Long); call trace_chain (x25_data.write_head); do i = 1 to x25_data.n_sc; call x25_dump_ (Ttybp, Areap, x25_data_ptr, i, ^Long); end; do i = 1 to x25_data.n_sc; call trace_chain (x25_data.sc (i).write_head); end; if x25_data.lc_ptr ^= null () then do; x25_data.lc_ptr = ptr (Ttybp, rel (x25_data.lc_ptr)); call Check_used (x25_data.lc_ptr, currentsize (x25_lces)); end; call Check_used (x25_data_ptr, currentsize (x25_data)); return; /* * * * * * * * * TRACE_CHAIN * * * * * * * * * * */ trace_chain: procedure (Chain); dcl Chain ptr parameter; dcl buf_offset fixed bin (18); if Chain = null () then return; buf_offset = binary (rel (Chain), 18); do while ((buf_offset ^= 0) & (buf_offset < 261120)); blockp = pointer (Ttybp, buf_offset); buf_offset = buffer.next; call Check_used (blockp, 16 * (binary (buffer.size_code, 3) + 1)); end; return; end trace_chain; %page; %include x25_data; %include tty_buf; %include lct; %include tty_buffer_block; end x25_analyze_;  x25_dump_.pl1 10/25/89 1156.0rew 10/25/89 1000.0 40464 /****^ *********************************************************** * * * Copyright, (C) BULL HN Information Systems Inc., 1989 * * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ /****^ HISTORY COMMENTS: 1) change(89-10-04,Parisek), approve(89-10-04,MCR8110), audit(89-10-09,Farley), install(89-10-25,MR12.3-1100): Added display of the "packet_trace_sw" flag for x25 devices. END HISTORY COMMENTS */ /* format: style4,delnl,insnl,ifthenstmt,indnoniterend */ /* modified by Robert Coren, July 1983, for long packet threshold */ /* Modified by R.J.C. Kissel, October 1984, for breakall_idle_timer. */ x25_dump_: procedure (Ttybp, Areap, Dp, Sc, Brief); dcl (Ttybp, Areap, Dp) ptr parameter; dcl Sc fixed bin parameter; dcl Brief bit (1) aligned parameter; dcl ioa_ entry () options (variable); dcl ioa_$nnl entry () options (variable); dcl tty_dump$print_chain entry (ptr, char (*), fixed bin, bit (1)); dcl x25_state_names (5) char (32) static options (constant) init ("p1(READY)", "p2(DTE WAITING)", "p41(FLOW CONTROL READY)", "p6(DTE CLEAR REQUEST)", "p42(DTE RESET REQUEST)"); dcl i fixed bin; dcl (addr, binary, hbound, mod, null, ptr, rel, unspec) builtin; %page; x25_data_ptr = Dp; x25_data.lc_ptr = ptr (Ttybp, rel (x25_data.lc_ptr)); if Sc > 0 then do; xscep = addr (x25_data.sc (Sc)); call ioa_ ( "X.25 SC ^d ^a devx ^o^[(^a)^;^s^]: ^[HUNGUP^;LISTENING^;DIALING^;DIALED^]^[ output_ready^]^[ eop^]^[ wru^]^[ need_ftd^]^[ long_packet^]^[ rawi^]^[ echoplex^]^[ breakall^]^[ iflow^]^[ oflow^]^[ hndlquit^]^[ polite^]^[ lfecho^]^[ 8bit^]^9(^s^)" , Sc, xsce.name, xsce.devx, (xsce.service ^= ""), xsce.service, xsce.state + 1, xsce.flags.output_ready, xsce.flags.end_of_page, xsce.flags.wru_done, xsce.flags.need_ftd, xsce.flags.long_packet_pending, xsce.mode); if xsce.lcx > 0 then do; xlcep = addr (x25_lces.lc (xsce.lcx)); call ioa_ (" LC ^d: state=^a,max_packet_size=^d,window used=^d/^d", xsce.lcx, x25_state_names (xlce.state), xlce.max_packet_size, mod (xlce.next_send_seq - xlce.next_ack_seq, x25_data.seq_mod), xlce.max_window_size); call ioa_ ( "^-^[iti ^]^[int_issued ^]^[rnr_sent ^]^[rnr_received ^]^[iti_break ^]^[baud=^d ^;^s^]^[originate ^]" , xlce.iti_call, xlce.int_issued, xlce.flags.rnr_sent, xlce.rnr_received, xlce.iti_break, (xlce.baud_rate ^= 0), xlce.baud_rate, xlce.flags.originate); call ioa_ ("^-^[ address=^a^;^s^]^[ call data=^a^;^s^]", (xlce.his_address ^= ""), xlce.his_address, (xlce.call_data ^= ""), xlce.call_data); if unspec (xlce.iti_params) ^= ""b then do; call ioa_$nnl ("^-PAR"); do i = 1 to hbound (xlce.iti_params, 1); if xlce.iti_params (i) > 0 then call ioa_$nnl (" ^d:^d", i, xlce.iti_params (i)); end; call ioa_ (""); end; if xsce.write_head ^= null () then do; call ioa_$nnl ("write chain:"); call tty_dump$print_chain (Ttybp, "", binary (rel (xsce.write_head), 18), (Brief)); end; end; end; else do; call ioa_ ( "X.25 devx ^o, ^d lc, ^d sc, ^[HUNGUP^;LISTENING^;RESTARTING^;ACTIVE^] flags: ^[started^]^[ send_output^]^[ bypass_restart^]^[ no_d^]^[ packet_tracing^]" , x25_data.devx, x25_data.n_lc, x25_data.n_sc, 1 + x25_data.state, x25_data.flags.mpx_started, x25_data.flags.send_output, x25_data.flags.bypass_restart, x25_data.flags.no_d, x25_data.flags.packet_trace_sw); call ioa_ (" packet_threshold=^d breakall_idle_timer=^d^[ address=^a^;^s^]^[ network=^a^;^s^]", x25_data.long_packet_size, x25_data.breakall_idle_timer, (x25_data.my_address ^= ""), x25_data.my_address, (x25_data.net_type ^= ""), x25_data.net_type); if x25_data.write_head ^= null () then do; call ioa_ (" write chain:"); call tty_dump$print_chain (Ttybp, "", binary (rel (x25_data.write_head), 18), (Brief)); end; end; return; %page; %include x25_data; end x25_dump_; bull_copyright_notice.txt 08/30/05 1008.4r 08/30/05 1007.3 00020025 ----------------------------------------------------------- Historical Background This edition of the Multics software materials and documentation is provided and donated to Massachusetts Institute of Technology by Group Bull including Bull HN Information Systems Inc. as a contribution to computer science knowledge. This donation is made also to give evidence of the common contributions of Massachusetts Institute of Technology, Bell Laboratories, General Electric, Honeywell Information Systems Inc., Honeywell Bull Inc., Groupe Bull and Bull HN Information Systems Inc. to the development of this operating system. Multics development was initiated by Massachusetts Institute of Technology Project MAC (1963-1970), renamed the MIT Laboratory for Computer Science and Artificial Intelligence in the mid 1970s, under the leadership of Professor Fernando Jose Corbato.Users consider that Multics provided the best software architecture for managing computer hardware properly and for executing programs. Many subsequent operating systems incorporated Multics principles. Multics was distributed in 1975 to 2000 by Group Bull in Europe , and in the U.S. by Bull HN Information Systems Inc., as successor in interest by change in name only to Honeywell Bull Inc. and Honeywell Information Systems Inc. . ----------------------------------------------------------- Permission to use, copy, modify, and distribute these programs and their documentation for any purpose and without fee is hereby granted,provided that the below copyright notice and historical background appear in all copies and that both the copyright notice and historical background and this permission notice appear in supporting documentation, and that the names of MIT, HIS, Bull or Bull HN not be used in advertising or publicity pertaining to distribution of the programs without specific prior written permission. Copyright 1972 by Massachusetts Institute of Technology and Honeywell Information Systems Inc. Copyright 2006 by Bull HN Information Systems Inc. Copyright 2006 by Bull SAS All Rights Reserved